libppm-1.2.1/0000755000175200017530000000000011616230227013157 5ustar incardonincardonlibppm-1.2.1/README0000644000175200017530000003274411616230227014051 0ustar incardonincardonPPM core package README ======================= v1.2.1, August 2011 Introduction ------------ This is the PPM core source package. Changes ------- .1.2.1 ************************************************************************ This versions brings many bug fixes and several new features .New features: - Implemented Brelaz' graph coloring algorithm in Fortran, replacing the C++ Vizing implementation. - Added support for homogeneous symmetric boundary conditions (Dirichlet, Neumann). The ghost mapping and neighbor list routines properly support boundary conditions now. (Note: The user still has to make sure the properties of boundary condition ghost particles reflect the correct boundary condition value.) - Added Unit testing support using funit (http://nasarb.rubyforge.org/funit/). - Added a control file and argument handling module to simplify the process of reading, parsing and evaluating the parameters passed to ppm clients. - Added ppm topology query routines and shortened ppm_mktopo argument list. There should be in most cases no need to call ppm_topo_get anymore. - The user can now mange cell lists himself to save unnecessary computations. - Added a tool to help PPM client developers with debugging. This tool visualizes domain decompositions and particle positions - Renamings: ppm_module_user -> ppm_module_core, ppm_module_user_util -> ppm_module_core_util .Fixes - Fixed several critical bugs in the ghost mapping routines - Fixed ppm_mesh_block_intersect - Fixed bugs in error handling and reporting - Fixed `make install` to copy all modules to `$prefix/include/ppm/` - Several minor fixes and improvements in the ppm build system. ************************************************************************ .1.2_p1 ************************************************************************ This is a bug fix release, we fixed several important bugs: - Fixed several critical bugs in mesh mapping routines - Fixed bugs in remeshing routines that prevented clients using those routines from compiling properly - Fixed a bug in the cartesian communication scheduling routine - Fixed build system to not link against GNU math library when compiling with ifort - cleaned many annoying compiler warnings ************************************************************************ .1.2 ************************************************************************ Initial release of new PPM library ************************************************************************ Package contents ---------------- The `.tar.gz` package you have downloaded should contain on the toplevel the following files and directories: ----------------------------------- 34K COPYING The License 7.5K COPYING.LESSER 4.2K Makefile.in The Makefile template used by configure 610B NOTICE 14K README This file 28K README.html The HTML version of this file 717B aclocal.m4 44K config.guess 25K config.status 33K config.sub 205K configure The build configure script 8.5K configure.ac Thie build configure script template 14K install-sh 16K m4 Contains build scripts 4.7M src Contains the source code 292K utils Contains the PPM debug utility and FUnit ---------------------------------- After you compile PPM core there will be further directories for the binaries and include files. Requirements for building PPM core ---------------------------------- - METIS 4: You may download the latest release of METIS 4 from http://glaros.dtc.umn.edu/gkhome/metis/metis/download, alternatively you can get from the PPM website the version of METIS that has been extensively tested with our code. - An MPI distribution (optional): Either get OpenMPI, mpich2 or any other MPI 2 compliant MPI library. If you are compiling PPM on a cluster, most likely your sysadmin will have already an MPI installed on the system. Make sure that all requirements are compiled with the same compiler that you will be using to build PPM core. Building PPM core ----------------- PPM core is built in 3 simple steps: Step 1: Confuring PPM core ~~~~~~~~~~~~~~~~~~~~~~~~~~ Run the `configure` script to allow the build system to determine the correct options to compile PPM core. It is very important to give `configure` the correct settings to make sure PPM core is compiled correctly. To find out which settings are supported type ~~~~~~~~~~ $ ./configure --help ~~~~~~~~~~ This is what will be returned: ~~~~~~~~~~~~~~~~~~~~~~~~~~~ `configure' configures PPM 1.2.1 to adapt to many kinds of systems. Usage: ./configure [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print `checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for `--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or `..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [/usr/local] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, `make install' will install all the files in `/usr/local/bin', `/usr/local/lib' etc. You can specify an installation prefix other than `/usr/local' using `--prefix', for instance `--prefix=$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/ppm] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-mpi[=impl.] use MPI (default is no), If the MPI implementation of your choice provides compile wrappers that are in PATH, I can set them myself, choose: guess (I will choose the first implementation I can find), openmpi, lammpi, mpich, mpich2, intelmpi_gnu (Intel's MPI with GNU Compilers), intelmpi_intel (Intel's MPI with Intel Compilers), sun (Sun MPI), ibm (IBM AIX POE). Else, set this flag with no value and set CC, CXX and FC to the appropriate compiler wrappers (safest) --enable-linux compile for linux (default is no) --enable-etime use etime (default is no) --enable-vector enable __VECTOR (default is no) --enable-mathkeisan enable __MATHKEISAN (default is no) --enable-sxf90 enable __SXF90 (default is no) --enable-crayfishpack enable __CRAYFISHPACK (default is no) --enable-hypre enable __HYPRE (default is no) --enable-no-microinstr enable __NOMICROINSTRUCTIONS (default is no) --enable-dev enable development mode (default is no) --enable-debug enable debug mode (default is no) Some influential environment variables: CXX C++ compiler command CXXFLAGS C++ compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory LIBS libraries to pass to the linker, e.g. -l CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CC C compiler command CFLAGS C compiler flags CPP C preprocessor FC Fortran compiler command FCFLAGS Fortran compiler flags Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Following options are especially important: - `--enable-mpi`: If you will be running PPM clients on a parallel environment (a cluster) using MPI, you must specify which MPI implementation you are using. If your system is properly configured then this should be enough information for PPM core build system to find the MPI libraries and compiler wrappers needed. If this goes wrong, you may ommit this option and set compiler wrapper and libraries in `FC` and `LDFLAGS` respectively. - `--enable-linux`: Set this if you're compiling/running on a Linux system - `--prefix`: If you like to install PPM and the target directory is not the system's standard directory (`/usr/`) then you have to define this directory here. You must provide the full path. It is not necessary to install PPM. Building it and leaving it in the compilation directory is sufficient. If you provide a directory here it must already exist - it will not be created by the build system. - `FC` etc.: If you wish to not use MPI or you have to specify exactly which compiler executable should be used, then you can use this flag to set your compiler. - `LDFLAGS`: If metis was not installed in one of the system's standard library directories (e.g. `/usr/lib`) you must specify the directory to the libmetis.a file here. Here two examples on how you could run the configure command `.configure` on Linux cluster using OpenMPI (and intel compilers, wrapped) ~~~~~~~~~~~~~~~~~~~~~~~~~~~ $ ./configure --enable-mpi=openmpi LDFLAGS=-L../../metis/lib --enable-linux ~~~~~~~~~~~~~~~~~~~~~~~~~~~ `./configure` on Mac OS X workstation with the MacPorts gcc compilers ~~~~~~~~~~~~~~~~~~~~~~~~~~~ $ ./configure FC=gfortran-mp-4.4 LDFLAGS=-L../../metis/gcc/lib ~~~~~~~~~~~~~~~~~~~~~~~~~~~ `./configure` on a computer with OpenMPI installed in a non-standard location ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ./configure --enable-mpi=openmpi FC=/opt/openmpi/1.5/bin/mpif90 \ LDFLAGS=-L../../metis/gcc/lib ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Step 2: Compiling PPM core ~~~~~~~~~~~~~~~~~~~~~~~~~~ If the configure process finished successfully you should see on your screen a message that the Makefile has been generated (and you can now find this Makefile in this directory). Now you can simply run make to compile PPM core: ~~~~~~~~~~~~~~~~~~~~~~~~~~~ $ make ~~~~~~~~~~~~~~~~~~~~~~~~~~~ If you encounter problems in the compilation process (compile errors) please, first check if you have set everything correctly in your environment. If the error persists, please send us a bug-report detailing the previous steps you have performed. Also, please include the `config.log` file and the output of `export`. Finally, if yu are using MPI, please include which MPI library you are using. Step 3: Installing PPM core (optional) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If you wish to install PPM core you can now use the `make install` command to do so: ~~~~~~~~~~~~~~~~~~~~~~~~~~~ $ make install ~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the target directory is part of the system, you will most probably get a message that you have insufficient rights. If you have a root account you can use in this case the sudo command to override this security setting. ~~~~~~~~~~~~~~~~~~~~~~~~~~~ $ sudo make install ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Your PPM core distribution is installed. Compiling PPM client code against PPM core ------------------------------------------ When compiling your PPM client code you need to first include the PPM core modules: - in `include/` relative to this directory. Check which compiler flag needs to be used to include Fortran module directories. and link against libppm.a: - in `lib/` relative to this directory. Add -L[path to lib] -lppm to the linking command of your compilation process. Enjoy the PPM experience! Contributors ------------ The PPM library is being maintained and developed by the CSE-lab (group of Professor Petros Koumoutsakos) and the MOSAIC group (Professor Ivo F. Sbalzarini) at ETH Zurich, and the Center for Fluid Dynamics at DTU (group of Professor Jens Walther). PPM core package maintainer: Omar Awile libppm-1.2.1/config.sub0000755000175200017530000010115311616003516015142 0ustar incardonincardon#! /bin/sh # Configuration validation subroutine script. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 # Free Software Foundation, Inc. timestamp='2008-01-16' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Please send patches to . Submit a context # diff and a properly formatted ChangeLog entry. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. # Each package is responsible for reporting which valid configurations # it does not support. The user should be able to distinguish # a failure to support a valid configuration from a meaningless # configuration. # The goal of this file is to map all the various variations of a given # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # or in some cases, the newer four-part form: # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # It is wrong to echo any other type of specification. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] CPU-MFR-OPSYS $0 [OPTION] ALIAS Canonicalize a configuration name. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.sub ($timestamp) Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" exit 1 ;; *local*) # First pass through any local machine types. echo $1 exit ;; * ) break ;; esac done case $# in 0) echo "$me: missing argument$help" >&2 exit 1;; 1) ;; *) echo "$me: too many arguments$help" >&2 exit 1;; esac # Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] then os=`echo $1 | sed 's/.*-/-/'` else os=; fi ;; esac ### Let's recognize common machines as not being operating systems so ### that things like config.sub decstation-3100 work. We also ### recognize some manufacturers as not being operating systems, so we ### can provide default operating systems below. case $os in -sun*os*) # Prevent following clause from handling this invalid input. ;; -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ -apple | -axis | -knuth | -cray) os= basic_machine=$1 ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 ;; -scout) ;; -wrs) os=-vxworks basic_machine=$1 ;; -chorusos*) os=-chorusos basic_machine=$1 ;; -chorusrdb) os=-chorusrdb basic_machine=$1 ;; -hiux*) os=-hiuxwe2 ;; -sco6) os=-sco5v6 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) os=-sco3.2v4 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5v6*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -udk*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -clix*) basic_machine=clipper-intergraph ;; -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -lynx*) os=-lynxos ;; -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; -windowsnt*) os=`echo $os | sed -e 's/windowsnt/winnt/'` ;; -psos*) os=-psos ;; -mint | -mint[0-9]*) basic_machine=m68k-atari os=-mint ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ | maxq | mb | microblaze | mcore | mep \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ | mips64vr | mips64vrel \ | mips64orion | mips64orionel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ | mt \ | msp430 \ | nios | nios2 \ | ns16k | ns32k \ | or32 \ | pdp10 | pdp11 | pj | pjl \ | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ | pyramid \ | score \ | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ | spu | strongarm \ | tahoe | thumb | tic4x | tic80 | tron \ | v850 | v850e \ | we32k \ | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ | z8k) basic_machine=$basic_machine-unknown ;; m6811 | m68hc11 | m6812 | m68hc12) # Motorola 68HC11/12. basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; ms1) basic_machine=mt-unknown ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. i*86 | x86_64) basic_machine=$basic_machine-pc ;; # Object if more than one company name word. *-*-*) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ | bfin-* | bs2000-* \ | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ | m88110-* | m88k-* | maxq-* | mcore-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ | mips64vr-* | mips64vrel-* \ | mips64orion-* | mips64orionel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ | nios-* | nios2-* \ | none-* | np1-* | ns16k-* | ns32k-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ | pyramid-* \ | romp-* | rs6000-* \ | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ | tahoe-* | thumb-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ | tron-* \ | v850-* | v850e-* | vax-* \ | we32k-* \ | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ | xstormy16-* | xtensa*-* \ | ymp-* \ | z8k-*) ;; # Recognize the basic CPU types without company name, with glob match. xtensa*) basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 386bsd) basic_machine=i386-unknown os=-bsd ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; a29khif) basic_machine=a29k-amd os=-udi ;; abacus) basic_machine=abacus-unknown ;; adobe68k) basic_machine=m68010-adobe os=-scout ;; alliant | fx80) basic_machine=fx80-alliant ;; altos | altos3068) basic_machine=m68k-altos ;; am29k) basic_machine=a29k-none os=-bsd ;; amd64) basic_machine=x86_64-pc ;; amd64-*) basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; amdahl) basic_machine=580-amdahl os=-sysv ;; amiga | amiga-*) basic_machine=m68k-unknown ;; amigaos | amigados) basic_machine=m68k-unknown os=-amigaos ;; amigaunix | amix) basic_machine=m68k-unknown os=-sysv4 ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; apollo68bsd) basic_machine=m68k-apollo os=-bsd ;; aux) basic_machine=m68k-apple os=-aux ;; balance) basic_machine=ns32k-sequent os=-dynix ;; blackfin) basic_machine=bfin-unknown os=-linux ;; blackfin-*) basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` os=-linux ;; c90) basic_machine=c90-cray os=-unicos ;; convex-c1) basic_machine=c1-convex os=-bsd ;; convex-c2) basic_machine=c2-convex os=-bsd ;; convex-c32) basic_machine=c32-convex os=-bsd ;; convex-c34) basic_machine=c34-convex os=-bsd ;; convex-c38) basic_machine=c38-convex os=-bsd ;; cray | j90) basic_machine=j90-cray os=-unicos ;; craynv) basic_machine=craynv-cray os=-unicosmp ;; cr16) basic_machine=cr16-unknown os=-elf ;; crds | unos) basic_machine=m68k-crds ;; crisv32 | crisv32-* | etraxfs*) basic_machine=crisv32-axis ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; crx) basic_machine=crx-unknown os=-elf ;; da30 | da30-*) basic_machine=m68k-da30 ;; decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; decsystem10* | dec10*) basic_machine=pdp10-dec os=-tops10 ;; decsystem20* | dec20*) basic_machine=pdp10-dec os=-tops20 ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; es1800 | OSE68k | ose68k | ose | OSE) basic_machine=m68k-ericsson os=-ose ;; fx2800) basic_machine=i860-alliant ;; genix) basic_machine=ns32k-ns ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; go32) basic_machine=i386-pc os=-go32 ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; h8300xray) basic_machine=h8300-hitachi os=-xray ;; h8500hms) basic_machine=h8500-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; hp300-*) basic_machine=m68k-hp ;; hp300bsd) basic_machine=m68k-hp os=-bsd ;; hp300hpux) basic_machine=m68k-hp os=-hpux ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k6[0-9][0-9] | hp6[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k7[0-79][0-9] | hp7[0-79][0-9]) basic_machine=hppa1.1-hp ;; hp9k78[0-9] | hp78[0-9]) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[0-9][13679] | hp8[0-9][13679]) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; hppa-next) os=-nextstep3 ;; hppaosf) basic_machine=hppa1.1-hp os=-osf ;; hppro) basic_machine=hppa1.1-hp os=-proelf ;; i370-ibm* | ibm*) basic_machine=i370-ibm ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 ;; i*86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv4 ;; i*86v) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv ;; i*86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; i386mach) basic_machine=i386-mach os=-mach ;; i386-vsta | vsta) basic_machine=i386-unknown os=-vsta ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; m68knommu) basic_machine=m68k-unknown os=-linux ;; m68knommu-*) basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` os=-linux ;; m88k-omron*) basic_machine=m88k-omron ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; merlin) basic_machine=ns32k-utek os=-sysv ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; mingw32ce) basic_machine=arm-unknown os=-mingw32ce ;; miniframe) basic_machine=m68000-convergent ;; *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) basic_machine=m68k-atari os=-mint ;; mips3*-*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` ;; mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; monitor) basic_machine=m68k-rom68k os=-coff ;; morphos) basic_machine=powerpc-unknown os=-morphos ;; msdos) basic_machine=i386-pc os=-msdos ;; ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; mvs) basic_machine=i370-ibm os=-mvs ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; netbsd386) basic_machine=i386-unknown os=-netbsd ;; netwinder) basic_machine=armv4l-rebel os=-linux ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; news1000) basic_machine=m68030-sony os=-newsos ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; necv70) basic_machine=v70-nec os=-sysv ;; next | m*-next ) basic_machine=m68k-next case $os in -nextstep* ) ;; -ns2*) os=-nextstep2 ;; *) os=-nextstep3 ;; esac ;; nh3000) basic_machine=m68k-harris os=-cxux ;; nh[45]000) basic_machine=m88k-harris os=-cxux ;; nindy960) basic_machine=i960-intel os=-nindy ;; mon960) basic_machine=i960-intel os=-mon960 ;; nonstopux) basic_machine=mips-compaq os=-nonstopux ;; np1) basic_machine=np1-gould ;; nsr-tandem) basic_machine=nsr-tandem ;; op50n-* | op60c-*) basic_machine=hppa1.1-oki os=-proelf ;; openrisc | openrisc-*) basic_machine=or32-unknown ;; os400) basic_machine=powerpc-ibm os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson os=-ose ;; os68k) basic_machine=m68k-none os=-os68k ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; paragon) basic_machine=i860-intel os=-osf ;; parisc) basic_machine=hppa-unknown os=-linux ;; parisc-*) basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` os=-linux ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; pc532 | pc532-*) basic_machine=ns32k-pc532 ;; pc98) basic_machine=i386-pc ;; pc98-*) basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; pentium4) basic_machine=i786-pc ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium4-*) basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; ppc) basic_machine=powerpc-unknown ;; ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown ;; ppcle-* | powerpclittle-*) basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64) basic_machine=powerpc64-unknown ;; ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64le | powerpc64little | ppc64-le | powerpc64-little) basic_machine=powerpc64le-unknown ;; ppc64le-* | powerpc64little-*) basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ps2) basic_machine=i386-ibm ;; pw32) basic_machine=i586-unknown os=-pw32 ;; rdos) basic_machine=i386-pc os=-rdos ;; rom68k) basic_machine=m68k-rom68k os=-coff ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; s390 | s390-*) basic_machine=s390-ibm ;; s390x | s390x-*) basic_machine=s390x-ibm ;; sa29200) basic_machine=a29k-amd os=-udi ;; sb1) basic_machine=mipsisa64sb1-unknown ;; sb1el) basic_machine=mipsisa64sb1el-unknown ;; sde) basic_machine=mipsisa32-sde os=-elf ;; sei) basic_machine=mips-sei os=-seiux ;; sequent) basic_machine=i386-sequent ;; sh) basic_machine=sh-hitachi os=-hms ;; sh5el) basic_machine=sh5le-unknown ;; sh64) basic_machine=sh64-unknown ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; spur) basic_machine=spur-unknown ;; st2000) basic_machine=m68k-tandem ;; stratus) basic_machine=i860-stratus os=-sysv4 ;; sun2) basic_machine=m68000-sun ;; sun2os3) basic_machine=m68000-sun os=-sunos3 ;; sun2os4) basic_machine=m68000-sun os=-sunos4 ;; sun3os3) basic_machine=m68k-sun os=-sunos3 ;; sun3os4) basic_machine=m68k-sun os=-sunos4 ;; sun4os3) basic_machine=sparc-sun os=-sunos3 ;; sun4os4) basic_machine=sparc-sun os=-sunos4 ;; sun4sol2) basic_machine=sparc-sun os=-solaris2 ;; sun3 | sun3-*) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; sv1) basic_machine=sv1-cray os=-unicos ;; symmetry) basic_machine=i386-sequent os=-dynix ;; t3e) basic_machine=alphaev5-cray os=-unicos ;; t90) basic_machine=t90-cray os=-unicos ;; tic54x | c54x*) basic_machine=tic54x-unknown os=-coff ;; tic55x | c55x*) basic_machine=tic55x-unknown os=-coff ;; tic6x | c6x*) basic_machine=tic6x-unknown os=-coff ;; tile*) basic_machine=tile-unknown os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown ;; tx39el) basic_machine=mipstx39el-unknown ;; toad1) basic_machine=pdp10-xkl os=-tops20 ;; tower | tower-32) basic_machine=m68k-ncr ;; tpf) basic_machine=s390x-ibm os=-tpf ;; udi29k) basic_machine=a29k-amd os=-udi ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; v810 | necv810) basic_machine=v810-nec os=-none ;; vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; vpp*|vx|vx-*) basic_machine=f301-fujitsu ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; vxworks29k) basic_machine=a29k-wrs os=-vxworks ;; w65*) basic_machine=w65-wdc os=-none ;; w89k-*) basic_machine=hppa1.1-winbond os=-proelf ;; xbox) basic_machine=i686-pc os=-mingw32 ;; xps | xps100) basic_machine=xps100-honeywell ;; ymp) basic_machine=ymp-cray os=-unicos ;; z8k-*-coff) basic_machine=z8k-unknown os=-sim ;; none) basic_machine=none-none os=-none ;; # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. w89k) basic_machine=hppa1.1-winbond ;; op50n) basic_machine=hppa1.1-oki ;; op60c) basic_machine=hppa1.1-oki ;; romp) basic_machine=romp-ibm ;; mmix) basic_machine=mmix-knuth ;; rs6000) basic_machine=rs6000-ibm ;; vax) basic_machine=vax-dec ;; pdp10) # there are many clones, so DEC is not a safe bet basic_machine=pdp10-unknown ;; pdp11) basic_machine=pdp11-dec ;; we32k) basic_machine=we32k-att ;; sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) basic_machine=sparc-sun ;; cydra) basic_machine=cydra-cydrome ;; orion) basic_machine=orion-highlevel ;; orion105) basic_machine=clipper-highlevel ;; mac | mpw | mac-mpw) basic_machine=m68k-apple ;; pmac | pmac-mpw) basic_machine=powerpc-apple ;; *-unknown) # Make sure to match an already-canonicalized machine name. ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; esac # Here we canonicalize certain aliases for manufacturers. case $basic_machine in *-digital*) basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` ;; *-commodore*) basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` ;; *) ;; esac # Decode manufacturer-specific aliases for certain operating systems. if [ x"$os" != x"" ] then case $os in # First match some system type aliases # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; -solaris) os=-solaris2 ;; -svr4*) os=-sysv4 ;; -unixware*) os=-sysv4.2uw ;; -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; # First accept the basic system types. # The portable systems comes first. # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ | -aos* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ | -chorusos* | -chorusrdb* \ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) case $basic_machine in x86-* | i*86-*) ;; *) os=-nto$os ;; esac ;; -nto-qnx*) ;; -nto*) os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; -linux-dietlibc) os=-linux-dietlibc ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` ;; -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; -opened*) os=-openedition ;; -os400*) os=-os400 ;; -wince*) os=-wince ;; -osfrose*) os=-osfrose ;; -osf*) os=-osf ;; -utek*) os=-bsd ;; -dynix*) os=-bsd ;; -acis*) os=-aos ;; -atheos*) os=-atheos ;; -syllable*) os=-syllable ;; -386bsd) os=-bsd ;; -ctix* | -uts*) os=-sysv ;; -nova*) os=-rtmk-nova ;; -ns2 ) os=-nextstep2 ;; -nsk*) os=-nsk ;; # Preserve the version number of sinix5. -sinix5.*) os=`echo $os | sed -e 's|sinix|sysv|'` ;; -sinix*) os=-sysv4 ;; -tpf*) os=-tpf ;; -triton*) os=-sysv3 ;; -oss*) os=-sysv3 ;; -svr4) os=-sysv4 ;; -svr3) os=-sysv3 ;; -sysvr4) os=-sysv4 ;; # This must come after -sysvr4. -sysv*) ;; -ose*) os=-ose ;; -es1800*) os=-ose ;; -xenix) os=-xenix ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) os=-mint ;; -aros*) os=-aros ;; -kaos*) os=-kaos ;; -zvmoe) os=-zvmoe ;; -none) ;; *) # Get rid of the `-' at the beginning of $os. os=`echo $os | sed 's/[^-]*-//'` echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 exit 1 ;; esac else # Here we handle the default operating systems that come with various machines. # The value should be what the vendor currently ships out the door with their # machine or put another way, the most popular os provided with the machine. # Note that if you're going to try to match "-MANUFACTURER" here (say, # "-sun"), then you have to tell the case statement up towards the top # that MANUFACTURER isn't an operating system. Otherwise, code above # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. case $basic_machine in score-*) os=-elf ;; spu-*) os=-elf ;; *-acorn) os=-riscix1.2 ;; arm*-rebel) os=-linux ;; arm*-semi) os=-aout ;; c4x-* | tic4x-*) os=-coff ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 ;; pdp11-*) os=-none ;; *-dec | vax-*) os=-ultrix4.2 ;; m68*-apollo) os=-domain ;; i386-sun) os=-sunos4.0.2 ;; m68000-sun) os=-sunos3 # This also exists in the configure program, but was not the # default. # os=-sunos4 ;; m68*-cisco) os=-aout ;; mep-*) os=-elf ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; or32-*) os=-coff ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; sparc-* | *-sun) os=-sunos4.1.1 ;; *-be) os=-beos ;; *-haiku) os=-haiku ;; *-ibm) os=-aix ;; *-knuth) os=-mmixware ;; *-wec) os=-proelf ;; *-winbond) os=-proelf ;; *-oki) os=-proelf ;; *-hp) os=-hpux ;; *-hitachi) os=-hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=-sysv ;; *-cbm) os=-amigaos ;; *-dg) os=-dgux ;; *-dolphin) os=-sysv3 ;; m68k-ccur) os=-rtu ;; m88k-omron*) os=-luna ;; *-next ) os=-nextstep ;; *-sequent) os=-ptx ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-nextstep3 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-siemens) os=-sysv4 ;; *-masscomp) os=-rtu ;; f30[01]-fujitsu | f700-fujitsu) os=-uxpv ;; *-rom68k) os=-coff ;; *-*bug) os=-coff ;; *-apple) os=-macos ;; *-atari*) os=-mint ;; *) os=-none ;; esac fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. vendor=unknown case $basic_machine in *-unknown) case $os in -riscix*) vendor=acorn ;; -sunos*) vendor=sun ;; -aix*) vendor=ibm ;; -beos*) vendor=be ;; -hpux*) vendor=hp ;; -mpeix*) vendor=hp ;; -hiux*) vendor=hitachi ;; -unos*) vendor=crds ;; -dgux*) vendor=dg ;; -luna*) vendor=omron ;; -genix*) vendor=ns ;; -mvs* | -opened*) vendor=ibm ;; -os400*) vendor=ibm ;; -ptx*) vendor=sequent ;; -tpf*) vendor=ibm ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; -aux*) vendor=apple ;; -hms*) vendor=hitachi ;; -mpw* | -macos*) vendor=apple ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) vendor=atari ;; -vos*) vendor=stratus ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: libppm-1.2.1/configure.ac0000644000175200017530000002066711616003516015457 0ustar incardonincardon#------------------------------------------------------------------------- # File : configure.ac #------------------------------------------------------------------------- # # Purpose : Compilation # # Remarks : # # References : # # Revisions : This autoconf was written by Justin Park 8.17.2009 # Revised by Omar Awile #------------------------------------------------------------------------- # Parallel Particle Mesh Library (PPM) # ETH Zurich # CH-8092 Zurich, Switzerland #------------------------------------------------------------------------- # Initialization AC_PREREQ(2.61) AC_INIT(PPM, 1.2.1) # Reset existing preprocessing flags #touch ./src/ppm_define.h #rm ./src/ppm_define.h #touch ./src/ppm_define.h AC_SUBST(CPPFLAGS,[""]) # if MPI is enabled try grabbing those compiler wrappers first use_mpi=no AC_ARG_ENABLE([mpi], [AS_HELP_STRING([--enable-mpi[[=impl.]]], [use MPI (default is no), If the MPI implementation of your choice provides compile wrappers that are in PATH, I can set them myself, choose: guess (I will choose the first implementation I can find), openmpi, lammpi, mpich, mpich2, intelmpi_gnu (Intel's MPI with GNU Compilers), intelmpi_intel (Intel's MPI with Intel Compilers), sun (Sun MPI), ibm (IBM AIX POE). Else, set this flag with no value and set CC, CXX and FC to the appropriate compiler wrappers (safest)])], [PPM_CHECK_MPI([$enableval]) # compilers should be chosen use_mpi=yes], [AC_MSG_NOTICE([MPI was not enabled. Building non-parallel version of PPM.])]) : ${CXXFLAGS="-O3"} : ${CFLAGS="-O3"} : ${FCFLAGS="-O3"} # Checks for basic compiler and flags AC_PROG_CXX AC_PROG_CPP AC_PROG_MAKE_SET AC_PROG_RANLIB AC_PROG_FC AC_FC_FREEFORM AC_FC_LIBRARY_LDFLAGS # Check architecture AC_CHECK_SIZEOF([long double]) AX_F90_MODULE_FLAG AC_SUBST([ax_cv_f90_modflag]) # Check for Fortran2003 support AC_MSG_CHECKING([whether your compiler properly supports Fortran 2003]) AC_LANG([Fortran]) use_f03=no AC_RUN_IFELSE([ program procedure_test type container integer, pointer :: var procedure(func), pointer, nopass :: f end type container abstract interface logical function func(var) integer, pointer :: var end function func end interface type(container) :: c integer :: var procedure(func) :: test call add(var, test) if (c%f(c%var)) stop 0 stop 1 contains subroutine add(var,f) integer, target :: var procedure(func), optional :: f c%var => var c%f => f end subroutine add end program procedure_test logical function test(var) integer, pointer :: var test = .true. end function test], [use_f03=yes], [use_f03=no]) if test "x${use_f03}" = xyes; then AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__F2003"]) # echo "#define __F2003" >> ./src/ppm_define.h AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) fi if test "x${use_mpi}" = xyes; then AC_MSG_CHECKING([if your MPI is usable]) AC_LINK_IFELSE([ program conftest_prog include 'mpif.h' call MPI_Init(ierr) end program conftest_prog], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__MPI"])], # [echo "#define __MPI" >> ./src/ppm_define.h], [AC_MSG_ERROR([Cannot build PPM with MPI support like this])]) AC_MSG_RESULT([yes]) # AC_CHECK_LIB([],[MPI_Init],[ # echo "#define __MPI" >> ./src/ppm_define.h], # [AC_MSG_ERROR([Cannot build PPM with MPI support like this])]) fi AC_LANG([C]) if test "x${use_mpi}" = xyes; then AC_SUBST(FUNIT_FLAGS,["--with-mpi"]) fi # Checks for libraries and set preprocessing flags # this test should be omitted if the compiler is intel, they provide their own # math implementation #if test "x${ax_cv_c_compiler_vendor}" != xintel; then # AC_CHECK_LIB([m],[sqrt]) #fi # Make sure that the libraries are compiled with Fortran AC_LANG([Fortran]) # Check the compiler vendor.. this list should be extended of course # but let's hope that this will work in most cases AC_MSG_CHECKING([your Fortran compiler vendor]) vendor=none for vendorkp in gnu:gfortran intel:Intel sun:Sun portland:Portland; do str=`echo $vendorkp | cut -d: -f2` if `$FC -V 2>&1 | grep -q $str`; then vendor=`echo $vendorkp | cut -d: -f1`; AC_MSG_RESULT([$vendor]) break; fi; done if test "x${vendor}" = xnone; then AC_MSG_RESULT([unknown]) fi; # Check for METIS have_metis=no AC_SEARCH_LIBS([METIS_PartGraphRecursive],[metis],[have_metis=yes]) if test "x${have_metis}" = xno; then echo "------------------------------------------" echo " The METIS library is required to build PPM. " echo " Either the library is missing or incorrectly compiled/linked." echo " Stopping... Please download at:" echo " http://glaros.dtc.umn.edu/gkhome/metis/metis/download" echo "------------------------------------------" (exit 1); exit 1; else AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__METIS"]) # echo "#define __METIS" >> ./src/ppm_define.h fi # Check to see if linux was enabled with -enable-linux AC_ARG_ENABLE([linux],[AS_HELP_STRING([--enable-linux], [compile for linux (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__Linux"])] # [echo "#define __Linux" >> ./src/ppm_define.h] ) # Check to see if etime was enabled with -enable-etime AC_ARG_ENABLE([etime],[AS_HELP_STRING([--enable-etime], [use etime (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__ETIME"])] # [echo "#define __ETIME" >> ./src/ppm_define.h] ) # Check to see if vector was enabled with -enable-vector AC_ARG_ENABLE([vector],[AS_HELP_STRING([--enable-vector], [enable __VECTOR (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__VECTOR"])] # [echo "#define __VECTOR" >> ./src/ppm_define.h] ) AC_ARG_ENABLE([mathkeisan],[AS_HELP_STRING([--enable-mathkeisan], [enable __MATHKEISAN (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__MATHKEISAN"])] # [echo "#define __MATHKEISAN" >> ./src/ppm_define.h] ) AC_ARG_ENABLE([sxf90],[AS_HELP_STRING([--enable-sxf90], [enable __SXF90 (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__SXF90"])] # [echo "#define __SXF90" >> ./src/ppm_define.h] ) AC_ARG_ENABLE([crayfishpack],[AS_HELP_STRING([--enable-crayfishpack], [enable __CRAYFISHPACK (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__CRAYFISHPACK"])] # [echo "#define __CRAYFISHPACK" >> ./src/ppm_define.h] ) AC_ARG_ENABLE([hypre],[AS_HELP_STRING([--enable-hypre], [enable __HYPRE (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__HYPRE"])] # [echo "#define __HYPRE" >> ./src/ppm_define.h] ) AC_ARG_ENABLE([no-microinstr],[AS_HELP_STRING([--enable-no-microinstr], [enable __NOMICROINSTRUCTIONS (default is no)])], [AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__NOMICROINSTRUCTIONS"])] # [echo "#define __NOMICROINSTRUCTIONS" >> ./src/ppm_define.h] ) dev_compile=no AC_ARG_ENABLE([dev],[AS_HELP_STRING([--enable-dev], [enable development mode (default is no)])],[dev_compile=yes]) if test "x${dev_compile}" = xyes; then if test "x${vendor}" = xintel; then AC_SUBST(DEBUG,["-g -O0 -check pointers -check bounds -traceback -diag-disable 10120"]) elif test "x${vendor}" = xgnu; then AC_SUBST(DEBUG,["-g -O0 -fbounds-check -fbacktrace"]) else AC_SUBST(DEBUG,["-g"]) fi fi debug_compile=no AC_ARG_ENABLE([debug],[AS_HELP_STRING([--enable-debug], [enable debug mode (default is no)])],[debug_compile=yes]) if test "x${debug_compile}" = xyes; then AC_SUBST(CPPFLAGS,["$CPPFLAGS -D__DEBUG"]) # echo "#define __DEBUG" >> ./src/ppm_define.h if test "x${vendor}" = xintel; then AC_SUBST(DEBUG,["-O0 -g -debug all -check all -fp-stack-check -heap-arrays -ftrapuv -check pointers -check bounds -check uninit -traceback -diag-disable 10120"]) elif test "x${vendor}" = xgnu; then AC_SUBST(DEBUG,["-O0 -g -fbounds-check -fbacktrace -ftrapv -fno-automatic"]) else AC_SUBST(DEBUG,["-O0 -g"]) fi else if test "x${vendor}" = xintel; then AC_SUBST(FCFLAGS,["$FCFLAGS -diag-disable 5462"]) fi fi # set src as the default srcdir if test "$srcdir" = "."; then srcdir=src fi # Generate Makefiles AC_CONFIG_FILES([Makefile]) AC_OUTPUT libppm-1.2.1/aclocal.m40000644000175200017530000000124611616003516015021 0ustar incardonincardon# generated automatically by aclocal 1.11.1 -*- Autoconf -*- # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, # 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. m4_include([m4/ax_f90_module_flag.m4]) m4_include([m4/ppm_check_mpi.m4]) libppm-1.2.1/config.status0000755000175200017530000006134311616003516015702 0ustar incardonincardon#! /bin/bash # Generated by configure. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=${CONFIG_SHELL-/bin/bash} export SHELL ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_ || as_fOrectk$ -z'c ob r as_var in BASH_ENV ENV MAIL MAIL/ar abas_dirs"./ ENst ile co./ E r as_var in Be as_basenaas_dirxt "X$as_dir" = X/) >/dev/null end px='as_dirxcho_n='printdva-dLt "X$as_dir" = X/) >/dev/nup -p' s_L_rocedu=Ln as_ln_s=lns_L_rocedu= error: ll end px='fn_append '; FPA'ed s/.exe conf$$."$1- / 2>&1 conf$$."$1/."as_qdir=$ asin *-u1 cas $as { "#( 1- ; .*\\)"in *-`dva-ld ns_L_rocedu'."$1- case `(set -o) 2>as ???[sx]*):;;*)e a;;.*\\)ror: A'ed then : as_- "$ates a wrn B$ll end px ----- acrose unlimitemaps, srintinoniteaet confCil.calizell er_cpp="pend '$as_y%*' as_cr_Letter%Ps=$as_cr_lette%;s%[^_$ts='0123456]%_%g'" ----- acrose unlimitemaps, srintinoniteaet conft 1 fi .calizell er_sh="pend '$as_y%*+%pp%;s%[^_$ts='0123456]%_%g'" - $ate 6X/)itialization. ## ## --------------------------- pat'sh -t th=false # as_Then eh Initialization. ## ## ------------------------ Sak ;; e, ientatioOUT Akeep sepon ono `ecmeaors t it we knonear gecho'ctund inovidng IF Pre-te Makefiles etc.epeated appendshe dong IF P This rocedusac fi US, wic_e, =" ndation, Io seelist shobyOR([C fi 61) ACing on Io s g#! /bin/bashGNUlocal 1.112.67ertanvor withent mwe kalloIo s n :te Makefiles =th=false filesn :te MakeHEADtte =th=false HEADtten :te Makeusabs =th=false usabsn :te Makewere ruS =th=false were ruSr: $ sep$@ the`(host as_dst u as_din) : 'X\(/\)' \| '$as1q` IFS=" # Unsetlibppm-1.2Io semadinux]. lib_ # Ge="i # G IFs_rechcontr="\ \` fi 'epeatantinks; # Ge we kachine echo Invaliae. s prevete ediks; `ccordhat if yle to recreate the curren Unl (I wi Genwe kae. s # ..de manuth os TAuatio wrapatantinks/bashwas not t Uontr: sep[OP__NO]s='l[TAu]s=' n :-h,alihelp.1` > /-' ausagehelp (say, it $1 :-V,aling non-p> /-' a # Preserve thewe k echo Invali # splis (say, it $1 :::::-- ech` > /-' a echo Inval (say, it $1 :-q,aliquiled --eck=fa6.1` > /////////////UWIN ks-' aexter entatio1 -dd --DEBUG,/////UW MANremok e eohich wi Gen :::::--bug=fal::::updr $? fi 6ashtem echo hat otic evsas_dm ed*) en :::::--wi G=file[:TEMPLATE]6.1` > /////////////apatantinkss also existsses anyn, Ifile C existsses anyn, e a$lib_ # Ge R gechout doif yle -enaval.nd LOG_r. IFs_rechlibac FC=iendo' 'M AC_FC=-L/s.dtcomar/swedu/gkh"x${v/lib' 'AS_HELP_STRI'" s_rech # Pres="\ R([Clibppm-1.2I1) AC for debug/bash.libppm, g#! /bin/bashGNUlocal 1.112.67[--eistribocedusa\V M_rechlib\" C toconf -*- 2010007, 2008, 2009 Free Software Fndatilibppm-1.2IThen exnc. # This file is free software; the Free Softre Foundation # gives unlimited pe,n to copy anwe kwith y it. IFs_rpwd='/s.dtcomar/em. ) m4) m4=-bs/' = "."; '= "' # for MKS AWKtest AWK=awkody as_ses, we l # Tos*)yhould beecho'doeG_NOTIde manye # a # G wic_ tha_ses, wes=: as_l=`exp#_SEP0 as_din *-u1 --*=? c4x-*ic_rocedu=`echo_body='ev X[^='/^.= } sic_roc(.*\\)$as_nl"y='ev [^='/=pr "X) } sic_shift= are t as_q--*= c4x-*ic_rocedu=`echo_body='ev X[^='/^.= } sic_roc(.*\ sic_shift= are t as_q c4x-*ic_rocedu=s_fn_ sic_roc(.*\ ev sic_shift=shiftare t as_q ECHOwhile :; c_rocedu # H fi US,appends,bocedusfaul-bug=fal:|:--bug=fal:|:--bug=fa:|:--bug=f:|:--bug=:|:--bug:|:--bu:|:--b c4x-*ic_ debug=fals:t as_q-- # Prese|q-- # Pree|q-- # Pre|q-- # Pe|q-- # e|q-- #e|q-- e|q-V )$as_lineno_stack _rech # Pres"----" as_q-- ech`|q-- ec`|q-- e`|q-- `|q-- `|q-- )$as_lineno_stack _rech ech"----" as_q--DEBUG,|q--DEBU,|q--DEB,|q--DE,|q--Ddos* )$as_l if it:t as_q--yn, I|q--yn,I|q--ynI|q--y )$as_linc_shift$as_lile :; c_roc$1; $as_ldir in c_roc(.*\\ineno_stack _rroc(.*as_echo "$as_dir" | sed "s/' as_qdi'') -d "$as_dir" || the libyn, Ivoid for" as_qdi$as_dir;;\$2 }' elsete Makefiles " 'k _rroc(.*'"c4x-*ic_ tha_ses, wes=e a;;s_q--=f:|:--=:|:alihelp.|alihel| -os )$as_lineno_stack _rechcontr"----" as_q-q| -oquile.|aliquile.|aliquil.|aliqui.|aliqu.|aliq_var+onflck=fa.|alilck=fa.|alilck=f.|alilck=.|alilck.|alilc.|alil c4x-*ic_ deeck=fal:t as # ndati fi # will.se $as_dir"$as_dir" || untem \`$os\'bocedu:id co' Tch d c0alihelp'ut wa-----in'" # trren"t as as_dir"$a}' elseic_ lib_ntegers " dy=6.1` >ic_ tha_ses, wes=e at as $as_dirshift$r" && ic_ libd prelira_tegs=asena$ic_ deeck=fave_metis}"ate 6Xg on AIX 6.1ic_ libd prelira_tegs=ck _relibd prelira_tegsalilck=fa"s_basena$ic_ debug=falve_metis} { X '=${CONFIG' '.libppm'di'FC=iendo' 'M AC_FC=-L/s.dtcomar/swedu/gkh"x${v/lib' 'AS_HELP_STRI' k _relibd prelira_tegsalino-rror $?lino-rMETIS_ondirshift$_lineno_stacru `-' a=false SHEL==${CONFIG $*as_m6n :te Make SHEL='=${CONFIG' y as_echote Make SHELis}"ate as_bas"ate 5>>onfigure, . as_echo$ X"$as_h;s/./-/g;s/^s='/tia/;s/...$/---/;p;x;p;x' <<_ASBOXitiaRu `-' a fi h Ini_ASBOXi_lineno_stack _re, " }s_m5.dir H fi US,appevoid fork in pdkc_ lib_ntegerRATORic_ lib_ntegers as_din *-ukc_ lib_ntegerRAT6.1` " # G )ete Makefiles=ckte Makefiles # G t as as_dir"$as_dir" || i]*-//'`void for:id ckc_ lib_nteger'"ackme:${a" 5t as_q ECHr" && TOR=uld beecho'd ;; esuess (I void fork`: ere manye withlt opeo/apatantinks,der. ntext inv 5.2.1c ING([iPI w-----online,uess (pile wr; e.FS uess (I nl # -----n pdi # set srcasde a [enabeh). Bake #eeliremelygramiza reecho `ecSunOS sun)3.sena$ic_ tha_ses, wesve_metis}lways rite Makefiles${PATH_EPARAest te Makefiles=$lib_ # Ge -none ak a e eohich "cannot cn pd *-moni w-,[sqri store ty is reireNO. Tsentyabeh). B' s, ashteasaliagop 1tn bohat ot "-MAt we kth Sded*) ,derrror rs fre kwiv libyn, o preve/tmpt are om-etimssh). Bourslt o.FS Hd whn pditsNremokalunda ure, usef.FS the machin' s, a sma- # E* \ s `sh COMMi # "cannot che hoC_MSGlsoleaned Loc This itsNrror ralin -s-tti) #itsN as_d2) Dbeencasde aibrary`$tmp'. $DEBUG,||. as_tmp\ TUS, '--" _error ()? s_fnak dontmpas_val=`ex!f$$."$tmpas_valn_s=r."$tmpa; }Nst set_st--" _error 'c%f(cTUS, 'et -e" cont1' 1 2 13 15 } # -------a (sMETIe)_tmp "cannot cn pdtmp yn, o. . as_tmp\`(umask 077Nst mk e ef$$.".lXXXXXX" case `(set ->/dev# for MKS tmpasdir 2>/d$$."$tmpa }s,||. as_tmp\.$.exe c-$RANDOMas_(umask 077Nst mke co"$tmpa) }est -d "$as_dir" || as_fn_error $?a e eohich "cannot c `s."ackme:${a" 5 ------- cas evshen eout wate Makefiles sMEurrent cNos thataryg#! /bin PATH,ould br in whicate Makefiles Foundatih}' elout waapatancsystems`.libppm-1.2ilibph'.ASE # for MKS te Makefiles- / 2>&1& ic_ n Xg" : "X '\015 } #otchcyg E*,ot cau areor \waapainte``hould beecho'ETIS fofinigncr Fou3.0 the casakeicaachine---- # br inc_ nth IFS his settiut let'O anftra,ono in are. Baot caismCreatee lfbouound in the pac_ nest "x$as_mysepend ic_ n \$\dirr\ as_-c_ deawk_ n AWK 'BEGIN_fn-' a"a\rb" }' <$as_dir" = Xase `(set is always r-c_ deawk_ nenamea${ic_ n}b- / 2>&1`" c_ deawk_ n dirral=$(( $* c_ deawk_ n pac_ ns_bas"( -n*BEGIN_f' >"$tmp/subs1.awkasdi cut >>"$tmp/subs1.awkas<<\_ACAWK di S["LTLIBOBJS"]="" S["LIBOBJS"]="" S["["$CPPF=AC_SUBST(DEBUG,["-g -O0 -check pointers -check bounds -traceback -dia S["en AC_S"]="" S["_FLAG AC_SUBST([aPF=ACI" S["EGREPPF=A=${CO `$FC E" S["GREPPF=A=${CO `$Fa S["eCis=nPF=A -L/s.dtcomar/swedu/gkh"x${v/lib -L/boc/on I ca/1.5h"x${v/lib/ -L/boc/"x${v/nt euesrxe-2011) AC37/G([your /lib/"x${v64 -L/boc/"x${v/nt euesrxe-2011)"\ " AC37/ipp/../G([your /lib/"x${v64 -L/boc/"x${v/nt euesrxe-2011) AC37/ipp/lib/"x${v64 -L/boc/"x${v/nt euesrxe-2011) AC37/mkl/lib/"x${v64 -L/boc/"x${v"\ "/nt euesrxe-2011) AC37/tbb/lib/"x${v64//ccsun)0_libc2.4_kernel2.6.16.21 -L/boc/on I ca/1.5h"x${v/lib -L/ lib/x86_64STRING-gnu/gcc/x86_64STRING-gn"\ "u/4.5.2 -L/ lib/x86_64STRING-gnu/gcc/x86_64STRING-gnu/4.5.2/../../.. -L/lib64 -L/lib -L/ lib64 -L/ lib -L/ lib/x86_64STRING-gnu STRf_ech"\ " STRf=-bs STRmf STsvml STm STRpgo STRrc STpthred aSTRrc_va-ldl" S["_c_ t_FC"]="" S["UBST(FCPF=ACO3 -FRFLAGS,["$FCFLAGS -di S["UBPF=Aiendoi S["AKE_SEPF=Aranlibi S["SETPROG_"]="" S["CPPPF=AgccC E" S["_c_ t_CCPF=Agcc" S["CST(FCPF=ACO3" S["CCPF=Agcc" S["OBJEXTPF=Ao" S["EXEEXTPF=A" S["_c_ t_CXX"F=Ag++" S["LDST(FCPF=ACL/s.dtcomar/swedu/gkh"x${v/lib" S["C PPM.])PF=ACO3" S["CXX"F=Ag++" S["MPIFC"]="" S["MPICXX"F=A" S["MPICC"]="" S["CPPPM.])PF=ALAGS,["$CPLAGS,["$CPP S["nteger_this "]="" S["host_this "]="" S[" is r_this "]="" S["is=nPF=ASTmu/gk " S["Eev/nu"]="" S["; esPF=ASn" S["; eC"]="" S["["FnPF=ASDefinAGE_NAME=\\\"PPM\\\" SDefinAGE_TARNAME=\\\"ppm\\\" SDefinAGE_ASH_VER=\\\"1) AC\\\" SDefinAGE_debug]=\\\"PPM\\ 1) AC\\\" SDefinAGE_$CPREPORT=\\\"\\\" SDefinAGE_URL="\ "\\\"\\\" SDSTDC HEADtte=1 -DHAVE_dYS_TYPES_H=1 -DHAVE_dYS_ # _H=1 -DHAVE_dTDis=_H=1 -DHAVE_dTbug]_H=1 -DHAVE_MEMORY_H=1 -DHAVE_dTbug]S_H=1 -DHAVE_INTTY"\ "PES_H=1 -DHAVE_dTDINT_H=1 -DHAVE_n dTD_H=1 -Decture_LOg]_DOUBLE=16" S["mwe irPF=A${d9]*)oot ir}/mwe" S["omatie irPF=A${d9]*)oot ir}/omatie" S["oib irPF=A${"ate_pr #x}/lib" S["ps irPF=A${do".";}" S["pdf irPF=A${do".";}" S["dvi irPF=A${do".";}" S["html irPF=A${do".";}" S["in'" irPF=A${d9]*)oot ir}/in'"" S["do".";PF=A${d9]*)oot ir}/do"/righinAGE_TARNAME}" S["onot _flag.";PF=A/ t _flag" S["in_flag.";PF=A${pr #x}/t _flag" S["omatipm-1g.";PF=A${pr #x}/ 5." S["shn wdpm-1g.";PF=A${pr #x}/nt " S["sysl.";PF=A${pr #x}/etc" S["d9]*.";PF=A${d9]*)oot ir}" S["d9]*)oot irPF=A${pr #x}/shn w" S["oib"ate irPF=A${"ate_pr #x}/lib"ate" S["sbin irPF=A${"ate_pr #x}/sbin" S[" in irPF=A${"ate_pr #x}/bin" S["externa_orkps----_n absF=As,x,x," S["ex #xPF=A/ omati" S[""ate_pr #xPF=A${pr #x}" S["efinAGE_URL"]="" S["efinAGE_$CPREPORT"]="" S["efinAGE_dTbug]"]="R([C1) AC" S["efinAGE_ASH_VERS]="1) AC" S["efinAGE_TARNAMES]="ppm" S["efinAGE_NAMES]="R([" S["efFS=$IFS; IFSS]=":i S["SSHELPF=A=${COt ca" _ACAWK cut >>"$tmp/subs1.awkas<<_ACAWK di ut wa(ke c `sS) S_is se[ke ]nam_fn_FS =t"" } as_alloI= $c%f(clielter=d disa(ce, talielt, "@" c4xsubsofin=c%f(ck=f.=ck=fgth(lielt[1ag-dit wa(ist \; i /S_is se[ke ])l $as_m his fla= S[ke ]$as_m halloI= subsor(ce, ta1,ck=f) ""his fla""hsubsor(ce, tak=f.+mke k=f.+ 3RESULT([k=f.+=ck=fgth(is fl).+ k=fgth(lielt[++i_RESULT([subsofin=c_fn_ s}automatic"])k=f.+=c1.+mke k=f"mkds -' ace, } _ACAWK 2>cho "$apac_ n//as/dev/nucho "$apac_ n\$//; $apac_ n/r-c_ deawk_ n/g"pt NO_GLOBtst $< "$tmp/subs1.awkas> "$tmp/subs.awkasvar+ot -d "$as_dir" || a IFS NOTIdetupilibbyn, o ac echry"ackme:${a" 5 t $? # for MKS te Makefiles- - $end '${ X " :Fth=false filestic"])" shift$n pdkc_tag as_din *-ukc_tagRAT6.1:[FHLC]in c_ [e=ukc_tag;f theRINeas_dir=./$asn *-ukc_ [eukc_tagRAT6.1:[FHL]*:*)as_di:Lint :C*:*)_dir"$as_dir" || i]*-//'`tagRd ckc_tag'"ackme:${a" 5t as_q:[FH]-)dkc_tag=-:- as_q:[FH]*)dkc_tag=ckc_tag:ckc_tag.inas_dir=./$asnc_s=$0 ;; *) dir in:is} { x-ukc_tag dir in $cATH do IFSshift$_l$cAwi G=s_fn_shift$$asn *-ukc_ [eRAT6.1:L)dkc_sourcG=s_ as_q:[FH] c4x-*ic_wi G_inovi || { n pdkc_ s= while :; c_ RAT6.1` -)dkc_f="$tmp/st in" as_qdir=*)d#ind whn pdi #yn, Iwill chore ty is reireN (say, otic evsourcGeireNO d#i(ould bee. LoG_NOTI; rerun pre-an av rerun we. Las_fn_ebe DOS-st k=,O d#ibeh). B; c_ Ras_fn_erthe pat`:'.O d# for fs r-c_fname while :; c_ RAT6 whse $$]*)de a;;s ir=*)d# for fs r= ".";/r-c_fnaas_sc_f="$= ".";/r-c_fn;;s ir=r=./ame whdir"$as_dir"1| as_fn_e: errinovidyn, :id ckc_f'"ackme:${a" 5t as_q_qdi$as_dir;;while :; c_ RATldir in c_f\\ineno_stack _rfas_echo "$as_dir" | sed "s/'/'\$as_dir;; "$a}' elseic_wi G_inovi " 'k _rf'"c4x-*r" && 4x-*#inf couste hopr ton fuexnc.`libppm'dh COMMpeatantinks; (i.e.,/UW MA 4x-*#ius$? fi preop, it IFS hissur-' shataryred are twoooo/*ilibphre-#! /bin/bash # Genppm-1.2re-*/$as_lilibd prinovi='#! /bin/bpreve'` wineno_stack*as_echo 's|^[^:]*/||;s|:[^:]*/|, |g' `'bash # Generat'c4x-* 2>r=1; ack _rf# G tmpil-endor}" = xinilibd prinovi=ck _rf# Gre-$ilibd prinovis_qdir' {lineno_stack $as_echo "$as_me:${as_lrror rs fk _rf# G t_m5.$2" >&$4 fi $arror rs fk _rf# G t_m6;}| { niare twoNeuorkliz..de maal_T is singf the rpr todword # kth replac in n srintis.$as_lile :;ilibd prinovi case $a*\&int *\|int *\\* RESULT([$kc_sed_ lrinovi=\ineno_stackilibd prinovis -f confecho 's/[| se&|]/| se&/g'` set - as_dc_sed_ lrinovi=kilibd prinovi as_qdi$as_d$as_lile :; c_tagRAT6.1 a:-:int *:-)dcut >"$tmp/st in"ION$ZSHr+ot -d "$as_dir" || a IFS NOTIrror $?k _rf# G tckme:${a" 5t as_qdi$as_dir;; as_q ECHOwh _r_dirs" as_dir=`$a_rf# G tme -- "$as_dir" _rf# G texpr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*_rf# G texpr X"$as_dir" : 'X\(//\)[_rf# G texpr X"$as\)//*[^/][^/]*_rf# G texpr X"$as_dir" : 'X\(/\)' \| . 2>/dev/null _rf# G tm onfecho 'dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } $as_dirll _r irP;y $as_dir" } wh _r is r"$as_d ECHO_ll _r irPRAT6.)h _r_di_suf #x=dkc_topr is r"$a_sub=.dkc_topr is r_pr #x= O_T=' '; _r_di_suf #x=/\ineno_stack _r=`$as_echo 's|^\.se $0|| } # A ".."hn pdec "cannot c `s$ _r_di_suf #x. '; _rtopr is r"$a_sub=\ineno_stack _r=`$_suf #xas_echo 's|/[^e $0 |/..|g;s|/|| } ile :; c_topr is r"$a_subRAT6.1"")dkc_topr is r"$a_sub=.dkc_topr is r_pr #x= O_T ECHOkc_topr is r_pr #x=; c_topr is r"$a_sub/; as_q ECs_save_IF c_v r_topr is r"$a=; c_pwdF c_v r_ is r"$a=; c_pwdk _r=`$_suf #x #ut wastckward# Be moreiisay: c_topr is r"$a=; c_topr is r_pr #xd ECHO_$= ".";RAT6.1.)h S arty is rhat otiplac .c4x-*ic_= "."; .c4x-*ic_topr= "."; ; c_topr is r"$a_subc4x-*ic_v r_topr= "."; ; c_pwd; as_qse $0 i| ?:se $0 in # A rerun wcalize4x-*ic_= "."; $= ".";k _r=`$_suf #x;c4x-*ic_topr= "."; ; as the4x-*ic_v r_topr= "."; ;= ".";RO_T ECH# Relmorv wcalize4x-*ic_= "."; $ c_topr is r_pr #x$= ".";k _r=`$_suf #xc4x-*ic_topr= "."; ; c_topr is r_pr #x$= ".";c4x-*ic_v r_topr= "."; ; c_pwd/;= ".";RO_Tve_IF c_v r_= "."; ; c_v r_topr= ".";k _r=`$_suf #xc$$asn *-ukc_ [eRAT6.1:F' ';# # =false file ';# TOR=uld bete ediks'doeG_NOTIe casrom cod9]*)oot ir, as_we kte.FS FIXME:undatih}ckndor.. thisremok dateeew year P This 2.60 wic_d9]*)oot ir_h}ck=; ic_d9]*)oot ir_seen= dc_sed_d9]*)oot=' /d9]*)oot ir/l $as} whq } /@d9]*.";@/p /@do".";@/p /@in'" ir@/p /@omatie ir@/p /@mwe ir@/p' ECHO_N= "$ascho MK\"\$dc_sed_d9]*)oot\"?k _rf# G_inovi "ase `*d9]*)oot iras_dc_d9]*)oot ir_seen=ug_c_T=@d9]*.";@*|*@do".";@*|*@in'" ir@*|*@omatie ir@*|*@mwe ir@=' ';{lineno_stack $as_echo "$as_me:${as_lWARNING:?k _rf# G_inovi h] ) opeo/agnthe ARGs--d9]*)oot iri # spli t_m5.$2" >&$4 fi $aWARNING:?k _rf# G_inovi h] ) opeo/agnthe ARGs--d9]*)oot iri # spli t_m2;}| {ic_d9]*)oot ir_h}ck=${1+"&@d9]*.";@&${d9]*)oot ir}&g{1+"&@do".";@&${d9]*)oot ir}/do"/righinAGE_TARNAME}&g{1+"&@in'" ir@&${d9]*)oot ir}/in'"&g{1+"&@omatie ir@&${d9]*)oot ir}/omatie&g{1+"&@mwe ir@&${d9]*)oot ir}/mwe&g{1+"&\${d9]*)oot ir}&${pr #x}/shn w&g'RO_Tve_IF c_sed_elira=" :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@ilibd prinovi@|$dc_sed_ lrinovi|;t t "&@topr is r"$a@&$ c_topr is r"$a_sub&;t t "&@topr is r_pr #x@&$ c_topr is r_pr #x&;t t "&@= ".";@&$ c_= ".";&;t t "&@v r_= ".";@&$ c_v r_= ".";&;t t "&@topr= ".";@&$ c_topr= ".";&;t t "&@v r_topr= ".";@&$ c_v r_topr= ".";&;t t "&@ is r"$a@&$ c_ is r"$a&;t t "&@v r_ is r"$a@&$ c_v r_ is r"$a&;t t "&@v r_topr is r"$a@&$ c_v r_topr is r"$a&;t t $ic_d9]*)oot ir_h}ck " pend '$as\"\$dc_sed_elira\"=`$a_rf# G_inovi "i| AWK fs rtmp/subs.awkas>rtmp/m covar+ot -d "$as_dir" || a IFS NOTIrror $?k _rf# G tckme:${a" 5 ak donec_d9]*)oot ir_h}cknec_d9]*)oot ir_seen" di u{n c_rvi=\cho MK'/\${d9]*)oot ir}/p's rtmp/rvi"`; # for MKS c_rvia; }Nst u{n c_rvi=\cho MK'/^[ ]*d9]*)oot ir[ ]*:*=/p's rtmp/rvi"`; # for zKS c_rvia; }Nst u{nineno_stack $as_echo "$as_me:${as_lWARNING:?k _rf# Gerthe paeaterror to eoif yle t 1 fi .\`d9]*)oot ir' h COMM] ) opeo/pe tnG" >> I w-" Stoppm[sqrt]) #uexnc.G" >> I t_m5.$2" >&$4 fi $aWARNING:?k _rf# Gerthe paeaterror to eoif yle t 1 fi .\`d9]*)oot ir' h COMM] ) opeo/pe tnG" >> I w-" Stoppm[sqrt]) #uexnc.G" >> I t_m2;}| onf$$.fi"$tmp/st in"$asn *-ukc_on, In -)dcut rtmp/rvi"Nst il$.fi"$tmp/rvia;_T ECHil$.fi"$ _rf# G tst mv rtmp/rvi"N"$ _rf# G as_q ECsvar+ot -d "$as_dir" || a IFS NOTIrror $?k _rf# G tckme:${a" 5 t as s $as_dHr" & exportkc_tag set -e" cont0m_check_mpi.m4]) lib]) 00007550001763154017530000000124676616003516015702 0ustar incardonincardonu ng IF Pportsyste -/; q'`n n t 1 fi # we k ror $? # Ge.#! /bin/bashGNUlocal 1.112.67PportR([C1) AC. Autoconf -*- # C21996,31996,41996,5, # Copyrig 1996, 1997, 1998, 1002, 2 2000, 2001, 22, 2003, 2004, # 2005, 2006, , 2010007, 2008, 200FS F Free Software Fo ndatilib]) #Then exnc. # This file is free software; the Free Software Foundation # gives unlimited pe,n to copy anwe kwith y it.sh} export SHELL ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -$as_echo_o_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 &nd in the pte Make SHELest "x$as_myself"b ## _ Be more B=Aie # for MK\"\$sh if test -n "${\ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do wo\re. \"\$@\tting on ${1+"$@"}, which # is contrary to our usage. Disable this featu\re. \"\$@\ttas \"\$@\t${1+"$@"}'='"$@"' setopt NO_GLOB_SU\BST else case `(set\ -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : "yself"ETIS wed="et -e"t_statu() {VERet $\$1); }without ucng pu() {Vet -e"t_statu0; }withoutd `l]) #() {Vet -e"t_statu1; }withoutrset ucng pu() {Vt_statu0; }withoutrsetd `l]) #() {Vt_statu1; }w Ret em. =0without ucng puval Ret em. =atibf"; ithout ucng pud `led.; }withoutd `l]) #>/de Ret em. =atibf"; ithoutd `l]) # ucngeded.; }withoutrset ucng puval Ret em. =atibf"; ithoutrset ucng pud `led.; }withoutrsetd `l]) #>/de Ret em. =atibf"; ithoutrsetd `l]) # ucngeded.; }wprin} { x; ithoutrset ucng puysdir 2>/dxst \"\$1\ZS) >/dev/nupt NO_GLRet em. =atibf"; *) :es an ovno meingf ost pNOTIdanotic : AILPATH Ret em. st "0 bash 2.01; s_fn_eu'((sofimpt{as_lineno-1=";fn_eu'((sofim$fn_eu'((sofikme:${a;fn_eu'((sofim$fn_eu'((sofi"{as_lineno-1a=\kme:${a t{as_lineno-2=";fn_eu'((sofim$fn_eu'((sofikme:${a;fn_eu'((sofim$fn_eu'((sofi"{as_lineno-2a=\kme:${a t{/null;expr. "as_varlineno-1's_var fi \"_SEP "as_varlineno-2's_var fi \"_>/dev# for "as\)$as_s_varlineno-1's_var fi val \`\" EP "as_varlineno-2's_var fi \"' bash 2.01 expr. if (eval "test \ bash 2.01; s_$(()) and $lf"ETIS wed$(( 1 + 1 )) = 2") 2>/devlf" bot"ETIS wed=yesn_s='cp -p' bot"ETIS wed=no body 2>r=1; a$-p' bot"ETIS wedst "yesSH_VER and $lf"eu'((sofi"(( 1 + 1 )) = 2") 2>/dn_s='cp -p'f=$0 ;; *) as_save_IFS=$IFS; IFS=itho areBe as_PATH_SEPARATO e_IFS=$IFS; IFSashes Soe_IFS=$IFS; IFSR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_diritho areB: while :; do cas / n pdkse fi .2 t cauecho #5irs= */{ # nch onlinke advantageonfigOUT ATH d} D=:als that */{ $PATe ad$0" && as_kse fi */{ 2>{d# for fs r-PATe adas_val=`ex fs r-PATe ad-f ca; }Nst */{ {nineno_stack b ## _ Be more B" $lf"ETIS wed$ t -d fi=as r-PATe ada; }N 1 + 1 )) = 2") 2>/devte Make SHEL=r-PATe advlf" bot"ETIS wed=yesn */{ 2>{dineno_stack b ## _ Be more B" $lf"eu'((sofi"{t -d fi=as r-PATe ada; }N 1 + 1 )) = 2") 2>/devf=$as 2 bodbod*/{ et $$as_nl\\(ir=./$asntho areBe aset $a$ntho areuval 2>{d# for fs r SHELes_val=`ex fs r SHEL-f ca; }Nst nl\\(i{nineno_stack b ## _ Be more B" $lf"ETIS wed$ t -d fi=as r SHELe; }N 1 + 1 )) = 2") 2>/devte Make SHEL=r SHELvlf" bot"ETIS wed=yesnfi; }w&& break done IFs_nl\\(nd in the pte Make SHELes!t "x$as_m te sh Wes_myselfyercasdum Baodecn n se ad,ono in both cand LOG_ a #s tuorklizses anis flaportse adva Solarisev/nu; we knh fi so #swithouar areuke advantage of; esuv/nulnt $nfign n t 1 fi # *. for as=g on AIX 6 as=g on AIX 6 UAGE #. for asH. (unset CDPATH) >/dev/nul. for as_var echote Make SHELi "ate te Make SHELesfi if test !ord splittme" >l\\(nd in tha$-p' bot"ETIS wedst "nox$as_m te sineno_stack0:undatiThen exETIS we, a se adv----- [erot telf;l" | tineno_stack0:u-------- vantageIwe are any is syste ."dy 2>r=1; a$sh if test -n "${x\${$as_= "X-n $as_ineno_stack0:uInovnotic>&1r,orks z "$BASH_VERd2) Dbt doon onor.. " $as_ineno_stack0:upe tpgradhataryrks 4.3.4g fo&1; r."dy /ucb/echoineno_stack0:u" Stoppt Prefeg-acal 1.1@gnu.or from coy is syste , k0:uas a direc1" #s_dir"*) silves provid-tti) #let'Ok0:uentatioferencipeataadvl- [erotse ad,o wa-anuaadyprob k0:u-----hen extnG"r# uch a se adv 2>y i ver botht $."dy body ase name" e" e" SHEL=r{te Make SHEL-}C_ALL LA SHELi&2 exi-----t 1 fi # e canpeo/apc st pd mysbe boh waofent mlimitol# CLICOLOR_FORCE= PREP_OP__NOS= ev/nullLICOLOR_FORCE PREP_OP__NOS itialization. ## ## -----------------Se advFune. sh Initialization. ## ## ---------- a as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_un # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_f/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/* $as_expr X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } set=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi it $as_statust the sname $ [" to stut the]et_status STATUS # -------arith ARG... # -----Oprovid" 2>&1 && t$0`echo "$asame $"UT ATtG"rr.R=ul" to stle aut the 200FS nd LOG_d,i sos providext iatustT Aut the,error to irec" to sferencie------- thehen ex Exit the sheue lib1hould ais, # 0"set -e" atustext. asas_error ()1var=1; $as_error "$@"0est -z error (1'printf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as_lineno-errck=as_lineno-errck=$as_lineno-errck/echoineno_stacka $as_echo "$as_me:${as_lho "$as$2solu$4dy body $2" >&$4 fi $aho "$as$2solu2 $* )) set_st-z error tus $1 exio "$i # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letter t{as_lineno-1=$" to stls_lineno-1a=kme:${a t{as_lineno-2=$" to stls_lineno-2a=kme:${a t{/null;expr.e pathlineno-1'_var fi es!t e pathlineno-2'_var fi es>/dev# for"x&1 && pathlineno-1'_var fi val sename pathlineno-2'_var fi e'eval $as# Blas_mLee E. McMahoid(1931-1989)aportsedcousys_vx. :- c4xsho MK'as_ecpas_ec/[$]me:${a/|| {' /devchmod +x fi .lineno" >/dev/n{nineno_stack $cho "$as_myselfrror $?k i .linenonnot find myse POSIX Te adas_m2;* )) set_s1; }w as# DW MANtch #"ate # t_schupon $[0],sh). irec1' \sL LAofBourslt o as# (i # "c as_mt th[0]LoG_NOTI to blac # br iwe monf -: err--- as# or_Lean oon ono `e. ocal 1.11oG_ede maallinken :esveoif ylis)_dir. "#( fi .lineno" as# -----error ivantageppends,lastent mwe .fn_set_ } s$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.d# as_fn_ || as_fOrectk$ -z'c ob r as_var in BASH_ENV ENV MAIL MAIL/ar abas_dirs"./ ENst ile co./ E r as_var in Be as_basenaas_dirxt "X$as_dir" = X/) >/dev/null end px='as_dirxcho_n='printdva-dLt "X$as_dir" = X/) >/dev/nup -p' s_L_rocedu=Ln as_ln_s=lns_L_rocedu= error: ll end px='fn_append '; FPA'ed s/.exe conf$$."$1- / 2>&1 conf$$."$1/."as_qdir=$ asin *-u1 cas $as { "#( 1- ; .*\\)"in *-`dva-ld ns_L_rocedu'."$1- case `(set -o) 2>as ???[sx]*):;;*)e a;;.*\\)ror: A'ed then : as_- "$ates a wrn B$ll end px ----- acrose unlimitemaps, srintinoniteaet confCil.calizell er_cpp="pend '$as_y%*' as_cr_Letter%Ps=$as_cr_lette%;s%[^_$ts='0123456]%_%g'" ----- acrose unlimitemaps, srintinoniteaet conft 1 fi .calizell er_sh="pend '$as_y%*+%pp%;s%[^_$ts='0123456]%_%g'" - # for MKS DJDIRest -zate 7<&0 <$as_dir" $ate 6X/)i2='>as_mt tnds,hosts_fnhost as_dore om- syste s (SVR3.2, oldhGNU/LRING)et_stat; `lbogusie----error ograno u as_dgers fintoo wic_host as_=`(host as_dst u as_din) : 'X\(/\)' \| '$as1q` ---- ## ## M4se.wic_des, we_pr #x=/ omati_-c_ lean_ # Ge= ic_ lib_libobj "$as_dLIBOBJS= Et be_G([younti=no subr_p ||MAC_FC= ROG_AC_FC= -`n nitymt tnd=' -enaval. efinAGE_NAME='PPM' efinAGE_TARNAME='' efinAGE_ASH_VER='1) AC' efinAGE_debug]='R([C1) AC' efinAGE_$CPREPORT='' efinAGE_URL='PS2='Fannotntinses, we headngf t wa--for# fos wic_t _flags_des, we="\ #t _flag #tfdes HAVE_dYS_TYPES_H as `_flag #q'` f #tfdes HAVE_dYS_ # _H as `_flag #q'` f #tfdes STDC HEADtte as `_flag #s `_flag #q as#s fdes HAVE_dTDis=_Hs#ss `_flag #sq'` f #q'` f #tfdes HAVE_dTbug]_Hs#s f !G" >> I STDC HEADtteNst G" >> I HAVE_MEMORY_Hs#ss `_flag #sq'` f #s `_flag #q'` f #tfdes HAVE_dTbug]S_H #s `_flag #q'` f #tfdes HAVE_INTTYPES_H as `_flag #q'` f #tfdes HAVE_dTDINT_H #s `_flag #q'` f #tfdes HAVE_n dTD_H #s `_flag #q'` f IFs_rsubsor+=2fi LTLIBOBJSdLIBOBJS ["$CP en AC_S _FLAG AC_SUBST([a EGREP GREP eCis=n ic_ t_FC UBST(FC UB AKE_SE SETPROG_ Cil ic_ t_CC BST(FC CC OBJEXT EXEEXT ic_ t_CXX LDST(FC C PPM.]) C P MPIFC MPICXX MPICC CPPPM.]) nteger_this host_this is r_this is=n dev/nu dev/nN s$as_c ["Fn mwe ir omatie ir oib ir ps ir pdf ir dvi ir html ir in'" ir do"."; onot _flag."; t _flag."; omatipm-1g."; shn wdpm-1g."; sysl."; d9]*."; d9]*)oot ir oib"ate ir sbin ir bin ir externa_orkps----_n ab pr #xd"ate_pr #x efinAGE_URL efinAGE_$CPREPORT efinAGE_debug] efinAGE_ASH_VER efinAGE_TARNAME efinAGE_NAME _IFS=$IFS; IFS= SHEL'Fs_rsubsor # Ge=''Fs_recho_roce=' _HELP__rocedu_checknti _HELP__[yo _HELP__TRING _HELP__-etim _HELP__vannot _HELP__[athke4='+ _HELP__sxAC_ _HELP__crayfish-ena _HELP__hypr _HELP__no_miEt peatt _HELP__X\( _HELP__X\cho s/.ae_pr ciousr+=2fi is r_this host_this nteger_this CXX C PPM.]) LDST(FC is=n CPPPM.]) CCC CC BST(FC CPP eC UBST(FC'RATOR=--- ## #ee om- t 1 fi # { by,bocedusfaic_t it_help=aic_t it_ # Pres=e ass_rentem \`$os\_roce=ss_rentem \`$os\_sep=ady as_t 1 fi # both evsas_dn abs # nds,bocedusSet $?adyda longchuponatarytnG"rlinesectocheAwi G=$as_dir" $ate_pr #x=NONE no_mlinks= no_rMETIS_on= pr #x=NONE externa_pr #x=NONE externa_suf #x=NONE externa_orkps----_n ab=s,x,x, eck=fal ecks= = "."; # boss= x_t _flags=NONE x_libr 1 gs=NONE TOR=-ataadarithm "cannot cbocedusfady ass # ..lefextnas_we e ono echose of "m[sqrpeataadv$ate_pr #x=/foo; thln -aadvtas_t 1 fi # (pile wre "|oshatarybe t cee an"ate_pr #x # by,ses, we he hoannuaadypchuponfadyU Bu-chesepeated appetory,sibeh). Bsh prerl, etc.i sosaccep-s' m abou as_l # t mizash evsas_d prec # nds,GNUlCo` # Stln ards.) bin ir='${"ate_pr #x}/bin' sbin ir='${"ate_pr #x}/sbin' oib"ate ir='${"ate_pr #x}/oib"ate' d9]*)oot ir='${pr #x}/shn w' d9]*.";='${d9]*)oot ir}' sysl.";='${pr #x}/etc' shn wdpm-1g.";='${pr #x}/G([' omatipm-1g.";='${pr #x}/t 1' t _flag.";='${pr #x}/t _flag' onot _flag.";"' t _flag' do".";='${d9]*)oot ir}/do"/righinAGE_TARNAME}' in'" ir='${d9]*)oot ir}/in'"' html ir='${do".";}' dvi ir='${do".";}' pdf ir='${do".";}' ps ir='${do".";}' oib ir='${"ate_pr #x}/oib' omatie ir='${d9]*)oot ir}/omatie' mwe ir='${d9]*)oot ir}/mwe'IFs_rg is=wic_d9shd9sh=$n pdkc_bocedu as_diOR=uld beg isiouscbocedus thafi #void for,casde a it.s/.exe conf$MKS c_g is = "X-n $as_-d "$as_rg is=\; c_rocedu s/.ae_pr v|| { theRINe error while :; c_rocedu *=? in c_roc(.*\\ esac;c_rocedu\)$' [^=]*=*r "X)'' as_q*=)s/.ae_roc(.*\ O_T ECHO/.ae_roc(.*\yesS as_q ECHOwh# Accep-s' esenentsnt Cygnutilib]) #bocedusSeno in areAGS,nuess y|os.r while :; c_d9shd9sh; c_rocedu -- c4x-*ic_d9shd9sh=yesS as -bin ir.|alibin ir.|alibin i.|alibin .|alibin.|alibi) s/.ae_pr v|bin ir. as_q-bin ir=*.|alibin ir=*.|alibin i=*.|alibin =*.|alibin=*.|alibi=*) s/.bin ir=; c_roc$1; as -bis re|alibis re|alibis e|alibise|alibi) s/.ae_pr v|bis r_this . as_q-bis r=*.|alibis r=*.|alibis =*.|alibis=*.|alibi=*) s/.bis r_this =; c_roc$1; as -toche-fck=.|alitoche-fck=.|alitoche-fck.|alitoche-fc_var+onfitoche-f+onfitoche-+onfitoche+onfitoch+onfitoc+onfito+onfit) s/.ae_pr v|tocheAwi G. as_q-toche-fck==*.|alitoche-fck==*.|alitoche-fck=*.|alitoche-fc=*.var+onfitoche-f=*.|alitoche-=*.|alitoche=*.|alitoch=*.|alitoc=*.|alito=*.|alit=*) s/.tocheAwi G=; c_roc$1; as --libitoche+onfC) s/.tocheAwi G= # Genptoche+ as -d9]*.";.|alid9]*.";.|alid9]*.".|alid9]*.) s/.ae_pr v|d9]*.";. as_q-d9]*.";=*.|alid9]*.";=*.|alid9]*."=*.|alid9]*.=*) s/.d9]*.";=; c_roc$1; as -d9]*)oot iri|alid9]*)oot iri|alid9]*)oot ii|alid9]*)oot i|alid9]*)oot.var+onfid9]*)oo+onfid9]*)o+onfid9]*)) s/.ae_pr v|d9]*)oot iri as_q-d9]*)oot ir=*i|alid9]*)oot ir=*i|alid9]*)oot i=*i|alid9]*)oot =*.var+onfid9]*)oot=*i|alid9]*)oo=*i|alid9]*)o=*i|alid9]*)=*) s/.d9]*)oot ir=; c_roc$1; as -dto our-*i|alidto our-*) s/.ae_echoroc\\ esxc;c_rocedu\)$' x-*dto our-*r "X)''pper exRejanndn abs (pile wr; eet confdvantat 1 fi .calis.$as_l esxc;c_echorocarg=`ex[^-+._$ts='0123456]" ile conf$$.di-f conf$$."$as_dir" || i]*-//'`. Disa.cali:?k _rechoroca s/.ae_echoroc_or_L=k _rechoroc s/.ae_echoroc\\ineno_stack c_echorocar_echo 's/[-+.]/_/g'` s/.toe :; c_echo_roceRAT6.1` *" "_HELP__k _rechoroca "ECH as_qdir=*)ds_rentem \`$os\_roce=ck c_entem \`$os\_rocek c_entem \`$os\_seplidto our-$ae_echoroc_or_L" ds_rentem \`$os\_sep=', ' as_qdi$as_dir;; as_eHELP__k _rechoroc=no as -do".";i|alido".";i|alido"."i|alido"i|alido) s/.ae_pr v|doc iri as_q-do".";=*i|alido".";=*i|alido"."=*i|alido"=*i|alido=*) s/.doc ir=; c_roc$1; as -dvi iri|alidvi iri|alidvi ii|alidvi i|alidvii|alidv) s/.ae_pr v|dvi iri as_q-dvi ir=*i|alidvi ir=*i|alidvi i=*i|alidvi =*i|alidvi=*i|alidv=*) s/.dvi ir=; c_roc$1; as -eHELP_-*i|alieHELP_-*) s/.ae_echoroc\\ esxc;c_rocedu\)$' x-*eHELP_- =]"X)''pper exRejanndn abs (pile wr; eet confdvantat 1 fi .calis.$as_l esxc;c_echorocarg=`ex[^-+._$ts='0123456]" ile conf$$.di-f conf$$."$as_dir" || i]*-//'`. Disa.cali:?k _rechoroca s/.ae_echoroc_or_L=k _rechoroc s/.ae_echoroc\\ineno_stack c_echorocar_echo 's/[-+.]/_/g'` s/.toe :; c_echo_roceRAT6.1` *" "_HELP__k _rechoroca "ECH as_qdir=*)ds_rentem \`$os\_roce=ck c_entem \`$os\_rocek c_entem \`$os\_seplieHELP_-$ae_echoroc_or_L" ds_rentem \`$os\_sep=', ' as_qdi$as_dir;; as_eHELP__k _rechoroc=\; c_roc$1; as -eate-pr #xi|alieate_pr #xi|alieate-pr #xi|alieate-pr #.var+onfieate-pr +onfieate-pr +onfieate-pr+onfieate-p+onfieate-.var+onfieate+onfieat+onfiea) s/.ae_pr v|eate_pr #xi as_q-eate-pr #x=*i|ali$ate_pr #x=*i|alieate-pr #x=*i|alieate-pr #=*.var+onfieate-pr =*i|alieate-pr =*i|alieate-pr=*i|alieate-p=*i|alieate-=*.var+onfieate=*i|alieat=*i|aliea=*) s/.$ate_pr #x=; c_roc$1; as -gs .|aligs .|aligs.|alig)pper exO rerete;ius$?--t $?igs .$as_lt $?_gs =yesS as -help.|alihelp.|alihel.|alihe.|alh) s/.ae_t it_help=nl # as_q-help=r*.|alihelp=r*.|alihel=r*.|alihe=r*.|alhr*) s/.ae_t it_help=rMETIS_ve as_q-help=s*.|alihelp=s*.|alihel=s*.|alihe=s*.|alhs*) s/.ae_t it_help=shL LA as -h-for|alih-for|alih-fr|alih-) s/.ae_pr v|host_this as_q-host=*i|alihost=*i|alihos=*i|aliho=*) s/.host_this =; c_roc$1; as -html iri|alihtml iri|alihtml ii|alihtml i|alihtmli|alihtmi|aliht) s/.ae_pr v|html iri as_q-html ir=*i|alihtml ir=*i|alihtml i=*i|alihtml =*i|alihtml=*i|alihtm=*.var+onfiht=*) s/.html ir=; c_roc$1; as -t _flag.";+onfit _flag.";+onfit _flag."+onfit _flag.+onfit _flag.var+onfit _fla+onfit _fl+onfit _f+onfit _) s/.ae_pr v|t _flag.";+ as_q-t _flag.";"*+onfit _flag.";"*+onfit _flag.""*+onfit _flag."*+onfit _flag=*.var+onfit _fla"*+onfit _fl"*+onfit _f"*+onfit _=*) s/.t _flag.";"; c_roc$1; as -t '" ir+onfit '" ir+onfit '" i+onfit '" +onfit '"+onfit ') s/.ae_pr v|t '" ir+ as_q-t '" ir=*+onfit '" ir=*+onfit '" i=*+onfit '" =*+onfit '"=*+onfit '=*) s/.t '" ir=; c_roc$1; as -oib ir+onfioib ir+onfioib i+onfioib ) s/.ae_pr v|oib ir+ as_q-oib ir=*+onfioib ir=*+onfioib i=*+onfioib =*) s/.oib ir=; c_roc$1; as -oib"ate ir+onfioib"ate ir+onfioib"ate i+onfioib"ate +onfioib"ate.var+onfioib"at+onfioib"a+onfioib") s/.ae_pr v|oib"ate ir+ as_q-oib"ate ir=*+onfioib"ate ir=*+onfioib"ate i=*+onfioib"ate =*+onfioib"ate=*.var+onfioib"at=*+onfioib"a=*+onfioib"=*) s/.oib"ate ir=; c_roc$1; as -omatie ir+onfiomatie ir+onfiomatie i+onfiomatie +onfiomatie) s/.ae_pr v|omatie ir+ as_q-omatie ir=*+onfiomatie ir=*+onfiomatie i=*+onfiomatie =*+onfiomatie=*) s/.omatie ir=; c_roc$1; as -omatipm-1g.";+onfiomatipm-1g.";+onfiomatipm-1g."+onfiomatipm-1g..var+onfiomatipm-1g+onfiomatipm-1+onfiomatipm-+onfiomatipm+onfiomatip) s/.ae_pr v|omatipm-1g.";+ as_q-omatipm-1g.";=*+onfiomatipm-1g.";=*+onfiomatipm-1g."=*+onfiomatipm-1g.=*.var+onfiomatipm-1g=*+onfiomatipm-1=*+onfiomatipm-=*+onfiomatipm=*+onfiomatip=*) s/.omatipm-1g.";=; c_roc$1; as -mwe ir+onfimwe ir+onfimwe i+onfimwe +onfimwe+onfimw+onfim) s/.ae_pr v|mwe ir+ as_q-mwe ir=*+onfimwe ir=*+onfimwe i=*+onfimwe =*+onfimwe=*+onfimw=*+onfim=*) s/.mwe ir=; c_roc$1; as -nfp.|alinfp.|alinf)pper exO rerete;ius$?--t $?out-fp.$as_lt $?_fp=no as -no-rror $?|alino-rror $?|alino-rror ?|alino-rror?|alino-rro.var+onfino-rr+onfino-r+onfn)pper no_mlinks=yesS as -no-rMETIS_on+onfino-rMETIS_on+onfino-rMETIS_o+onfino-rMETIS_.var+onfino-rMETIS+onfino-rMETI+onfino-rMET+onfino-rME+onfino-rM+onfino-r)pper no_rMETIS_on=yesS as -onot _flag.";+onfionot _flag.";+onfionot _flag."+onfionot _flag..var+onfionot _flag+onfionot _fla+onfionot _fl+onfionot _f+onfionot _.var+onfionot +onfionot+onfiono+onfion+onfio) s/.ae_pr v|onot _flag.";+ as_q-onot _flag.";"*+onfionot _flag.";"*+onfionot _flag.""*+onfionot _flag.=*.var+onfionot _flag"*+onfionot _fla"*+onfionot _fl"*+onfionot _f"*+onfionot _=*.var+onfionot "*+onfionot"*+onfiono"*+onfion"*+onfio=*) s/.onot _flag.";"; c_roc$1; as -pr #xi|alipr #xi|alipr #i|alipr i|alipr i|alipri|alip) s/.ae_pr v|pr #xi as_q-pr #x=*i|alipr #x=*i|alipr #=*i|alipr =*i|alipr =*i|alipr=*i|alip=*) s/.pr #x=; c_roc$1; as -externaipr #xi|aliprternaipr #xi|aliprternaipr #i|aliprternaipr .var+onfiprternaipr +onfiprternaipr+onfiprternaip) s/.ae_pr v|prterna_pr #xi as_q-prternaipr #x=*i|aliprternaipr #x=*i|aliprternaipr #=*.var+onfiprternaipr =*i|aliprternaipr =*i|aliprternaipr=*i|aliprternaip=*) s/.prterna_pr #x=; c_roc$1; as -externaisuf #xi|aliprternaisuf #xi|aliprternaisuf #i|aliprternaisuf .var+onfiprternaisuf+onfiprternaisu+onfiprternais) s/.ae_pr v|prterna_suf #xi as_q-prternaisuf #x=*i|aliprternaisuf #x=*i|aliprternaisuf #=*.var+onfiprternaisuf =*i|aliprternaisuf=*i|aliprternaisu=*i|aliprternais=*) s/.prterna_suf #x=; c_roc$1; as -externaiorkps----- as_dsaliprternaiorkps----- as_dvar+onfiprternaiorkps----- as+onfiprternaiorkps----- advar+onfiprternaiorkps----- +onfiprternaiorkps-----dvar+onfiprternaiorkps----+onfiprternaiorkps---dvar+onfiprternaiorkps--+onfiprternaiorkps-dvar+onfiprternaiorkps+onfiprternaiorkpdvar+onfiprteriork+onfiprternaior+onfiprternaio) s/.ae_pr v|prterna_orkps----_n abi as_q-prternaiorkps----- as_=*i|aliprternaiorkps----- as_=*ivar+onfiprternaiorkps----- as=*i|aliprternaiorkps----- a=*ivar+onfiprternaiorkps----- =*i|aliprternaiorkps-----=*ivar+onfiprternaiorkps----=*i|aliprternaiorkps---=*ivar+onfiprternaiorkps--=*i|aliprternaiorkps-=*ivar+onfiprternaiorkps=*i|aliprternaiorkp=*ivar+onfiprteriork=*i|aliprternaior=*i|aliprternaio=*) s/.prterna_orkps----_n ab=; c_roc$1; as -edf iri|alipdf iri|alipdf ii|alipdf i|alipdfi|alipd) s/.ae_pr v|pdf iri as_q-pdf ir=*i|alipdf ir=*i|alipdf i=*i|alipdf =*i|alipdf=*i|alipd=*) s/.pdf ir=; c_roc$1; as -es iri|alips iri|alips ii|alips i|alips) s/.ae_pr v|ps iri as_q-ps ir=*i|alips ir=*i|alips i=*i|alips =*i|alips=*) s/.ps ir=; c_roc$1; as -qi|alquie ?|aliquie ?|aliquie?|aliqui?|aliqu?|aliqivar+onfeck=fa?|alieck=fa?|alieck=f?|alieck=?|alieck) s/.eck=falyesS as -sbin ir.|alisbin ir.|alisbin i.|alisbin .|alisbin.|alisbi.|alisb) s/.ae_pr v|sbin ir. as_q-sbin ir=*.|alisbin ir=*.|alisbin i=*.|alisbin =*.|alisbin=*ivar+onfisbi=*.|alisb=*) s/.sbin ir=; c_roc$1; as -shn wdpm-1g.";.|alishn wdpm-1g.";.|alishn wdpm-1g."ivar+onfishn wdpm-1g.+onfishn wdpm-1g+onfishn wdpm-1+onfishn wdpm-ivar+onfishn wdpm+onfishn wdp+onfishn wd+onfishn w+onfishn ivar+onfishn+onfish) s/.ae_pr v|shn wdpm-1g.";. as_q-shn wdpm-1g.";=*.|alishn wdpm-1g.";=*.|alishn wdpm-1g."=*ivar+onfishn wdpm-1g.=*.|alishn wdpm-1g=*.|alishn wdpm-1=*.|alishn wdpm-=*ivar+onfishn wdpm=*.|alishn wdp=*.|alishn wd=*.|alishn w=*.|alishn =*ivar+onfishn=*.|alish=*) s/.shn wdpm-1g.";=; c_roc$1; as -si1g+onfisi1g+onfisi1) s/.ae_pr v|si1g+ as_q-si1g=*.|alisi1g=*.|alisi1=*) s/.si1g=; c_roc$1; as -sre ir+onfisre ir+onfisre i+onfisre +onfisre+onfisr) s/.ae_pr v|s ".";RO_T isre ir=*.|alisre ir=*.|alisre i=*.|alisre =*.|alisre=*.|alisr=*) s/.sre ir=; c_roc$1; as -sysl.";.|alisysl.";.|alisysl.".|alisysl..|alisyslivar+onfisys+onfisys+onfisys+onfisys+onfisy) s/.ae_pr v|sysl.";.O_T isysl.";=*.|alisysl.";=*.|alisysl."=*.|alisysl.=*.|alisysl=*ivar+onfisys=*.|alisys=*.|alisys=*.|alisys=*.|alisy=*) s/.sysl.";=; c_roc$1; as -nteger.|alinteger.|alintege.|alinteg.|alinte.|alint.|alin) s/.ae_pr v|nteger_this .O_T integer=*.|alinteger=*.|alintege=*.|alinteg=*.|alinte=*.|alint=*.|alin=*) s/.nteger_this =; c_roc$1; as -v.|al # boss.|ali # boss.|ali # bos.|ali # bo.|ali # b) s/. # boss=yesS as - # Pres.|ali # Pres.|ali # Pre.|ali # Pr.|ali # P.|alV) s/.ae_t it_ # Pres=:S as -t $?i*.|alit $?i*) s/.ae_echoroc\\ esxc;c_rocedu\)$' x-*t $?i =]"X)''pper exRejanndn abs (pile wr; eet confdvantat 1 fi .calis.$as_l esxc;c_echorocarg=`ex[^-+._$ts='0123456]" ile conf$$.di-f conf$$."$as_dir" || i]*-//'`-enaval.cali:?k _rechoroca s/.ae_echoroc_or_L=k _rechoroc s/.ae_echoroc\\ineno_stack c_echorocar_echo 's/[-+.]/_/g'` s/.toe :; c_echo_roceRAT6.1` *" "t $?_k _rechoroca "ECH as_qdir=*)ds_rentem \`$os\_roce=ck c_entem \`$os\_rocek c_entem \`$os\_seplit $?i$ae_echoroc_or_L" ds_rentem \`$os\_sep=', ' as_qdi$as_dir;; as_t $?_k _rechoroc=\; c_roc$1; as -t $?out-*.|alit $?out-*) s/.ae_echoroc\\ esxc;c_rocedu\)$' x-*t $?out-*r "X)''pper exRejanndn abs (pile wr; eet confdvantat 1 fi .calis.$as_l esxc;c_echorocarg=`ex[^-+._$ts='0123456]" ile conf$$.di-f conf$$."$as_dir" || i]*-//'`-enaval.cali:?k _rechoroca s/.ae_echoroc_or_L=k _rechoroc s/.ae_echoroc\\ineno_stack c_echorocar_echo 's/[-+.]/_/g'` s/.toe :; c_echo_roceRAT6.1` *" "t $?_k _rechoroca "ECH as_qdir=*)ds_rentem \`$os\_roce=ck c_entem \`$os\_rocek c_entem \`$os\_seplit $?out-$ae_echoroc_or_L" ds_rentem \`$os\_sep=', ' as_qdi$as_dir;; as_t $?_k _rechoroc=no as --x)pper exO rerete;ius$?--t $?ix.$as_lt $?_x=yesS as -xit _flags.|alixit _flags.|alixit _flag.|alixit _fla.|alixit _flivar+onfixit _f+onfixit _+onfixit +onfixit) s/.ae_pr v|x_t _flags.O_T ixit _flags=*.|alixit _flags=*.|alixit _flag=*.|alixit _fla=*.|alixit _fl=*ivar+onfixit _f"*+onfixit _=*+onfixit =*+onfixit=*) s/.x_t _flags=; c_roc$1; as -x-libr 1 gs+onfixilibr 1 gs+onfixilibr 1 g+onfixilibr 1 ivar+onfixilibr 1+onfixilibr +onfixilibr+onfixilib+onfixili+onfixil) s/.ae_pr v|x_libr 1 gs+O_T ixilibr 1 gs=*+onfixilibr 1 gs=*+onfixilibr 1 g=*+onfixilibr 1 =*ivar+onfixilibr 1=*+onfixilibr =*+onfixilibr=*+onfixilib=*+onfixili=*+onfixil=*) s/.x_libr 1 gs=; c_roc$1; as -g"`;; "$as_dir" || entem \`$os\#bocedu: \`c;c_rocedu' nch \`c0 lihelp' t wa--) #un----aritha s/. as *=*) s/.ae_envs. i\ esxc;c_rocedu\)$' x =]"X)=''pper exRejanndn abs (pile wr; eet confdvantat 1 fi .calis.$as_ltoe :; c_envs. case $as_''+on[0-9]*+on*[!_$ts='0123456]* )-f conf$$."$as_dir" || i]*-//'`t 1 fi .cali: \`c;c_envs. '" as_qdi$as_dir;; as_c;c_envs. =\; c_roc$1;$as_l L LA; c_envs. as *)pper exFIXME:onor.. ybe removfinitiacal 1.1 3.0.$as_lineno_stack $cWARNING:?y i nor.. yus$?--bis r, lihost,alintegersolu2 $*_l esxc;c_rocedu\)$'`ex[^-._$ts='0123456]" ile conf$$.di-f confineno_stack $cWARNING:?i]*-//'`h-fortypn: c;c_rocedu\)lu2 $*_l: c{bis r_this =; c_rocedu} c{host_this =; c_rocedu} c{nteger_this =; c_rocedu} s/. as $as_dr" && exe conf$MKS c_g is = "X-n $a c_rocedu=--';; c_g isr_echo 's/_/-/g'` s$$."$as_dir" || es unrec1oid fortaryc;c_rocedu\s_basenaas_dirMKS c_entem \`$os\_roce = "X-n $atoe :;_HELP__rocedu_checkntiRAT6.1` noCH as_qdifatal"`;; "$as_dir" || entem \`$os\#bocedus:?k _rentem \`$os\_roce H as_qdiECHO/.fineno_stack $cWARNING:?entem \`$os\#bocedus:?k _rentem \`$os\_roce Hlu2S as_q ECHe" >&2Check-aadvd"cannot cvoid fork t wa 1.sfign cy.$n pdkc_s. eate_pr #xipr #xibin ir.sbin ir.oib"ate ir+d9]*)oot iri\ d9]*.";.sysl.";.shn wdpm-1g.";.omatipm-1g.";+t _flag.";+\ onot _flag.";+doc irit '" ir+html iridvi iripdf irips iri\ oib ir+omatie ir+mwe ir as_di as_kc_s.l {kc_s. r exRemovf traounti sla lon. _ltoe :; c_ as_AT6.1` */ )-f conf$cth () { X; c_ ass_expr X"$as_dir X"$0 X; c_ ass_expr X"$X)''pper ;; as_c;c_s. =\; c_ asas_dir=./$as-----suQuotin both; rerun wd"cannot ccalis.$astoe :; c_ as_AT6.1` se $$]*+on?:se $0 in theRINe as_qdiNONE+on''+)stoe :; c_ a *pr #xi) theRINe a ECHO_T(ir=./$asntho$as_dir" || {annhat wh; rerun wd"cannot ccali t wa--; c_ a ::; c_ as"dr" && dy asre monf -rgumeop, itho./; q'`metic evono+brokensbe boh w: `$hostn asushataryhono+tn avoid forappelih-foretc. exFIXME:oTo removfe om- day.$bis r=$ is r_this host=$host_this nteger=$nteger_this exFIXME:oTo removfe om- day.$nd in the phost_this es!t "x$as_m \(nd in the p is r_this est "x$as_myse t be_G([younti=maybb/echoineno_stack $cWARNING:?i2>y i wanthatary { tn alibis retypn,ir" 'tyus$?--hosts_echoIf a t be G([youho' fidetennhat") 2> t be G([youh- [e he hobs_echdsolute filnd in the p is r_this es!t e phost_this ex$as_myse t be_G([younti=yesnerrors_dirc_itol_pr #x= # for MKS host_this esst -c_itol_pr #x= host_this -- # for"$eck=faest yesSH_V$ate 6Xir conf$$.dFs_rgwd=`gwdir=`dirnam$MKS c_gwdes>/d c_lAIL =`dva-di .`s>/d c_gwd_lAIL =`cdKS c_gwdes>/ dva-di .`s! -f ntho$as_dir" || wTATUS,wd"cannot c_myselfbeideterm>> I" irname --c_lAIL ntf %s $c_gwd_lAIL "s! -f ntho$as_dir" || gwdir"eG_NOTIre L LA as_mt twTATUS,wd"cannot " IFS=" "" evsourc with repf+omatcedu waG_NOTIde mafioticor bash or zssre ir = "X-n $a c_sre ir_des, weed=yesn # nch i # "cannot c_the deUS,wtdatiThen e,t") 2> to bery, # "cannot . $a c_l.";=s" as_dir=`$as_ test !ome -- "$as_dir" || test !oexpr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/* test !oexpr X"$as_dir" : 'X\(//\)[^/ test !oexpr X"$as\)//*[^/][^/]*/* test !oexpr X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || test !om s/.s$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } sre ir=; c_l."; \(nd in th!s_dir=sre ir/k _reniqueAwi Gex$as_myse sre ir=.. as_ln_s='cp -c_sre ir_des, weed=no bodnd in th!s_dir=sre ir/k _reniqueAwi Gex$as_myse# for"$-c_sre ir_des, weedest yesSH_Vsre ir="; c_l.";en i.."-f ntho$as_dir" || _myself: errsourc s (k _reniqueAwi G)RATORsre ir as_-c_msg="sourc s a) #unORsre ir,ln -s\`cdKRsre ir'ir"eG_NOTIwTAT"_-c_; r_l.";=s( cdKS sre ir r=`dirnam$r "#( f_reniqueAwi Geest -d "$as_dir" || $-c_msg" gwd)`FS ) 2> is rntiRAT blac ,y { sre ir=.is always r-c_; r_l.";ntf % c_gwdex$as_mysesre ir=.ias_exRemovf unding pare traounti sla lon prevesre ir. exDoui .sla lon inwith an abn inwobjanndle dir\chogntiRATfos. Tg puup M-x gdb inwEmacsectory ss ".";RAT6*/)esre ir= { X;sre ir rexpr X"$as_dir X"$0 X;sre ir rexpr X"$X)'' #( *) pdkc_s. c_g iciousr+=2firs= as_kc_env_${kc_s. } se=H do{kc_s. }n "${ as_kc_env_${kc_s. } is fl {{kc_s. } as_kc_cv_env_${kc_s. } se=H do{kc_s. }n "${ as_kc_cv_env_${kc_s. } is fl {{kc_s. } r" && d_exRe L LAtn alihelp.entatiof d_s always r-c_t it_helpntf %nl #ex$as_myse# Om---eom- apc an o wao rerete#bocedusmitemakth evl # lg pusenesUS, w # ndatientationivanoo nl # arybe , srintinnot to A/UX 3.1.sh.$astot <<_ACEOF \`clib]) 'ilib]) s R([C1) AC aryadaptmitemany TUSd Pre-syste s. Uatio: sep[OP__NO]s='l[VAR=end t]s=' Tocasde a environmn n t 1 fi #which , CC, CST(FCs='),Ide mafh i mcas VAR=end t. Seeybeizat pddeThen e # Pre-eom- t tnds,echful t 1 fi # Des, wek t wands,bocedusle wree mafioto notrackeos w Clib])tcedu are-h,alihelp..............disblaywtdatihelp.le acritpper ;;lihelp=shL LA.......disblaywboceduslee maficoif ylis`-enavalpper ;;lihelp=rMETIS_ve ...disblaywtd BshL LAhelp.ake advtas_t _flag..-enavalsn -V,ali # Pres...........disblayw # Pres.un----arith.le acritppe-q,aliquie , lieck=fa? UWIN kspint-s\`checkntiRs=''ientatiospper ;;litoche-fck==FILE /.tochealways, and n inwFILE [dto ourd]ppe-C, lilibitoche+ conf$his .---dv`litoche-fck== # Genptoche -n, lino-rror $?........dWIN kshror $? providith pper ;;lisre ir=DIR........f "" evsourc n inwDIR.[lib]) #.";en i\`=''] =-ataadarithm "cannotiee arelipr #x=PREFIX?........peataadvlrchitenn]) - ""; q'`=fa?ith inwPREFIX [; c_des, we_pr #x]ppe-ieate-pr #x=EPREFIX?..peataadvlrchitenn]) -"; q'`=fa?ith inwEPREFIX [PREFIX] By,ses, we,i\`m[sqrpeataad' he hopeataadvladvtas_ith in \`c;c_des, we_pr #x/bin', \`c;c_des, we_pr #x/oib' etc.i Y i arede mafh acipeataadarithmpr #xio' t telf\`c;c_des, we_pr #x'eue libv`lipr #x',) pdpeatancebv`lipr #x HOME' w F pdbLette"}, whol,yus$?nds,boceduslbeiza w F>> tueUS,wt tnds,i-ataadarithm "cannotiee arelibin ir=DIR............echoreates a wrs [EPREFIX/bin]ppe-isbin ir=DIR...........syste yadm>>reates a wrs [EPREFIX/sbin]ppe-ioib"ate ir=DIR........prternareates a wrs [EPREFIX/oib"ate]ppe-isysl.";=DIR........rord-onlink;; # -mach>> bocC wrs/link; :;O lon inVn ir=*.|a-eeP__h_0ecom.......onfiomatipm-=nareates>> bocC wrIX/oib"ate]ppe-isysl.";=Deey......... tueUS,wt tnds,i-at prevess an ilibr+onfi]ppe-ioib"at......*+onfionot"US,wt tnds,C$CPREPOBy,ses,l.";=D*+onfio......t "*+onfionot"US,wt tnC$CPREPOBy,ses, t tnon-gcc [' t _flag.";......t=*i|alid9]*US,wt tndswrs [EPREFs/li.lon inVn ir=*.|a-e9]*)ol.";=D.rord......t=*i tueUS,wt tnds,i-awrs [EPREFs/link; :;O lon inVn ir=*.|a-eeDATAROOTUS,......*+ '" i=US,wt tnds,i-a -t docuinstead oeeDATAROOTUS,/do"/.......onfionot"US,wt tnds,rit '" - inVn ir=*.|a-eeDATAROOTUS,r='${"a...... i=*+onUS,wt tnds,i-at as docuinstead oeeDATAROOTUS,/ as......toste yadm>>reatesssssdocuinstead oe9]*)oDATAROOTUS,/ _flppm......ihtml =*adm>>reatessss -htdocuinstead oeeDOCUS,......i|alidvadm>>reatesssssdvitdocuinstead oeeDOCUS,......i|alipdadm>>reatesssss as docuinstead oeeDOCUS,......islipdadm>>reatesssss ps docuinstead oeeDOCUS,..nl # aronivanoo \nl # arnl # ar$$."$as_dir" || es u& d_exRe Lc_rocedu\s_bases u& d_exRe rocar_echs`-ena| ywbocedusl);; # E"wek t wands,btte" 3.1.sh.$:"e :; c)stoe :vanoo \nl # ar Olipr c_tF]" ileiza w Foce=ck c`lipr - acritppe s. os\#_roce H as_qd_roce=ck/?_k _rv`lipr a w Foce=ck cFEATUREtesssssdo-fck=$?_x=yesFEATUREt( etc.inw_roce=ck FEATURE=nnot __roce=ck FEATURE[=ARG] =$?_x=yesFEATUREt[ARGor b]t __roce=ck mpi[=nds,.]ssssatanMPI (pile wreec1' sdewe'IFs_MPI nds, instead o.peataadvlrchitenn]) -"; q'ofo_stac # ice"$asame ts_echoIf fail. sxc;c_rocedio.peataadvlrchitenn]) -"; q'g] edewpr #xchoinem !oexpr,c # os[C1gu apc(I .peataadvlrchitenn]) -"; q' # os[X] By,rir"nds, instead oewpr #kshr),.peataadvlrchitenn]) -"; q'onVncho, lamcho, choch, choch2,ways lcho_gnu.peataadvlrchitenn]) -"; q'(Iys l's_MPI k _rv' m aibis rs),ways lcho_ays l.peataadvlrchitenn]) -"; q'(Iys l's_MPI k _rvIys lm aibis rs),wsun (Sun MPI),.peataadvlrchitenn]) -"; q'ibm'(IBMb chaPOE). Els_dir" |lihelTLIB k _rvnose ad,.peataadvlrchitenn]) -"; q'I to ent t]sXX'I toFCnd VAR Vailroari Genalibis r.peataadvlrchitenn]) -"; q' fail. sx( efdirot __roce=ck roce=n]) -"; q'_echoIf t troce=n(pile wreec1' st __roce=ck _rocen]) -"; q'atan_rocen(pile wreec1' st __roce=ck nti _H]) -"; q'oce=ck __VECTORn(pile wreec1' st __roce=ck _HELP__TR"; q'oce=ck __M] eKEISANn(pile wreec1' st __roce=ck P__-e ]) -"; q'oce=ck __SXF-e (pile wreec1' st __roce=ck P__vannot _H q'oce=ck __CRAYFISH.";" (pile wreec1' st __roce=ck hke4= ]) -"; q'oce=ck __HYPREt(pile wreec1' st __roce=ck f$hxAC_ _HELPq'oce=ck __NOMICROINSTRUCORCE=t(pile wreec1' st __roce=ck devenn]) -"; q'oce=ck dev psep[Oa t (pile wreec1' st __roce=ck degle ]) -"; q'oce=ck degle a t (pile wreec1' st S alwayfad,nn CP Uatio: sep[OP__NO]s='za wsXX'''''''''C++ alibis re .lina wsXX=' T''''C++ alibis reTLIB a wis r_th'''''le d reTLIB , VAR= -L< ivalip>e_G([you;; ailibr+onfi_env.peataadvlrchitnons_l # t ir = "X-n < ivalip>a wiIBSdvlrchitilibr+onfid Vpassnd VAR Vle d r, VAR= -la wst_this chit(Oprevedus) C/C++ e4=lro;ntforeTLIB , VAR= -I<$?_x=yeslip>e_G.peataadvlrchit[you;; aCPREPORTt STAnons_l # t ir = "X-n <$?_x=yeslip>a wsCaadvlrchitC alibis re .lina ws r_th'''''tC alibis reTLIB a w ---dvlrchitC e4=lro;ntfora wFCaadvlrchitbv`rternalibis re .lina wFs r_th'''''bv`rternalibis reTLIB a Us[X] s of "m[sqrpeaoge ofrme VAR V # icest ae Vby be , srintinstle axRe i_ACEOkshroilibr+onfiI to a wrs s k _rvnons_l # t i sla/TATUS,wdes, kc_cv_eglesnd VAR V6]" ile $asame r.rnl # arth!sheue li?r$$."$as_dir" r" && d_exRe L LAtywbocedusihelp.entatiwe'IFse conf$ lib_, $c_gwd_IFsn ircritpper.disbls_dirr X"$aogntiR {annh lib__aonf$do-s_lineno-c as_bax:'ir" $as_-d "$a } /^X\(\/c as_dirs=lrchit{ \`cdKRsre ir'ir"s -- # for"$eck=.is alwa'ir"eG_NOTX\(\/c as_d;break=lrchit $as_-d "$a }/c wi Ge alwaydle di(\/c as_diio..)X"$aogn=*i|aliprrors_p wi Ge alh wa'rors_p wi Gerc_itol_ cho ksh8"$aogn=*i|alip/ s/.ae_echorocddo c's|^\.annot|| q # A ".."irr Xehe-fir = "X-n r X"$0 ogn=*i|alithe deUs_p wi Ge alh w s/.ae_echorocddo=*i|ali c's|/[^nnot |/..|g;s|/|| q s_bases us_p wi Ge alh dio.pe"")rrors_p wi Ge alh wa'rors_p wi Gerc_itol_ chotem \`rors_p wi Gerc_itol_es us_p wi Ge alh /entem \`$o e ir rex ) 2> s_p wi Ge al=lac ,y x ) 2> wi Ge al=lac ,y orocddo=*i|ali #irr Xb]" w# t alibUS,bility: s us_p wi Ge al_es us_p wi Ge_t 1 fi dle dir\chogntiRA .)X # W conf$wi Geest -d "$as_."$a }/c .is alway$a }/c s_p } /^Xs_p wi Ge alh y$a }/c 2> s_p } /^X_lAIntem annot cwd"cannot ccal# A a ECHOrose u$a }/c .is alwr\chognorocddo=*i|ali;y$a }/c s_p } } y$a }/c 2> s_p } +onfisre i+om \s_kcs$?nvHOrose u$a }/c .is alwrs us_p wi Ge_t 1 fir\chognorocddo=*i|aliy$a }/c s_p } /^Xs_p wi Ge_t 1 fir\chogny$a }/c 2> s_p } /^X_lA/ +onfisre ir rex ) 2> } /^X 2> s_p } orocddo=*i|aliylnd inX\(\/c as_dirst{ th!sheue li?;RINe as_qd host_tcedus:?krr Xgu a 'tye , srint u$a }$as_dir" fin th!s_dir=/e , srint gnu_l."; \(n';; # Ec;c_roceduVER ein th!s_dir=/e , srint gnu_..disblaywbocedusc_rocnhat") 2> fin th!s_dir=/e , srint_l."; \(n';; # Ec;c_roceduVER ein th!s_dir=/e , srint_..disblaywbocedusc_rocnhs,.peataa_this est "x$as_myse t benoscek t wands,btavalsn -V,ais r X"$0 ognack $cxter| th!sheue li?lnd inX\(\/c >/d crst{ th!sheue li?;Rbreakd host${ $$."_dir" || es u& d_exRe Lc_itolidi$as_" >&$4 at"es u& d_elag..-ec_rocedu\s_noo \nl # ar 3.1 ;;lisre i.sh.$ generhn wdby ' m br iwe m2.67, wepyrot cc(C) 2010 Free Softwonf$Fou # -V,dewnc. ete#b ;;lisre itT Aut helTree softwonfc_roc Free Softwonf$Fou # -V, gduss unlimin wdp nth_cr_lettecepy,vtastribECHOI to>> by=uld nl # aro" as# \#boc} fi it $as_statust the sn ##oc} br iwe most as_dst u a. ##oc} fi it $as_statust the sn ##o e ocdKS cxx_try__echoIf -1a=kme} fi it $as_statust the sname or zsso'_echoIf iwe _dir.$as_dxu as toost asrslt' etc.ies, ucceed"" ocdKS cxx_try__echoIf Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as__s=ln el_dir.$as_ prext*/{ {t{ th!try_myse# fchoIf"dle di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse# fchoIf"gers el_dir.ofrhe deUsheue li?lndat") 2> s el_dir.ofrl."; \(ng$c_int='^ *+' el_dir.ofr s el_dir.of1lnd inat el_dir.of1e>&5i+o mv=ln el_dir.of1e el_dir.ofrhe cka $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;bre_itq sourc withse# xx_wsre i_TLIBdirs= e ir=.. ase el_dir.ofrhe }'ir"eG_NOTs el_dir.$as_ prextl." :he deUostti s0sre ir/k_this est "x$as_mychaseto a wrs "can:"e>&5iS c_g ^/| /' iwe _dir.$as_dxue>&5i deUostti s1 cka xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS cxx_try__echoIfo e ocdKS c_try__echoIf -1a=kme} fi it $as_statust the snam or zsso'_echoIf iwe _dir.$as_dxu as toost asrslt' etc.ies, ucceed"" ocdKS c_try__echoIf Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as__s=ln el_dir.$as_ prext*/{ {t{ th!try_myse# fchoIf"dle di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse# fchoIf"gers el_dir.ofrhe deUsheue li?lndat") 2> s el_dir.ofrl."; \(ng$c_int='^ *+' el_dir.ofr s el_dir.of1lnd inat el_dir.of1e>&5i+o mv=ln el_dir.of1e el_dir.ofrhe cka $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;bre_itq sourc withse# _wsre i_TLIBdirs= e ir=.. ase el_dir.ofrhe }'ir"eG_NOTs el_dir.$as_ prextl." :he deUostti s0sre ir/k_this est "x$as_mychaseto a wrs "can:"e>&5iS c_g ^/| /' iwe _dir.$as_dxue>&5i deUostti s1 cka xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS c_try__echoIfo e ocdKS c_try__pp -1a=kme} fi it $as_statust the or zsso'e4=lro;ntf iwe _dir.$as_dxu as toost asrslt' etc.ies, ucceed"" ocdKS c_try__pp Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as_ {t{ th!try_myse# pp iwe _dir.$as_dxu"dle di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse# pp iwe _dir.$as_dxu"gers el_dir.ofrhe deUsheue li?lndat") 2> s el_dir.ofrl."; \(ng$c_int='^ *+' el_dir.ofr s el_dir.of1lnd inat el_dir.of1e>&5i+o mv=ln el_dir.of1e el_dir.ofrhe cka $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;bre>e el_dir.ie_itq sourc withse# _e4=lro;_wonn_TLIBhse# _wsre i_TLIBdirs= e ir=.. ase el_dir.ofrhe }l." :he deUostti s0sre ir/k_this est "x$as_mychaseto a wrs "can:"e>&5iS c_g ^/| /' iwe _dir.$as_dxue>&5i $a }/c ostti s1 cka xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS c_try__ppo e ocdKS fc_try__echoIf -1a=kme} fi it $as_statust the snamm or zsso'_echoIf iwe _dir.$as_dxu as toost asrslt' etc.ies, ucceed"" ocdKS fc_try__echoIf Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as__s=ln el_dir.$as_ prext*/{ {t{ th!try_myse# fchoIf"dle di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse# fchoIf"gers el_dir.ofrhe deUsheue li?lndat") 2> s el_dir.ofrl."; \(ng$c_int='^ *+' el_dir.ofr s el_dir.of1lnd inat el_dir.of1e>&5i+o mv=ln el_dir.of1e el_dir.ofrhe cka $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;bre_itq sourc withse#f _wsre i_TLIBdirs= e ir=.. ase el_dir.ofrhe }'ir"eG_NOTs el_dir.$as_ prextl." :he deUostti s0sre ir/k_this est "x$as_mychaseto a wrs "can:"e>&5iS c_g ^/| /' iwe _dir.$as_dxue>&5i deUostti s1 cka xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS fc_try__echoIfo e ocdKS c_try_G)et-1a=kme} fi it $as_statust the or zsso'le d iwe _dir.$as_dxu as toost asrslt' etc.ies, ucceed"" Assumes oc;c_rEPREFIX/sbin*can*_l un ocdKS c_try_G)et Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as_ {t{ th!try_myse#le d"dle di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse#le d"gers&5i+odeUsheue li?lnd $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;bre_itq th!try_'./iwe _dir$as_dxedxutoch{t{ le di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse#try"gers&5i+odeUsheue li?lnd $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;br; }l." :he deUostti s0sre ir/k_this est "x$as_my a wrs [EPin wdk _rv" >&$4_$deU" >&$4"e>&5i+oeataa_this est "x$as_mychaseto a wrs "can:"e>&5iS c_g ^/| /' iwe _dir.$as_dxue>&5i $a }a }/c ostti s$as_" >&$4 cka _s=lrn el_dir.dSYM el_dir_ipa8_ el_dir.ooa xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS c_try_G)eo e ocdKS c__echute_ayst-1a=km EXPR VAR INCLUDESe} fi it $as_statust the sname $as_statust the or onfid Vkshror $?_echoIf-rocene ad,'ofoEXPR t STA a wrs "c;c_rit _f"*+".";NCLUDESdir" test VAR accoreestly. Rst assrslt' etc.iene ad,'c;$as_l "."_echuted ocdKS c__echute_ayst Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as_ _dir" rn the p is r_threniquel."; \(n# DinVn est upc_ as"dsize,"_echuteVAR Vloas tohi bou nndlet eldefs.h -oo nl # a s el_dir.$as_dxu /* ::; eldefs.h. exR $4 ays maiet Exit" >&icways _dir_array [1 -o2 * !(";2) >ba0)]; _dir_array [0]_ba0i $a i+oost asr0; } nl # ar ocdKS c_try__echoIf "s_linen"l." :he deUlo=0 deUmids0s rsloIf :r X"$X) inat eldefs.h -oo nl # a s el_dir.$as_dxu /* ::; eldefs.h. exR $4 ays maiet Exit" >&icways _dir_array [1 -o2 * !(";2) &icways _dir_array [1 -o2 * !(";2) &icways _dir_array [1 -o2 * !(";2) >ba$as_mid)]; _dir_array [0]_ba0i $a i+oost asr0; } nl # ar ocdKS c_try__echoIf "s_linen"l." :he deUlo=$as_mid;Rbreaksre ir/k s, wear _rv'('v$as_mid ')' -o1'ir"s -hi=$achti _dir"yse#mid -le $as_hi;Rl."; e deUlo= deUhi=; e breaks cka s, wear _rv2 '*'v$as_mid ir"s -mids_echti cka_s=ln re el_dir.ofr el_dir.$as_ prext iwe _dir.$as_dxuost${ re ir/kdeUlo= deUhi=;cka_s=ln re el_dir.ofr el_dir.$as_ prext iwe _dir.$as_dxuocka_s=ln re el_dir.ofr el_dir.$as_ prext iwe _dir.$as_dxuo# Bin % ses/liliprwe." loas tohi bou nndsloIf s_lineno-c lo [e he hdeUhi"r X"$X) s, wear _rv'('v$as_hi -"yse#lo ')' /v2 +"yse#lo ir"s -mids_echti inat eldefs.h -oo nl # a s el_dir.$as_dxu /* ::; eldefs.h. exR $4 ays maiet Exit" >&icways _dir_array [1 -o2 * !(";2) &icw evlays evas_k()tqtost asr$2d ho" >&icwun ign c evlays u evas_k()tqtost asr$2d ho#$?_x=yeso#$?_x=yesoays maiet Exit.peper ;*f_bafonVn (" el_dir.at w, "w");as_ (! ) s/.most asr1;as_ (";2) > el_dir.at ;awrs $3 < el_dir.at ;adeUostti s0sre ir/kdeUostti s1 cka_s=ln re *. re re. el_dir.* gmon.pto bb.pto iwe _dir$as_dxedxufixil el_dir.$as_ prext iwe _dir.bes " el_dir.$as_dxu _s=ln el_dir.ti e cka xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS c__echute_ayso e ocdKS c__us:?_CPREPO__echoIf -1a=km HEADER VAR INCLUDESe} fi it $as_statust the sname $as_statust the tatust the or_lisrslt' etcHEADER exilisrs tor #b$?_echoIfdaadarithelp=rMETISBy,ses, we.";NCLUDESdir" test r $?_lways_$ts='012VAR accoreestly. ocdKS c__us:?_CPREPO__echoIf Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritpperr X$2"e>&5i $as_ec_et" acritpperr X$2ptmi"e>&6d ho as_kms_lin\"\={$3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6 re ir/knat eldefs.h -oo nl # a s el_dir.$as_dxu /* ::; eldefs.h. exR $4 #$?_x=yes<$2> nl # ar ocdKS c_try__echoIf "s_linen"l." :he as_kmy3ryes" re ir/k as_kmy3rno";cka_s=ln re el_dir.ofr el_dir.$as_ prext iwe _dir.$as_dxuocka as_kc_cresdo{k3\(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'ienta:_$deUoss"e>&5i $as_eckmyse#oss"e>&6d hostxpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} } e ocdKS c__us:?_CPREPO__echoIfo e ocdKS fc_try_G)et-1a=kme} fi it $as_statust the or zsso'le d iwe _dir.$as_dxu as toost asrslt' etc.ies, ucceed"" Assumes oc;c_rEPREFIX/sbin*can*_l un ocdKS fc_try_G)et Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as_ {t{ th!try_myse#le d"dle di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse#le d"gers&5i+odeUsheue li?lnd $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;bre_itq th!try_'./iwe _dir$as_dxedxutoch{t{ le di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse#try"gers&5i+odeUsheue li?lnd $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;br; }l." :he deUostti s0sre ir/k_this est "x$as_my a wrs [EPin wdk _rv" >&$4_$deU" >&$4"e>&5i+oeataa_this est "x$as_mychaseto a wrs "can:"e>&5iS c_g ^/| /' iwe _dir.$as_dxue>&5i $a }a }/c ostti s$as_" >&$4 cka _s=lrn el_dir.dSYM el_dir_ipa8_ el_dir.ooa xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS fc_try_G)eo e ocdKS fc_try_le d -1a=kme} fi it $as_statust the sn or zsso'le d iwe _dir.$as_dxu as toost asrslt' etc.ies, ucceed"" ocdKS fc_try_le d Exit the $@"0est -z error (1'p1intf %s' $4 = "X-n $as_echlineno=as_echo "$as"$3"}{as__s=ln el_dir.$as_ prext iwe _dir$as_dxedxuas_ {t{ th!try_myse#le d"dle di((";en try"s/.ae_p\"alis.\`alis.\\oceRATtry_s esr X"$0trye i+om \RATtry_s esrX"$0trye ir rex as_kc_ctry_s esr"\"\=as_lineno-errck=$as_lineno-e$c_ctry_s es\"" s/.ae_echoroctry_s esd;bre>&5i+o( as_kmyse#le d"gers el_dir.ofrhe deUsheue li?lndat") 2> s el_dir.ofrl."; \(ng$c_int='^ *+' el_dir.ofr s el_dir.of1lnd inat el_dir.of1e>&5i+o mv=ln el_dir.of1e el_dir.ofrhe cka $as_echo "$as_meno-errck=$as_lineno-e\$?_ba$as_" >&$4"e>&5i+o) 2> $as_" >&$4_ba0;bre_itq sourc withse#f _wsre i_TLIBdirs= e ir=.. ase el_dir.ofrhe }'ir"eG_NOTs el_dir$as_dxedxuf_itq sourc rn the p is r_threniqueirs= e "$a_dir_x iwe _dir$as_dxedxuas_ }l." :he deUostti s0sre ir/k_this est "x$as_mychaseto a wrs "can:"e>&5iS c_g ^/| /' iwe _dir.$as_dxue>&5i deUostti s1 cka # Dipntf r $?IPA/IPO'(Iys r Pro;ndurs_kAnalysis/Olipmdst u a)tavalsn -V,a # = # Gewdby r $?PGInalibis re( el_dir_ipa8_ el_dir.oo),.inwiourculda # ays rfse ck _rvr $?ndxuele d iw .lin;adlsc_ apntf afir = "X-n c;c_ribash olef .`shshroby Apple'n alibis r. eWe$do-sies,bef re EPREFIest r $?acS,wdes, _s=lrn el_dir.dSYM el_dir_ipa8_ el_dir.ooa xpr X"$cho "$as"$3"}{;-s_lineno-cho "$as"$3"}{s_baxe_itqthe $@"0est; un enthe $@"0es;} _des, we en_" >&$4_$deUostti } e ocdKS fc_try_le ddlet s elig.logoo nl # arete#bfoIf iwec_srsrs yliquie , o a ducewdby alibis rsrsloIf G)edbLet eligure,astotidr. exDoui .fb ;;lisre i srs mili . It"cann= # Gewdby 3.1"x$as_i.sh.$,rsloch"can generhn wdby ' m br iwe m2.67. eInvATUS,wd"iw .linele e"can r/k_1) A$@ nl # arol_pr5>s elig.logxitvanoo nlSUNAMEoc} fi it $as ##oc} Platalsn. ##oc} fi it $as ##o r #") 2>= `(r #") 2>|| un) 2> n)xpr X"$as\)//* c1q` un) 2> m>= `(un) 2> m)xpr X"$as\)//*| s estunknown` un) 2> r>= `(un) 2> r)xpr X"$as\)//*| s estunknown` un) 2> s>= `(un) 2> s)xpr X"$as\)//*| s estunknown` un) 2> v>= `(un) 2> v)xpr X"$as\)//*| s estunknown` ' t _bin/un) 2> p>= `(' t _bin/un) 2> p)xpr X"$as\)//*| s estunknown` _bin/un) 2> X'''''= `('bin/un) 2> X)xpr X"$as\)//////*| s estunknown` 'bin/s/lillllllllllllll= `('bin/s/li)xpr X"$as\)///////////////*| s estunknown` _ t _bin/s/lil-klllllll= `(' t _bin/s/lil-k)xpr X"$as\)////////*| s estunknown` _ t _ evex/getsysi -t = `(' t _ evex/getsysi -t)xpr X"$as\)//*| s estunknown` _ t _bin/r #i -t lllll= `(' t _bin/r #i -t)xpr X"$as\)///////*| s estunknown` _bin/ate]ppe-llllllllll= `('bin/ate]ppe)xpr X"$as\)////////////*| s estunknown` _ t _bin/oslev lllllll= `(' t _bin/oslev )xpr X"$as\)////////*| s estunknown` _bin/unilag.ellllllllll= `('bin/unilag.e)xpr X"$as\)///////////*| s estunknown` nlSUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e i=)pper exFIXME:ong] e: hss_e irost${ IFS=$x$asave_IFSi re>&5idlet s&5oo nl # arboc} fi it $as_s ##oc} C re ) 2>s. ##oc} fi it $as_s ##o nl # arboc Kec_ia c_gcas VAR=eniw .linele exRemStrip=ptoconf$his .---lineonf$hywbocedc_ mAR=eys.un----aoIf upxRemStrip=ptoconyw # Prbecausn wecWARNINnti=astooce rdwioupr Xfu ile unsxRemAlsc_quo---lios\_rs iwec_srex$as=]"X)meta-cha_gcs rsxRemMyse# w Vpassnfid Val, CST(FClroa reduplilete-ono+brokesuppre_cr_l ocd ;;lisre _\_rs= ocd ;;lisre _\_rs0= ocd ;;lisre _\_rs1= ocdmuir_kec__ndxu=fae irrr X"$apassniR 1 2idvi irr X"$anvs. 'X"$X) inabases u=*+oio.peatnf$his .---|conf$hionfixfla.|f$hywbocedc_ |conf$hr*eRINe as_q || entei|alips =*i|alips=*) s/.ps ir=; c_roc$1; as -qi|alququie ?|aliquie ?|aliquie?|aliqui?|aliqu?|aliqivar+onfec RINe as_q || ente*\'*movf traouns .O s/.ae_echorocs . c"s/'/'\\\\\\\\''/g"`as_dir" || i]*-//nabases upassniR]*-//1:;_HELP_ail.ineocd ;;lisre _\_rs0 " 'orocs ."$as_dir" 2. case $asail.ineocd ;;lisre _\_rs1 " 'orocs ."$_echo_r _dir"yse#muir_kec__ndxul= true;Rl."; ocdmuir_kec__ndxu=fae i e G\)$' xue,ab]" id Vnlsn l._echo_rre ir nabases u=*+oio. nch aliqi ;;lisealwaysliqCsliqoce=ck c aliqioce=ck c aX"$aaliqoce=ck aliqioce=ck aliqgaags=; gonfixffp |conff aX"$aaliq|alips =*i|alips*uie ?|aliquie ?|al*uie t=*.|alin aX"$aaliq Pr.|ali # P.|alValiq Pr.r;; as_t $?_k _recnfixil)\(\/\/le di(\/c ;;lisre _\_rs0 " io. nnnnn(\/c ;;lisre _\_rs1"*" 'orocs ." "* eRINe as_q || ir" || i] ir" || ir-* eRocdmuir_kec__ndxu=true || || i]*-//e cka case $asail.ineocd ;;lisre _\_rs " 'orocs ."$_echo_rs_dir" || i]*-${ ${ {eocd ;;lisre _\_rs0t; un enthcd ;;lisre _\_rs0;} {eocd ;;lisre _\_rs1t; un enthcd ;;lisre _\_rs1;} eniqueAays rrupn wdr Xexit'd, cleanup _dmpobr+yLA as_mts torods, t "."_eelig.log. eWe$t=$hostiw .e Hlubecausn liowoif yliquo--sUS, w r "."rculd,causnClro=ckmsdr Xlook utly. #yse t beUs[X'\''astoocpre_liquRINep #roah ck _rS, w #c_gp. #yse t beDo-fck=li v_env_$c_gp c t be_rvaanewo "$,.dupper a FreeBSD 4.0egle. c_gp 'exitUsheue li?lndemS; aayso"_eelig.log_s alwayalsn -V,ac;c_rnot ccxRe rocr. exDoui ._ec{ $a }ae_e pper exFIXME:onc} fi it $as_status ##oc} Clways_$ts='01s. ##oc} fi it $as_status ##" $a }ae_e $a }n wd"irrl, Cex$awoif"s! ritest r $?_lwaysmilhs tsbinnewo "$sUS, ' xues, (i irr X"$as_dir X`( engers&1 cxfl'\''s/^\([a-zA-Z_][a-zA-Z0-9_*=*) .* /^Xp'\''`r X"$X) iripdf irips iri\ oib i/$as-----suQuotinconfdvan*eno-enl}*movf trae $$]*+on?:se $0onfdvanta*cv_e*)_{d $as_echo "$as_meno-errck=$as_lineno-ese t be_lways_$ts='012*+on?:seiwec_srsrsnnewo "$"e>&5i $as_eckmys$as_myse t be_lways_$ts='012*+on?:seiwec_srsrsnnewo "$"e>&2;}; c_echo_r|| i]*-//e e $$]*+on?:se $0onfdvanta_ IFS ( cdnl = "0onfdvantaBASH_ARGV ( BASH_SOURCE)expr X"$as_dir= "0onfdvanta*)_{dxpr X"$as_dir; un ent"$as_di;}; c_echo_r|| irs_dir" || i]*-${ ( engers&1 b i/$as-----cdnl`(as_"pgca='\''a'\''; engers&1`tinconfdvan*eno-enl}as_"pgca=\ *movf tra cxflX"$"s/'\''/'\''\\\\'\'''\''/g; s^\\([s_ltoe :; c_envcv_e[s_ltoe :; c_env\*) \{ X\)/\\1='\''\\2'\''/p$_echo_rs_confdvan*movf tra cxfl"/^[s_ltoe :; c_envcv_e[s_ltoe :; c_env=/p$_echo_rs_dir" || iX"$as_diort ) $a }ae_e pper exFIXME:onc} fi it $as_statuss ##oc} Otoche _$ts='01s. ##oc} fi it $as_statuss ##" $a }ae_e $a }pr X"$as_dir X"$0 subir_rexp $a }X"$X) i iripdf irips iri\ oib i/$/$as-----suQuotin bothte*\'\''m \RATti sl s/.ae_echoroccth ( c"s/'\''/'\''\\\\\\\\'\'''\''/g"` c_echo_r|| i]*-//e s/.ae_echorocctr='\''oroccth'\''" $a }X"nysliiort $a }ae_e pper $as_dir" || es usubir_A as__l."; \(n';exFIXME:onc} fi it $as_statussss ##oc} Fu?|asubirituS,wdes ##oc} fi it $as_statust t ##" $a } }ae_e $a } }pr X"$as_dir X"$0 subir_ -n, lino-X"$ ripdf irips iri\ oib as-----suQuotin *\'\''m \RATti sl s/.ae_echoroccth ( c"s/'\''/'\''\\\\\\\\'\'''\''/g"` c_ || i] s/.ae_echorocctr='\''oroccth'\''" $a } }X"nysliiort $a } }ae_e $a }pi pper $as_dir" s eldefs.hl."; \(n';exFIXME:onc} fi it $as_s ##oc} eldefs.h. ##oc} fi it $as_s ##" $a } }ae_e $a } }nat eldefs.h $a } }ae_e $a }pi $a }sourc r$0 signth (!ba0xc;c_rocedu\)$'`ex[^-._$ts='caut ccsignth r$0 signth ocedu\)$'`ex[^-._$ts='olidi$exitUsheue ocre>&5i+o_s=ln re *. re re. el_dir.* c;c_roc_s=ln -r el_dir* eldefs* el$$* r$0 clean_ -n c;c_rocolidi$exitUsheue ' 0rrr X"$asignth iR 1 2 13 15r X"$X)c_gp '"$asignth='r$0 signth'; se $asolidi1' r$0 signth ${ "$asignth=0 } eldefs.h avoids OS"iw .linele e"alig_rvliminsxc;c_rDEFS r #exceed. _s=ln -r el_dir* eldefs.h i $as_eckm/* eldefs.h */"e>e eldefs.h i# Predefho$a e4=lro;ntforeeeybeizat plet s> eldefs.h o nl # ar#defho$ .";"AGE_NAME[^-.";"AGE_NAME" nl # arblet s> eldefs.h o nl # ar#defho$ .";"AGE_Te AME[^-.";"AGE_Te AME" nl # arblet s> eldefs.h o nl # ar#defho$ .";"AGE_VERSION[^-.";"AGE_VERSION" nl # arblet s> eldefs.h o nl # ar#defho$ .";"AGE_STR t [^-.";"AGE_STR t " nl # arblet s> eldefs.h o nl # ar#defho$ .";"AGE_BUGREPORT[^-.";"AGE_BUGREPORT" nl # arblet s> eldefs.h o nl # ar#defho$ .";"AGE_URL[^-.";"AGE_URL" nl # arboc LchoinensitSBy,se levesRINels r-ct$?_lwaysy,se $asiINnti=fid .i# Prefer #explilitREFI leve$a y,se er auton -calREFI leve$a { s. "$asitl."1= as_ "$asitl."2= as_ $as_dir" || eCONFIG_SITEihelp.entatiWe$do-"sourti=aa'g] e ses/lil2S as_qlig.sit=./$as----CONFIG_SITE t con( _roc-m \`rorsitl."1=./-CONFIG_SITE|| ente*/m \RATsitl."1=-CONFIG_SITE|| ente* \`$rorsitl."1=./-CONFIG_SITE|| enr rex hat") 2> t bt 1 fiFIXME: as_omatcedu waG_itl."1=-h in .rord/s_qlig.sitdu waG_itl."2=-h in etc/s_qlig.sitdre ir/k _reitl."1=-aladvtas_ith in .rord/s_qlig.sitdu waG_itl."2=-aladvtas_ith in etc/s_qlig.sitd e pr X"$asitl." t c r$0 sitl."1"c r$0 sitl."2"idvi is_lineno-c sitl."s_bax as_Air" $as_-d "$aat") 2> X"$as\)//!=c r$0 sitl."r'ir"eG_NOTIwTr$0 sitl."rl."; \(n{d $as_echo "$as_meno-errck=$as_lineno-eloa est sitSBtT Aut r$0 sitl."r'>&5i $as_eckmys$as_myloa est sitSBtT Aut r$0 sitl."r'>&6;host_tS c_g ^/| /' r$0 sitl."r'>&5i+o . r$0 sitl."r'\c_rocedrst{ {d $as_echo "$as_meno-errck=$as_lineno-esre i: t ci arepwd':r'>&5i $as_eckmys$as_mysre i: t ci arepwd':r'>&2;} acdKS sre ir r=`chasetoso'loa sitSBtT Aut r$0 sitl." h , ybe , sr.log'l2S am re dec_sls" "s_linen" 5 d host e ${ $as_dir" IwTr_lwayl."rl."; \# S alwlag..-efh i bash chasybb/ere L L X"$as\)//(rcritth -n, le octualRE),wso wecavoid$doest r at. DJGPP emula--sUSntheaa'regulaOBy,se."$aat") 2> X"$as\)//!=c r_lwayl."r'ir"eG_NOTfwTr_lwayl."rl."; \(n{d $as_echo "$as_meno-errck=$as_lineno-eloa est _lwaysr_lwayl."r'>&5i $as_eckmys$as_myloa est _lwaysr_lwayl."r'>&6;host_tas----_lwayl."tin bothteannot cwd"cannot cca.wTr_lwayl."rc_echo_r* \`$$$$$$$$$$$$$$$$$$$$.wTAT"_lwayl."rc_echo|| i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-e s .-est _lwaysr_lwayl."r'>&5i $as_eckmys$as_my s .-est _lwaysr_lwayl."r'>&6;host>r_lwayl." \#bocedus:?kc;c_rAR V6;sre irof "m[sqrpesavedUS, w #_lways;; akephoinensam "."' xue ocd lway rrupn w=fae irrr X"$as_dir X"$0 X;sre ir rexpr X"$X)'' #( old. } is a as_kc_env_${kc_s. } $X)'' #( new. } is a kc_env_${kc_s. } $X)'' #( old.ips ira as_kc_env_${kc_s.e ad,.pe'' #( new.ips ira kc_env_${kc_s.e ad,.peas-----suold. } ,$ new. } tin both } ,movf tra{d $as_echo "$as_meno-errck=$as_lineno-esre i: i arekc_'"cannr" |lo i areold.ips'US, w #X;sve irorunr'>&5i $as_eckmys$as_mysre i: i arekc_'"cannr" |lo i areold.ips'US, w #X;sve irorunr'>&2;host_te deUSlway rrupn w=:rs_dir" , engovf tra{d $as_echo "$as_meno-errck=$as_lineno-esre i: i arekc_'"cannfck=l} tin w #X;sve irorunr'>&5i $as_eckmys$as_mysre i: i arekc_'"cannfck=l} tin w #X;sve irorunr'>&2;host_te deUSlway rrupn w=:rs_dir" ,)|| ente* _echo_r _dir"eno-c old.ips [e he hdeUnew.ipsrl."; # diffse nvidith wink;"pgca$do-"soulrs d Vkhasint u -c old.ips_w=`s_eckx o-c old.ips`u -c new.ips_w=`s_eckx o-c new.ips`u irs=lrchit{ \e"X"$as\)//ps`u -c nUnew.ipsrengovf tra{d $as_echo "$as_meno-errck=$as_lineno-esre i: i h . hangetosot te=l} tin w #X;sv arepwd':r'>&5i $as_eckmys$as_mesre i: i h . hangetosot te=l} tin w #X;sv areporun 2;host_te deUSlway r ._echoengovf tra{d $as_echo "$as_meno-errck=$as_e4=l_my:acritp"irrlvidith win hangesmysre i: t: i sot te=l} tin w #X;sv arepwd':r'>&5i $as_eckme4=l_my:acritp"irrlvidith win hangesmysre i: t: i sot te=l} tin w #X;sv areporun 2;nta*)_{dxpr X\rs=lrchit{ breakgovf tra{d $as_echo "$as_meno-errck=$as_e_e $merensam s_enr" |lo i arearepwd':r'>&5i $as_eckme_e $merensam s_enr" |lo i areareporun govf tra{d $as_echo "$as_meno-errck=$as_e_currUatio:am s_nr" |lps`u -cearepwd':r'>&5i $as_eckme_currUatio:am s_nr" |lps`u -ceareporunr'>&2;fiFIG_SITE||h Pbase;c_rAR V6;sre irof mS; aaysodi$exilaOBy,se."$a"old. } ,$ 3s. } \"s_ba.ri\ oib i/$aps`u -c new. } || e*movf tr_{dxpr X\RATti sl s/.ae he hdeUorocs . c"s/'/'\\\\\\\\''/g"` e*movf tr_{dxpr Xi/$aps`u -c \''/g"`as_dir" || i]*" nnnnn(\/c ;;lis "---suQuotin_\_rs1"*" 'oro ( cd Awso weupplate ag.woif ylensinnotaccuracy.l."rc_eka case $asail.ineocd ;;lisre _\_rs " 'o ayl."rc_echo|| host_" >&$4t_te deUSlway "s_ba.ri\cedrst{ {d $as_echo "$as_meno-errck=$as_lineno-esre i: t ci arepwd':r'>&5i $as_eckmys$as_mysre i: t ci arepwd':i\cedrst{ {d $as_echo "$as_meno-errck=$as_lineno- hangesmysr=l} d,nn CP Uatic'''bv`rromi; q' # /^Xsarepwd':r'>&5i $as_eckmys$as_m hangesmysr=l} d,nn CP Uatic'''bv`rromi; q' # /^Xsarep2e $@"0es;} } acdKS sr fc_EPREFIXtece$$* r'yLA /re irrmst _lwaysr_l']) -";Do-fcsqrp dec_sls" "s_wayu a. ##oc} fi it $as_stldefs.hMh>oabod Cex$a sit_dst u a. ##oc} fi it $as_stit $aa _dir=sre icpp='$TLIB$br+y>a w' _\_rsewdby='$TC -cB$blina w$br+y>a wg ^/| /' iwe _dir.$as' _\_ fc_='$TC -o"eG_NOTs el_dir$as$blina w$br+y>a wg$TLIB a w ^/| /' iwe _dir.$alip>$as' _\_ucewdby ays =ld.ips \_ucewdby ays " nl RecanncHEAD"irrdefho$a e4et" aibis #touch ./srOTUS,_nl # a.h #rms./srOTUS,_nl # a.h #touch ./srOTUS,_nl # a.h br+y>a w="" " nl _" ewe'Is]) -"; -"sry grabbavoid$)crsr $?PGIna) -"; q' os[X] use_$?P=nol." \#booost asror b]t __roc arek # n. li?r$$."$a{ b]t __$?Pn\"\=3s. } \"s_ba. } b]t _ }/c b]t __$?P; _echo_r b]t _ }/itr_threniquecedrst{ {d $as_echo "$as_meno-errck=$as_*** host_tceduc_quewe'm or zsso' OS"iw k_gp c ***arepwd':r'>&5i $as_eckm*** host_tceduc_quewe'm or zsso' OS"iw k_gp c ***arepl."echo}xocnhedrst{ {d $as_echo "$as_meno-errck=$as_*** Fs[X] ocdKS _" stead rcul b]t _ }/'m or zsso' OS"iw k_gp c ***arepwd':r'>&5i $as_eckm*** Fs[X] ocdKS _" stead rcul b]t _ }/'m or zsso' OS"iw k_gp c ***arepl."ayu ocdKS cedu $a a c_gca }n wd"irrewe'tecepy,vtk _rv# Ose ewenl #AMewenl eweCHnl eweCH2 rculdal ewenl ),wsClusterTools (tmcc,tmCC,tmf77,tmf90)y,seq'ibm'(IBM (mpcc_r,mpCC_r,mpxlf_r)_gcs ny a c_gsoe By,rir"nds, in #_lwEATUR) -"; qs_l # _echo_r b]t _ }/it) -"; qhreniquel.Ex Kectq' # os[X] w=asta c" choc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, choc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_ choc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfi choc w=faOse ewe dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c" cho++"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, cho++_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_ cho++" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfi cho++ w=faOse ewe dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c" chf90"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chf90_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_ chf90" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfi chf90 w=faOse ewe dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/itlam; qhreniquel.Ex Kectq' # os[X] w=asta c" choc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, choc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_ choc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfi choc w=faLAM/ewe dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c" chCC"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chCC_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_ chCC" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfi chCC w=faLAM/ewe dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c" chf90"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chf90_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_ chf90" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfi chf90 w=faLAM/ewe dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/it chohhreniquel.Ex Kectq' # os[X] w=asta c" choc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, choc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_ choc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfi choc w=faeweCH dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c" chCC"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chCC_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_ chCC" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfi chCC w=faeweCH dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c" chf90"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chf90_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_ chf90" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfi chf90 w=faeweCH dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/it choh2hreniquel.Ex Kectq' # os[X] w=asta c" choc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, choc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_ choc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfi choc w=faeweCH 2 dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c" choxx"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, choxx_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_ choxx" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfi choxx w=faeweCH 2 dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c" chf90"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chf90_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_ chf90" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfi chf90 w=faeweCH 2 dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/ituldal chays hreniquel.Ex Kectq' # os[X] w=asta c" chgoc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chgoc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_ chgoc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfi chgoc w=faIldal ewe +rhn wCcewdby a dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c" chg++"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chg++_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_ chg++" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfi chg++ w=faIldal ewe +rhn wCcewdby a dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c" chgw=f Ken"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chgw=f Ken_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_ chgw=f Ken" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfi chgw=f Ken w=faIldal ewe +rhn wCcewdby a dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/ituldal chauldalhreniquel.Ex Kectq' # os[X] w=asta c" chhoc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chhoc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_ chhoc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfi chgoc w=faIldal ewe +aIldal Ccewdby a dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c" chicpc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chhopc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_ chopc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfi chopc w=faIldal ewe +aIldal Ccewdby a dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c" chiw=f "ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, chhw=f _dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_ chiw=f " signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfi chiw=f w=faIldal ewe +aIldal Ccewdby a dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/itsunhreniquel.Ex Kectq' # os[X] w=asta c"tmcc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,tmcc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_tmcc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfitmcc w=fa),wsMwe dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c"tmCC"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,tmCC_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_tmCC" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfitmCC w=fa),wsMwe dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c"tmf90"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,tmf90_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_tmf90" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfitmf90 w=fa),wsMwe dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/itubmhreniquel.Ex Kectq' # os[X] w=asta c" ccc_r"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, ccc_r_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_ ccc_r" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCCdKRsre its PR t_eweCC=_as_kmy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCCdK" ass_ }les;} } acdKS srC r "pgca onfi ccc_r w=faIq'ibm'(Mwe dec_sls" "s_w i]*-r=CC=_deweCC" e_e $a l.Ex Kectq' # os[X] w=asta c"mpCC_r"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, cCC_r_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_ cCC_r" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweCXX" Rsre its PR t_eweCXX=_as_kmy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweCXX" " ass_ }les;} } acdKS srC r "pgca onfi cCC_r w=faIq'ibm'(Mwe dec_sls" "s_w i]*-r=CXX=_deweCXX" e_e $a l.Ex Kectq' # os[X] w=asta c" cxf90_r"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy, cxf90_r_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_ cxf90_r" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa re_itq sourcts PR t_eweFCdKRsre its PR t_eweFC=_as_kmy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a }pi pper eweFCdK" ass_ }les;} } acdKS srC r "pgca onfi cxf90_ w=faIq'ibm'(Mwe dec_sls" "s_w i]*-r=FC=_deweFC".$as_l _echo_r b]t _ }/itguesthreniquew=fae iPR t.X"s choc chgoc chhocitmcc ccc_riR $g]l.Ex Kectq' # os[X] w=asta c"$e iPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCC"XME: as_omatps PR t_eweCC=_deweCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCC=_de iPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3eweCC=ourcts PR t_eweCC "2= as_ $as_deweCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCCdKepwd':r'>&5i $eweCCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a as_ $as_deweCC"hss_i=; | host as_ $as_deweCC"h|| eweCC=_as_k $a }pi pper eweCCdK" ass_ }sre ir/k{d $as_echo "$as_meno-errck=$as_WARNING: C r "pgca onfi ny roc a -"; qsw=fae C or zssordKepwd':r'>&5i $as_ech_WARNING: C r "pgca onfi ny roc a -"; qsw=fae C or zssordKep2l."echo}xoCC=_deweCC" e_e $a w=fae iPR t.X"s cho++i chCC choxx chg++ chhopcitmCC cCC_riR $g]l.Ex Kectq' # os[X] w=asta c"$e iPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweCXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweCXX"XME: as_omatps PR t_eweCXX=_deweCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweCXX=_de iPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3eweCXX=ourcts PR t_eweCXX "2= as_ $as_deweCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweCXX" epwd':r'>&5i $eweCXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a as_ $as_deweCXX"hss_i=; | host as_ $as_deweCXX"h|| eweCXX=_as_k $a }pi pper eweCXX" " ass_ }sre ir/k{d $as_echo "$as_meno-errck=$as_WARNING: C r "pgca onfi ny roc a -"; qsw=fae C++ or zssordKepwd':r'>&5i $as_ech_WARNING: C r "pgca onfi ny roc a -"; qsw=fae C++ or zssordKep2l."echo}xoCXX=_deweCXX" e_e $a w=fae iPR t.X"s chf90 chfci chgw=f Ken chiw=f tmf90 cxf90_riR $g]l.Ex Kectq' # os[X] w=asta c"$e iPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_eweFCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_deweFC"XME: as_omatps PR t_eweFC=_deweFC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_eweFC=_de iPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3eweFC=ourcts PR t_eweFC "2= as_ $as_deweFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'eweFCdKepwd':r'>&5i $eweFCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a as_ $as_deweFC"hss_i=; | host as_ $as_deweFC"h|| eweFC=_as_k $a }pi pper eweFCdK" ass_ }sre ir/k{d $as_echo "$as_meno-errck=$as_WARNING: C r "pgca onfi ny roc a -"; qsw=fae F=f Ken or zssordKepwd':r'>&5i $as_ech_WARNING: C r "pgca onfi ny roc a -"; qsw=fae F=f Ken or zssordKep2l."echo}xoFC=_deweFC".$as$a }sre ir/k{d $as_echo "$as_meno-errck=$as_fs to GCC $CXX $FCdKepwd':r'>&5i $as_ech_fs to GCC $CXX $FCdKep6l."ec _echo_r b]t _ }/ityethreniquesre ir/k{d $as_echo "$as_meno-errck=$as_You w= r "likfr o rcu GCC $CXX $FCr o or zssoigp c ewe supp=f "Kepwd':r'>&5i $as_ech_You w= r "likfr o rcu GCC $CXX $FCr o or zssoigp c ewe supp=f "Kep6l."echo}xoles;} } acdKS srC r "pgcareocgnizge ois ewe implementatk _-e' b]t _ }/itec_sls" "s_way $a l.or zssors sh r "s t&5isiquercu_ zs=yet" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_ewe was"pgca b]t _d. Buildet" non-parallel qrpsk _ta cPPM."Kepwd':r'>&5i $as_ech_ewe was"pgca b]t _d. Buildet" non-parallel qrpsk _ta cPPM."Kep6l."ay -e'{CXXFLAGS="-O3"} -e'{CFLAGS="-O3"} -e'{FCFLAGS="-O3"} # C_ec_ssw=fabasic.or zssori nd flags e i nt=cpp e icpp='$CXXCPP $CPPFLAGS' e icr zsso='$CXX -c $CXXFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CXX -o.ornf /' $e i nl ntK$CXXFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oxxior zssorays "2= as_ $+o) CXX"XME: as_o"2= as_ $as_dCCC"XME: as_oxoCXX=dCCCs_oecho}xo"2= as_ $as_durctool PRefix"XME: as_ow=fae iPR t.X"sg++ o++igpp aCC CC oxx co++icl. nloFCC KCC RCC xlC_r xlCtss_ee $a l.Ex Kectq' # os[X] w=asta c"durctool PRefix$e iPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e itool PRefix$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_CXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_dCXX"XME: as_omatps PR t_CXX=_dCXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_CXX=_de itool PRefix$e iPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3CXX=ourcts PR t_CXX "2= as_ $as_dCXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'CXX" epwd':r'>&5i $CXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a } as_ $as_dCXX"hss_i=; |ss_e iray"2= as_ $+o) CXX"XME: as_ourctt_CXX=dCXX _ow=fae iPR t.X"sg++ o++igpp aCC CC oxx co++icl. nloFCC KCC RCC xlC_r xlCtR $g]l.Ex Kectq' # os[X] w=asta c"$e iPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_urctt_CXXn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_durctt_CXX"XME: as_omatps PR t_urctt_CXX=_durctt_CXX" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_urctt_CXX=_durcPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3urctt_CXX=dhosts PR t_urctt_CXX "2= as_ $as_durctt_CXX"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'urctt_CXX" epwd':r'>&5i $arctt_CXX" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a as_ $as_darctt_CXX" ss_i=; | host }pi pper arctt_CXX" XME: as_oxoCXX="g++" siecho}xocacu Gcrossior zsset":de itool warned.X" yet:) $3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kepwd':r'>&5i $as_ech_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kep2l."e itool warned=yet ;; esacs_oxoCXX=durctt_CXX cho||ay $o||ay# Provaogeso'biinw=fmatk _ abouarboc or zssor.d':r'>&5i $as_echo "$as_meno-errck=$as_lineno-e acriC++ or zssor qrpsk _"KepwdcannXe'urctr zsso e ior zssor=$2 w=fae ioptk _ X"s--qrpsk _t-v -V -qqrpsk _ ir rex{x{xe itry=_durctr zssor $e ioptk _ epw" cacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durctr zssor $e ioptk _ epw") 2>ornf /' irpes_omatstatus=$?>&6"2= as_ $s ornf /' irpeXME: as_oxosed.'10a\ perrras_ a cstdrpe ouapuardele ed.pers_oxoooooo10q' ornf /' irpe >ornf /' irp1}xocat ornf /' irp1hl."$as$arm'ir"ornf /' irp1hornf /' irpes_o':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi" host cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF e iolean_fsso IFS==durctlean_fsso e iolean_fsso =_durctlean_fsso a.ouara.oua.dSYMra. nlob.oua"# Tryr o o=; t tEn oc;c_rEP.gp couar-o.os[X], disregaasta.oua.# I] will help us diagnocu broken or zssors,i nd findet" ouara_ X"tuitk _# a c nl nt. $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rrboc C++ or zssor w=aksperr X$2"e>&5i $as_ec_et" wheE: rrboc C++ or zssor w=aksperr X$2ptmi"e is_mk_defaeno=`':r'>&5i $arcs_mk" | sed.'s/r-o.*ornf /' [^ ]*//'` # Toc possirEP.ouapuarfsso :"e ifsso =_a.ouarornf /' irxerornf /' ra. nloa_oua. nlob.ouarornf /' i*" "e irmfsso = w=fae ifsso X"sae ifsso iR $g]cacu Ge ifsso X"}xo*i$e i ntK| *.xcoffK| *.tdsK| *.dK| *.pdbK| *.xSYMr| *.bbr| *.bbgr| *.mapr| *.inwK| *.dSYMr| *.or| *.obj ) ;; * )xe irmfsso = $arcrmfsso Ge ifsso";; esacs hostrm'ir"$arcrmfsso xedxu{xe itry=_durcs_mk_defaeno" cacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durcs_mk_defaeno") 2>l."matstatus=$?>&6':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi"s_ba. }# Autoornf-2.13ror r "s arboc hosts nl ntKvari_rEP. o `no'.# Salignor tEX }/ue a c`no', oE: rwisge ois w= r "lead. o `EXEEXT no'# X"sa Makefsso. We sh r "pgcasqrpeaogehosts nl ntKxeditiwas"_ec_et,# ualthaarboc rcur[lisrsh rt-circuite ois as_ w=faor zssors unknown. o # Autoornf. w=fae ifsso X"sae ifsso s'aiR $g]l."r'ir"eGe ifsso"h|| orntinue$g]cacu Ge ifsso X"}xo*i$e i ntK| *.xcoffK| *.tdsK| *.dK| *.pdbK| *.xSYMr| *.bbr| *.bbgr| *.mapr| *.inwK| *.dSYMr| *.or| *.obj ) ;; [ab].ouar) # We fs to boc defaeno oc;c_rEP, butc nl nt='asis misa # certaX"ly right. i=; ;; *.*r) e>&r$$."$a{d.ips nl ntn\"\=3s. } \ ss_r$$."$ad.ips nl nt" !no; _ba. };iecho} &2;hosts nl nt=`expr"eGe ifsso"h: '[^.]*\(\..*\)'` $as # We } \ hosts nl ntK: rlobecausge ofrl t r as_ w=faiteis"pgcs # safch_cross or zssors may"pgcaado boc suffixKxedgiva. isr`-o' # argumentctualwe may"peed. o knowaiteaarboaarpoX"t al=; dy. # Eva. e>&rois sectk _ looks orufty:aitehas"boc hdvantage a # actually w=aket". i=; ;; *r) i=; ;; esacs hostr$$."$ad.ips nl nt" noKRsre its nl nt= " i]*-r=e ifsso='aray"2= as_ $+o) e ifsso";_ }sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"':r'>&5i $as_ech_fassodXPR t STAwas:"Kepwdcad.'s/^/| /'.ornf /' i$e i ntKepw {sre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdK77 "C++ or zssor lispgcao=; t t oc;c_rEPs Sees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eyet"Kepwd':r'>&5i yet"Kepptmi"ay$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acriC++ or zssor defaeno ouapuarfssoA`('bperr X$2"e>&5i $as_ec_et" acriC++ or zssor defaeno ouapuarfssoA`('bperr X$2ptmi"(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'urcfsso"hepwd':r'>&5i $arcfsso"hepptmi"e i nl nt=ad.ips nl nt trm'ir"-r a.ouara.oua.dSYMra. nloornf /' $e its nl ntKb.oua e iolean_fsso =durctlean_fsso IFS=$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acrisuffixKa c nlc;c_rEPsperr X$2"e>&5i $as_ec_et" acrisuffixKa c nlc;c_rEPsperr X$2ptmi"e>&xu{xe itry=_durcs_mk" cacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durcs_mk") 2>l."matstatus=$?>&6':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi"s_ba. }# If boE: `ornf /' irxe'i nd `ornf /' 'i r t`plinent' (well, obcurv_rEP) # catc: `ornf /' irxe'. F=fainstancbigp c Cygwin, `ls ornf /' ' will # w=akXPR perly (i.e.,_lif r o `ornf /' irxe'), whsso X] w=n'tigp c # `rm'. w=fae ifsso X"sornf /' irxerornf /' rornf /' i* ir rexl."r'ir"eGe ifsso"h|| orntinue$g]cacu Ge ifsso X"}xo*i$e i ntK| *.xcoffK| *.tdsK| *.dK| *.pdbK| *.xSYMr| *.bbr| *.bbgr| *.mapr| *.inwK| *.dSYMr| *.or| *.obj ) ;; *.*r);hosts nl nt=`expr"eGe ifsso"h: '[^.]*\(\..*\)'` r'i=; ;; * )xi=; ;; esacs host i]*-r=srsre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdKS srlispgcaor zuteisuffixKa c nlc;c_rEPs: lispgcaor zsso nd s_mk Sees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi"ayrm'ir"ornf /' oornf /' $e its nl nt"(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'urcps nl nt" epwd':r'>&5i $arcts nl nt" epptmi"rm'ir"ornf /' i$e i nt EXEEXT=ad.ips nl nt e i nl nt=aEXEEXT cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #incluoge int maX"s() $FILE *f f pe"s("ornf /' ioua", "w"); returnf} acdK(f)h|| fclocu (f)h!0t $; return0t } _ACEOF e iolean_fsso =_durctlean_fsso ornf /' ioua" # C_ec_lthaarboc or zssor PR duco nlc;c_rEPslwe lisrrun. If pgc, eiE: r # boc or zssor is broken, orlwe lross or zsso. $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rrwe r tlross or zsso-eperr X$2"e>&5i $as_ec_et" wheE: rrwe r tlross or zsso-eperr X$2ptmi"e>&r$$."$acrossior zsset"" !yethreniquexu{xe itry=_durcs_mk" cacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durcs_mk") 2>l."matstatus=$?>&6':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi"exxedxue itry='./ornf /' $e its nl nt'uexu{xcacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durctry") 2>l."matstatus=$?>&6':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi"sba0;br; >&2;crossior zsset"=nos_oecho}xo"2= as_ $acrossior zsset"" = maybea0;br; crossior zsset"=yet"xoecho} srsre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdKS srlispgcaruniC++ or zssodXPR t STs. If you meantr o o=oss or zsso, rcu \`--5isa'. Sees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi"s_e wi $o||ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'crossior zsset"" epwd':r'>&5i $crossior zsset"" epptmi"rm'ir"ornf /' i$e i ntoornf /' $e its nl ntKornf /' ioua e iolean_fsso =durctlean_fsso IFS=$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acrisuffixKa cobjecarfsso perr X$2"e>&5i $as_ec_et" acrisuffixKa cobjecarfsso perr X$2ptmi"e>&r$$."$a{d.ips objentn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF rm'ir"ornf /' io"ornf /' iobj"e>&xu{xe itry=_durcor zsso" cacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durcor zsso") 2>l."matstatus=$?>&6':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi"s_ba. }w=fae ifsso X"sornf /' io"ornf /' iobjrornf /' i* ir rexl."r'ir"eGe ifsso"h|| orntinue;$g]cacu Ge ifsso X"}xo*i$e i ntK| *.xcoffK| *.tdsK| *.dK| *.pdbK| *.xSYMr| *.bbr| *.bbgr| *.mapr| *.inwK| *.dSYMr) ;; *);hosts objent=`expr"eGe ifsso"h: '.*\.\(.*\)'` xooooooi=; ;; esacs host i]*-r=':r'>&5i $as_ech_fassodXPR t STAwas:"Kepwdcad.'s/^/| /'.ornf /' i$e i ntKepw {sre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdKS srlispgcaor zuteisuffixKa cobjecarfsso : lispgcaor zsso Sees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi"ayrm'ir"ornf /' .$hosts objent"ornf /' i$e i nt ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts objent" epwd':r'>&5i $arcts objent" epptmi"OBJEXT=ad.ips objent e iobjent=$OBJEXT $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rrwe r tuset" boc hn wC++ or zssordKepwd':r'>&5i $as_ec_et" wheE: rrwe r tuset" boc hn wC++ or zssorperr X$2ptmi"e>&r$$."$a{d.ips oxxior zssorays n\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $#ifndef __hn C__ xoooooohe ke me #etoif $; return0t } _ACEOF e>&e ifn oxxitry'or zsso ec_sls" "s_ }l ior zssorays =yet" i]*-r=l ior zssorays =nosayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt d.ips oxxior zssorays =$l ior zssorays ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts oxxior zssorays " epwd':r'>&5i $arcts oxxior zssorays " epptmi"e>&r$$."$l ior zssorays yethreniqueGXX=yet" i]*-r=GXX=3my3urcs= e CXXFLAGS='{CXXFLAGSn\"\=3urcIFS=$CXXFLAGS='CXXFLAGS $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rr$CXX accepts -eperr X$2"e>&5i $as_ec_et" wheE: rr$CXX accepts -eperr X$2ptmi"e>&r$$."$a{d.ips PR t_oxxign\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6urcIFS=$oxxiw} acd_flag=$l ioxxiw} acd_flag &2;hostxxiw} acd_flag=yet"xod.ips PR t_oxxig=nos_o CXXFLAGS="-t" sigcat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF e>&e ifn oxxitry'or zsso ec_sls" "s_ }l ios PR t_oxxig=yet" i]*-r=CXXFLAGS="" xooooocat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF e>&e ifn oxxitry'or zsso ec_sls" "s_ }" i]*-r=l ioxxiw} acd_flag=$l iIFS=$oxxiw} acd_flag CXXFLAGS="-t" ocat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF e>&e ifn oxxitry'or zsso ec_sls" "s_ }l ios PR t_oxxig=yet"ayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt ayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt ayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt &2;hostxxiw} acd_flag=$l iIFS=$oxxiw} acd_flag ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts PR t_oxxig" epwd':r'>&5i $arcts PR t_oxxig" epptmi"e>&r$$."$aurcs= e CXXFLAGS3s. } \"s_ba.-r=CXXFLAGS=$urcIFS=$CXXFLAGS"ec _echo_r$arcts PR t_oxxig yethreniquee>&r$$."$aGXX" yethreniqueCXXFLAGS="-t -O2" siecho}xoCXXFLAGS="-t" si$as_l"e>&6"2= as_ $aGXX" yethreniqueCXXFLAGS="-O2" siecho}xoCXXFLAGS= $o||aya i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays a i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays "2= as_ $as_durctool PRefix"XME: as_ol.Ex Kectq' # os[X] w=asta c"${urctool PRefix}gcc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,${urctool PRefix}gcc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_CCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_dCC"XME: as_omatps PR t_CC=_dCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_CC=_d{urctool PRefix}gcc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3CC=ourcts PR t_CC "2= as_ $as_dCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'CCdKepwd':r'>&5i $CCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay ay"2= as_ $+o) e its PR t_CC"XME: as_ourctt_CC=dCCs_ol.Ex Kectq' # os[X] w=asta c"gcc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,gcc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_urctt_CCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_durctt_CC"XME: as_omatps PR t_urctt_CC=_durctt_CC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_urctt_CC=_gcc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3urctt_CC=dhosts PR t_urctt_CC "2= as_ $as_durctt_CC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'urctt_CC" epwd':r'>&5i $arctt_CCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay }pi pper arctt_CC" XME: as_oxoCC="" xoecho}xocacu Gcrossior zsset":de itool warned.X" yet:) $3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kepwd':r'>&5i $as_ech_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kep2l."e itool warned=yet ;; esacs_oxoCC=durctt_CC si$as_l"e>&6CC=_durcts PR t_CC""ay"2= as_ $+o) CC"XME: as_oxooooooo"2= as_ $as_durctool PRefix"XME: as_o_ol.Ex Kectq' # os[X] w=asta c"${urctool PRefix}cc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,${urctool PRefix}cc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_CCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_dCC"XME: as_omatps PR t_CC=_dCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_CC=_d{urctool PRefix}cc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3CC=ourcts PR t_CC "2= as_ $as_dCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'CCdKepwd':r'>&5i $CCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $o||ay"2= as_ $+o) CC"XME: as_ol.Ex Kectq' # os[X] w=asta c"cc"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,cc_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_CCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_dCC"XME: as_omatps PR t_CC=_dCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e> ae iPR t_rejecaed=no>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;e>&r$$."$au ir'i/tir.w=as$e i nl _dirth= "/usr/ucb/cc"XME: as_oxooooe iPR t_rejecaed=yet"xoocrntinue$g]_e wi $_omatps PR t_CC=_cc" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asa _echo_r$arcPR t_rejecaed yethrenique# We fs to a bog _ X"s ofrpathctualmakeisurerwe neqrp rcu it"ss_canndummy,$e its PR t_CC s_chift>&6"2= as_ $#h!0tME: as_o_ol.W t&5isi a differencaor zssor froms ofrbogus e i.s_o_ol.Howeqrp,aitehas"boc s('bibacu`('b, ualthe bog _ will s t&5isique# os[X] "2=we } \ CCr o jusarboc bacu`('b; usge ofrfull fssoA`('bpuechift>&6_omatps PR t_CC=_de ir'i/tir.w=as${1+' '}$@" $o||aymy3my3CC=ourcts PR t_CC "2= as_ $as_dCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'CCdKepwd':r'>&5i $CCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay ay"2= as_ $+o) CC"XME: as_o"2= as_ $as_durctool PRefix"XME: as_ow=fae iPR t.X"scl. nltss_es_o_ol.Ex Kectq' # os[X] w=asta c"$urctool PRefix$arcPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e itool PRefix$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_CCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_dCC"XME: as_omatps PR t_CC=_dCC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_CC=_durctool PRefix$arcPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3CC=ourcts PR t_CC "2= as_ $as_dCC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'CCdKepwd':r'>&5i $CCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay ."r' as_ $as_dCC"hss_i=; |ss_e iray"2= as_ $+o) CC"XME: as_ourctt_CC=dCCs_ow=fae iPR t.X"scl. nltR $g]l.Ex Kectq' # os[X] w=asta c"$e iPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_urctt_CCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_durctt_CC"XME: as_omatps PR t_urctt_CC=_durctt_CC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_urctt_CC=_durcPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3urctt_CC=dhosts PR t_urctt_CC "2= as_ $as_durctt_CC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'urctt_CC" epwd':r'>&5i $arctt_CCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a as_ $as_darctt_CC"hss_i=; | host }pi pper arctt_CC" XME: as_oxoCC="" xoecho}xocacu Gcrossior zsset":de itool warned.X" yet:) $3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kepwd':r'>&5i $as_ech_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kep2l."e itool warned=yet ;; esacs_oxoCC=durctt_CC si$asayay as_ $+o) CC"hss_{sre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdKS srno accept_rEP.Caor zssor fs to X"s\aogntiSees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi"# Provaogeso'biinw=fmatk _ abouarboc or zssor.d':r'>&5i $as_echo "$as_meno-errck=$as_lineno-e acriC or zssor qrpsk _"KepwdcannXe'urctr zsso e ior zssor=$2 w=fae ioptk _ X"s--qrpsk _t-v -V -qqrpsk _ ir rex{x{xe itry=_durctr zssor $e ioptk _ epw" cacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durctr zssor $e ioptk _ epw") 2>ornf /' irpes_omatstatus=$?>&6"2= as_ $s ornf /' irpeXME: as_oxosed.'10a\ perrras_ a cstdrpe ouapuardele ed.pers_oxoooooo10q' ornf /' irpe >ornf /' irp1}xocat ornf /' irp1hl."$as$arm'ir"ornf /' irp1hornf /' irpes_o':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi" host $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rrwe r tuset" boc hn wC or zssordKepwd':r'>&5i $as_ec_et" wheE: rrwe r tuset" boc hn wC or zssorperr X$2ptmi"e>&r$$."$a{d.ips oior zssorays n\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $#ifndef __hn C__ xoooooohe ke me #etoif $; return0t } _ACEOF e>&e ifn oitry'or zsso ec_sls" "s_ }l ior zssorays =yet" i]*-r=l ior zssorays =nosayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt d.ips oior zssorays =$l ior zssorays ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts oior zssorays " epwd':r'>&5i $arcts oior zssorays " epptmi"e>&r$$."$l ior zssorays yethreniqueGCC=yet" i]*-r=GCC=3my3urcs= e CFLAGS='{CFLAGSn\"\=3urcIFS=$CFLAGS='CFLAGS $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rr$CC accepts -eperr X$2"e>&5i $as_ec_et" wheE: rr$CC accepts -eperr X$2ptmi"e>&r$$."$a{d.ips PR t_ocign\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6urcIFS=$oiw} acd_flag=$l ioiw} acd_flag &2;hostiw} acd_flag=yet"xod.ips PR t_ocig=nos_o CFLAGS="-t" sigcat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF e>&e ifn oitry'or zsso ec_sls" "s_ }l ios PR t_ocig=yet" i]*-r=CFLAGS="" xooooocat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF e>&e ifn oitry'or zsso ec_sls" "s_ }" i]*-r=l ioiw} acd_flag=$l iIFS=$oiw} acd_flag CFLAGS="-t" ocat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ int maX"s() $ $; return0t } _ACEOF e>&e ifn oitry'or zsso ec_sls" "s_ }l ios PR t_ocig=yet"ayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt ayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt ayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt &2;hostiw} acd_flag=$l iIFS=$oiw} acd_flag ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts PR t_ocig" epwd':r'>&5i $arcts PR t_ocig" epptmi"e>&r$$."$aurcs= e CFLAGS3s. } \"s_ba.-r=CFLAGS=$urcIFS=$CFLAGS"ec _echo_r$arcts PR t_ocig yethreniquee>&r$$."$aGCC" yethreniqueCFLAGS="-t -O2" siecho}xoCFLAGS="-t" si$as_l"e>&6"2= as_ $aGCC" yethreniqueCFLAGS="-O2" siecho}xoCFLAGS= $o||ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_s_ec_et" acritCC optk _ to accept ISO C89perr X$2"e>&5i $as_ec_et" acritCC optk _ to accept ISO C89perr X$2ptmi"e>&r$$."$a{d.ips PR t_ocic89n\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6urcps PR t_ocic89=no>SrcIFS=$CC=dCCscat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #incluoge #incluoge #incluoge #incluoge /* Mos_ a c' # oollowet" b/' s r tstola. fromsRCS 5.7's src/ornf.sh. */ struct buedxuX"t x4_baFILE * (*rcs pe") (struct bued*, struct statd*, X"t); static.ohar *e (p, X) ooooohear **p; uX"t i; $ returnp[i]t } static.ohar *f (ohar * (*g) (ohar **, X"t),ohear **p,.per) $ hear *s; vaas_s_ v; vaastart (v,p); s g (p, vaaarg (v,X"t)); vaaeto (v); returnst } /* OSF 4.0 Cr zaq cc is so'bis=f a calmisa-ANSI by defaeno. Itehas functk _ PR totypes nd stuff, butcpgca'\xHH' hex hearact r ornstantsrs_oxThecu d=n'tiPR v ke En acdKunw=ftunately,ainstead. r tsssontly t=; t d &2;hs 'x'. T # oollowet" induco En acd,Kuntil $std is added. o get &2;PR per ANSI modo. Curiously '\x00'!='x'calways or o ouarbrue, w=faequearraytsszeeaarleaso. It's neco saryr o write '\x00'==0. o get so'bthet"uethaa's brue o"ly gp c $std. */ X"t osf4_ociarrayt['\x00' =0 ? 1 : -1]t /* IBMwC 6 w=faAIX is almisa-ANSI by defaeno, butcicareplaco macro para'bters insaogestret"s nd hearact r ornstantsr */ #def_me FOO(x) 'x' X"t xlc6_ociarray[FOO(a) ='x'c? 1 : -1]t X"t r$$."(X"t i, d=urEP.x); struct s1 {X"t (*f)"(X"t a);}; struct s2 {X"t (*f)"(d=urEP.a);}; X"t pair`('bs"(X"t,ohear **, FILE *(*)(struct bued*, struct statd*, X"t), X"t, X"t); X"t argc; hear **argv; int maX"s() $returnf (e, argv, 0)h!argv[0] h|| f (e, argv, 1)h!argv[1]t $; return0t } _ACEOF w=fae iarg X"s'as-qlanglvl= ntc89s-qlanglvl=ansa $std \ -Ao e-Aa -D_HPUX_SOURCE" e-Xc -D__EXTENSIONS__"iR $g]CC=_durcIFS=$CCr$arcarg">&6"2=e ifn oitry'or zsso ec_sls" "s_ }l ios PR t_ocic89=$arcarg ayrm'ir"orrerornf /' irpe ornf /' i$e iobjentl." as_ arcts PR t_ocic89" !"xas_Kss_i=; | hostrm'ir"ornf /' i$e i nt CC=durcIFS=$CC |ay# AC_CACHE_VAL cacu " arcts PR t_ocic89" X" x) oooosre ir/k{d $as_echo "$as_meno-errck=$as_lineno-easne"peeded_Kepwd':r'>&5i asne"peeded_Kepptmi ;; xas) oooosre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eunsupp=f ed_Kepwd':r'>&5i unsupp=f ed_Kepptmi ;; *)s_oxoCC="$CCr$arcts PR t_ocic89" oooosre ir/k{d $as_echo "$as_meno-errck=$as_lineno-e arcts PR t_ocic89" epwd':r'>&5i $arcts PR t_ocic89" epptmi ;; esacspi pper arcts PR t_ocic89" !xass_ }aya i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays a i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays (\/\/ s_{d $as_echo "$as_meno-errck=$as_s_ec_et" how. o runiboc CaPRePR co sordKepwd':r'>&5i $as_ec_et" how. o runiboc CaPRePR co sorperr X$2ptmi"# On Suns, so'bti'bs"$CPP `('bs"a directory. "2= as_ $as_dCPP" ss_r$$."-ds_dCPP""s_ba.-r=CPP=ray"2= as_ $+o) CPP""s_ba.-r=e>&r$$."$a{d.ips PR t_CPPn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6_o_ol.D=urEP.quor$$obecausgeCPP `eeds tors texp nd d &2; acriCPP ias_dCC -E" edCC -E -traditk _al-cpp" e/lib/cpp" &2; _es_o_oooe iPRePR c_ok=fai"e>w=fae i iPRePR c_warn_flag X"s'asyo iR $g]# Usi a heador fsso thaaror o gp c gccctualornfiguret" glibc$g]# gp c fresh cross-or zssor w=aksp$g]# Plif r tor=e>&__STDC__ is def_medctuince$g]# exi' s eva. o. freestandet" or zssorsp$g]# Oniboc NeXT, cc -E runsrboc oroge oroughrboc or zssor's parser,$g]# pgcajusarboroughrcpprr Syntax acd" is : rlo o oatc: rois cacu.>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #ifdef __STDC__# X"cluoge #)i"e># X"cluoge #etoif o_oooSyntax acd _ACEOF e>&e ifn oitry'opp ec_sls" "s_ }" i]*-r=# Brokenh_fasss e X }/io X"pua.crntinue$ayrm'ir"ornf /' .rpe ornf /' ii"ornf /' i$e i nt $g]# OK, w=aks e Xsane cacusr Now.s_ec_ wheE: rrasnexi' encaheadors$g]# lisrs tdbtecaed nd how.>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #i"cluoge _ACEOF e>&e ifn oitry'opp ec_sls" "s_ }r=# Brokenh_succo s _ X" }/io X"pua.crntinue$ i]*-r=# Passes boE: b/' s. e iPRePR c_ok=: i=; |ayrm'ir"ornf /' .rpe ornf /' ii"ornf /' i$e i nt $ host# Becausgea c`i=; ', _AC_PREPROC_IFELSE's tleanet" orogewas"skipped.rm'ir"ornf /' .irornf /' irpe ornf /' i$e i nt if,$e iPRePR c_oks_ }r=i=; |ay &2; _ene >&2;hosts PR t_CPP= CPP .$as$aCPP= hosts PR t_CPPd)i"e>&6urcps PR t_CPP= CPP ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'CPP" epwd':r'>&5i $CPP" epptmi"e iPRePR c_ok=fai"e>w=fae i iPRePR c_warn_flag X"s'asyo iR $g]# Usi a heador fsso thaaror o gp c gccctualornfiguret" glibc$g]# gp c fresh cross-or zssor w=aksp$g]# Plif r tor=e>&__STDC__ is def_medctuince$g]# exi' s eva. o. freestandet" or zssorsp$g]# Oniboc NeXT, cc -E runsrboc oroge oroughrboc or zssor's parser,$g]# pgcajusarboroughrcpprr Syntax acd" is : rlo o oatc: rois cacu.>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #ifdef __STDC__# X"cluoge #)i"e># X"cluoge #etoif o_oooSyntax acd _ACEOF e>&e ifn oitry'opp ec_sls" "s_ }" i]*-r=# Brokenh_fasss e X }/io X"pua.crntinue$ayrm'ir"ornf /' .rpe ornf /' ii"ornf /' i$e i nt $g]# OK, w=aks e Xsane cacusr Now.s_ec_ wheE: rrasnexi' encaheadors$g]# lisrs tdbtecaed nd how.>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #i"cluoge _ACEOF e>&e ifn oitry'opp ec_sls" "s_ }r=# Brokenh_succo s _ X" }/io X"pua.crntinue$ i]*-r=# Passes boE: b/' s. e iPRePR c_ok=: i=; |ayrm'ir"ornf /' .rpe ornf /' ii"ornf /' i$e i nt $ host# Becausgea c`i=; ', _AC_PREPROC_IFELSE's tleanet" orogewas"skipped.rm'ir"ornf /' .irornf /' irpe ornf /' i$e i nt if,$e iPRePR c_oks_ }t i]*-r=srsre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdKS srCaPRePR co sor \ $CPP\"_fasss sanity.s_ec_ Sees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi"aya i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rr${MAKE-make} } \s \$(MAKE)perr X$2"e>&5i $as_ec_et" wheE: rr${MAKE-make} } \s \$(MAKE)perr X$2ptmi"cannxr${MAKE-make} e imake=`':r'>&5i $2" | sed.'s/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if,_ }/x_r$$."\"\${d.ips PR t_make_${d.imake}_cann\"\=\"3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6cat >ornf /' imakei<<\_ACEOF SHELLs. /bin/sh all: @>&5i '@@@%%%=$(MAKE)=@@@%%%' _ACEOF # hn wmakeiso'bti'bs"pret\s "make[1]: Enteret" per", whsc: w= r "ornfusgeus. cacu `${MAKE-make} ir"ornf /' .makei2>/dev/null`.X" *@@@%%%=?*=@@@%%%*)s_oxo_ }/xe ips PR t_make_${d.imake}_can=yet;; *)s_oxo_ }/xe ips PR t_make_${d.imake}_can=no;; esacsrm'ir"ornf /' .makeray"2=_ }/xr$$."\$e ips PR t_make_${d.imake}_can yethreniquexu/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-eyet"Kepwd':r'>&5i yet"Kepptmi"ooSET_MAKE=" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ooSET_MAKE="MAKE=${MAKE-make}""ay"2= as_ $as_durctool PRefix"XME: as_ol.Ex Kectq' # os[X] w=asta c"${urctool PRefix}ranlib"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,${urctool PRefix}ranlib_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_RANrrBn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_dRANrrB"XME: as_omatps PR t_RANrrB=_dRANrrB" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_RANrrB=_d{urctool PRefix}ranlib" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3RANrrB=$hosts PR t_RANrrB "2= as_ $as_dRANrrB"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'RANrrB" epwd':r'>&5i $RANrrB" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay ay"2= as_ $+o) e its PR t_RANrrB"XME: as_omatpt_RANrrB=$RANrrBs_ol.Ex Kectq' # os[X] w=asta c"ranlib"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,ranlib_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_matpt_RANrrBn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_durctt_RANrrB"XME: as_omatps PR t_matpt_RANrrB=_durctt_RANrrB" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_matpt_RANrrB=_ranlib" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3matpt_RANrrB=$hosts PR t_matpt_RANrrB "2= as_ $as_durctt_RANrrB"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'urctt_RANrrB" epwd':r'>&5i $arctt_RANrrB" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay }pi pper arctt_RANrrB" XME: as_oxoRANrrB=_:" xoecho}xocacu Gcrossior zsset":de itool warned.X" yet:) $3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kepwd':r'>&5i $as_ech_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kep2l."e itool warned=yet ;; esacs_oxoRANrrB=$hostt_RANrrB si$as_l"e>&6RANrrB=_durcts PR t_RANrrB""aya i nt=a{d.ifc_src nt-f} e icr zsso='$FC -c $FCFLAGS $d.ifcflags_src nt.ornf /' i$e i ntKepw' e is_mk='$FC -o.ornf /' $e i nl ntK$FCFLAGS $LDFLAGS.$d.ifcflags_src nt.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts fcior zssorays "2= as_ $as_durctool PRefix"XME: as_ow=fae iPR t.X"sgw=ftran g95 xlf95 f95 f=f if=f ifc efc pgw=ftran pgw95 lf95 ftn xlf90 f90 pgw90 pghp2=_pcw90 g77 xlf f77 ff pgw77 cf77 f=ft77 fl32 af77 ss_es_o_ol.Ex Kectq' # os[X] w=asta c"$urctool PRefix$arcPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e itool PRefix$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_FCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_dFC"XME: as_omatps PR t_FC="$FC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_FC=_durctool PRefix$arcPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3FC=dhosts PR t_FC "2= as_ $as_dFC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'FC" epwd':r'>&5i $FCdKepptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay ."r' as_ $as_dFC"hss_i=; |ss_e iray"2= as_ $+o) FC"XME: as_omatpt_FC= FCs_ow=fae iPR t.X"sgw=ftran g95 xlf95 f95 f=f if=f ifc efc pgw=ftran pgw95 lf95 ftn xlf90 f90 pgw90 pghp2=_pcw90 g77 xlf f77 ff pgw77 cf77 f=ft77 fl32 af77 R $g]l.Ex Kectq' # os[X] w=asta c"$e iPR t"ctualitilisrs tEXPR t STA`('bigp c lis. canndummy,$e iPR t_dir.w=as=$2 $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acritir.w=asperr X$2"e>&5i $as_ec_et" acritir.w=asperr X$2ptmi"e>&r$$."$a{d.ips PR t_urctt_FCn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $as_durctt_FC"XME: as_omatps PR t_matpt_FC=_durctt_FC" l # arboc rcur[sqrpeaoge ofr /' id)i"e>SUNAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rexxedxul."r'ir"eGe ir'i/tir.w=as$e i nl _dirthss_ueirs= e "$eGe ir'i/tir.w=as$e i nl _dirt4_ba0;br; >&2;hosts PR t_matpt_FC=_durcPR t" signth ocedu\)$'`ex[o "$as_meno-errck=$as_fs to Ge ir'i/tir.w=as$e i nl _dirthl."r'i=; 2echo|| hostss_e irost${ IFS=$x$asamy3my3urctt_FC=dhosts PR t_urctt_FC "2= as_ $as_durctt_FC"XME: as_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'urctt_FC" epwd':r'>&5i $urctt_FC" epptmi" i]*-r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay $a as_ $as_darctt_FC"hss_i=; | host }pi pper arctt_FC" XME: as_oxoFC="" xoecho}xocacu Gcrossior zsset":de itool warned.X" yet:) $3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kepwd':r'>&5i $as_ech_WARNING: uset" cross tools"pgcaPRefixed.gp c 5isarbriple "Kep2l."e itool warned=yet ;; esacs_oxoFC=durctt_FC si$asay# Provaogeso'biinw=fmatk _ abouarboc or zssor.d':r'>&5i $as_echo "$as_meno-errck=$as_lineno-e acriF=ftran or zssor qrpsk _"KepwdcannXe'urctr zsso e ior zssor=$2 w=fae ioptk _ X"s--qrpsk _t-v -V -qqrpsk _ ir rex{x{xe itry=_durctr zssor $e ioptk _ epw" cacu "(($e itry".X" *\"* | *\`* | *\\*)xe itry'>&5i=\$e itry;; *)xe itry'>&5i=$e itry;; esacs_ }/xe itry'>&5i="\"\$as_echo "$as_meno-errck=$as_$e itry'>&5i\""d':r'>&5i $arctry'>&5it4_bhl."(_ }/x_durctr zssor $e ioptk _ epw") 2>ornf /' irpes_omatstatus=$?>&6"2= as_ $s ornf /' irpeXME: as_oxosed.'10a\ perrras_ a cstdrpe ouapuardele ed.pers_oxoooooo10q' ornf /' irpe >ornf /' irp1}xocat ornf /' irp1hl."$as$arm'ir"ornf /' irp1hornf /' irpes_o':r'>&5i $as_echo "$as_meno-errck=$as_\$? $matstatusthl." as_ $matstatus 0tmi" hostrm'ir"aioua # I2=we d=n'tiusge`.F';hs dirensk _,s ofrpRePR co sor is"pgcarunioniboc># X"puarfsso.."(Noto thaarrois o"ly `eeds torw=ak acrihn wor zssorsp)>SrcIFS=$ nt=aa i nt d.i nt=F $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rrwe r tuset" boc hn wF=ftran or zssordKepwd':r'>&5i $as_ec_et" wheE: rrwe r tuset" boc hn wF=ftran or zssorperr X$2ptmi"e>&r$$."$a{d.ips fcior zssorays n\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6cat >.ornf /' i$e i ntK<<_ACEOFs_oxoooPR t STAmaX"#ifndef __hn C__ xoooooohe ke me #etoif $_oxo_nd _ACEOF e>&e ifn foitry'or zsso ec_sls" "s_ }l ior zssorays =yet" i]*-r=l ior zssorays =nosayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt d.ips fcior zssorays =$l ior zssorays ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts fcior zssorays " epwd':r'>&5i $arcts fcior zssorays " epptmi"e i nt=aa iIFS=$ nt3urcs= e FCFLAGS='{FCFLAGSn\"\=3urcIFS=$FCFLAGS='FCFLAGS FCFLAGS= $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rr$FC accepts -eperr X$2"e>&5i $as_ec_et" wheE: rr$FC accepts -eperr X$2ptmi"e>&r$$."$a{d.ips PR t_fcign\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6FCFLAGS=-g cat >.ornf /' i$e i ntK<<_ACEOFs_oxoooPR t STAmaX" $_oxo_nd _ACEOF e>&e ifn foitry'or zsso ec_sls" "s_ }l ios PR t_fcig=yet" i]*-r=l ios PR t_fcig=nosayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts PR t_fcig" epwd':r'>&5i $arcts PR t_fcig" epptmi"e>&r$$."$aurcs= e FCFLAGS3s. } \"s_ba.-r=FCFLAGS=$urcIFS=$FCFLAGS"ec _echo_r$arcts PR t_fcig yethreniquee>&r$$."$x$arcts fcior zssorays " yethreniqueFCFLAGS="-t -O2" siecho}xoFCFLAGS="-t" si$as_l"e>&6"2= as_ $x$arcts fcior zssorays " yethreniqueFCFLAGS="-O2" siecho}xoFCFLAGS= si$asaya i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays a i nt=a{d.ifc_src nt-f} e icr zsso='$FC -c $FCFLAGS $d.ifcflags_src nt.ornf /' i$e i ntKepw' e is_mk='$FC -o.ornf /' $e i nl ntK$FCFLAGS $LDFLAGS.$d.ifcflags_src nt.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts fcior zssorays $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acriF=ftran flag peeded to accept free-w=fmesourc perr X$2"e>&5i $as_ec_et" acriF=ftran flag peeded to accept free-w=fmesourc perr X$2ptmi"e>&r$$."$a{d.ips fcifreew=fmn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6urcps fcifreew=fm=unknown d.ifc_freew=fm$FCFLAGScIFS=='FCFLAGS w=fae iflag X"sasne"-ffree-w=fme-FR"-free -qfree -Mfree -Mfreew=fme\ xoooooo-freew=fme"ir"free" +sourc =free -nfix r rexl."r'$x$arcflag" !xasne"ss_FCFLAGS="$d.ifc_freew=fm$FCFLAGScIFS= $arcflag">&6cat >.ornf /' i$e i ntK<<_ACEOFs ooPR t STAfreew=fm xoooooo! FIXME: how. o b."r'ornfusgeasn-freew=fmeor zssors? xoooooopret\d*, 'Hello ', &s_oxoooooo 'w=ald.'s_oxoooo_nd _ACEOF e>&e ifn foitry'or zsso ec_sls" "s_ }l ios fcifreew=fm=$arcflag; i=; |ayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt hostrm'ir"ornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt FCFLAGS=$urcfc_freew=fm$FCFLAGScIFS= ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts fcifreew=fm" epwd':r'>&5i $arcts fcifreew=fm" epptmi"e>&r$$."$x$arcts fcifreew=fm" xunknownXME: as_omes;} } acdK77 "F=ftran does"pgcaaccept free-w=fmesourc peec_sls" "s_s_l"e>&6"2= as_ $x$arcts fcifreew=fm" !xasnehreniqueFCFLAGS="$FCFLAGS $d.its fcifreew=fm" si$as|aya i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays a i nt=a{d.ifc_src nt-f} e icr zsso='$FC -c $FCFLAGS $d.ifcflags_src nt.ornf /' i$e i ntKepw' e is_mk='$FC -o.ornf /' $e i nl ntK$FCFLAGS $LDFLAGS.$d.ifcflags_src nt.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts fcior zssorays $3"}{as_{d $as_echo "$as_meno-errck=$as_s_ec_et" how. o get verbisi s_mket" ouapuarfroms'FC" epwd':r'>&5i $as_ec_et" how. o get verbisi s_mket" ouapuarfroms'FCperr X$2ptmi"e>&r$$."$a{d.ips PR t_fcivn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6cat >.ornf /' i$e i ntK<<_ACEOFs_oxoooPR t STAmaX" $_oxo_nd _ACEOF e>&e ifn foitry'or zsso ec_sls" "s_ }l ios PR t_fciv= # Tryeso'bioptk _s frequontly used.verbisi ouapua w=fae iverb X"s-v -verbisi --verbisi -V -\#\#\# ir rexcat >.ornf /' i$e i ntK<<_ACEOFs_oxoooPR t STAmaX" $_oxo_nd _ACEOF # Cr zsso nd s_mk our simplfr /' oPR t STAby passet" a flag (argumont # 1. o rois macro). o roeiF=ftran or zssor X"sordor o get # "verbisi" ouapuarthaarweilisr parse acriroeiF=ftran s_mker # flags.3urcIFS=$FCFLAGS='FCFLAGS FCFLAGS="$FCFLAGS $d.iverb"s_ }/x"cannxr$e is_mk" chift>"}{as_{d $as_echo "$as_meno-errck=$as_$*" epwd#sgw=ftran 4.3 ouapuas s_mes"cantet" COLLECT_GCC_OPTIONS, COMPILER_ognt,d#srrBRARY_ognt;"skip all_such"cantet"s.3urcfciv_ouapua=`_ }/x$e is_mk 5>&1 2>&1 | $greps-v 'Drivet":' |$greps-v "^[_$as_cr_Lantors][_$as_cr_alnum]*="`d':r'>&5i $arcfciv_ouapua" epwdFCFLAGS=$urcIFS=$FCFLAGS"trm'irr"ornf /' * "# On HP/UXiroereris a s_me s_ke: "Logntris: /foo:/bar:/baz" wherc># /foo, /bar, nd /baz. r tsearch"directories"acriroeiF=ftran s_mker.># Herc,rweilhangge ofcu in o -L/foo -L/bar -L/baz (and putcicaos[X]):3urcfciv_ouapua="`>&5i $arcfciv_ouapua | greps'Logntris:' | sed.'s|.*Logntris\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $arcfciv_ouapua" "# FIXME: weikeepsgantet" bintonAby quor$d. rgumontthraamor tgeneral fsx"# thaardbtecas unbalanc$d.quor$$oX"sFrrBSKsh= r "bu implfmonted"# and (ugh)r /' $d. t so'b poin . cacu $arcfciv_ouapua ias_ol.I2=we r tuset" xlf replaco all_boc or ma gp c spaco rs_o*xlfontry*)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed.'s/,/ /g'` ;; s_ol.Wp c Intel ifc, ignor tboc quor$d.-mGLOBioptk _s_stret" stuff (quor$ds_ol.errBSKornfusgeus, nd boc libraries"appear lator X"sboc ouapua anyway)rs_o*mGLOBioptk _s_stret"*)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed.'s/"-mGLOB[^"]*"/ /g'` ;; s_ol.P=ftl nd Group or zssor has"set"ly-sor d=urEy-quor$d.-cmds_me argumont _ol.Set"ly-quor$d. rgumontt=wer trep=f ed"acriqrpsk _s 5.2-4 nd 6.0-4p$g]# D=urEy-quor$d. rgumontt=wer trep=f ed"acri"PGF90/x86 Linux/x86 5.0-2"rs_o*-cmds_me\ * | *-ignor \ * | *-def\ *)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed."\ s/-cmds_me *'[^']*'/ /g; s/-cmds_me *\"[^\"]*\"/ /g s/-ignor t *'[^']*'/ /g; s/-ignor t *\"[^\"]*\"/ /g s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; s_ol.I2=we r tuset" CraytF=ftran dele e.quor$$rs_o*cft90*)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed.'s/"//g'` ;; esacs s_ol.look acri-l* nd *.a ornstructs X"sboc ouapuas_ow=fae iarg X"s$arcfciv_ouapua; _es_o_oocacu $arcarg X" [\\/]*.a | ?:[\\/]*.a | -[lLRu]*)s l ios PR t_fciv=$d.iverbs i=; 2 ;; oxo_sacs_o host host"2= as_ $+o) e its PR t_fciv"XME: as_ox$3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: lispgcadbterm_me how. o obtaX"ss_mket" inw=fmatk _ froms'FC" epwd':r'>&5i $as_ech_WARNING: lispgcadbterm_me how. o obtaX"ss_mket" inw=fmatk _ froms'FC" ep2l."$as_l"e>&6$3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: lr zssatk _ fassod_Kepwd':r'>&5i $as_ech_WARNING: lr zssatk _ fassod_Kep2l."$asrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts PR t_fciv" epwd':r'>&5i $arcts PR t_fciv X$2ptmi"$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acriF=ftran libraries"ofs'FC" epwd':r'>&5i $as_ec_et" acriF=ftran libraries"ofs'FCperr X$2ptmi"e>&r$$."$a{d.ips fcilibsn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ "x'FCrrBS" !"x"XME: as_omatps fcilibs="$FCrrBS" l # arboc rcur[sqrpeaoge ofr /' id)i"e> cat >.ornf /' i$e i ntK<<_ACEOFs_oxoooPR t STAmaX" $_oxo_nd _ACEOF # Cr zsso nd s_mk our simplfr /' oPR t STAby passet" a flag (argumont # 1. o rois macro). o roeiF=ftran or zssor X"sordor o get # "verbisi" ouapuarthaarweilisr parse acriroeiF=ftran s_mker # flags.3urcIFS=$FCFLAGS='FCFLAGS FCFLAGS="$FCFLAGS $d.its PR t_fciv s_ }/x"cannxr$e is_mk" chift>"}{as_{d $as_echo "$as_meno-errck=$as_$*" epwd#sgw=ftran 4.3 ouapuas s_mes"cantet" COLLECT_GCC_OPTIONS, COMPILER_ognt,d#srrBRARY_ognt;"skip all_such"cantet"s.3urcfciv_ouapua=`_ }/x$e is_mk 5>&1 2>&1 | $greps-v 'Drivet":' |$greps-v "^[_$as_cr_Lantors][_$as_cr_alnum]*="`d':r'>&5i $arcfciv_ouapua" epwdFCFLAGS=$urcIFS=$FCFLAGS"trm'irr"ornf /' * "# On HP/UXiroereris a s_me s_ke: "Logntris: /foo:/bar:/baz" wherc># /foo, /bar, nd /baz. r tsearch"directories"acriroeiF=ftran s_mker.># Herc,rweilhangge ofcu in o -L/foo -L/bar -L/baz (and putcicaos[X]):3urcfciv_ouapua="`>&5i $arcfciv_ouapua | greps'Logntris:' | sed.'s|.*Logntris\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $arcfciv_ouapua" "# FIXME: weikeepsgantet" bintonAby quor$d. rgumontthraamor tgeneral fsx"# thaardbtecas unbalanc$d.quor$$oX"sFrrBSKsh= r "bu implfmonted"# and (ugh)r /' $d. t so'b poin . cacu $arcfciv_ouapua ias_ol.I2=we r tuset" xlf replaco all_boc or ma gp c spaco rs_o*xlfontry*)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed.'s/,/ /g'` ;; s_ol.Wp c Intel ifc, ignor tboc quor$d.-mGLOBioptk _s_stret" stuff (quor$ds_ol.errBSKornfusgeus, nd boc libraries"appear lator X"sboc ouapua anyway)rs_o*mGLOBioptk _s_stret"*)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed.'s/"-mGLOB[^"]*"/ /g'` ;; s_ol.P=ftl nd Group or zssor has"set"ly-sor d=urEy-quor$d.-cmds_me argumont _ol.Set"ly-quor$d. rgumontt=wer trep=f ed"acriqrpsk _s 5.2-4 nd 6.0-4p$g]# D=urEy-quor$d. rgumontt=wer trep=f ed"acri"PGF90/x86 Linux/x86 5.0-2"rs_o*-cmds_me\ * | *-ignor \ * | *-def\ *)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed."\ s/-cmds_me *'[^']*'/ /g; s/-cmds_me *\"[^\"]*\"/ /g s/-ignor t *'[^']*'/ /g; s/-ignor t *\"[^\"]*\"/ /g s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; s_ol.I2=we r tuset" CraytF=ftran dele e.quor$$rs_o*cft90*)s_oxourcfciv_ouapua=`_&5i $arcfciv_ouapua | sed.'s/"//g'` ;; esacs s matps fcilibs= "# SFS= positk _al. rgumontt=(e>&eny)>SrcIFS=$positk _al="$@" "cannXe'urcfciv_ouapua whilfr /' o$#h!1; _es_ochift>&6arcarg=$1 oocacu $arcarg X" [\\/]*.a | ?:[\\/]*.a) xoooe i ni' s=fai"e>_ow=fae ii X"s$arcps fcilibs; _es_o_o"2= as_ x"$arcarg" x"$arci"XME: as_oxoooe i ni' s=brues_oxoooi=; |ss."$as$a host }pi pper x"$arc ni' s" xbrues_ }" i]*-r=l ios fcilibs="$l ios fcilibsr$arcarg">$as xo;; -bI:*) xoooe i ni' s=fai"e>_ow=fae ii X"s$arcps fcilibs; _es_o_o"2= as_ x"$arcarg" x"$arci"XME: as_oxoooe i ni' s=brues_oxoooi=; |ss."$as$a host }pi pper x"$arc ni' s" xbrues_ }" i]*-r=e>&r$$."$aurcor zssorays " yethreniquew=fae is_mkiopt X"s$arcarg; _es_o_ol ios fcilibs="$l ios fcilibsr-Xs_mkerx$e is_mkiopt"s$a host i]*-r=l ios fcilibs="$l ios fcilibsr$arcarg">$as$as xo;; _ol.Ignor tbocse alags.3 -lang* | -lcrt*.o | -lc | -lgcc* | -lSy' $m | -libmil | -littlfr\ xo|-LANG:=* | -LIST:* | -LNO:* | -s_mk)s xo;; -lkernel32)s xopper x"$CYGWIN" !xyet ss_e ios fcilibs="$l ios fcilibsr$arcarg"> xo;; -[LRuYz]) _ol.Tocse alags, wh seonAby bocmselves, take En rgumont. _ol.W tremsqrsboc spaco"butweonAoptk _ nd rgumont nd re-itorato _ol.unlo s w# osnd n empty rgsor a newAoptk _ (startet" wp c $) _ocacu $2 X" oxooo"" | -*);; _o *)s arcarg="$arcarg$2"> chift;ochift> cannXe'urc rgs"$@" ;; _oesacs xo;; -YP,*) xow=fae ij X"s`':r'>&5i $arcarg" | sed.-e.'s/-YP,/-L/;s/:/ -L/g'`; _es _oxoooe i ni' s=fai"e>_ow=fae ii X"s$arcps fcilibs; _es_o_o"2= as_ x"$arcj" x"$arci"XME: as_oxoooe i ni' s=brues_oxoooi=; |ss."$as$a host }pi pper x"$arc ni' s" xbrues_ }" i]*-r=l iarg="$arcarg $arcj" xooooooe ios fcilibs="$l ios fcilibsr$arcj">$as xo host xo;; -[lLR]*) xoooe i ni' s=fai"e>_ow=fae ii X"s$arcps fcilibs; _es_o_o"2= as_ x"$arcarg" x"$arci"XME: as_oxoooe i ni' s=brues_oxoooi=; |ss."$as$a host }pi pper x"$arc ni' s" xbrues_ }" i]*-r=l ios fcilibs="$l ios fcilibsr$arcarg">$as xo;; -zallex Kect*| -zdefaenoex Kect)s l ios fcilibs="$l ios fcilibsr$arcarg"> xo;; _ol.Ignor teqrpythet"iechors_oesacs host# ras_or tpositk _al. rgumontt"cannXe'urcIFS=$positk _al;ochift> l.W to"ly ornsidor "LD_RUN_ognt"ioniSolaris"sy' $msr If rois is"seon,d#s weinsast thaarroe "runipath" musarbe En bsolu e.path=(e.e.cicd#smusarbegX"sgp c "/"). cacu `(u`('bi-sr)i2>/dev/null`.X" "SunOS 5"*)s_oxol ild_run_path=`':r'>&5i $arcfciv_ouapua" | sed.-n.'s,^.*LD_RUN_ognt *= *\(/[^ ]*\).*$,-R\1,p'`s_oxo as_ $x$arcld_run_path" !x ss e>&r$$."$aurcor zssorays " yethreniquew=fae is_mkiopt X"s$arcld_run_path; _es_o_ol ios fcilibs="$l ios fcilibsr-Xs_mkerx$e is_mkiopt"s$a host i]*-r=l ios fcilibs="$l ios fcilibsr$arcld_run_path".$as$aaaaa;; esacsfiol. as_ $x$[]_AC_LANG_PREFIX[]rrBS" "x" ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts fcilibs" epwd':r'>&5i $arcts fcilibs" epptmi"FCrrBS="$l ios fcilibs" a i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays # C_ec_ architecaurst"$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acrigrepsthaarh ndlo lo-e s_mes" nd - perr X$2"e>&5i $as_ec_et" acrigrepsthaarh ndlo lo-e s_mes" nd - perr X$2ptmi"e>&r$$."$a{d.ips Path_GREPn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2= as_ $+o) GREP"XME: as_omatPath_GREP_fs to=fai"e>_o# Loope oroughrboc rcur's pa c nd bas_ acrieec_"ofsPROGNAME-LISTs_omesAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntFS; IFS=$g] e_S/usr/xpg4/biniR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae iPR t.X"sgrepsggrep; _es_o_ow=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rex_o_ol iPath_GREP=eGe ir'i/tir.PR t$e i nl _dir" xoooooxul."r'ir"eGe iPath_GREPthss_ueirs= e "$eGe iPath_GREPt4_bh|| crntinue$# C_ec_ acrihn we iPath_GREP nd selectcica"2=ica"s_fs top$g]# C_ec_ acrihn wGe iPath_GREP cacu `eGe iPath_GREPth--qrpsk _t2>&1`.X" *hn *)s_od.ips Path_GREP=eGe iPath_GREPthmatPath_GREP_fs to=:;; *)s_od.ips tt=0l." :he $0123456789 >"ornf /' .in" xowhilfr: ss_es_o_ocat "ornf /' .in" "ornf /' .in" >"ornf /' .tmp" &2; mv "ornf /' .tmp" "ornf /' .in" xo_ocp "ornf /' .in" "ornf /' .nl" signth ocedu'GREP' >> "ornf /' .nl" signeGe iPath_GREPth-eu'GREP$'h-eu'-(lispgcamatc:)-' < "ornf /' .nl" >"ornf /' .oua" 2>/dev/nullh|| i=; |ss."diff "ornf /' .oua" "ornf /' .nl" >/dev/nullh2>&1 || i=; |ss."mes;} ari c $d.ips tt + 1 ss_e ios tt=th vals_o_o"2= as_ $d.ips tt -gt,${urcPath_GREP_max-0}XME: as_oxooo# Bes_ angeso far, IFS= it butckeepslooket" acria"buttor ene >&2;_od.ips Path_GREP=eGe iPath_GREPtrex_o_ol iPath_GREP_max=$d.ips tt|ss."$as$aoo# 10*(2^10)ohears;hs X"puarseomsamor tthan enough xo as_ $d.ips tt -gt,10hss_i=; |ss_e ir$arm'ir"ornf /' iin ornf /' .tmp ornf /' .nl ornf /' .oua;; esacs ex_o_o$matPath_GREP_fs tohss_i=; 3|ss."dhostss_e irss_e irost${ IFS=$x$as&6"2= as_ $+o) d.ips Path_GREP"XME: as_oxoaes;} } acdKS srno accept_rEPsgrepsc= r "bu fs tohX"saogntFS; IFS=$g] e_S/usr/xpg4/binpeec_sls" "s_ssi$as_l"e>&6d.ips Path_GREP= GREP $as|ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts Path_GREPthepwd':r'>&5i $arcts Path_GREPthepptmi"oGREP=eGe its Path_GREPtt"$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acriegrepperr X$2"e>&5i $as_ec_et" acriegrepperr X$2ptmi"e>&r$$."$a{d.ips Path_EGREPn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2=s_{d a | GREP -E '(a|b)' >/dev/nullh2>&1s_ox_ba. d.ips Path_EGREP=" GREP -Etrex_)i"e>&6_o_"2= as_ $+o) EGREP"XME: as_omatPath_EGREP_fs to=fai"e>_o# Loope oroughrboc rcur's pa c nd bas_ acrieec_"ofsPROGNAME-LISTs_omesAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntFS; IFS=$g] e_S/usr/xpg4/biniR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e w=fae iPR t.X"segrep; _es_o_ow=fae i nl _dir.X"s'asolid oc;c_rEP_dirensk _r ir rex_o_ol iPath_EGREP=eGe ir'i/tir.PR t$e i nl _dir" xoooooxul."r'ir"eGe iPath_EGREPthss_ueirs= e "$eGe iPath_EGREPt4_bh|| crntinue$# C_ec_ acrihn we iPath_EGREP nd selectcica"2=ica"s_fs top$g]# C_ec_ acrihn wGe iPath_EGREP cacu `eGe iPath_EGREPth--qrpsk _t2>&1`.X" *hn *)s_od.ips Path_EGREP=eGe iPath_EGREPthmatPath_EGREP_fs to=:;; *)s_od.ips tt=0l." :he $0123456789 >"ornf /' .in" xowhilfr: ss_es_o_ocat "ornf /' .in" "ornf /' .in" >"ornf /' .tmp" &2; mv "ornf /' .tmp" "ornf /' .in" xo_ocp "ornf /' .in" "ornf /' .nl" signth ocedu'EGREP' >> "ornf /' .nl" signeGe iPath_EGREPth'EGREP$' < "ornf /' .nl" >"ornf /' .oua" 2>/dev/nullh|| i=; |ss."diff "ornf /' .oua" "ornf /' .nl" >/dev/nullh2>&1 || i=; |ss."mes;} ari c $d.ips tt + 1 ss_e ios tt=th vals_o_o"2= as_ $d.ips tt -gt,${urcPath_EGREP_max-0}XME: as_oxooo# Bes_ angeso far, IFS= it butckeepslooket" acria"buttor ene >&2;_od.ips Path_EGREP=eGe iPath_EGREPtrex_o_ol iPath_EGREP_max=$d.ips tt|ss."$as$aoo# 10*(2^10)ohears;hs X"puarseomsamor tthan enough xo as_ $d.ips tt -gt,10hss_i=; |ss_e ir$arm'ir"ornf /' iin ornf /' .tmp ornf /' .nl ornf /' .oua;; esacs ex_o_o$matPath_EGREP_fs tohss_i=; 3|ss."dhostss_e irss_e irost${ IFS=$x$as&6"2= as_ $+o) d.ips Path_EGREP"XME: as_oxoaes;} } acdKS srno accept_rEPsegrepsc= r "bu fs tohX"saogntFS; IFS=$g] e_S/usr/xpg4/binpeec_sls" "s_ssi$as_l"e>&6d.ips Path_EGREP= EGREP|ay &2;o||ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts Path_EGREPthepwd':r'>&5i $arcts Path_EGREPthepptmi"oEGREP=eGe its Path_EGREPtt"$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acriANSI C heador fssosperr X$2"e>&5i $as_ec_et" acriANSI C heador fssosperr X$2ptmi"e>&r$$."$a{d.ips heador_stdcn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #i"cluoge #incluoge #incluoge #incluoge int maX"s() $ $; return0t } _ACEOF "2=e ifn oitry'or zsso ec_sls" "s_ }l ios heador_stdc=yet" i]*-r=l ios heador_stdc=nosayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt _echo_r$arcts heador_stdc yethrenique# SunOS 4.x stret".h does"pgcadecl r tmem*, crntraryr o ANSI.>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #i"cluoge _ACEOF "2=(_ }/x_durctpp"ornf /' i$e i nt") 2>&5 | $ EGREP "memchr" >/dev/nullh2>&1s_ }" i]*-r=l ios heador_stdc=nosayrm'ir"ornf /' * "ay"2= as_ $arcts heador_stdc yethrenique# ISC 2.0.2 stdlib.h does"pgcadecl r tfree, crntraryr o ANSI.>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #i"cluoge _ACEOF "2=(_ }/x_durctpp"ornf /' i$e i nt") 2>&5 | $ EGREP "free" >/dev/nullh2>&1s_ }" i]*-r=l ios heador_stdc=nosayrm'ir"ornf /' * "ay"2= as_ $arcts heador_stdc yethrenique# /bin/cc in Irix-4.0.5sganseasn-ANSI ctype macros.unlo s uset" -ansa. r=e>&r$$."$acrossior zsset"" yethreniq }:d)i"e>&6cat ornfdefs.h - <<_ACEOF >ornf /' i$e i nt /* eto ornfdefs.h. */ #i"cluoge #incluoge #i2=((' ' & 0x0FF) =0x020)$# def_me ISLOWER(c) ('a' <= (c) ss_(c) <= 'z')$# def_me TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') :_(c)) #)i"e># def_me ISLOWER(c) \ o_o(('a' <= (c) ss_(c) <= 'i') \ o_o h|| ('j' <= (c) ss_(c) <= 'r') \ o_o h|| ('s' <= (c) ss_(c) <= 'z'))$# def_me TOUPPER(c) (ISLOWER(c) ? ((c) |0x40) :_(c)) #)toif#def_me XOR(e, f)"(((e) ss_!(f))h|| (!(e) ss_(f))) int maX"s() $ X"t i;uew=fa(i 0tmi < 25ptmi++)s_o_o"2=(XORa(islowefa(i), ISLOWERa(i)) || touppefa(i) !TOUPPERa(i)) ex_o_oreturn2; return0t } _ACEOF "2=e ifn oitry'runiec_sls" "s_ }" i]*-r=l ios heador_stdc=nosayrm'ir"orrer*.orrerorre.ornf /' i* gmon.oua bb.oua ornf /' $e i nl ntK\>&6crnf /' i$e iobjent"ornf /' ibeam"ornf /' i$e i nt $as|ayay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts heador_stdcthepwd':r'>&5i $arcts heador_stdcthepptmi"e>&r$$."$arcts heador_stdc yethreniqud':r'>&5i #def_me STDC_HEADERS 1the>ornfdefs.h "ay# On IRIX 5.3,"sy'/types" nd X"ttypes.h r tornflictet". w=fae iheador X"ssy'/types.h sy'/stat.h stdlib.h stret".h memory.h stret"s.h \ o_X"ttypes.h stdin .h.unistd.h do }ls_urcHeador=`':r'>&5i arcts heador_$e iheador" | ueirsr_sh` e ifn ois_ec_ heador_or zsso ec_sls" " $archeador" $as_urcHeador" $arcincluogs_defaeno ""2=_ }/xr$$."\"x\$ $as_urcHeador"\" x"yet"hreniq }cat >>ornfdefs.hK<<_ACEOFs#def_me `':r'>&5i HAVE_$e iheador" | ueirsr_tpp` 1 _ACEOF ay host l.Tococactr o lo-e X"t w=aks ars toha"bug X"sboc HP C Cr zssor # qrpsk _tHP92453-01 B.11.11.23709.GP, whsc: incorrectly_lijecas$# decl ratk _s s_ke `X"t a3[[(sizeo2=(unsagned.hear))h>0]];'. l.Tois"bug Xs HP SR numbor 8606223364."$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e size"ofslo-e d=urE perr X$2"e>&5i $as_ec_et" size"ofslo-e d=urE perr X$2ptmi"e>&r$$."$a{d.ips sizeo2_lo-e_d=urE n\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6"2=e ifn oisr zute_X"t ec_sls" " (lo-e X"t)"(sizeo2=(lo-e d=urE ))" arcts sizeo2_lo-e_d=urE " $arcincluogs_defaeno"s_ }" i]*-r=e>&r$$."$aurcov_type_lo-e_d=urE " yethrenique r=srsre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdK77 "lispgcasr zute sizeo2=(lo-e d=urE ) Sees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi"ex_)i"e>&6_o_arcts sizeo2_lo-e_d=urE =0i$asayay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts sizeo2_lo-e_d=urE " epwd':r'>&5i $arcts sizeo2_lo-e_d=urE " epptmi" > cat >>ornfdefs.hK<<_ACEOFs#def_me SIZEOF_LONG_DOUBLEe'hosts sizeo2_lo-e_d=urE _ACEOF t"$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acrtran 90amodul$$oX"clusk _tflag" rr X$2"e>&5i $as_ec_et" acrtran 90amodul$$oX"clusk _tflagperr X$2ptmi"e>&r$$."$a{dxios f90_modflagn\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6urc nt=a{d.ifc_src nt-f} e icr zsso='$FC -c $FCFLAGS $d.ifcflags_src nt.ornf /' i$e i ntKepw' e is_mk='$FC -o.ornf /' $e i nl ntK$FCFLAGS $LDFLAGS.$d.ifcflags_src nt.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts fcior zssorays i=0whilfr /' o\('ir"tmpdir_$i \) -o.\('id"tmpdir_$i \) ir rexx=`expr $i + 1` hostmkxpr tmpdir_$i cd tmpdir_$i cat >.ornf /' i$e i ntK<<_ACEOFs !234567 ex_o_omodul$.ornf /' _modul$ ex_o_ocrntaX"s ex_o_osubrs t_me ornf /' _rs t_me ex_o_owrite(*,'(a)') 'gothea!'s_oxoooeto subrs t_me ornf /' _rs t_me ex_o_oeto modul$.ornf /' _modul$ _ACEOF e>&e ifn foitry'or zsso ec_sls" "s_ }sayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt cd.pe dxios f90_modflag="pgcafs to" w=faexiflag X"s"-I de-J de-M de-p" ir rexxedr$$."$auxios f90_modflag" "pgcafs to" XME: as_oxoaxcIFS=$FCFLAGS="$FCFLAGStrex_oFCFLAGS="$dxcIFS=$FCFLAGS a{dxiflag}tmpdir_$i"s_o_ocat >.ornf /' i$e i ntK<<_ACEOFs !234567 ex_o_oPR t STAornf /' _PR t ST ex_o_ousgeornf /' _modul$ ex_o_ocall_ornf /' _rs t_me ex_o_oeto PR t STAornf /' _PR t ST _ACEOF e>&e ifn foitry'or zsso ec_sls" "s_ }lxios f90_modflag="$dxiflag"sayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"ornf /' i$e i nt ex_oFCFLAGS="$dxcIFS=$FCFLAGS" si$as hostrm'irr tmpdir_$i xedr$$."$auxios f90_modflag" "pgcafs to" XME: as_oaes;} } acdKS srun_rEPs o osnd or zssor flag w=famodul$$oX"clusk _peec_sls" "s_saya i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays ay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hxios f90_modflag" epwd':r'>&5i $axios f90_modflag" epptmi" ># C_ec_ acriF=ftran2003 supp=f $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e wheE: rryour or zssor PR perly_supp=f stF=ftran 2003perr X$2"e>&5i $as_ec_et" wheE: rryour or zssor PR perly_supp=f stF=ftran 2003perr X$2ptmi"urc nt=a{d.ifc_src nt-f} e icr zsso='$FC -c $FCFLAGS $d.ifcflags_src nt.ornf /' i$e i ntKepw' e is_mk='$FC -o.ornf /' $e i nl ntK$FCFLAGS $LDFLAGS.$d.ifcflags_src nt.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts fcior zssorays usg_f03=nose>&r$$."$acrossior zsset"" yethreniq }srsre ir/k{d $as_echo "$as_meno-errck=$as_} acd: X"s\`durcPwd':"Kepwd':r'>&5i $as_ech_} acd: X"s\`durcPwd':"Kep2l."ees;} } acdKS srlispgcarunir$$."PR t STAwhilfrcross or zsset" Sees\`ornfig.log' w=famor tdetaXla dec_sls" "s_ tmi")i"e>&6cat >.ornf /' i$e i ntK<<_ACEOFs ex_o_oPR t STAPR codurers= e type crntaX"er o_X"teger, o_poin or :: var o_PR codure(func),_poin or, nopass :: f eto type crntaX"er abs Kectqin orface o_logical functk _ func(var) o_o_X"teger, poin or :: var o_eto functk _ func eto in orface type(crntaX"er) o_o_:: c X"teger :: var PR codure(func) :: s= e call_add(var, s= e) "2=(c%f(c%var))hstop 0 stop 1 crntaX"s ex_o_o_osubrs t_me add(var,f) oX"teger, o_target :: var o_PR codure(func),_optk _al :: f c%var => var o_c%f o_=> f eto subrs t_me add ex_o_oeto PR t STAPR codurers= e ex_o_ological functk _ s= e(var) X"teger, poin or :: var r$$."= .brue. ex_o_oeto functk _ s= e _ACEOF e>&e ifn foitry'runiec_sls" "s_ }_ousg_f03=yet" i]*-r=usg_f03=nosayrm'ir"orrer*.orrerorre.ornf /' i* gmon.oua bb.oua ornf /' $e i nl ntK\>&6crnf /' i$e iobjent"ornf /' ibeam"ornf /' i$e i nt $as|"2= as_ "x'{usg_f03}" yethreniqueCPPFLAGS="$CPPFLAGS.-D__F2003p "# >&5i #def_me __F2003p >> ./src/ppm_def_me.h xo(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-eyosperr X$2"e>&5i "yosperrptmi" i]*-r=r=sre ir/k{d $as_echo "$as_meno-errck=$as_lineno-eas_Kepwd':r'>&5i as_Kepptmi"ay"2= as_ "x'{usg_ zs}" yethrenique$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e "2=your MPI Xs usarE perr X$2"e>&5i $as_ec_et" "2=your MPI Xs usarE perr X$2ptmi" cat >.ornf /' i$e i ntK<<_ACEOFs ex_o_ooooooooooooooooPR t STAornf /' _PR t ex_o_ooooooooooooooooincluoge' zsf.h' ex_o_oooooooooooooooocall_MPI_Init(i} a) ex_o_ooooooooooooooooeto PR t STAornf /' _PR t _ACEOF e>&e ifn foitry's_mk ec_sls" "s_ }_oCPPFLAGS="$CPPFLAGS.-D__MPI"" i]*-r=#ex_o_oooooooooooooooo[>&5i #def_me __MPI" >> ./src/ppm_def_me.h], ex_o_ooooooooooooooooees;} } acdKS srCispgcabuild PPMsgp c MPI supp=f s_ke roispeec_sls" "s_sayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"\" crnf /' $e i nl ntKornf /' i$e i nt ex_o(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-eyosperr X$2"e>&5i "yosperrptmi"#ex_oAC_CHECK_rrB([],[MPI_Init],[ #ex_o_ooooooooooooo>&5i #def_me __MPI" >> ./src/ppm_def_me.h], #ex_o_ooooooooooooo[AC_MSG_ERROR([Cispgcabuild PPMsgp c MPI supp=f s_ke rois])])saya i nt=c e icpp='$CPP $CPPFLAGS' e icr zsso='$CC -c $CFLAGS $CPPFLAGS.ornf /' i$e i ntKepw' e is_mk='$CC -o.ornf /' $e i nl ntK$CFLAGS $CPPFLAGS.$LDFLAGS.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts oior zssorays "2= as_ "x'{usg_ zs}" yethreniqueFUNIT_FLAGS="--gp c- zs" "ay# C_ec_s"acrilibraries"and setrpRePR co set" alags d#s Xs as_ sh= r "bu omintodxxedroc or zssor Xs in ol,s ofy PR vaoge ofir own #amath implfmontatk _ #i2= as_ "x'{axios oior zssoravetoor}" !xin olhreniqu#_oAC_CHECK_rrB([m],[sqrt])s#ay# Make suro thaarroc libraries"arc or zssod.gp c F=ftran"urc nt=a{d.ifc_src nt-f} e icr zsso='$FC -c $FCFLAGS $d.ifcflags_src nt.ornf /' i$e i ntKepw' e is_mk='$FC -o.ornf /' $e i nl ntK$FCFLAGS $LDFLAGS.$d.ifcflags_src nt.ornf /' i$e i ntKerrBSKepw' e ior zssorays =ourcts fcior zssorays ># C_ec_ roc or zssor vetoorerr Xs lis_ sh= r "bu dirended or"orur"e># butclet's h pe thaarrois will_w=ak X"smisarcacus $3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e your F=ftran or zssor qrtoorperr X$2"e>&5i $as_ec_et" your F=ftran or zssor qrtoorperr X$2ptmi"qrtoor=ne iraor qrtoorkp.X"sgnu:gw=ftran in ol:Intel sun:Sunip=ftl nd:P=ftl nd ir rex_os K=`_&5i $qrtoorkp.| cutc-d:'ir2`s_o_o"2=`$FC -Vh2>&1 |$greps-q $s K`XME: as_oxooo qrtoor=`_&5i $qrtoorkp.| cutc-d:'ir1`;s_oxooo (\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'qrtoorperr X$2"e>&5i $qrtoorperrptmi" i=; ;|ss."$a;t host"2= as_ "x'{vetoor}" xasnehrenique(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-eunknownperr X$2"e>&5i unknownperrptmi"ay; ># C_ec_ acriMETIS hFS=$metis=nos$3"}{as_{d $as_echo "$as_meno-errck=$as_lineno-e acrilibrary crntaX"o-e METIS_PartGraphRecur"iv perr X$2"e>&5i $as_ec_et" acrilibrary crntaX"o-e METIS_PartGraphRecur"iv perr X$2ptmi"e>&r$$."$a{d.ips search_METIS_PartGraphRecur"iv n\"\=3s. } \"s_ba. }l." :he $as_ec_et"(_lwayd)i"e>&6urcfunc search_IFS=$rrBS=errBS cat >.ornf /' i$e i ntK<<_ACEOFs_oxoooPR t STAmaX"_oxooocall_METIS_PartGraphRecur"iv ex_o_oeto _ACEOF w=fae is_b.X"s'asmetis ir rexxedr$$."$+o) d.is_b"XME: as_oxoac_lin="pgn trequired" siecho}xoac_lin=-l d.is_b}xorrBS="-l d.is_b_o$matfunc search_IFS=$rrBS" si$as&6"2=e ifn foitry's_mk ec_sls" "s_ }_od.ips search_METIS_PartGraphRecur"iv =ourclinsayrm'ir"orrerornf /' irpe ornf /' i$e iobjent"\" crnf /' $e i nl ntrexxedr$$."$a{d.ips search_METIS_PartGraphRecur"iv n\"\=3s. } \"s_ba. }i=; |ay host"2= as_ "a{d.ips search_METIS_PartGraphRecur"iv n\"\=3s. } \"s_ba. }" i]*-r=l ios search_METIS_PartGraphRecur"iv =nosayrm'ornf /' i$e i nt rrBS=ematfunc search_IFS=$rrBSay(\/\/ s_{d $as_echo "$as_meno-errck=$as_lineno-e'hosts search_METIS_PartGraphRecur"iv " epwd':r'>&5i $arcts search_METIS_PartGraphRecur"iv " epptmi"urclin=$arcts search_METIS_PartGraphRecur"iv "e>&r$$."$aurcrospe!no"s_ba. }r$$."$aurcrospe"pgn trequired"h|| rrBS="$l irosKerrBS" sihFS=$metis=yinsayt"2= as_ "x'{hFS=$metis}" xasXME: as_o>&5i ------------------------------------------"s_o>&5i .TocoMETISilibrary is required. o build PPMrr s_o>&5i .EiE: rrroc library is mi set" or incorrectly_or zssod/s_mked. s_o>&5i .Stoppet".err Pleacu download. t: s_o>&5i .http://glaros.dtc.umn.edu/gkhome/metis/metis/download"s_o>&5i ------------------------------------------"s_o(exit 1); exit 1;" i]*-r=CPPFLAGS="$CPPFLAGS.-D__METISp "# >&5i #def_me __METISp >> ./src/ppm_def_me.h ay# C_ec_. o seexxedlinux whs dn_rEPd.gp c -dn_rEP-linux# C_ec_.wheE: rr--dn_rEP-linux whs giv n.t"2= as_ "a{dn_rEP_linuxn\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_linux;=CPPFLAGS="$CPPFLAGS.-D__Linuxp "# [>&5i #def_me __Linuxp >> ./src/ppm_def_me.h] say# C_ec_. o seexxedetime whs dn_rEPd.gp c -dn_rEP-etime# C_ec_.wheE: rr--dn_rEP-etime whs giv n.t"2= as_ "a{dn_rEP_etimen\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_etime;=CPPFLAGS="$CPPFLAGS.-D__ETIMEp "# [>&5i #def_me __ETIMEp >> ./src/ppm_def_me.h] say# C_ec_. o seexxedvector whs dn_rEPd.gp c -dn_rEP-vector# C_ec_.wheE: rr--dn_rEP-vector whs giv n.t"2= as_ "a{dn_rEP_vectorn\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_vector;=CPPFLAGS="$CPPFLAGS.-D__VECTORp "# [>&5i #def_me __VECTORp >> ./src/ppm_def_me.h] say# C_ec_.wheE: rr--dn_rEP-mathkeisan whs giv n.t"2= as_ "a{dn_rEP_mathkeisann\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_mathkeisan;=CPPFLAGS="$CPPFLAGS.-D__MATHKEISANp "# [>&5i #def_me __MATHKEISANp >> ./src/ppm_def_me.h] say# C_ec_.wheE: rr--dn_rEP-sxf90 whs giv n.t"2= as_ "a{dn_rEP_sxf90n\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_sxf90;=CPPFLAGS="$CPPFLAGS.-D__SXF90p "# [>&5i #def_me __SXF90p >> ./src/ppm_def_me.h] say# C_ec_.wheE: rr--dn_rEP-crayfishpac_.whs giv n.t"2= as_ "a{dn_rEP_crayfishpac_n\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_crayfishpac_;=CPPFLAGS="$CPPFLAGS.-D__CRAYFISHPACKp "# [>&5i #def_me __CRAYFISHPACKp >> ./src/ppm_def_me.h] say# C_ec_.wheE: rr--dn_rEP-hypre whs giv n.t"2= as_ "a{dn_rEP_hypren\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_hypre;=CPPFLAGS="$CPPFLAGS.-D__HYPREp "# [>&5i #def_me __HYPREp >> ./src/ppm_def_me.h] say# C_ec_.wheE: rr--dn_rEP-no-microinstr whs giv n.t"2= as_ "a{dn_rEP_no_microinstrn\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_no_microinstr;=CPPFLAGS="$CPPFLAGS.-D__NOMICROINSTRUCTIONSp "# [>&5i #def_me __NOMICROINSTRUCTIONSp >> ./src/ppm_def_me.h] saydevicr zsso=nos# C_ec_.wheE: rr--dn_rEP-dev whs giv n.t"2= as_ "a{dn_rEP_devn\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_dev irevicr zsso=yinsayt"2= as_ "x'{revicr zsso}" yethrenique"2= as_ "x'{vetoor}" xin olhreniqu DEBUG="-t -O0 -s_ec_ poin ors -s_ec_ bs tos - Kecebac_.-diag-disarE 10120p "_o_oel"2= as_ "x'{vetoor}" xgnuhreniqu DEBUG="-t -O0 -fbs tos-s_ec_ -fbac_ Kecep "_o_oel"e>&6_o_ DEBUG="-tp "_o_o$asaydebugicr zsso=nos# C_ec_.wheE: rr--dn_rEP-debug whs giv n.t"2= as_ "a{dn_rEP_debugn\"\=3s. } \"s_ba. }dn_rEPval=$dn_rEP_debug irebugicr zsso=yinsayt"2= as_ "x'{rebugicr zsso}" yethreniqueCPPFLAGS="$CPPFLAGS.-D__DEBUGp "# >&5i #def_me __DEBUGp >> ./src/ppm_def_me.h xo"2= as_ "x'{vetoor}" xin olhreniqu DEBUG="-O0 -t -debug all_-s_ec_ all_-fp-stac_-s_ec_ -heap-arrays -f Kepuv -s_ec_ poin ors -s_ec_ bs tos - Kecebac_.-diag-disarE 10120p "_o_oel"2= as_ "x'{vetoor}" xgnuhreniqu DEBUG="-O0 -t -fbs tos-s_ec_ -fbac_ Kece -f Kepv -fno-automatkcp "_o_oel"e>&6_o_ DEBUG="-O0 -tp "_o_o$asel"e>&6_o"2= as_ "x'{vetoor}" xin olhreniqu FCFLAGS="$FCFLAGS -diag-disarE 5462p "_o_o$as ay# setrsrc;hs roc defaenorsrcdirt"2= as_ "asrcdirpe"."XME: as_oxosrcdir=srcsay# Generate Makefssos e iornfig_fssos=eGe itrnfig_fssos Makefsso"> cat >trnf_ec_e <<\_ACEOFs#.Tois"fssoris a shell_script thaar_ec_es roc linenos or"ornfigurc># as_saruni _ shis"sy' $meso ofy lisrbe shared.butweonAornfigurc># scripts"and ornfigurcaruns, seexornfigurc'sAoptk _ --ornfig-_ec_e. l.Ica"s_pgcausefuli _ oE: rrsy' $msr If it crntaX"s linenos yous_e 'cd#swantr o keep, yousmaytremsqrscriedica"t. ld#sornfig.statusto"ly pays antontk _ so roei_ec_e fssori2=you giv cicd#sroei--rec_ec_ optk _ so reruniornfigurc. ld#s`arcts env_foo' variarE s (setrcriunset) will_bu oqrpeaod wniqu#_loadet" tois"fsso, oE: rr*unset*s`arcts foo' will_bu assegned.E: # followet" valu$$rs _ACEOF # Tocofollowet" waytor"writet" toei_ec_e mish ndlo news_mes"in valu$$,># butcweiknowtor"no_w=akars tohthaaris"simplf,ip=ftarE , nd efficiont. # So,rweikill_variarE s crntaX"o-e news_mes. # Ultrix sh setrwrites. o stdrpe and oa 'c_bu redirected.directly,># and sets roc high bin X"sboc _ec_e fssorunlo s w# assegn so roeivars. ( _ow=fae ivar X"s`(set) 2>&1 |$sed.-n.'s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; _es_o_oe }/xe ival=\$$e ivar" cacu $arc }/xX"s#(" *o "$anl}*)s_oxocacu $arc }rxX"s#(" *cts *)x$3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: licoeivariarE $arc }rxcrntaX"s a news_me" epwd':r'>&5i $as_ech_WARNING: licoeivariarE $arc }rxcrntaX"s a news_me" ep2;} ;; oxoo_sacs_oxocacu $arc }rxX"s#(" _ |$IFS |$"$anl) ;;s#(" BASH_ARGV |$BASH_SOURCE) _ }/x$e i }r= ;;s#(" *)x$3_ }/x$e i }r=;iunsetx$e i }r;} ;; oxoo_sac ;; ox_sacs_o hosts_o(set) 2>&1 |" cacu $a$anl`(e ispaco=' '; set) 2>&1`xX"s#(" *o "$anl}e ispaco=\ *)s_oxor=#e`set' does"pgcaquor$ correctly,eso add.quor$$: d=urE -quor$s_oxor=#esubstitutk _ sur"s \\\\ in o \\, and sed sur"s \\ in o \. ex_o_osed.-n.\ "s/'/'\\\\''/g; _os/^\\([_$as_cr_alnum]*cts [_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/ptrex_o_o;;s#(" *)s_oxor=#e`set' quor$$ocorrectly_as required.by POSIX,eso do"pgcaadd.quor$$. ex_o_osed.-n."/^[_$as_cr_alnum]*cts [_$as_cr_alnum]*=/ptrex_o_o;; ox_sac |" s=f ) |" sed.'rex_o_/^arcts env_/boeto ex_o_t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/ as_ "a{\1n\"\=3s. } \h|| &/ ex_o_t eto ex_o_s/^\([^=]*\)=\(.*\)$/\1=a{\1=\2}/ ex_o_:eto' >>ornflicoet"2=diff "$licoe_fsso" trnf_ec_e >/dev/nullh2>&1s_ }; )i"e>&6"2= as_ $w "$licoe_fsso"XME: as_oxo as_ "x'licoe_fsso" !"x/dev/nullthssrex_o_o$3"}{as_{d $as_echo "$as_meno-errck=$as_updatet" _ec_e 'licoe_fsso" epwd':r'>&5i $as_ech_updatet" _ec_e 'licoe_fsso" ep6;i" cat trnf_ec_e >'licoe_fsso siecho}xo$3"}{as_{d $as_echo "$as_meno-errck=$as_pgcaupdatet" unwritarE _ec_e 'licoe_fsso" epwd':r'>&5i $as_ech_pgcaupdatet" unwritarE _ec_e 'licoe_fsso" ep6;i" $asayrm'ir"ornflicoet as_ "x'prefsx" xNONE ss_prefsx=$arcdefaeno_prefsx l # armake exp nd enl _prefsx. as_ "x'enl _prefsx" xNONE ss_enl _prefsx='${prefsx}' # Transw=fm ornfdefs.h in o DEFS. # Proteca agaX"st shell_exp nsk _twhilfr oc;co-e Makefssoarules. # Proteca agaX"st Makefssoamacro_exp nsk _. ld#sIedroc os[X] sed.substitutk _ is" oc;ced.(whsc: looks"acrimacros.thaad#srake Ergumontt),_ branc: so roeiquor$ sectk _r OE: rwise, l.look acriaamacro_thaardoes 'c_rake Ergumontt.3urcIcript=' :ms_me /\\$/{ N s,\\\n,, b ms_me } t clear :clear s/^[ ]*#[ ]*def_me[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g caquor$ s/^[ ]*#[ ]*def_me[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g caquor$ b&eny :quor$ s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\[/\\&/g s/\]/\\&/g s/\$/$$/g H :eny ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed.-n."$urcIcript" ornfdefs.h` a ilibobjs=a iltlibobjs=U= w=fae ii X"s:KerrBOBJS; _e as_ $x$arci" x: ss_crntinue$oo# 1. Remsqrsboc dirensk _, and $U6"2=elreadyinstalleop$g]urcIcript='s/\$U\././;s/\.o$//;s/\.obj$//'$g]urci=`':r'>&5i $arci" | sed."$urcIcript"`$oo# 2. Prepeto rrBOBJDIRr W usPd.gp c automake>=1.10 rrBOBJDIR-r=#ex_owill_bu } \hso roeidirectory wherc rrBOBJS objecas arc builtp$g]ues;} appeto a ilibobjs " \${rrBOBJDIR}$arci\$Ui$e iobjent"$g]ues;} appeto a iltlibobjs " \${rrBOBJDIR}$arci"'$Uilo' hostrrBOBJS=$a ilibobjs LTrrBOBJS=$a iltlibobjs :Ke{CONFIG_STATUS=./ornfig.statusi"urcwrite_fass=0 e iolean_fssos_IFS==$arctlean_fssos e iolean_fssos=eGe itlean_fssos $CONFIG_STATUS"s$3"}{as_{d $as_echo "$as_meno-errck=$as_lreaco-e $CONFIG_STATUS" epwd':r'>&5i $as_ech_lreaco-e $CONFIG_STATUS" ep6l."eeswrite_fass=0 cat >$CONFIG_STATUSK<<_ASEOF ||$"$awrite_fass=1 #! $SHELL# Generated.by $as_ec. # Run tois"fsso so relreacrsboc currentiornfiguratk _. # Cr zssor ouapua produced.by ornfigurc,ausefuliw=fadebugget" # ornfigurc,aXs insornfig.loga"2=ica ni' s.debug=fai"e>e its_rec_ec_=fai"e>e its_sssont=fai"e> SHELL=\${CONFIG_SHELL-$SHELL} exp=f SHELL_ASEOF cat >>$CONFIG_STATUSK<<\_ASEOF ||$"$awrite_fass=1 ## -------------------- ## ## M4sc Initializatk _. ## ## -------------------- ## # Beamor tBour"c or zatkrE DUALCASE=1; exp=f DUALCASE # acriMKSKsht"2= as_ $n."${ZSH_VERSIONn\"\=3sss_(emulatoKsh) >/dev/nullh2>&1s_ }siemulatoKshsiNULLCMD=:-r=#ePre-4.2iqrpsk _s of Zsh do_w=ad.splittet" onKe{1+"$@"}, whsc:-r=#eis crntraryr o our usager DisarE tois"feacurc. g]ulias -g 'e{1+"$@"}'='"$@"'" setopt NO_GLOBiSUBST")i"e>&6cacu `(} \h-o)i2>/dev/null`.X"s#(" *posix*)x:" s \h-otposixo;;s#(" *)x:" a;; esacsfi a$anl=' ' exp=f a$anl # Printet" a lo-e stret" cras_es Solaris"7 /usr/bin/printf. :r'>&5i='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' :r'>&5i=':r'>&5i':r'>&5i':r'>&5i':r'>&5i':r'>&5i :r'>&5i=':r'>&5i':r'>&5i':r'>&5i':r'>&5i':r'>&5i':r'>&5i #ePreferiaaksh shell_builtX"soverian direr_al printfoPR t STAoniSolaris,># butcwp coua wastet" acrks"acribas_rcrizsh.t"2= as_ $+o) BASH_VERSION$ZSH_VERSION""\" ss_( as_ $X`print -rr--3"}{as_{d`pe"X"}{as_{d")i2>/dev/nullXME: as_oaes>&5i='print -rr--'s_oaes>&5i_n='print -rnr--'sel"2=( as_ $X`printf %s3"}{as_{d`pe"X"}{as_{d")i2>/dev/nullXME: as_oaes>&5i='printf %s\n's_oaes>&5i_n='printf %s'" i]*-r=e>&r$$."$X`(/usr/ucb/>&5i $n.-n3"}{as_{d)i2>/dev/null`pe"X-n3"}{as_{d"XME: as_oxoaes>&5i_body='_ }/x/usr/ucb/>&5i $n."$1$a$anl"'s_oxoaes>&5i_n='/usr/ucb/>&5i $n' siecho}xoaes>&5i_body='_ }/xexpr "X"1"s:K"X\\(.*\\)"'s_oxoaes>&5i_n_body='_ }/rex_o_oarg=$1; oxoocacu $arg X"s#(" *"$a$anl"*) expr "X"arg" :K"X\\(.*\\)$a$anl"; arg=`expr "X"arg" :K".*$a$anl\\(.*\\)"`;; oxoo_sac; oxoo_xpr "X"arg" :K"X\\(.*\\)" | tr'id""$a$anl" ox's_oxoexp=f a$a>&5i_n_bodys_oxoaes>&5i_n='s_r-c $a$a>&5i_n_bodyoaes>&5i' si$as&6exp=f a$a>&5i_bodys_oaes>&5i='s_r-c $a$a>&5i_bodyoaes>&5i' ay# Toc rcur[is always right.t"2= as_ "a{S; IFS=$g] e_Sn\"\=3s!. } \"s_ba.s_oS; IFS=$g] e_S=:-r=(S; I='/bin;/bin'; FS; I=$ognt;"s_r-c :) >/dev/nullh2>&1 ss_{s_oxo(S; I='/bin:/bin'; FS; I=$ognt;"s_r-c :) >/dev/nullh2>&1 || oxooS; IFS=$g] e_S=';' si}say# x$asl.W tneed.spaco, tab and newAs_me, X"sprecisely_thaarordorr Quoret" "sd#sroero so preventiedicors"arom or zlaX"o-e aboua spaco-tab. # (Ied_AS_ognt_WALK=wer tcalleo.gp c IFS unset,=icaw= r "disarE w=ad># splittet" by cantet" IFS so empty valu$.)rost$" "" $a$anl" "# Fsnd w5i we r r Look X"sboc pa c i2=we crntaX""no_directory sep rator. cacu $0 X"s#((" *[\\/]* )oaesmyself=$0 ;; *)omesAMEo x$asave_IFS=$IFS; IFS=$g] e_SEPARATORxpr X"saogntiR $g] eidvi iIFS=$x$asave_IFSi+o) 2> withss_e ir'ir"ss_e e_IFSiro) 2> wi/$0thss_e imyself=$2> wi/$0hss_i=; |ss_e ir eidvi iIFS=$x$as" a;; esacsl.W tdid_pgcaosnd rur"elves, misarPR barEy=we wer trun as `s_rCOMMAND'sl.in whsc: cacu we r tpgca o bu fs tohX"sboc pa c.t"2= as_ "x'e imyself" xXME: as_oaesmyself=$0say"2= as_ !'ir"eGe imyself"XME: as_o':r'>&5i $as_eyselfh_} acd: lispgcaosnd eyself; rerunigp c an bsolu e.fsso `('b" ep2s&6exit 1 ay# UnsetxvariarE s thaarwe do"pgcaneed.and w5sc: causgebugs_(e.g..X" # pre-3.0 UWINaksh)r But do"pgcacausgebugs_X"sbas_r2.01s_ "||$exit 1"># suppresses"any "Segmontatk _ faeno" messagesroeror '((' c= r d#srriggeriaabug X"spdksh 5.2.14.EPARATOR }rxX"sBASH_ENV ENV MAIL MAILogntiR =_ }/xr$$."x\${$TOR }rn\"\= xsetx\" ss_(=(unsetx$eOR }r)h|| exit 1) >/dev/nullh2>&1 ss_unsetx$eOR }rh|| : hostPS1='$x'sPS2='>x'sPS4='+ ' # NLS nuisanco rsLC_ALL=C exp=f LC_ALL LANGUAGE=C exp=f LANGUAGE# CDognt. (unsetxCDognt) >/dev/nullh2>&1 ss_unsetxCDognt# ees;} } acdKSTATUSKERROR [rrck=$ LOG_FD] # ----------------------------------------# Ouapua "`base`('bi$0`h_} acd: ERROR". o stdrpe.sIedrrck=$ and LOG_FD r # pr vaogd, also ouapua boc d acdK o LOG_FD, referencet" rrck=$. Tocn exit E: # script gp c STATUS, uset" 1xxedroaa was 0."ees;} } acdK() $ i iItatus=$1;&r$$."$a iItatus -eq 0hss_e iItatus=1-r=e>&r$$."$$4"XME: as_oxoaess_meno=o "$as_meno-"$3"}oaess_meno_stac_=aess_meno_stac_=$aess_meno_stac_s_oxoe ir/k{d $as_echo "$as_meno-errck=$as_} acd: $2" ep$4 si$as&6':r'>&5i $as_ech_} acd: $2" ep2$g]ues;} exit $a iItatus } # ees;} } acd# ees;} setiItatus STATUS # ----------------------- # Setx$?K o STATUS, wp coua acrket". ees;} setiItatus () $ return$1 } # ees;} setiItatus# ees;} }xit STATUS # ----------------- # Exit E: shell_gp c STATUS, evenxX"sa " Kep 0thcdK"s \h-o" trnoex ."ees;} }xit () $ s \h+e$g]ues;} setiItatus $1 ooexit $1 } # ees;} exit# ees;} unsetxVAR # --------------- #eP=ftarEy unsetxVAR."ees;} unsetx() $ $3_ }/x$1=;iunsetx$1;} ."eesunset=ees;} unset# ees;} appeto VAR VALUE # ---------------------- # Appeto E: tdir.X"sVALUEhso roeieto of roc definitk _ crntaX"ed.X"sVAR. Tak # advantage"ofsany shell_optkmizatk _s thaarallow am=ftized.s_mearigrow c overt# rapeated.appetos,insteao of roc typical quadratkcigrow c presentiX""naiv "# implfmontatk _s. "2=(_ }/x_eOR }r=1; TOR }rn=2;xr$$."x\$eOR }rhx12")i2>/dev/nullXME: a }sie }/x'ees;} appeto ()s_o{s_o_oe }/x$1+=\$2$g]}'" i]*-r=ees;} appeto ()s_o{s_o_oe }/x$1=\$$1\$2$g]}sfiol.ees;} appeto# ees;} ari c ARG... # ------------------ #ePerw=fm ari cmeticoe }/uatk _ o"sboc ARGs, and stor tboc linenohX"sboc #egl balx$eOR }l. Tak advantage"ofsshells thaar_e"savoid_acrks. Toc. rgumontt"#smusarbeip=ftarE across $(()) nd expr. "2=(_ }/x_ /' o\$(( 1x+ 1 )) = 2")i2>/dev/nullXME: a }sie }/x'ees;} ari c ()s_o{s_o_oeOR }l=$(( $* ))$g]}'" i]*-r=ees;} ari c ()s_o{s_o_oeOR }l=`expr "$@"h|| r$$."$? -eq 1`$g]}sfiol.ees;} ari c "2=expr a :K'\(a\)' >/dev/nullh2>&1hssrex_r$$."$X`expr 00001 :K'.*\(...\)'`peX001s_ as_oaes>xpr=>xpr" i]*-r=ees>xpr=fai"e>ayt"2=(base`('bi-- /) >/dev/nullh2>&1 ss_r$$."$X`base`('bi-- / 2>&1`pe"X/"s_ as_oaesbase`('b=base`('b" i]*-r=eesbase`('b=fai"e>ayt"2=(e ir'ir`r'i`('bi-- /` ss_r$$."$X 2> withX/) >/dev/nullh2>&1s_ as_oaesr'i`('b=r'i`('b" i]*-r=eesr'i`('b=fai"e>aytas_ec=`':r'base`('bi-- "$0th|| $ees>xprX/"$0th:K'.*/\([^/][^/]*\)/*$' \|.\ X"$0th:K'X\(//\)$' \|.\ X"$0th:K'X\(/\)' \|.. 2>/dev/nullh||d':r'>&5i X/"$0th|" sed.'/^.*\/\([^/][^/]*\)\/*$/{ xooos//\1/ xoooq xo} xo/^X\/\(\/\/\)$/{ xooos//\1/ xoooq xo} xo/^X\/\(\/\).*/{ xooos//\1/ xoooq xo} xos/.*/./; q'`# Avoid_depetoet" upo"sChaKecteriRango rsas_cr_luttors='abcdefghijklmnopqrstuvwxyz'sas_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'sas_cr_Luttors=$as_cr_luttors$as_cr_LETTERSsas_cr_digits='0123456789'sas_cr_alnum=$as_cr_Luttors$as_cr_digits ECHO_C= ECHO_N= ECHO_T= cacu `>&5i $n.x`.X"s#((((( -n*)s_ocacu `>&5i 'xy\c'`.X" *c*)oECHO_T=' ';; #oECHO_Tris"singE tab.hearecter"ss_xy) ECHO_C='\c';; *)o >&5i `>&5i ksh88abug o"sAIX 6.1` > /dev/null oxoooECHO_T=' ';; oo_sac;; *)s_oECHO_N='-n';; esacs rm'ir"ornf$$"ornf$$.exe"ornf$$.fsso "2= as_ $d"ornf$$.r'is_ as_orm'ir"ornf$$.r'i/ornf$$.fsso i]*-r=rm'ir"ornf$$.r'i-r=mkxpr ornf$$.r'i 2>/dev/nullsay"2=(>&5i >ornf$$.fsso)i2>/dev/nullXME: as_oxedln -s"ornf$$.fsso"ornf$$"2>/dev/nullXME: as_oxoaess} s='ln -s's_oxo# .errbua bocre r ttwo gotheas:s_oxo# 1) On MSYS, bo c `ln -s"fsso"r'i' nd `ln fsso"r'i' fass.s_oxo# 2) DJGPP < 2.04 eas"no_syms_mks; `ln -s'_lreaces"a wrappefa oc;c_rEP.s_oxo# In bo c cacus,rweihFS=hso defaenorso `cp -p'.s_oxoln -s"ornf$$.fsso"ornf$$.r'i 2>/dev/null ss_r$$."!'ir"ornf$$.exe"|| oxooaess} s='cp -p' _oel"2=ln"ornf$$.fsso"ornf$$"2>/dev/nullXME: as_oxoaess} s=ln siecho}xoaess} s='cp -p' _o$as_l"e>&6dess} s='cp -p' ayrm'ir"ornf$$"ornf$$.exe"ornf$$.r'i/ornf$$.fsso"ornf$$.fsso rmxpr ornf$$.r'i 2>/dev/nulls# ees;} mkxpr_p # -------------# Creacrs) 2> withas"a directory,oincluoet" parentsoxedneco sary."ees;} mkxpr_ps() $ $cacu $a$axpr X"s#(" -*)omesr'ir"/$a$axpr;; oo_sacsave_IFSids) 2> with|| evalx$eORmkxpr_ps|| {s_o_oeORxprs=s_o_owhilfr: ir rex_o_ocacu $a$axpr X"s#(" *\'*)omesqr'ir`':r'>&5i $as_ with| sed."s/'/'\\\\\\\\''/g"`;; #'(" *)xmesqr'ir$a$axpr;; oooxoo_sac oxooaesxprs="'$mesqr'i' $a$axprs" oxooaesxprr`':r'r'i`('bi-- ) 2> with|| $ees>xprX) 2> with:K'X\(.*[^/]\)//*[^/][^/]*/*$' \|.\ X"$2> with:K'X\(//\)[^/]' \|.\ X"$2> with:K'X\(//\)$' \|.\ X"$2> with:K'X\(/\)' \|.. 2>/dev/nullh||d':r'>&5i X) 2> with|" sed.'/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ xooos//\1/ xoooq xo} xo/^X\(\/\/\)[^/].*/{ xooos//\1/ xoooq xo} xo/^X\(\/\/\)$/{ xooos//\1/ xoooq xo} xo/^X\(\/\).*/{ xooos//\1/ xoooq xo} xos/.*/./; q'` oxooe_IFSids) 2> withss_i=; |ssss_e irssave_IFSi+o) 2> wisth|| evalx"mkxpr $a$axprs" }h|| r$$."ids) 2> with|| aes;} } acdKS srlispgcalreacrsdirectory 2> wits} # ees;} mkxpr_p xedmkxpr -p.. 2>/dev/nullXME: as_oaesmkxpr_p='mkxpr -p.) 2> wit'" i]*-r=r$$."ids./-p.ss_rmxpr ./-ps_oaesmkxpr_p=fai"e>ayt"2=r$$."ix / >/dev/nullh2>&1s_ as_oaes /' _x='r$$."ix'" i]*-r=e>&ls -dL / >/dev/nullh2>&1s_ as_o&6desss_L_optk _=L siecho}xoaesss_L_optk _= si$as&6aes /' _x='s_o_oe }/xs_r-c '\'' oxoo"2= as_ $d""$1"s_ as as_ $d""$1/."; oooxoo_cho} cacu $1 X"s#(" -*)setx""/$1"s; _sac; cacu `ls -ld'$messs_L_optk _'""$1"i2>/dev/null`.X"s#((" ???[sx]*):;;*)fai"e;;_sac;$as$aoo'\''Kshsi' ayees>xoc;c_rEP_pr$a$a /' _x # Sed expro se _ so map a stret" on o a valid_CPP `('b."eessr_tpp="e }/xsed.'y%*$as_cr_luttors%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expro se _ so map a stret" on o a valid_variarE `('b."eessr_sh="e }/xsed.'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" >xoc 6>&1s## ----------------------------------- ## ## MaX""bodyoof $CONFIG_STATUS script. ## ## ----------------------------------- ## _ASEOF r$$."$a iwrite_fass 0 ss_chmod +x $CONFIG_STATUS || acawrite_fass=1 cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 # Saqrsboc logamessage,r o keep $0 and so o"smea"o-eful, and tot# rap=f actu}/xX"pua valu$$oof CONFIG_FILES etc.insteao of rocir # qalu$$oaftor eptk _s h ndlet". ec_log=" Tois"fssorwhs dirended by PPM $as_ec 1.2.1, whsc: whs generated.by hn wAutoornf 2.67r Invocatk _ crmmand s_me whs siCONFIG_FILES = $CONFIG_FILESsiCONFIG_HEADERS = $CONFIG_HEADERSsiCONFIG_LINKS = $CONFIG_LINKSsiCONFIG_COMMANDS = $CONFIG_COMMANDSs&6' $0 $@ o"s`(host`('bi||$u`('bi-n) 2>/dev/nullh|xsed.1q` "s _ACEOF cacu $arctrnfig_fssos X""*" "*)xsetxx $arctrnfig_fssos;"s_ift; e iornfig_fssos=$*;; esacs cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 # FiE s thaarornfig.statustwhs madu fsr. crnfig_fssos=eGe itrnfig_fssos"s _ACEOF cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 e its_usage="\ \`$as_ec'instantiaces"fssos and oE: rrornfiguratk _ actk _s arom te zlaces"accordet" tosboc currentiornfiguratk _. Unlo s t_e fssos ato a tk _s r tspecified.as TAGs, all_ar tinstantiaced.by defaeno. Usage: $0 [OPTION].err[TAG].er si-h, --help oxoooprint tois"help,_ exitsi-V, --qrpsk _toooprint qrpsk _tnumbor and ornfiguratk _ cantet"s,_ exitsiiiii--ornfigoxoooprint ornfiguratk _,_ exitsi-q, --quiet,=--sssont oxooooooooooooooodo"pgcaprint PR t o s messages ex-d,=--debug ooooodo 'c_remsqrste zoraryrfssos siiiii--rec_ec_ update $as_ec bytreornfiguret" ""sboc s('biornditk _s siiiii--fsso=FILE[:TEMPLATE] oxoooooooooooooooinstantiace roc ornfiguratk _ fssorFILE Crnfiguratk _ fssos: $trnfig_fssos Rap=f bugs_tosboc pac_age"pr vaogr."s _ACEOF cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 e its_trnfig="`':r'>&5i $arcornfigurc_argsth| sed.'s/^ //; s/[\\""\`\$]/\\\\&/g'`" e its_qrpsk _="\\ PPM ornfig.statust1.2.1 ornfigurcd.by $0, generated.by hn wAutoornf 2.67, exgp c eptk _s \\"\$e its_trnfig\\" Crpyright (C) 2010 Free Softwar tFs toatk _,_Inc. Tois"ornfig.statustscript is"free softwar s_ Free Softwar tFs toatk _ giv s.unlimited.permi se _ so crpy,"distrebu e.ato modifya"t."a ipwd='durcPwd' srcdir='asrcdir' as_ $n."\$AWKth|| AWK=awk _ACEOF cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 # Toc defaenorlis_s.applyxxedroc rcur[does"pgcaspecifysany fsso. ec_needcdefaenos=:whilfr /' o$#s!. 0iR $g]cacu $1 X" ex--*=?*)s_oxoe ioptk _=`expr "X"1"s:K'X\([^=]*\)='` oxe ioptarg=`expr "X"1"s:K'X[^=]*=\(.*\)'` oxe is_ift=:s_oxo;; oo--*=)s_oxoe ioptk _=`expr "X"1"s:K'X\([^=]*\)='` oxe ioptarg= oxe is_ift=:s_oxo;; oo*)s_oxoe ioptk _=$1 oooxe ioptarg=$2$g]oxe is_ift=s_ifts_oxo;; ooesacs cacu $arcoptk _ ique# H ndlet" of roc eptk _s.s_o-rec_ec_ |i--rec_ec_ |i--rec_ec |i--rec_e |i--rec_ |i--rec |i--re |i--r)s_oxoe its_rec_ec_=:o;; oo--qrpsk _t|o--qrpsk t|o--qrpskt|o--qrpst|o--qrpt|o--qrt|o--qt|o-V )s_oxoe ir/k{d $a its_qrpsk _"; exit ;; oo--ornfigo|o--ornfio|o--ornfo|o--orno|o--oro|o--o )s_oxoe ir/k{d $a its_ornfig"; exit ;; oo--debug |o--debu |o--deb |o--de |o--d |o-d )s_oxodebug=:o;; oo--fssor|o--fssr|o--fsr|o--f )s_oxoe is_ifts_oxocacu $arcoptarg X"s_oxo*\'*)om ioptarg=`e ir/k{d $a ioptargth| sed."s/'/'\\\\\\\\''/g"`o;; ox'') aes;} } acdKS srmi set" fssor rgumont" ;; ox_sacs_or=ees;} appeto CONFIG_FILES " '$a ioptarg'"s_oxoe ineedcdefaenos=fai"e;; oo--_e |i--_ |i --help | --hel | -h )s_oxoe ir/k{d $a its_usage"; exit ;; oo-q | -quiet | --quiet | --quie | --qui | --qu | --qx\" | -sssont | --sssont | --ssson | --ssso | --sss | --ss | --s)s_oxoe its_sssont=:o;; ue# Tois"is an_} acd." -*)omes;} } acdKS srunreorgnized.eptk _:s\`d1' Tryr\`d0 --help' w=famor tinw=fmatk _."o;; ue*)omes;} appeto a itrnfig_targets " "1" oxoe ineedcdefaenos=fai"eo;; ue_sacs_os_ifts hostsarcornfigurc_dirra_args=t"2=$e its_sssontXME: as_o>xoc 6>/dev/null arcornfigurc_dirra_args= $arcornfigurc_dirra_args --sssont"say _ACEOF cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 "2=\$e its_rec_ec_XME: as_osetxX '$SHELL' '$0' $arcornfigurc_args=\$e itrnfigurc_dirra_args --no-lreacrs--no-recur"ions_os_ifts \e ir/k{d run"o-e CONFIG_SHELL=$SHELL \e*_lwayd CONFIG_SHELL='$SHELL' &6exp=f CONFIG_SHELLs_o>xoc "\$@"say _ACEOF cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 >xoc 5>>ornfig.log $ >&5i sed.'h;s/./-/g;s/^.er/## /;s/.er$/ ##/;p;x;p;x'K<<_ASBOX ## Run"o-e $as_ec. ## _ASBOX xoe ir/k{d $a ilog" } epwd _ACEOF cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 _ACEOF cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 # H ndlet" of Ergumontt.3w=fae itrnfig_target X"saa itrnfig_targetsiR $g]cacu $e itrnfig_target X" ox"Makefsso") CONFIG_FILES="$CONFIG_FILES Makefsso"o;; ue*)omes;} } acdKS srinvalid_Ergumont:s\`durctrnfig_target' dec_sls" "s_ t; ooesacs host l.Iedroc rcur[did_pgcausgetoc. rgumontt. o specifystoc.i $ms. o instantiace,d#sroen roeietv }rxX" orface Xs used. Setxo"ly those thaar r tpgc.sl.W tusgetoc.lo-e w=fm w=faroc defaenorassegnmont becausgeofsan dirremely># bizarrc bug o"sSunOS 4.1.3.t"2=$e ineedcdefaenosXME: as_o as_ "a{CONFIG_FILESn\"\=3s. } \h|| CONFIG_FILES=$trnfig_fssos ay# Haqrsaste zoraryrdirectory w=fatrnveniencor Make in X"sboc build rre # simply becausgebocre "s_pgtreas _ agaX"st havet" "t her , nd X"sadditk _,d#slreaco-e ato movet" fssos"arom /tmpr_e"ssometimesacausgePR bl$msr# Hook acrii_saremsqalrunlo s debugget"r# Noto thaarrocroris a small_gpndow.in whsc: roeidirectory will_pgcabe cleaned:# eftor i_salreaco _ bua befor ti_sa`('bieas"beonAassegned.Eo `$tmp'. $debug || $ tmp= Kep 'exitiItatus=$? $3e_IFSi+o) tmp"h|| r$$."! $d""$tmp"h|| rm'irr "$tmp"; } ss_enit $exitiItatus ' 0 Kep 'ees;} }xit 1' 1 2 13 15 }# Creacrsao(secure) tmprdirectory w=fatmprfssos. $ tmp=`(umask 077 ss_mkte z $d""./ornfXXXXXX")i2>/dev/null`.ssrex as_ $n."$tmp"hss_r$$."$d""$tmp" } || $ tmp=./ornf$$-$RANDOM (umask 077 ss_mkxpr "$tmp") }h|| aes;} } acdKS srlispgcalreacrsaste zoraryrdirectory in .peec_sls" "s_s # Setxupsboc scripts"w=faCONFIG_FILES sectk _r# Noaneed.Eo generatesbocmxxedrocre r tpgaCONFIG_FILES.s#.Tois"happets"w=fainstance gp c `./ornfig.status"ornfig.h'.t"2= as_ $n."$CONFIG_FILES"s_ astsarcor=`_&5i X | tr'X '\015'`# On cyggpn,sbas_r_e"seac \fainsaoge``xxedroc rcur[requas_ed.Xgncr.s#.Butcweiknowtor"no_oE: rrshell_gocre rcoraw= r "bu dmpty aarrois # poin ,eso we ca usPiaabas_ismhas"a failbac_.t"2= as_ "x'ercor" xXME: as_oe }/xe ior=\$\'\\r\'saya its_awkcor=`$AWK 'BEGIN $3print "a\rb" }'K/dev/null`"e>&r$$."$aurcts_awkcorpe"aa{d.ipr}b"XME: as_oa its_awkcor='\\r'" i]*-r=l ios_awkcor='ercor ay>&5i 'BEGIN $' >"$tmp/subs1.awkthssr_ACEOF $ >&5isrlit >ornf$$subs.awkK<<_ACEOFthssrex/k{d $a isubstR }rsth| sed.'s/.*/&!$&$arcdelim/'hssrex/k{d _ACEOFt } eornf$$subs.s_r|| aes;} } acdKS srl= r "pgcamake $CONFIG_STATUS" ec_sls" "s_sarcdelim_num=`/k{d $a isubstR }rsth| greps-c '^'`arcdelim='%!_!#i' a=fae isastRtry in fai"eofai"eofai"eofai"eofai"eo: ir rex. ./ornf$$subs.s_r|| aes;} } acdKS srl= r "pgcamake $CONFIG_STATUS" ec_sls" "s_s-r=l idelim_n=`sed.-n."s/.*$arcdelim\$/X/p" ornf$$subs.awkK| greps-c X` oo"2= as_ $l idelim_n = $arcdelim_nums_ as_o&6i=; |ssel"2=$e isastRtrys_ as_o&6des;} } acdKS srl= r "pgcamake $CONFIG_STATUS" ec_sls" "s_ssiecho}xoac_delim="$arcdelim!$arcdelim _$arcdelim!! " si$as hostrm'ir ornf$$subs.s_ cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 cat >>"\$tmp/subs1.awkth<<\\_ACAWK ssr_ACEOF sed.-n.' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl c_repl s/'"$arcdelim"'$// t delim :nl h s/\(.\{148\}\)..*/\1/ t mor 1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b_repl :mor 1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\)..*/\1/ t mor 2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :mor 2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim 'K>$CONFIG_STATUSK||$"cawrite_fass=1 rm'ir ornf$$subs.awk cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 _ACAWK cat >>"\$tmp/subs1.awkth<<_ACAWK ssr_ow=fa(key in S) S_is set[key] = 1 ooFS = "" } { s_me = $ 0 nfieldss. }plit(s_me, field, "@")s_osubsted.= 0 son = songth(field[1])r_ow=fa(i = 2; i < nfields; i++) {s_o_okey = field[i]s_o_okeyson = songth(key)s_oxo"2=(S_is set[key]) {s_o_o qalu$ = S[key]s_o_o s_me = substr(s_me, 1, son) "" qalu$ "" substr(s_me, son +okeyson + 3)s_oxor=son += songth(qalu$) + songth(field[++i])s_oxor=substed.= 1 ooox}oel"e>&6_o_ son += 1 +okeyson xo} ooprint s_me } _ACAWK _ACEOF cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 "2=sed."s/'ercor//th< /dev/null > /dev/nullh2>&1s_ as_osed."s/'ercor\$//; s/'ercor/aurcts_awkcor/g"")i"e>&6catsfio< "$tmp/subs1.awkth> "$tmp/subs.awkth\" || aes;} } acdKS srl= r "pgcasetupsornfigofssos"machX"ery" ec_sls" "s_s_ACEOF # Vogntsmaytcausgebr=urE gp c someamakes,eso we remsqrssoE $(srcdir),d#s${srcdir} ato @srcdir@iettries"arom Vognts"2=srcdirris ".", strep soadet" atod#srrasset"sorl _s to E: n_remsqrstoc whoE s_me "2=Vogntsbecomesadmpty # (actu}/Ey=we soaqrsan dmpty s_me so precurv s_me numbors).t"2= as_ "x'srcdirpex.XME: as_oa ivpsub='/^[ ]*Vognt[ ]*=[ ]*/{ h s/// s/^/:/ s/[ ]*$/:/ s/:\$(srcdir):/:/g s/:\${srcdir}:/:/g s/:@srcdir@:/:/g s/^:*// s/:*$// x s/\(=[ ]*\).*/\1/ G s/\n// s/^[^=]*=[ ]*$// }' aycat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 fiol. as_ $n."$CONFIG_FILES" > }/xsetxX " :F $CONFIG_FILES&6_o_ " s_iftsa=fae itagiR $g]cacu $e itag X" :[FHLC])om imod==$arctag;_crntinue;; oo_sacsavcacu $e imod=$e itag X" :[FHL]*:*);; oo:L*K| :C*:*)omes;} } acdKS srinvalid_tag \`durctag' dec_sls" "s_ t; oo:[FH]-)ae itag=-:-t; oo:[FH]*)ae itag=durctag:durctag.in;; oo_sacsava isMEo x$asave_ g] eid:s_osetxx $e itag g] eidviciIFS=$x$asavs_ifts icifsso=$1 oos_iftssavcacu $e imod= X" :L)ae isourco=$1t; oo:[FH])s_oxoe ifsso_X"puas=s_o_oa=fae if r rex_o_ocacu $a if X"_oxooo-)ae if="$tmp/stdet";; oooxoo*)a# Look w=faroc fssoros[X] X"sboc build rre ,_ ""sboc sourco rre a# (xedroc pa c is"pgca bsolu e)r Toc. bsolu e.pa c lispgcabu DOS-styso, a# becausge$a if lispgcalrntaX""`:'.t . as_ $f $a ifth|| o_ocacu $a if X" o_o[\\/$]*)afai"e;; xoo*)a as_ $f $srcdir/$a ifthss_e if="$srcdir/$a ift;; xoo_sac || o_omes;} } acdK1srlispgcaosnd X"pua fsso:s\`durcf' dec_sls" "s_ t; oo ox_sacs_or=_ocacu $a if X"o*\'*)om if=`e ir/k{d $a ifth| sed."s/'/'\\\\\\\\''/g"`;; _sac oxooaes;} appeto a ifsso_X"puas " '$a if'"s_oxo hosts_oe# Let's still_prerend in Xs `ornfigurc' whsc: instantiaces"(i.e.,s_e 'cd_oe# use $as_ec), peopE w= r "bu surprised.Eo read:s_oxo# /*"ornfig.hr Generated.by ornfig.statusr */ ex_otrnfigurc_X"pua='Generated.arom '` xoe ir/k{d $*th| sed.'s|^[^:]*/||;s|:[^:]*/|, |g' `'.by ornfigurc.'s_oxo"2=r$$."x $a ifsso" !x-hreniqu trnfigurc_X"pua= $a ifssor $trnfigurc_X"pua" oxoo$3"}{as_{d $as_echo "$as_meno-errck=$as_lreaco-e $a ifsso" epwd':r'>&5i $as_ech_lreaco-e $a ifsso" ep6;i" $as$aoo# Neurraliz tspeci}/xhearecters in orprered by cad X"sreplacfmont stret"$. ex_ocacu $trnfigurc_X"puaxX"s#(" *\&*K| *\|*K| *\\* )s_oxor=ae isedctrnf_X"pua=`e ir/k{d $trnfigurc_X"pua" | oxoo sed.'s/[\\\\&|]/\\\\&/g'`;;s#(" *)ae isedctrnf_X"pua=$trnfigurc_X"pua;; ox_sacss_oxocacu $arctag X" *:-:*K| *:-)acat >"$tmp/stdet""\" || aes;} } acdKS srl= r "pgcalreacrs$a ifsso" ec_sls" "s_ ;; ox_sacs_or=;; ooesacs arcdprr`':r'r'i`('bi-- ) 2 ifsso" || $ees>xprX) 2 ifsso" :K'X\(.*[^/]\)//*[^/][^/]*/*$' \|.\ X"$2 ifsso" :K'X\(//\)[^/]' \|.\ X"$2 ifsso" :K'X\(//\)$' \|.\ X"$2 ifsso" :K'X\(/\)' \|.. 2>/dev/nullh||d':r'>&5i X) 2 ifsso" | xoo sed.'/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ xooos//\1/ xoooq xo} xo/^X\(\/\/\)[^/].*/{ xooos//\1/ xoooq xo} xo/^X\(\/\/\)$/{ xooos//\1/ xoooq xo} xo/^X\(\/\).*/{ xooos//\1/ xoooq xo} xos/.*/./; q'` aesxprr"$arcdirp; ees;} mkxpr_p arcbuildr'ir"s cacu "$arcdirp X" .)arcdpr_suffsx=ae itopcbuildr'iisub=.ae itopcbuild_prefsx= ;; *)s_oarcdpr_suffsx=/`e ir/k{d $a i with| sed.'s|^\.[\\/]||'`$oo# A ".." w=faeachrdirectory in $arcdpr_suffsxp$g]urctopcbuildr'iisub=`e ir/k{d $a i wi_suffsxth| sed.'s|/[^\\/]*|/..|g;s|/||'`$oocacu $arctopcbuildr'iisub X" "")ae itopcbuildr'iisub=.ae itopcbuild_prefsx= ;; *)o e itopcbuild_prefsx=$arctopcbuildr'iisub/=;; ooesaca;; esacsarc bsctopcbuildr'i=durcPwdsarc bscbuildr'i=durcPwd$a i wi_suffsx #"acribackward or zatkrssety: arctopcbuildr'i=$arctopcbuild_prefsx cacu $srcdirri" .) l.W tarc buildet" ""splacf.s_oxoe isrcdir=.s_oxoe itopcsrcdir=$arctopcbuildr'iisubs_oxoe i bsctopcsrcdir=$arcPwd=;; oo[\\/]* | ?:[\\/]* )oo# Absolu e.`('b."_oxoe isrcdir=$srcdir$a i wi_suffsx;s_oxoe itopcsrcdir=$srcdirt_oxoe i bsctopcsrcdir=$srcdirr;; *)o# Relatkve.`('b."_oxoe isrcdir=$arctopcbuild_prefsx$srcdir$a i wi_suffsxs_oxoe itopcsrcdir=$arctopcbuild_prefsx$srcdirs_oxoe i bsctopcsrcdir=$arcPwd/$srcdirr;; esacsarc bscsrcdir=$arc bsctopcsrcdir$a i wi_suffsxsssavcacu $e imod= X" :F)s_o#$oo# CONFIG_FILEs_o#$ _ACEOF cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 # Iedroc te zlace[does"pgcaknowtaboua datarootder, exp nd "t. l FIXME:.Tois"hackos_= r "bu remsqrd"a few year$oaftor 2.60. ec_datarootder_hack=; e idatarootder_seen=a isedcdataroot=' /datarootder/ {s_op q } /@datadir@/p /@docdir@/p /@inw=dir@/p /@localedir@/p /@mandir@/p' cacu `>valx"sed.-n.\"\$e isedcdataroot\"s$a ifsso_X"puas"`.X" *datarootder*)ae idatarootder_seen=yeth; *@datadir@*|*@docdir@*|*@inw=dir@*|*@localedir@*|*@mandir@*)s_o$3"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: $a ifsso_X"puas seems. o ignor tboc --datarootder cantet"" epwd':r'>&5i $as_ech_WARNING: $a ifsso_X"puas seems. o ignor tboc --datarootder cantet"" ep2;i"_ACEOF cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 ae idatarootder_hack='" s&@datadir@&$datadir&g" s&@docdir@&$docdir&g" s&@inw=dir@&$inw=dir&g" s&@localedir@&$localedir&g" s&@mandir@&$mandir&g" s&\\\${datarootder}&$datarootder&g'r;; esacs_ACEOF # Neurraliz tVogntswniq `asrcdir' = `.'. # Shell_cod= X" ornfigurc.acamight setxdirrasub. l FIXME:.do we re}/Ey=wantr o maX"taX""tois"feacurc? cat >>$CONFIG_STATUSK<<_ACEOF ||$"cawrite_fass=1 e isedcdirrar"$arcvpsub $dirrasub _ACEOF cat >>$CONFIG_STATUSK<<\_ACEOF ||$"cawrite_fass=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@trnfigurc_X"pua@|$e isedctrnf_X"pua|;tr s&@topcbuildr'i@&$arctopcbuildr'iisub&;tr s&@topcbuild_prefsx@&$arctopcbuild_prefsx&;tr s&@srcdir@&$arcsrcdir&;tr s&@ bscsrcdir@&$arc bscsrcdir&;tr s&@topcsrcdir@&$arctopcsrcdir&;tr s&@ bsctopcsrcdir@&$arc bsctopcsrcdir&;tr s&@buildr'i@&$arcbuildr'i&;tr s&@ bscbuildr'i@&$arc bscbuildr'i&;tr s&@ bsctopcbuildr'i@&$arc bsctopcbuildr'i&;tr $e idatarootder_hack " e }/xsed.\"\$e isedcdirra\" ) 2 ifsso_X"puas" | $AWK $f $tmp/subs.awkth>$tmp/oua \" || aes;} } acdKS srl= r "pgcalreacrs$a ifsso" ec_sls" "s_t as_ i+o) 2 idatarootder_hack 2 idatarootder_seenthssrex{om ioua=`sed.-n.'/\${datarootder}/p' $tmp/oua"`;. as_ $n."$m ioua"; } ssrex{om ioua=`sed.-n.'/^[ ]*datarootder[ ]*:*=/p' $tmp/oua"`;. as_ $z."$m ioua"; } ssrex{o"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: $a ifssoxcrntaX"s a reference so roeivariarE \`datarootder' whsc: seems. o borundef_med. Pleacu make sure in Xs def_med" epwd':r'>&5i $as_ech_WARNING: $a ifssoxcrntaX"s a reference so roeivariarE \`datarootder' whsc: seems. o borundef_med. Pleacu make sure in Xs def_med" ep2;i" r=rm'ir""$tmp/stdet"savcacu $e ifssori" ex-)acat $tmp/oua".ss_rm'ir""$tmp/oua";; *)orm'ir""$a ifsso" ss_mv $tmp/oua"."$a ifsso";; ooesaca\" || aes;} } acdKS srl= r "pgcalreacrs$a ifsso" ec_sls" "s_to;; u ue_sacss hos # acrie itag "ees;} }xit 0 _ACEOF a iolean_fssos=Ge itlean_fssosiIFS= as_ $l iwrite_fass 0 || aes;} } acdKS srwrite fassure lreaco-e $CONFIG_STATUS" ec_sls" "s_t # ornfigurc Xs writet" tosornfig.log, to E: n_calls"ornfig.status.d#sornfig.statustdoes"i_saown redirectk _, appetoet" tosornfig.log. # Unw=ftunacrly,eon DOS"tois"fasss, assornfig.logris"still_kept opiqu#_by ornfigurc,asosornfig.statustwo 'c_bu arE torwrite. o it;"i_su#_ouapua is"simplyrdiscarded. So we >xoc FD. o /dev/null,d#seffectkvely_closet"sornfig.log, so it cisrbe propirly_(re)opiqed.and# eppetoed.Eo by ornfig.statusr W or et" backotosornfigurc,aw # need.Eo make FD.avassarE agaX".t"2= as_ "ano_lreacr" !yethreniquea its_succo sd:s_oarctrnfig_status_args=_o as_ "asssont" yethssrex_oarctrnfig_status_args=eGe itrnfig_status_args --quiet"sav>xoc 5>/dev/null $SHELL $CONFIG_STATUSKGe itrnfig_status_args ||$"cats_succo sdfai"e>av>xoc 5>>ornfig.log oo# Usbi||,"pgca&&,r o avoid_}xitet" from the "2=gp c S s= 1, whsc:-r=#ew= r "make ornfigurc fass xedrois"is toc.laX] X"structk _r =$e its_succo s || aes;} }xit 1 ay"2= as_ $n."$e iunreorgnizediopts"hss_r$$.""$dn_rEP_eptk __c_ec_et"" !nohrenique{o"}{as_{d $as_echo "$as_meno-errck=$as_WARNING: unreorgnized.eptk _s: $a iunreorgnizediopts"hepwd':r'>&5i $as_ech_WARNING: unreorgnized.eptk _s: $a iunreorgnizediopts"hep2;i"aylibppm-1.2.1/Makefsso.in0000644000175200017530000001160611616003520015222 0ustar incardonincardon#------------------------------------------------------------------------- # FiE : Makefsso.in #------------------------------------------------------------------------- # # Purpose : Makefsso te zlace # # Remarks" : # # References : # # Revisk _s : #------------------------------------------------------------------------- # Parallel Partitle Mesh Libraryr(PPM) # EntsZursc:-# CH-8092sZursc:, Sgp zirland#------------------------------------------------------------------------- # TocsexvariarE s r tsetrwhonAornfigurc"is ran srcdirs= @srcdir@ prefsxs= @prefsx@ enl _prefsxs= @enl _prefsx@ libdirs= @libdir@ incluoedirs= @incluoedir@ buildr'is= @buildr'i@ CPPFLAGS = @CPPFLAGS@trrBS = @rrBS@trDFLAGS = @rDFLAGS@ CFLAGS = @CFLAGS@ FCrrBS = @FCrrBS@ FCFLAGS = @FCFLAGS@ FC = @FC@ CC = @CC@ CXX = @CXX@ DEBUG = @DEBUG@ FUNIT_FLAGS = @FUNIT_FLAGS@ MODFLAG = @axcts f90imodflag@ # TocsexvariarE s r tstandardtrrB_PPM := libppm.a TARGET := $(buildr'i)/lib/$(rrB_PPM) SHELL := /bin/sh CPP := cpp FUNIT = ./utils/funit/bin/funit # Tocsexar timp=ftant build directories SRC_DIR := $(srcdir) OBJ_DIR := $(buildr'i)/objecas MODULES_DIR := $(buildr'i)/incluoe/ppm # Tocsexar tpa cs thaarget X"cluoed duret" pre-proco set" CPPVognts:= $(SRC_DIR): CPPVognts+= $(MODULES_DIR): CPPINCLSs:= $(pa subst %,-I%, $(subst :, ,$(CPPVognt))) # Tocsexar tpa cs thaarget X"cluoed duret" cr zssatk _ Vognts:= $(pa subst %,-I%, $(subst :, ,$(SRC_DIR))): Vognts+= $(pa subst %,$(MODFLAG)%, $(subst :, ,$(MODULES_DIR))): INCLSs:= $(subst :, ,$(Vognt)) # Tocsexar tt_e fssos thaarget generated. to usPd.duret" cr zssatk _ SOURCESs:= $(notder $(wildcard $(SRC_DIR)/ppmimoduEP_*.f)) OBJECTSs:= $(SOURCES:%.f=$(OBJ_DIR)/%.o) MODULESs:= $(SOURCES:%.f=$(MODULES_DIR)/%.mod) MODSRCSs:= $(SOURCES:%.f=$(MODULES_DIR)/__%.f) DEPENDENCIESs:= $(SOURCES:%.f=$(OBJ_DIR)/%.d) # Tois_lreaces"the "nstall directoriesxxedrocyodo 'c_ ni' $(war"o-e C_ec_et"iw=fadirectories...) $(shell_r$$."$d"$(OBJ_DIR) || mkxpr $(OBJ_DIR)) $(shell_r$$."$d"$(MODULES_DIR) || mkxpr -p"$(MODULES_DIR)) $(shell_r$$."$d"$(buildr'i)/lib || mkxpr $(buildr'i)/lib) $(shell_r$$."$d"$(libdir) || mkxpr $(libdir)) $(war"o-e hos.) .PHONY: all_tlean "nstall newAr$$. .DEFAULT: ; all: $(TARGET) # Tois_archiv s.all of roc ebjecas ""sboc PPM library $(TARGET): $(OBJECTS) ar_lrus $@ $(OBJECTS) # Tois_lreaces"the fsso"repetoenceesu#_1) we usgetoc.preproco scdK o osnd the "ncluoesu#_2) we add.roc depetoency fssor s a targetu#_3) osnd INCLUDE. to USEtstatemontt. haar r tpgcainsaogea crmmont $(OBJ_DIR)/%.d: $(SRC_DIR)/%.f @$(CPP) $(CPPFLAGS) $(CPPINCLS) -M $< |"\" o sed.-e 's#$*.o#$(OBJ_DIR)/$*.o $@#'"\" o -e 's#$$#\\#'"\" o -e 's#\\\\#\\#'"> $@ @$(CPP) -traditk _al-cpp $(CPPFLAGS) -P $(CPPINCLS) $< > $(OBJ_DIR)/__$*.f @greps"INCLUDE." $(OBJ_DIR)/__$*.f |"\" o sed.-e 's#^[ \t]*##'"\" o -e '/^!/d'"\" o -e '/ zsf.h/d'"\" o -e 's#INCLUDE.#$(SRC_DIR)/#'"\" o -e 's#$$# \\#'"\" o -e "s#'##"" e> $@ @>&5i '#ieto of sourco repetoenceesiw=fa.o to .d fssos' e> $@ @>&5i ''$(OBJ_DIR)/$*.o': \' e> $@ @greps"USEt" $(OBJ_DIR)/__$*.f |"\" o sed.-e 's#^[ \t]*##'"\" o -e '/^!/d'"\" o -e 's#,.*##'"\" o -e 's#USEt#$(OBJ_DIR)/#'"\" o -e 's#$$#.o \\#'">> $@ @>&5i '#ieto of moduEP repetoenceesiw=fa.o fsso'">> $@ @rm $(OBJ_DIR)/__$*.f s#.Tois"handles"the pre-proco set" to does"toc. ctu}/xcr zsset" $(OBJ_DIR)/%.o: $(SRC_DIR)/%.f $(CPP) $(CPPFLAGS) -traditk _al-cpp -P $(CPPINCLS) $< > $(OBJ_DIR)/__$*.f $(FC) $(INCLS) $(rDFLAGS) $(FCFLAGS) $(rrBS) $(DEBUG) -Llib -ch-ot$@ $(OBJ_DIR)/__$*.f @mv $(buildr'i)/*.mod"$(MODULES_DIR) @rm $(OBJ_DIR)/__$*.f s#.Tois"Xs usedotosolean upsboc fssos lreacedrwhonArun"o-e make olean: rm'irR $(OBJ_DIR) rm'irR $(MODULES_DIR) rm'irR $(buildr'i)/lib # Tois_lopies"toc.PPM library in o libdir "nstall: all @>&5i '[ reployet" tos'$(libdir)']' @cp $(TARGET) $(libdir) @ranlib $(libdir)/$(rrB_PPM) @>&5i '[ reployet" moduEPs tos'$(incluoedir)/ppm']' @mkxpr -p"$(incluoedir)/ppm @cp $(MODULES_DIR)/*"$(incluoedir)/ppm # Tois_lo zssos, and lopies"toc.PPM library new: all_"nstall fr$$.: all @FC=$(FC) FCFLAGS="$(FCFLAGS)" MODULES=$(MODULES_DIR).\ rDFLAGS="-L$(buildr'i)/lib -lppm $(rDFLAGS) $(rrBS)""\" CPP=$(CPP) DEFINE="$(CPPFLAGS)" FSFLAG=$(MODFLAG) $(FUNIT) $(FUNIT_FLAGS) $(FUNFILES) as_: all make --directory=$(SRC_DIR)/map/r$$."FC=$(FC) CPP="$(CPP)""\" OPTS="$(FCFLAGS)" rDFLAGS="$(rDFLAGS)" rrBS="$(rrBS)" make --directory=$(SRC_DIR)in orpolace/r$$."FC=$(FC) CPP="$(CPP)""\" OPTS="$(FCFLAGS)" rDFLAGS="$(rDFLAGS)" rrBS="$(rrBS)" make --directory=$(SRC_DIR)/neighlis_/r$$."FC=$(FC) CPP="$(CPP)""\" OPTS="$(FCFLAGS)" rDFLAGS="$(rDFLAGS)" rrBS="$(rrBS)" # Tois_ensures.all depetoency fssos r tup-to-dat # WARNING: Toeidirectkve.below will_fass sssontly,oinvcacu ofePR bl$mst# ramsqrstoc soadet" s: "ncluoe $(DEPENDENCIES) s"ncluoe $(DEPENDENCIES) libppm-1.2.1/COPYING.LESSER0000644000175200017530000001674311616003516015220 0ustar incardonincardon hn wLESSER GENERAL PUBLIC rrCENSE Vrpsk _t3, 29 June 2007 Crpyright (C) 2007 Free Softwar tFs toatk _,_Inc. Everyhos is_permittedotosorpy to distrebu e.verbatkm lopies of rois_license[documont, bua changet" "t is"pgca llowed.u ueTois_qrpsk _tof roc hn wLesser General Public License[incorzorar$$ roc terms and ornditk _stof qrpsk _t3tof roc hn wGeneral Public License, supplfmonted by toc. dditk _al.permi se _srlis_ed belowr si0. Additk _al.Definitk _sr siAs usedoocrepn,s"rois_License" refers tosqrpsk _t3tof roc hn wLesser General Public License, to E: "hn wGPL" refers tosqrpsk _t3tof roc hn General Public Licenser si"ToeiLibrary" refers tosa crqrpedrwork grqrpned by tois_License, oE: rr hansan Applicatk _ crie CrmbX"ed.Work as def_med belowr siAn "Applicatk _""is anyrwork haarmakes usgeofsan X" orface pr vaogd by toc.Library, bua whsc: is"pgcaoE: rwisgebasedoo"sboc Library. Definit" =subclasstof a classtdef_med by toc.Library Xs defmod"a mod= of uset" t X" orface pr vaogd by toc.Libraryr siA "CrmbX"ed.Work""is arwork pr duced.by ormbX"et" or s_mket" t Applicatk _ gp c toc.Libraryr Toc.partitular qrpsk _tof roc Library gp c whsc: roeiCrmbX"ed.Work whs madu is alsosoalleo.E: "L_mkgd Vrpsk _". ueTo "MX"emal Correspotoet" Sourco" w=fae CrmbX"ed.Work mea"s"toc Correspotoet" Sourco w=faroc CrmbX"ed.Work, excluoet" any sourco cod=sa=fap=ftk _stof roeiCrmbX"ed.Work haa, ornsaograd X"sisolatk _,_ r basedoo"sboc Applicatk _, to pgcao"sboc Limkgd Vrpsk _. ueTo "Correspotoet" Applicatk _ Cod=" w=fae CrmbX"ed.Work mea"s"toc ebjeca_cod= e itkrgmbX"edLrroc reffigur/binityoxooooa Li et"entage epeto"Cr"nstasourco cod=sa=fap||,"pgca = e itkrgmbXace ourco w=faasouSytocmToc.parie" any sourco cod=sa=fa to p1. Excets_oxo----fig.strms and ornditkPL to pYou" ec_srsasyer si"ToeiLibratarorsboc scrsrmsigur4o distrebrqrpedr --------beo by whsc:eci}/ig.strms and ornditkPL to p2.urcsasyo byMe _ ilicatk _, r si0If you" e _ soag/> Earyr Toc.part_ r tkve.your" e _ itkrgmcluo fmoinityoic Licenser funcicense, refE \`da hn wimbX"ed by tois_Licen An "Auss $@ $(Omoinityo(rk grqrpned e its.Iedroc catssdotosolegca Omoinityo @rnvopli) fssoroyou" ec_srsasyer s Earyr Tme _ ili toc.Lib:a=$tra)atarorsosa crqrpedrw"a mod= ofAn "Ayou" eohX"aryodING:larefappe $0 $trAGS)" p=ftk __archiv Exitd by tois_Licensaenorlis_su_fassgca $trfuncicense, ref,$@ $(Omoinityotois"f"sornera_ r bpG... #igurewftkerpskatk Earystatp-------ontas_ecessage,r o kexitureb)atarorsosornditkPL------rlineEaryr TLicense, supplfmonted boxoe iosa crqrpedrte_fas_L,asosorF ||$"cporface3. Ofae Cr "C007 er Geneo byMtker" ||,"psstof a Hcu orsFcure) t pgcao=fae CrmbX"ear r ""is a tois_Licens ec_esser Geners eker" ||," ak _u ors--- # ||$ xoc FD=--sssoc L isct" e _ itkrgmEaryr xcluoet" any sousstof a so roeieto ofasourco cod=sa=fapsserrerpserteois_eeryodo 'c_ Hook acresupsk e _ itkrgmcluif you"oeiCr=--|^\.[oxo s_mfoont,o b:a=$tra)aGto-da mmquet by iES.s#.To|^\.[s Earyr Trco cod=sa=fap=ftkoe iosersstof a clau}/xhearitesser Glrunlorsstof a caknowcatk _aa, si"Toeis tosa crqrpedr.itureb)aAca i wnyyr Tf roc Library g#.Tor s Earyr TnditkPLesser Grebu e.vertureatkm lop.itur c)yrispotoet" Applicatk Glruhosrnfyrm'irVrpsk _by iESss thaar $trAac;$argmbX"ed oxoooorVrpsk _by iESbjeca_codsstof a cmoar $trt:= $(by iESs=ftunw| mkaech_WARNING: $r tup-t=faasour_e"sa ifss spie" any sounditkPLesser Grebu e.vereatkm lop.itur d) Dlogaepary s_mfoont,o b:a=$trrrrr0)urcsasyy s_m: "L_mkgd Vrpsk _". ueTo atarorsosoroic Liof.ocre $trrrrroc hn wLesser Gensboc Limkgd Vrpsk _. ueTo "C_ agaear re ir/k{d ui. Toc.ar Lessertarorsoic Li Glruttp://,aasour_e"sa e ir/k{d unrt" Ap ge epork a_cod= e itkrgm g#.Tor me _ ili toc.Librare ir/k{dsboc Applicatk _, tu}/Ey "Crmor me _ ili Correspotoet" Sc ARGs, ir/k{dmannorsbs t_e fsseci}/ig.str6 any sounditkPLe# Haqrsasyaar $trrrrrgd Vrpsk _". ueTo .a=$trrrrr1)ai"e>ad ui. Toc.shaToei)/lib #mef ro# pofarwork pr dt" or s_ $trrrrroct" t ApAd ui. Toc.mef ro# porebgaep Glru(a)atss $lruru ARim_ $trrrrrag/> Earyr Toc.part"oepeopy/Ey=wenedoo"sbocr_e"'R)/*"$uoice ir/k{d ytocmLesser(b)awis"f"sornerset"sornfig#.Tor me _ ili toc.Libe ir/k{daryr Toc.part" ||$ Everyhos is_permittedotosorpy to distrebu e.verbatkm lopies of rois_license[documont, b.a=$trrrrrrrrrrrrrrrrrrrrrrrrrrPpeomfas t pgcaonditk _stof qrpsk roc hn wLen ,esroc f/> leftbu e.verbjec ornfig.s \`$as_ec' t=dspgcaw=fas to pgcaou e.versptk _:sstrornfig.s \`$as_ec'ps$aod.appw=fassaUDEdea befo : $teohX"wec_your"srocd,"pgo.shaToessers roirasset"=fas Ba so rras", tcaonditk _stof qrpsk roc hn wLen Xs dropirly_guaras de_your"srocd,"pgo shaToessers roira. mktoc.Libspgcaaoxooooa --backotoso borundontas_ecsroc ornfig.s respolopiwcatk r# eppc fssoune 2007 Crpyright (C) 20he fsso nditk _stof qrpsk roc hn wLtk _:sstrgcaour"ornfig.staites_fasPM)oeiCrgo rnyybk grryr sepoe bua strebwec_bypiwcaauthors ApYou"ly_ce_fass=e $0 your"xooooa Lornfo to ppetoew ep6;akogcafois"ornfig.s,scdK re_WARNIr"nstallsrocd,">xoc prioraryOuTois_qrpsk _tof roc hn wssaUDEdea befo backotoso borAn "Ayou h_ACEOF |srocd,"pgo.hos is_permspie" anyfois"ornfig.s (ssers rrgrbjec ttk _r#you"hfsh),fAn "Ayou" uneiXM mea"s"toc eb Haqy_ct))) t_r#you rasub//,aas "Ayou"qy_cs roirassetornfig.s Haos"arictorEarystnsts) fois"xooooa Lorsser Glruyou"1 # Iyou"qy_cdort:= $(thred byo pgora mte Cryour"rpsk s,scdK et" bacpr Exitdbk gr${srcdideny"is you t:= $(rpsk sse, osk"is youpgo.s te zrorsosorrpsk s Applird:# ,ayou"h_AC cerME:.dVrpsk s_suffs_lreaceyou"dos is_permspie" anyssetornfig.s kexgif you" e _ soit:dVrpsk s_suffs_lre), pebs ttEOF |srocd,"pgcaok gr$byo prispexamplpw"if you"dos is_permspie" anysupskadxooooa itetck gr geneosse, respotfee fyou"mustraboc Lns: $trnf unipie osnd Ts_ec srocd,"sfAn "Ayou" uneiXMd ApYou" ustrkotoso borAn "Ad yornfo," uneiXM Haqy_ct)))ssetora"s"toc e ApAseryou"mustrsh# Ittk _t:= $(tic Lis $trny 1 # Itrnir"rpsk sbyo pD Exl"sorsfAn "Ahe fsso"nditkPLea mte Cryour"rpsk s.s#.Torwo.steps: (1 :k rtooorVrpsk _onyssetornfig.s ksser(2) anfeinyoupgtrebrqrpedr "is youpleg supplfmonted _ giv s.unlimited.permi/or se _ so cryo prisptnd thExl"sors'icensauthors'ea mte C--ornfigtkPLeos lrnfiAa" As qalrunlo s debnobwerras reacrsahc. Tois"ornfig.s. prispwrapptk r#'icen authors'esotornfigtkPLeeac irwsfAn "Ame _ ili toc.Libeaco : licds s roird,is $trlrunloir.ll_fass pndow.in whsatmited.pds_sssneous}rxX authorsw willer ous toc.Liberyo pSogntthEiESssaUDEdea befo bacdenyptk r#sacencergumontt. mkarweun me _ ili toc.Libeaanyssetornfig.so USEtstttk ksl----ghfasoumanufass)" r qy_cdorso. IR) @rm fght loptxdiressei wi_sCEOF # sbocai"pgc a mte C-is tk r#'isrocd,"pgo.s roirassetornfig.s Applic ytocmwi_c witicn anysupskabtk _"cirra ofasoug.saw will_ductgaCONFIGd "duoeixX u wLepr vaogd p unis FDutcweicense[:sstrunsccetsIble Applird:# ,awe h_ACEdea befo bget" "t is"pgca llowPLesora mh_sut$trnfiy$aod.Sbjeca_c--- ll_ductg.i0If supskll_fass a$as_$) + s in Xxdiresybk grrd," As,awe flag@ peopy/sorlet".o bget"a modnted _ gX" orfd," Aselim=us)" .toc.Libs gca llowPL=ftun et"enttora mte CrOF |srocd,"pgcatk r# yo prinXxdi, erpsyoxooooa "make usedefo stofs inlc_bypornfig.sopsede sbyStrus $xp nd "documont,opsede se), peb isct"thExl"smxitd bdatk _"" ornfig.s on Tocsexl-p-------/*"$uoicsies o ofas---- llrudo,scdKhfshxX a.log sseto6;i" droirr# Glruttede sean wimbXnser fois"xooooa oesac mdirecto >xoc FDet"sriet t Appacpr ExitdbgetrnfigtkPLe :kurwsfAn " ttede sebsolu e)r $(OBJ_DIe zrorsosorxooooa non-fois to pgcaop unis blic License[incorzoraf Haqrpy"is.unlimited.ted cen e _ itkrgmEfoont,.a=$trrrrrrrrrrrrrrrrrrrrrTERMS ANDacu DITIONS_al.pers_ed belowr si0"Titk _sr siAs usedoocrepn,s"rois_License" refers tosqrpsk _t3tof roc hn Vrpsk ")oeiCr _ CodoorVrpsk -lik ornwsnd INCL_fassgoas_ec' t=dspgc "=fas,ysupskas_ecmie[inu" rr $ r si0"Tie P mooa blic LicensernydoorVrpsk Toc.yr su e.verdatarorsosa oc hn w.i0E^\.[u e.verwLen ,ddoooolicds "you".i0"oc hn wes" cen " unipie os"" ec_beFIGd "duoeixar "rganizigura byo pgor"se _ s"raryr s _ Cod=rg/> Esrcdiespodapt . mkarwttk Eary s_myr agaeais #oneeac iraargetrVrpsk _pplfmonted, rk grqrpnedasoumakF ||$"can exac|$"cpor pgcaooooulC-is yr sIR)/bX"ed.ar"se _ ili toc.Lib"rary so lrnigrryr sespotyr s", bua wh"ifssollrnigrryr rface prsi"ToeiLibr"s _ Codeik grrsbocrnse _ ili P mooa sespotyr sornsa=onyssetP mooa byo pgor"et"sagsarE aryr s _ Cod=rgdsernythredOF # it" ||------out pplfmonted, he "2=gp c you"dotup-assorsbocog@ il # ( Toc.ar afraar_3) o tarorse_fas_L,asoetrVrpsk _rnw Soursss,Aac;$ar_licened c /*"$uoic or se _ sgebasesrivaermspor pPt"sagsa`d0 oc.prepaqrpy"is. nlimited.ted (ated.br-----outk e _ itkrgm),fmakF ||rc,aw # na ifss a_tofcreas _ agVogntoes),d#s${rk grq$aodvfs_lretunw| mbyo pgor"ssasyE aryr s _ Codrnyd t=dw will_sagsa`d0 d INCunreor${rk gr atk _lre), gp c arwepneiXM spie"aryrcweics deackrgm g#.Tor r_e"sahr--gh a-/*"$uoicn etwet" S----rlirrisnsfqrpLicagiv s.use[docuqrsasyaarrmbX"ed.cs deackrvour_e"sXs defmod"hosrnfyrmWorkt"sriaermLeg suNy iESs" X ifssolet".t" ||$it oc.prepaaaqrsaste ztd bdaa mmquetl #odntfas re}/Ey=" ||$(1 hosrnfyrmy_ce_ft"sriaermoorVrpsk _by iES ksser(2) tet" tasour_e"saalrunlo s debnobwerras reacrsahc.yr s(oursss,a ifss let".t" ||$werras iSssaUDEa mod= o),fAn "Au e.verws" ec_srsasyefss Libratarorsosa crqrpedrw"sserh# Itrepiewor s Earyr recrqrpedr.i0If tcaoXs defmod"a =wenepaaay topgcatk rtemona=dspgr$as_ech_,ysupskas_a 3) u,kadxoomquet toc. ofasouy topmeeosnd ar_iker") .si01.ueTo aoede.to pgcao"ora"s"toc eorrespotyr s _ Cod=caop uRNIroeiar r ""ir Tyr tk _:akF || e _ itkrgmc) @//.i0"Ofae CrmbX""s _ Codrnydnon-ora"s" ar r ""isryr rface prSlag@ # Is defmod"s _ CodrnoXs defmod"d INCuik grrd bel anfii" flag@ #efinit" =sua ':r'>&5i $flag@ #eacodtosor __archivbelow w Xs defmodssbs t_e fssrespotatk _ gp c xooooa Eo bylroiuags keaep Glr rebwd= ly $(OBJcmoar thExl"sorsryr rcdirriAn "Auroiuags.to pgcao"SytocmToc.parie"" ""is aAac;$a Toc.yr s"ed rnythred, rk gr rpnedasouwn Appliat"sorl,fAn "A(a)aen Xs# Tocse_archivnTryrliar r "" atckaggebaseMaj" "s*"$onlopies opr vaogd by tttk Eary s "AMaj" s*"$onlopiesser(b)awe sosas }rxX iunreoratk _""iasouwn ApF # sblr Maj" "s*"$onlopieesu#_1rite_3) o a Slag@ # Is defmodsresppr vaoan rite_3) or\`d0are|rc,aw # na ifsska_tofcg agVoa"s"toc ebjecm ApA "Maj" "s*"$onlop" __archIR)/*s dxpie _ Codr_:aj" "ooolin Xx-/*"$onlop (k refl S--nd# I ytocmLessersloga)aanyssetos t_e cf"sorneacresytocm _ rny)ned qrpsk _toAac;$a Toc.yr seuns kexga)/*"$(inr $(OBJ_D Ey "Crmoasouwn A kexganT=fae CrmbX"eeurraliz tr $(OBJ_DIeuno cryo pgcao"gd Vrpsk _". ueTo "MX"emalyr s"eo=fae CrmbX"ear r _ Codrll ssetora"s"toc en et"enttorTocsexar,montt. miesser(fexganTAac;$a Toc Libr)uru AR T=fae CrmbX"esser o se _ soasouwn A k"edLr.peec_sl_D so rrolfas----$aodvfs_lr ApHowerps,:itsaenorlis_"ed oxoown A's SytocmToc.parie" kexgTocsexl-p-------tooeixar Tocsexl}rxrc,aw # nsroc xooooa Lipr vaoarr $(OBJrnse _ ili rri"G... #o bsos----$aodvfs_lres pr vaoarr by tttk Eary sc yr . prispexamplpw"gd Vrpsk _". ueTo oc.prepaXs defmod"h_ed below# Tois_essocisedoto # Vork meaTois_jec ttkuwn A ksser Genmea"s"toc ebjecashaToei)/lib iSssaeryhynamd.aply lApplicsubxooooa Li Glrunloryr sIR)os t_e cxl}rxdea befo baceac irw, supskas_b # ToimcawrirefEemonuns_License, so rrolffnt,obetweeofas--- subxooooa Li\`$as_ec'ptk sEary sc yr .yo pgcaogd Vrpsk _". ueTo a et" lis_"ed rnythredOAn "Ahe rs qy_creTocsexarsautomwi_cxl}rxsrcdie_ec'ptk sEary sc gd Vrpsk _". eTo .a=$tgcaogd Vrpsk _". ueTo aX"emalyr s"eoVoa"s"toc ebjecm "makelr s_ec yr .itur2. Bas cfPplfmonted rface mkrpsk s.gras ddatarorsosa crqrpedroarr gras ddaacrsahc.lic "" oorVrpsk _onyssetPooooa itcensaUDEi Vrvo_L,asoa mod= ofAnegetu#_# e[incorzoraaUDEmet. IR) @oc hn w exfas_itl #anfic Liyour"un Softwa pplfmonted _ gru AR Trnse _ ili P mooa r pgcaou arE srcdian upsboc /*i"ToeiLibraIR)/*i"Toeis tosa crqrpedr v }rxif tcaou arE ,r n-o 'c/*s dnk _stoftitutepaaaqri"ToeiLibr. IR) @oc hn w tcknow"edgeLiyour rpsk ssefING:Haos"agr$a_ec'ac ivallopiess"a mod= of usetrVrpsk _rnw to pYou" ec_motornru A bdaa msagsaraqri"ToeiLibrsfAn "Ayou"=--sss srsasy------outse[incorzorasloloar aLiyour"u e.verboc.Libraryontas_e agacroraryYou" ec_srsasyeqri"ToeiLibrsfAodbk gr${scrsahc.p c sp------ gcahavo bsosom gp c e _ itkrgmc)ourcos FDkar you kexga mod= eyou r # Omoinitiesnfarweunno bsos----"=fas,ya mod= ofAn "Ayou"/*"$nfig#.Tl Public Liaryr recrqrpedr`asrcdiasyaarrt"rm ker" |esppr vaoyou"=- -styso, rolfetrVrpsk . IR)---- lusumakF ||$rweunno bsosraqri"ToeiLibrs kar you"mustrdorso)ourcos FDoe.your"behalf,atarorsyour"ornfig.st cense[i rolosornoic Li Glrut mh_sut$trnm srcdimakF ||rnydoorie" an your"etrVrpsk edm ker" outLEtstttkirwepotkrgmchipto # you to prcsasyo bytarorsenyybk grrcircumssILESs. xoc noichnolog_cxl 3)ao bortarorsenyye_fas_L,asornw fulaTo".", otofgtkrgmc)tarorse------ 11Eary sc WIPOsetrVrpsk _t useyyedas_ua whs20 Dcto--qrp1996 kexi Sofl inrnwsnt mh_sut"is arwepb isctaargeircumExit.stranysups 3)ao bos to ppetoeyou"/*sasyer si"ToeiLibr fyou"waiv--s yyleg supowe"sa ikarbi# eircumExit.stranyoichnolog_cxl 3)ao bosxX ifssolet".t"supskeircumExit.st rebA>xoc of usAacrcidrcdirpsk sstarorsosa crqrpedroo # pebs ttEOo osraqri"ToeiLibritcensyou"dosclai"ps yyXs drs_oxo--- Softf"sorneaense, e _ itkrgmEaryr uwn Appliat _ Codarye' Trcred, eed.Esrunloryr 's he rs,syour"crsahcrf_ttk iepetleg surpsk ssa ikarbi#geircumExit.stran oichnolog_cxl 3)ao bos.itur4.urcsasyo byVttedotosCspie"ato pYou" ec_srsasyeittedotosorpy Earyr uP mooa '$aoa"s"toc ebaecyou uneiXMb//,a agan #medium,ya mod= ofAn "Ayou"/*nsp_ gous}rxcen a_ft"sriaerlc_"_tofshrstr|^\.[s Ey_ce_ft"sriaermoorVrpsk _by iES; keepyXs ac|$adow.iniESssstaoredOAn "Aosa crqrpedroaensany non-pplfmontv blic Licdocse_araca roto # V/ig.str7CL_fassgoaosraqrdS; keepyXs ac|$adow.iniESssaryr TLbseLES.""is yywerras r;oaensgiv--sll unipie osnr s Earyr recrqrpedr-slor dt" or s_tP mooa byo pYou" ec_s rrgrbs yyprior"crsnoyprior"d.'s|^\.[s EAn "Ayou"/*nasy- censyou" ec_anfeinsu_fppe espperras rea mte C--o respotfee.to p5.urcsasyo byMe _ iliceTo aatk _, r si0You" ec_srsasyer yr s, bua whsc: iPooooa itcrsahc. e _ itkrgmc) Ey "Crmoiti||,"pgca&Pooooa it_archivar r ""iaoa"s"toc ebtarorsoso lic LiaryV/ig.str4,ya mod= ofAn "Ayou"oeiCr _etl: $(TARGETsraqrincorzor:a=$trra)pgcaoyr s ustrcerryda mmquet by iESssstaoredOAn "Ayou" e _ ilie ir/ipiesser "is asepoevasubl de.a=$trrb)pgcaoyr s ustrcerryda mmquet by iESssstaoredOAn "Acense=$trrepoe bua tarorsosa crqrpedroaensanyaqrincorzoracdocsetarorsboc scr=$trr7. IR) @eac irw3) o e _ ilod=caoeac irw3) o "eoV/ig.str4sa e ir/"keepyXs ac|$adow.iniESs".a=$trrc)pYou" ustru e.verbfssolit.rkuwn A ksliat"sorl,ftarorsosa $trrrqrpedronsernyeaep"so"/*"epaXs oyposses is"pgcaa$"cpor pgca $trrrqrpedropndowtlird:# e_fay,aslor dt" orenyye_fas_L,asoV/ig.str7=$trraicense, sulic L,sgoaosra"sorlEaryr uwn Aitcensalopiwcaptk s,=$trrepgar$(OBLiaryh# Ittkyst :, ,ckagMd ApR) @oc hn w g alln e ir/pplfmonted _ gu e.verbfssoyr s"eornyybk grryaorface oyr s ustrt=fufshoaoslfmonacdocseFn w exfas_--- 11Eapite_3) o a Sll rehrstrsbs t_e fsnou" ustd)part"aecybk ghasour_e"sXs defmod"hosrnfyrmWsorn "Ayourcose_ft"s" ustmLeg suNy iESs" X ifssole; :, norlis_a '$aoa"s"toghasour_e"sXs delfmonac t_e fssrKhfshxXb;i}/se_ft"stmLeg suNy iESs" X ifssolehcrf_tlfmonybk gd rnyurc,aw m @rm f@ # Id. to usPd. pgca $shall_beFsslo zssosOmoll rehrntoes), Tois_entskas_ecmy tttk Eary sc007 chin(1 hokeircetornfig.so Uritcensyou"doc_anfy tttk Eary sc.Tornyybk grrlit3) u,kadxircumEmtk rior" bylroiua,yYou ivaeeacvolumrras r "Aor@oc $(Om (ated.br---od= ofAnr"se _ ili n "aggaryh _ Cig.so Uri to usPd. _aa, r sIR)/bXy iES; kee Eary s o cryo peaense.""istt. mkt" osa ikarbi#geog.so Uri to usPd.'c fssou be"epdtk Ea od"a =r "rganik gr${s c l #s dene.youd. pgca $shall_beFsoneeaeeaggaryh _ed oxocatkPLeag alln e iso"/aqrdS; keepylre), gp cseLES.""isggaryh _ #licatke _ iliceNv b_, r sFkerpc_srsasyer si"ToeiLibratarorsboc sbX"ear r _ Codrll sic Liof.ocrecrq 4,ya mod= skee_aa,5An "Ayou"oeiCr _etl: $(TALibratarorsm "Anyy-t".otr7=$. ueTo atarorsosoroic Liof.ocre $trrrrroc k grqrpnedbX"eoont,o b:rd:aygcaoyr s u: "L_mkgd eeurraliz tr $ _ ikexoeaoto t tohysoo# , f supsoyr (oc reffigutohysoo# ,m (ated.br---od= of),is ta.Worie 2007 oyr . ueTo aX"emalyr s"ixooooa aAac; ofAnehysoo# ,od= of" ustrurcomc.ar o cry)/libEtstttk kre ornfigcaoyr s u: "L_mkgd eeurraliz tr $ _ ikexoeaoto t tohysoo# , f supsoyr (oc reffigutohysoo# ,m (ated.br---od= of),is ta.Worie 2007alfmonyr #tanppe es, docseto p5.tbl$m's he oes"bu remaa,docseto p5.dropndr"u e.verboppe espppd ApR)rs youprurcomespperras r sp---$trnm supsoyr brarlorlEag supoweepaXs oygcaa$"cirw3) oeeurraliz trl anfiioorVr" ustrrco cod=sa=faueTo aX"emalyr s"eoVo e_faibEtstttk k7 oyr nm sups defmod-aosa crqrpedr v }rxif tc,ooa aAac; ofAnehysoo# oyr bd= oftrurcomc.ar o cry)/libEtstttk kre ornfig,_ gp c x\.[smonted m"puas alf,atart".sonsk _rnwemona=ehysoo# str|s----$aodvfsedropnd"rm ker" c ebtaror _ ioupgntt. mkarwou"/*na oyr . ueTo aX"emalyr s"ooa a---rlirrrxX iup5.tbnoyprior"ou" ustru : "L_m =r "rganik uP mooa '$aes#.Tor s Earyr TnditkPLesslfmonyr #tanppe esesupsk1' Try=sa=faueTo aX"emalyr rrqrpedropndalskabcdirr;"ed.W.str1aou aroccas,sgoa"sriae ar r r trcioxooooiaeropnd"he "2=oc.Lisbs t_e f '$aes#.Tor s Earyr) u,kanppe es, # V/ig.lfmonyaryr) bny soundibou" ustd)p: "L_mkgd eeurraliz trbfppe esffigutt. mk"ooa a-ceac irzorayr n #Omo(espotfee fyou"muprior")X ifssoe eseess"a mod=gntt. mkarwna oyr . ueTo aX"emalyr s ""iaoatur2. a_mkgrnufass)" tur2.n #Omo.tbnooyr furssILESrior"orsasyed rny "eoV/ind Ts_ec srorwou"/*na oyr . ueTo aX"emalyr s s_tP mooa byo eeurraliz t..part"aecn #OmopyXs acou"/*na eeurraliz tr s a---rlirrrxX iup,y=sa=faueTo aX"emalyr nted m"duoeioa aAatG: TrcumEX iup5(sornfigqrpedrboppu"muepetleg suy)nted ' Tryr\rras seess"a mod=gimited., ssasyen "Ayou"oeeinsu_ re}/EXs aco Ascense[i rora mx=wenedtoceeurraliz trsay_1) we usg=$traca i wny"i=faueTo aX"emalyr rrqRryh# Ittkyst k Ea EX iup5hwems i wny"i=faueTo aX"emalyr ,oc.Lisbu_ rc)tarorscryo p __archiv Eepoe bua taroc xooooa p5.ddr"u e.veocsexar,mospotf k"eds o "eoV/ig.stsou" uste)p: "L_mkgd eeurraliz tr defmopeeroencpeericagiv "2=gp c geofsan X ustc.Liare $tsEary sceirriAe usg=bX"esser o se _ soa. eTo .a=$t ustalyr sppliat _ Codarec:eci}/oe esxar,moiat c,aw #Voa"s"to.tbnooyr prior"ccr=$trr bny soundidf@ # Ill reofAne soussooa '$aes#.Tor s cmy kF |btarorsoso li FDkar an Xoooa it_a. ueTo aX"emalyr s s a-arie" kexgTocoood rnybXs defmoddarrt"rm ker" '$aes#.Tor s ESlag@ # IssuRpaoa"supssiA "l anfiioorVrryr skamenm sups"cmy tttkon-ora"s" te[doofAneirrnted bTor mtyy tttk Eary " atr o cry)/lieirrnted,_ amar ,)ssehoo cuwndahavo bss _ ioupgn"Ahe rs ceac irw,/libEldduoeixXyMtker" ofnooooadr"scs d denrddoc l #_1) we anfiianm sups i ztd bdskamenm sups, doubtful defmsstdef_ttk eTolvddarrtfavfigc tosa cagpptk r#'c xooooa Eo 0If supsisbs t_e f5i $xooooa Eo bfsso, "y " atr o crernydoorVrpsk typoo# ,ogr$as_c scn ApF #e3. y. Definnm sups,iaryh# Ittkyst e[incorzuL=ftun etxooooa Eo bfssonfigc tiat _ners Aac;$a Toc.xooooa Eo bfsso set" r o cs _ iexpv s.aorli FDkpcrcidrrpsgd p oeiar supsoc.menm supsoi ztd bdskamenm supsiaryh# Ittkyst we anfiioeiar supsghasodiresybk gr r r trciox, du(ate# ,ogrtv b bdskameo cs _unIttky) u,kARim_tasotopgceiLib"he "ac i Eyd=caoeeona=dspgc tiat r supsomooa m I' Tryr\`d0 mustratk is"eo=fasuRpaoa"supsnon-ora"s" m anods, s"handurcs,uratkar you"orgkeys _ iEary sare $trectorra mod= esup libraryor me _ ili c.Libeaanyssetornfig.ibratarorsboc sbX" #e3.suRpaoa"supsnors--- c.Librar"sboc Applic faueTo aX"emalyr rrqrpesare $trectorourc sug@ eyo p __archiv Eezorastatinucry)detrorner" c etkrgmc) rw,/tarorsoic Le_arcbnoypefmotrnfigtrw,/liac t_earorsbaTois_osraqbecatkPgmEaryr uwn AhasobubxoCrmb" e _ soag/>i"ToeiLinaes#.Tor s ESlacrqrpedroaenny sound $ _ ibaToinrnwsxdea befo baforEarys t tsuRpaoa"supsea"s"toc e"rm ker" coug.sa.drA>xoc icagiva sound $Aac;$a Toc.etPoooofpgcaa$"cpor ornfig.s o i wnsuRpaoa"supsnc yragiv s.sxar,moiat d Ts_ec o bsos-petusorne fyou"m "ixoooVrpsk(aryh# Ittkyst :, ,ckaicagiva sound sprioa sesfzou" ec_s"ed.Work mea"s"toc Corrorsosoroic Liof.aenny soundourcobeis ta.Worie X" orfacm I' Tryr\`d0 mustratk ias",uedroaen "eoV/ig.strd oxo/aqrd|| anl anfiiag/>nc toc.Lepetleg suyn "t)" .t.""is f"sornsup librarymc) rw,/taror_ct))) ""iaoasuRpaoa"supsn;$a T Vrpsk _""aecybk ghas bubxo librarddarrtROM) Vrpsk _" "eoV/ig.strsupsk1' Trym I' Tryr\`d0 mustratk i d oxoown A's a "eoV/ig.strsupstatinucesupsk1' Tryr\rras rEX i) tetmte C--o _ iupd, few"eoVoa"s"toiv EehasobubxoCc) rw,/ro librardda" orfacd Ts_ec ,ne fyou iaoasuRpaoa"supsn $Aac;$a iEehasobubxoCc) rw,/ro librarddoc.mtt. mkarwa --rlirrrm"duoeiderie 2oinityo gmEaryr xclu elfutLEtsttt"sriaerldeeryoyour"uv s.aiLib" e _ itk etkrg--rlirrr/roviy=$(Srw3) o i '[ iaerrespocexl}fogr$as_, so rrolfsanfusetkrg--rlirro bytar.Work mea"s"toc Corrorsosorea"s"tm I' Tryr\`d0 mustratk i geofsan edbX" V/ig.str7CLf.aenny soundourcobeiir/k{d uias defmod-aoa"s"trd| of roie 2bjec fas_L,a `d0are|rc,aw # ifsska_tofcg agVoa"s"toc bjecm "makelr s_)X ifssourco "eoV/innoyirr# Glrtrnfwig.sogrkeyfyou unR) runlor$mst# runlimited.o byt7lis_ed belowrTeerpc_srs"Aplfmonted boxoe iosa "$(Vogn mh_sut$trl Public Lof.ocre $trrrrroc E^\.[u ea" ooorie" e--fig.stmk"ooa o a_codm"pualic cdocsetaro. Aplfmonted boxoe iosa yr sornsaorF ||$"cporfac A ksliatoa"s"tog,a llrbes_ua w.i0"ocmanufass)"yy krgm ghivnTryrliarv }rxif tc,o.t"supskeircu debnobwegMd Apdocset_L,asoetrVrpsk _r" ec _ sopplfmonted boxoe iosa rutl_xreoratk _ yr . prisprchivar rrysttureibm"duoeio cryll rehrst ic Liof.kF |boxoe iosa s ustrac A ksliatoa"s"togc ornfigtosa crqrpe roo # pebs ttEOozoraaryh# o.t"supspplfmonted boxoe iosa ou"/*sasyer si"ToeiLibr ditkPLibr fyou"waiv--s yylm"dua s.s#.Tpskas_ acu ofe,asoVplfmonted boxoe iosa oooa ite3. Ofa,ne fyooa asnoyyr . #s d(Aplfmonted boxoe iosa m"duoeiyr #tanp supskas_b7 chiow_ acu oSoftn--qrli todefmssw_srsasyern A k"edL.) .i)/lib #Om pplfmonted boxoe iosa crnutLEtsttt,rsboc spedrbopeiLibrary" refers, ou"=- -styso, o a Sssetora" supooorVrpsk _by iES; keeboxoe iosa"ToeiLittEOoodtosie" an yd.appw=fX" orfd,rrrroc k grqrpnecaour"LEtstttkb//, "ncliLibrary" refers,s yylm"du qrpatkar ydda" orfacy iES; keeuwndeous t tk _""iEtsttt)rl Public Lof.ocre $trrrrroc # pebs ttEOo re $tcaoyr s uDyXs drs_1) wte C--o t" ormb isct afrf"sornatG: Trcuc'ptk si wny"i=ig.str4,ya mod= s 15 ifss16rrrrroc # pebs ;tarorsoss uRrVrpsk _psotoprv _ itk eespotatk _t".sonsk _rosa ikr TLbseLtlfmonpatkars_sssneoud= s bX" #e3.tLEtstttkirs ""iaoamLeg suNy iESs" XlfmonNar $trAae_ft"sdda" o gr${sofasour /*"$u;tarorsosc7s"towepb isctoe tasotopgc _ itk etkrgar ginApF #e3.tLEtsttt,rLtlfmontrVrpsk _pli toc.Libeaco : licdk _"cirrtLEtstttks s roird,/EXs act".sonsk _rw"sriasAatG: Trcumoooa it_aar ginagcaaoxooo;tarorsosd) # mb isctit_aurgcaouroa"s"tLi etavo bssdk _namssdk _oyr s ous tlfmonpatkarkyst e[intLEtsttt;tarorsose)996 lur /*"lEag C--orsosa crqrpedrrrmb roi".", oorEarysc ebtg/> Earrrmb_namss,drrrmb roim rgumX i) ts rois;tarorsosf uRrVrpsk _p), Tmnryr uwn Apployr s ous'ea mte C--ApF #e3nted m"Etstttksy"/*"epaXs oypoToeis e[intLEtsttt (basesriveaco : licdk er "i)ttEOo caondiet" t" ttmpousstof a afrf"sorn,moiat d Ts_ec ecaoulfmonpnya afrf"sorn,ebnobweor:a=$ndiet" t" ttmpousstosbocog@ `d0otcaounted ' otcaoyr s ous'ea mte C--sk s.grasd.appwtv blic Licdocslic L,sgoaosra"sMd ApmbX"ed.Work"furssIL geircumExsa "$tEOoorsbs t_exiturr4,ya mod= o10..part"aecoa"s"togiXME:itsaenorlis_se CrmbXytureibraryr,sofasours a--r T.W"Acense=$trrepoe butosa crqrpedrwork grqrpnrenyye_fas_L,oVrpskdefmod-aa furssIL geircumExsa,s yylm"duacu ofePRbnobe" "s* sopkm lopies of roisofasours a furssIL geircumExsa ustr c l #saso documontorgd Vrpsk _"oc hn w.i0E^\.[u e-s yylm"dua"ncliLibrary" refersntLEtsttt tosa crqrpedrwocrecrq 4,yrws" ec_srsas of rois_ "Ayou"oeiCr _rwocfurssIL geircumExsa d gca $t i)v w exfaso documontorgd Vrpsk _" e _ soag/>a"ncl mh_suiLibrary" refersnbX" V/ig.str7CLf.aenny soun-s yy ns: $t #Om r ""iaoade.a=$trrs_jec ttkuwn, r "AsccetsILES.i wnlic L,sgoaosra"sMgoas_ec' t=ds' otcatkuwn, eoVoa-r T.W =r ccense we usg=$traca i wsaorF ||$"cpoeerpc_srsAic L,sgoaosra"sorlic Licdocsopwtv blic Licdoc, m"duoeik S_t k7 or rface pll rehrstryr #tanplxif tc,oorik S_tas e--fig.stm; .""is ofe "eoV/ig.sts_ec' tl anfiiw"sc_srs8.rTeerinf CEO oc.p .i)/liby sc i"ToeiLibcryo prispibrary" refersnss let"as e-sotosst "Ayou"oerqrpedroaensanyaqrmustrdua tensy, bua whsc:supsk1ToeiLibcr o prisptnod-a;i" X ifss# e}rxsrcdie_ec'teerinf es.s#.Torwo.strincorzoork grqrpnr(oc reffigur/blu e)rk _:sstrororsosa crqrpedroeLepetlrA>xaorsphr4,ya mod= o11) VrpsH, norlis_a r sisosabspgcaiol _ itk etkv }rxif tc,o._srsasyr ornfig.sooa a-xooooa Eo by iES; keeuwndeo aen " librie 2bj) =fX" orfdoxoooounIttkyic Li tilorfacy iES; keeuwndeo#anfic Liyournd fsyoxooteerinf everboc.Librarye sosas }ruthorizigw wilforfacy iES; ke uwndeo#ectk_suiL-r fedrboppforfacaiol _ itopsedmect".sonsk _ron-orTois3) o a60 d"sriaftpedroeLe3. P CEO oc.pM"puoorlisrboc.Libraryosooa a-xooooa Eo by iES; keeuwndeo ae " librie 2uthorizigw ilforfacy iES; keeuwndeo -r fiesdrboppforfa aiol _ itopsedmect".sonsk _ron-or,etkv }iityo(rkir's hx'SurME:.dVrpsaenorlis-r T.Wpfoaiol _ itk etkv }rxif tcc;$a Toc o gr$) oooa ite3 y iES; keeuwndeoosclai"ps cuusg=bX"aiol _ itois3) o a30 d"sriaftpe ,atart"enop . prisp-r T. Vrpskeerinf CEO. p.s#.Torwo.strincoLf.aenny soundd oxoteerinf esrfa _:sstrorofpgp c arws oyo a Ssaenorlis uP moo.Torwo.stoooa _oxo4incorzoork grqrpn. _ soag/.Torwo.sto a Sbubxoteerinf ed sboc Apputhorizigw " librie appary s_ Appq" A k"eopie"aryrc H _:sstrornfigs)" tur2d by t Sofcrr6 any so 10.Vrps9..mtt. yytoc.NaruRrVrpscry)/liHgp c You" ec_srsasye Eary scra mod= esupAppliretkv }rxif tccYou idesesupie"aryrccr sagsatrrco cod=sa=caou arE Anc# at by iINCunreorpgca $shall_beFsocoug.sk _ps_osraqa ztd bdsa mywerras defmopeeroencpeericagiv "2=gp supie"aryrcatrrco INCwhsc:d oxopskas_b7""is yytoc:itsaenorli gcae rs asoumakF ||$"g alln e irrsossdrbop_ gu e.verbfsssk1ToeiLibcr o prispzoracd IR) @oc hn w elres = s bXtarorscy iES; keerappary s gca Appliretkv }rxif tc ,awe h_ACEdea" oosrivaermyou r INCunreiLibraIR)/*i"Toe,tc.Liarr ccees.s#.T""is yytoc.Libeag alln e iso" @rm f@ #10..Arxsrcdie alln eturr4,yDowlibgcaouRr Ts_ec soc.Libribrhx'SurME:i"ToeiLibr fyou"waiv--siat d Ts_ec o}rxsrcdie_ec'psaenorlsopkm lopiesoooa it_aar ginagcoyr s ou,Trnse _,yo prispiaerresToeiLib iSssaiv--ssutaror_=ds' v }rxif tc ,aasye Eary scra_lre), let" aneed.EsrunTl Pubiytoc.b.Lepetleg su arwsr7CLf.aenn Vrpsk "def_ kslorn,agiva sounsiA "Crcagiva soundragiv s.srunTl psk . $"cpora byo pgor"s,oorikiresybk grrd,;$aeossecseLESepa,oorikirr "rgffigurra byo pgor"s,oorimergermyobyo pgor"se _ soy iINCunreorpgca $shall ua stresIRmk"ooa an kslorn,agiva sounorn "Ayg suynorface3 cagiva sounds oysaenorlsopkrrco cod=sa=_ Coda$(TAsaenorlsok Earyst _:sstrorlEaryr s"toivc.xoooetu#_allegget"r Glruc t_eirto dtorgd o >x" suprqrpedroeLc.LiberyoA>xaorsphorllu: $r yedas_"pgcaa$"cpor pgcc_s"ed.Work mea"s"toc Corcod=sa=_ Codoooa it_a_allegget"r Glruc t_eirwilf it_a_allegget"r hasout) t_r#you rasutEOo os.sonsk _rtrAGS)s oc.p .i)/liby sc`d0otcazorafurssIL geircumExsas) ""iaoarpsk ss.s o i wn ddatarorsosa ca To"un S"oerqrpedroaensanyaqrmusw"gd Vrpsk _" yylm"d y sc`d0otcazkm lopiesotrabroyal-o _ iossILESrior"s EAnpsk ss.s on ddatarorsosa crqrpedrw"sserh# Itrepiewy.i)/liby sc`s_esiLibssaCunreo (oc reffigutanfus-s drs_orgd okre o drs_ir/k{ut"iu"i)trardgnse=$trr ur/blu e)rko drs_is bXtarorsda" ooorie", defm-ss"scs ,ppe esffigs \`$alu" e _ me sousctit_aotyr sornsar/bl soussooa snou" u11. Pus $xp noeiLibr"nssneouor" i ztd biES; keeuwndeo s oypatkar yd si"oc hn w.i0E^\.[u e cod=sa=caou arornsa=onysstoAac;$a Toc.Pe usedefo iPoo ,awe s"toivusarorsosa r"se _ ilizorastatsneouortu#br"nssneouorry so lrf@ # Id.atsneouortu#b*"$onlop (lu e)rko drs "$(Vog;$aelu e)rko drs owledffnt,obetwerdda" orfacd.atsneouor, we anfiiaenedoo"ac mod= e \`e h_aftpedac mod= ,b iSssaiu"dobeiirtarorsda" oedmec_e fss,p c l #tar pedr v }rxif tc,oofooorie", defm-srgumXtkrgmc cdossneouorry so l, ustr s_ Appown A's o drs b iSssaiu"dobeiirtarorsdaeoratadxoo bdsa mywerras furssIL mEaryr uwn Appliat cdossneouorry so lmusw"g tavo bssdk _r v } Tois_esso,#br"nssol"aqrsaste zToc.etPooolEag C--olu e)rikir _:sstrorir/k{_e fssembX"es e)rimooa byo "eoV/ig.sts_ t tkaenn Vrpsk "E "Ayouossneouorrrrsossdrbopawtv bDoe.your"c yorldJcmoabroyal-o- Lipr u e)rk _:sstrprqrpedroeLd.atsneouortu#*"$onlop (lu e)rko drs ,Trn bdaa mgd p mXtk,ppe esy)/libalu" me soptk sEary e aga _,yo prispiaerresToeiLib ieLd.at.sts_ tc cdossneouorry so l" e _ ""iaoa"sroic Li:-# oesa>xaorsphn, r " u e)rk _:sstr" i ztny e-sotos aorecetsILEgr$as_it rois_:, norliderorinf ed, oxotoneed.Ese a-xoircu () u,kadxon e-sotosp_ gu e.verbfsssk_c--- la-xoircuLEgr$avenastaoresers ugcaourooircuLo tarorse_fa)itdbge"rrsos"ooa itetcu e)rk _:sstrparwa g suynernythredn "Ad u,kanpaorecetsILEgr$as_it roi oxotoneed.Ese ar u e)rkryr 's he rg suy" e _ soag/>i"ToeiLibr fyou"waiv--syourrorstrsblaermyntetcu e)rk _:sstroc_anfit_a. ueTo aX"emalyr scod=sa=_ Cod, b;i}/ioc xooooa p5.*"epa imited.pe oesc torior"crsroic Liof.ocrecrqrpedr.itureb)aGt,b irnufasa oa"s"trd/ioc xooooa--rlirrrxX iup5 iossILEr$mstrd/itt. mik _ron-or, t_srsasyers: $l anfiioorVcatkPLea_a. ueTo aX"emalyr stmbX"edto6;c xoooo _ ioupgne C-g iso" eor pes.s#. elfucod=sa=benToiILES.i wncu e)rk _:sstrpis"ornfigxooooa Eo bT=fae Crm(3pgne C-g ,rir/k{_e fss mbX"es e)rimooa byo "eoV/ig.sts_ tiarv }rxif tc,o.t""a modnteStrus $x llln e iso" @wlibgcaoud Ts_ec smbX"KourrorstrsblaermXs defmorME:.dVrpiet" tyour rpsk ut pplustrnfigs)" cu e)rk _:sstropfAn ",rm ker" '$ rary" refersnbX" gd okrro _ i,atart"eTs_ec 'c fssfig.so Uritcensyou"d bX" gd okrro _aiu"dobXtarorsco a_codm"puai_entryreofAneu e)r $bX" #e3 d okrro iCr _etl:o a Ssa.sonstmbX"lieveMd Apdocse" e _ s,etavsuastrsup"r Glr,rner r_e"sahr--gb #--gcagiva sound"g ne C-g rois_ censyou" eyou r INCunc.b.Ls"hausrunTl pu" ytoc.Li,LibraIR)/*i"Toe,tasepo C--oetcu e)rk _:sstrparwedmecftun etxooooespsaenor"ToeiLibrs kar you"mypatkar y c e _ rpsgd p r INCunc,yo pris orgd Vrps--gbrneacresrrco cod=sa=r fyou"waiv--siatngs)" cu e)rk _:sstroit:do C--oise}rxsrcdie_ec'"a mod= esupAras Ts_ec srcod=sa=r fyou" s"toifssgr${s iPooooa snou" uAtcu e)rk _:sstrpise"yyXsririnf ory Cig._"ed oxoown A's tEOoortoc enrrcualic cda cagp,s arwepb s"iaoarpsk ss.s o" e _ saaUDEmet. ooooa itcrtv bDosk ss.s o o a_codm"pualicToc.etPoo yr sornwsxdea befo baorsosa crqrpedrw"sserh# It..p .i)/liby sci"ToeiLibr fyou" s"tor=--|^\.re a-xoooy"so"/* ne C-g roi_fas_L,oVpetleg suyndefmod- ""iaoab defttkyst m (ated.br _ps_r(2) anfrqrped- -styso, n "Adpaymrcu dodroeLepetleg suyn iPooooa itcrkeircum. p.s#.Ts pr ygc tosrrrrgd V=sa=_ Cosoic Li Glruac;$a Toc.epetleg suynrrsoss,Vrpsk TES.i wncu c arws oyaiu"doie"aryrciLibrs kar you"myoooa _ox,fsh"issririnf oryncu e)rk _:sstrpTocselr,rner r_e"sahr- uP mooa '$aritcensyou"d rorsosoropedrbop(unlimiisyefsdesoooa itcsies iisy)e Crm( }rurirc.ar w"eoVondselr,rner r_e"sahr-brneacresNFIGd "dEgr$asto usPd.s" #e3 d asourd=sa=r fyou"waiv--sunIttkyrbopec t_eds is"pyr sor C-g rois sp---$trnu e)rk _:sstrpwaarorsosa ,tois3) o a28 Mar$a 7 "ToeiLithiuroiuagsg alln e i "y " atrpetlegrw"sserh#ceg suy,tois3) o a28 "d bX" gsearAamaryontas_sILEr$mss_eorlEaryr rorse_fas_L,a.tLEtstgd e aga _, ta.ka_tofcg agV4incorzooF ||$"cpoeer)rk _:ssoeiLibr12.rashSsk s Appl'$aOe as'rightdom_ soag/>met. IR) @oc htcazkmd,ataror (nfiiaenew to ua mtesclai"etsILEgr$asd e aga _) . Ofa,net" dicrastatinu. IR) @kv }rxif tc,o._srsasy-----outg sig.sror it_a_allinu. IR) @kv }rxif tc,o._.oag/>i"ToeDIe zreiLibr fy" refersnbX" soircumEmf k"edssimultaorsw wilTpskasrse------ 11Eary E^\.[u e cod=zoracdoc sceirrictitEgr$arse------ tngs)" d bdsa mywerras m"d y sc`d0oeiLibr rgo a=$tr"gd Vrpsk _" yyl|^\.re aetsIryr Mgoas_ec'orscryo sse, d.pea" .a=$al-o- Ligs)" sILESriorker" '$ itcsies ii d.aiumnsyou" eyo rchivar rrysttue "ac i"pgo.sh >x" smf k"eds authies ii rzoraf HaE^\.[u e cod=dobeiirtae"aryfr=sa=iatoa"tk si wn ker" '$aes#." ec_s rrgrb13..shaT byo "eosk _Ay)/lo_t3tof roc hn Vrpsk ")oeiEOoodtosie" an yd.appw=fX" orfd,rrrroc k grqrpnecaour.dVrpiet" e.verbfssoyr snk$asto ubk gacd IR) @oc hn w_L,oVpetarorsosa oc Liof.kFse" refers tosqrpsk _Ay)/lo_t3tof roc hn Vrpsk ooadr"--gcag nyybk grrla"s"toc ebbratarorsm "sIR)/bX"ed.ar"spesare trrrrroc E^\.[u ea" ooe}rxsinucesupsk1'dS; keepylre)braryk Eary " r fyou"waiv--sunI ac A ksl GlrtrnfV/ig.sts_ tiarv }rrpsk _Ay)/lo_t3tof roc hn Vrpsk , o 10.Vr3asourtoc.iuagsgr r_e"sahrufasa oa"lirrrxX ie}rxsrS; keepylre nyybk # ifssu,kARirrgrb14, rpgca llowed.u ueTois Vrpsk "E "Aare ight (C) " ec_"_tofshrrer #licd.Work ) .toc.Libs gca llowed.u utkaennrpsk roc hn wLen Xs dropirly_p;x'Supsk) toc.Liibsawis"flowed.u ute}rx sirits: $trnfiy=wenedtoc.LibbXace ec _ feinstsdetG Tnserddooooo) .ll fass Haqrscer r si0E^\.[toc.Libribr n-----s-t=fufsh"is xitsi-V, --qr.<\_ACEO oc.part""aecyou""tog,a ll cerME:.d, --qrli toc.Libegca llowed.u uarv }rrpsk _oc hn w "isponyynfigc toc.Lib" e_fasPM) @//, you"h_ACEOF |"ts_oxogcafoon ,o bsosoroic Li:-# e[incorzoraeiklinu. IR) @t_tofshli toc.Lbegca ll wed.u uartoc.Lib t_tofshli uset" ne 2007 Crpyright (C) .si CEO oc.part""aecoa"s"togiXMEyxxexitsi-V, --qrpLicense" refers tosqrpsk roc hn wLtk _:sstrgcaou--s yy "t is"pgca llowed.u ue uset" ne 2007 Crpyright (C) .si0If CEO oc.part"aecyou""tog,a ll cerME:.d, --qrlp utck grrfus)" yk Eary gca l vernfig.so USEtssk roc hn wLen Xs dropirly_ grr cryll a_tofcgetu#_3) o ""isccetsILES.""is yytoc.Librib thli uset"izigw ilforar yd si"sse, d.pLibrjeca_co t X" orf." ec_s rrgrbLtofsharyontasvernfig.s "t g.s#. el L,sgoaosra"or: Trcumooo e iosa ou"/* norlis_a rno L,sgoaosra"orse------ 1oc htcazkmd,atate[dars_sssoiES; keeuwndeo ae d bdsIR)/bX.s#.Ts pLibrlEag C-ic Li: fy_tofshli userrgrb15.s drs_1) ers toW--o t" "E "AaHERE IS NO WARRANTY FORAaHE PROGRAM, TOAaHE EXTENT PERMITTED BY APPLICABLE LAWwLenXCEPT WHEN OaHERWISE STATED IN WRITINGAaHE RIGHT HOLDERS_al./ORAOaHER PARTIES PROVIDEAaHE PROGRAM "AS IS" WITHOUT WARRANTY OF_alY KIND, EIaHER EXPRESSED ORAIMPLIED, INCLUDING, BUT NOT LIMITED TO, aHE IMPLIED WARRANTIES OF_MERCHANTABILITY al.pFITNESS FORAA PARTICULAR PURPOSE. AaHE ENTIRE RISK AS TOAaHE QUALITY al.pPERFORMANCE OF_aHE PROGRAM IS WITH YOULiibHOULDAaHE PROGRAM PROVE DEFECTIVE, YOU ASSUMEAaHE ST OF ALL NECESSARY SERVICING, REPAIR ORACORRECTIONrrgrb16.b isct Appliat L"sorn,ebpart"aN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW ORAAGREED TO IN WRITING WILL alY RIGHT HOLDER, ORAAlY OaHER PARTY WHO MODIFIES al./ORACONVEYS aHE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FORADAMAGES, INCLUDINGAAlY hn w, SPECI w, INCIDENTAL ORACONSEQUENTIAL DAMAGES ARISINGAOUT OF_aHE USE ORAINABILITY TO USE aHE PROGRAM (INCLUDINGABUT NOT LIMITED TO LOSS OF DATA ORADATA BEINGARENDERED INACCURATE ORALOSSES SUSTAINED BY YOU ORAaHIRD PARTIES ORAA FAILURE OF_aHE PROGRAM TO OPERATE WITH AlY OaHER PROGRAMS), EVEN IF SUCH HOLDER ORAOaHER PARTY HAS BEEN ADVISED OF_aHE POSSIBILITY OF SUCH DAMAGESrrgrb17.pr vaoeuno Appliat S= s 15 ifss16rrrrpart"aecyou"ddrs_1) ers toC--o t" o16rrlisct Appliat f"sorn,ebnsan X ustfe "eo_DIe zrorsufsh"iloogr$ikr Trcidrcig.str7lEag C-tiow_ sorlic ) .ewl pu" uess"" atrprS; keloogr$iawa.tLEtsna=eclour"uv suNyxuns_Ls e C-bsolc.Liupowetoc.Lirxsiivil f"sorn,ebnrner r_e"sahr-brneyou""tog,a Ittkyic Li C--o t" ormbmpousstosbiat f"sorn,ebn.Worie X" bdsa od=sa=caou arE A s_lreca p5.urcsasyo byMeeeeeeeeeeeeeeeeeeeeEND OF_aIONS_al.pers_ed belowr H EaryAS; keres TsuiLibraYs Nqrs arE As soag/>i"Torcdirria"lirwgr geneossy.i)/libou"qy_cX"edto6sa=caoug.i0"oso eo _ron-ousg agVoa"s"toc ,=benToistmkgrnuplirhMd Ap}iityo(rk"Ad u,it ssers rrgrbjeck Earymake codmautomwor se _ so cryfig.s Apiof.ocrec ii rzorE aryr f@ ,ensyaoc.epetic Li:-# eLbseLtlftoc.LibbXrE Anc#Ie}rxssafoso uplisyaoc.epemftoc.Libcetaryr,syg suc ttkuwn, rwn A kst"sriet t Ap cetsIrkeircuud. pgca $iv--sll unipiyg sun, rw,opsedeogcaf$m's he ennrp"S; keeuwn" snd=zorac posgr ri d.ai=bX"essefutrrc)pYoudiresf CE byMeee=faueT keeuwnd(C) eebyMeeeT gX" orefo iPossers rrgrbje: $(thred mwor se _ so it.Libs gcis orgd"i)ttELiof.ocrecrqrpedr.iturtssk roc hn wLen Xs dropirly_ast" ne 2007 ' otcayright (C) .si0If CEO oc.,@t_tofshse" refers tosqrp tc,oofoooonpnya(s#.Tpskas_ acu)Lib t_tofshli use.byMeeeT gX" orefo iPoor se _ soiar r "" hlic epoe bute}rxs cryllfutLiaryhstsdWITHOUT AlY WARRANTY;ozoraaryhtrw,r "" gsearAamC--o t" or "i)tMERCHANTABILITY gcFITNESS FORAA PARTICULAR PURPOSE. ASeafoon "i)tsk roc hn wLen Xs dropirly_p"pualicTooo) uste)p:/lib,opsedeogcaforlis uPco cod=sa=_ Cosk roc hn wLen Xs dropirlydalskabmooa byo eegX" orefo t""aecc)ptk,pe ustAsaenl mh$trectorourcasob Earyourd=s#.Torrpsk " .arontbnoi"ToapEary) part"aecyou"ptogiXMEyxxexinf ed lgsgr r_e"sah,Ad u,it upsboc ab,oprt c)pYoudL_faseegX"sasye u,ktyoupreeagga"sXs defmod"ona=r s uDueT keeuwnd(C) eebMeeeT gX" orefo es is" byo ABSOLUTELY NO WARRANTY;_p"puooo) tyic `(tic w'.bMeeeT gX"iPossers rrgrbjessy.i)/libbjeckeles iae"aryor se _ so itbMeeeiof.oci todefmsnu. IR) ; tyic `(tic c'_p"puooo) parare hyppw=fec'" ech_,ysup`(tic w'sy.i)`(tic c'_,opsede(tic LisrVrpsk _by icseLES.""isggat3tof roc hn Vrpsk " Ofu" uefAn ",rmbXrE A'ssech_,ysu meuwnderieTrcumooo;5.urcsaGUIt_e fssrKhyleg supsedeugca l "fe oc box"p .i)/lib,opsedeAsaenasut",rmeseaoyorVc|^\.re darye' Trciuags keer)mXtkrpLibtLisk _tosk T Er ska keeuwndddrs_1) er"gs)" cu e)ar r ""ia anfP mte C-iF"puai_enttrectorourcaso:kurwsor s EaryrS; keor ic Li: _ Cosk roora ,pe ust"Aare sk roc hn wLen Xs dropirly_yxxexits #tar Mtker" ofooa",rmbXrE Aoooadrpcpr ExitdbmbXrE Assoag/.Torwo orefo iPoa _:sro_ps_ehynamd.yy ns: $"ToeiLWork"e u,ai_enyllfutsk_c-#tar Msnksotoprpr Exitdbm ||$"cpt.u ute}yr recrynamd.yt""aecoagX"iPowetl:o a wsup"r Ga.loea_a. uesk rLnlopr_oc hn w "isponyynfigc t he ead@kv }rxif tc,o._.oaroaes hx'u: $bspgctrd/ usynappm-1.2.1/m4/0000755000175200017530000000000011616003520013471 5uktyo tkeardontkeardonynappm-1.2.1/m4/ppm_check_mpi.m40000644000175200017530000001217611616003520016540 0uktyo tkeardontkeardon# SYNOPSIS # #eeePPM_CHECK_MPI(mpiare|rc,aw # if) # #eee. uevaluy_ grr crt,o b: #eeelicnmpi #eeel kepi #eeeepich #eeeepich2 #eee_e flepi_gnu #eee_e flepi__e fl #eeesun #eee_bm #eDESCRIPd be # # #eLICENSE # AC_DEFUN([PPM_CHECK_MPI], [isk "oso "x$1" = xy:, ngs)"bMeeeAC_MSG_NOTICE([*** Check5.*"epa MPIEaryouEy "Co16rrlinw_L,oVp***]) ellydalskAC_MSG_NOTICE([*** F hx'Scheckia aI_ grrea_a$1EaryouEy "Co16rrlinw_L,oVp***]) fi #echeck5.*"et,o b:rd:tic Li:-# eMPIEted.br---od=s #eOicnMPI #eLAMMPI #eMPICH #eMPICH2 #e_e fl MPI #eSun Cd. fsT}rxrc(tmcc,tmCC,tmf77,tmf90) # IBM AIX POE (mpcc_r,mpCC_r,mpxlf_r) # MES.i wncusoeare|rc,aw # ifsSll r a_mkr ||r f,drrisk "oso "x$1" = xlicnmpi ngs)"bMeeeAC_CHECK_PROG(MPICC,[epicc],[epicc],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wsepicc5.*"eOicnMPI])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[epic++],[epic++],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wsepic++5.*"eOicnMPI])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[epif90],[epif90],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wsepif905.*"eOicnMPI])],[FC="$MPIFC"]d elsk "oso "x$1" = xl kepi ngs)"bMeeeAC_CHECK_PROG(MPICC,[epicc],[epicc],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wsepicc5.*"eLAM/MPI])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[epiCC],[epiCC],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wsepiCC5.*"eLAM/MPI])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[epif90],[epif90],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wsepif905.*"eLAM/MPI])],[FC="$MPIFC"]d elsk "oso "x$1" = xepich ngs)"bMeeeAC_CHECK_PROG(MPICC,[epicc],[epicc],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wsepicc5.*"eMPICH])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[epiCC],[epiCC],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wsepiCC5.*"eMPICH])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[epif90],[epif90],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wsepif905.*"eMPICH])],[FC="$MPIFC"]d elsk "oso "x$1" = xepich2 ngs)"bMeeeAC_CHECK_PROG(MPICC,[epicc],[epicc],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wsepicc5.*"eMPICH 2])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[epicxx],[epicxx],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wsepicxx5.*"eMPICH 2])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[epif90],[epif90],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wsepif905.*"eMPICH 2])],[FC="$MPIFC"]d elsk "oso "x$1" = x_e flepi_gnu ngs)"bMeeeAC_CHECK_PROG(MPICC,[epigcc],[epigcc],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wsepigcc5.*"eIe fl MPI +esk rC Ey "Crs])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[epig++],[epig++],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wsepig++5.*"eIe fl MPI +esk rC Ey "Crs])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[epigs ocran],[epigs ocran],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wsepigs ocran5.*"eIe fl MPI +esk rC Ey "Crs])],[FC="$MPIFC"]d elsk "oso "x$1" = x_e flepi__e fl ngs)"bMeeeAC_CHECK_PROG(MPICC,[epiicc],[epiicc],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wsepigcc5.*"eIe fl MPI +eIe fl C Ey "Crs])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[epiicpc],[epicpc],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wsepicpc5.*"eIe fl MPI +eIe fl C Ey "Crs])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[epiis oc],[epiis oc],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wsepiis oc5.*"eIe fl MPI +eIe fl C Ey "Crs])],[FC="$MPIFC"]d elsk "oso "x$1" = xsun ngs)"bMeeeAC_CHECK_PROG(MPICC,[tmcc],[tmcc],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wstmcc5.*"eSun MPI])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[tmCC],[tmCC],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wstmCC5.*"eSun MPI])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[tmf90],[tmf90],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wstmf905.*"eSun MPI])],[FC="$MPIFC"]d elsk "oso "x$1" = x_bm ngs)"bMeeeAC_CHECK_PROG(MPICC,[epcc_r],[epcc_r],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_ERROR([Cpsedeits i wsepcc_r5.*"eIBM AIX MPI])],[CC="$MPICC"]d ' TrAC_CHECK_PROG(MPICXX,[epCC_r],[epCC_r],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_ERROR([Cpsedeits i wsepCC_r5.*"eIBM AIX MPI])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROG(MPIFC,[epxf90_r],[epxf90_r],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_ERROR([Cpsedeits i wsepxf90_5.*"eIBM AIX MPI])],[FC="$MPIFC"]d elsk "oso "x$1" = xguess ngs)"bMeeeAC_CHECK_PROGS(MPICC,[epiccsepigcc5epiiccstmcc5epcc_r],[no]d ' TrAS_VAR_IF(MPICC,[no],[AC_MSG_WARN([Cpsedeits i wsm anopimkr ||r .urcsaCyouEy "Cr])],[CC="$MPICC"]d ' TrAC_CHECK_PROGS(MPICXX,[epic++sepiCC5epicxx5epig++5epiicpcstmCC5epCC_r],[no]d ' TrAS_VAR_IF(MPICXX,[no],[AC_MSG_WARN([Cpsedeits i wsm anopimkr ||r .urcsaC++5ouEy "Cr])],[CXX="$MPICXX"]d ' TrAC_CHECK_PROGS(MPIFC,[epif90sepifcsepigs ocran5epiis oc5tmf905epxf90_r],[no]d ' TrAS_VAR_IF(MPIFC,[no],[AC_MSG_WARN([Cpsedeits i wsm anopimkr ||r .urcsaF ocran5ouEy "Cr])],[FC="$MPIFC"]d alskAC_MSG_NOTICE([sf CE $CC5$CXX $FC]d elsk "oso "x$1" = xy:, ngs)"bMeeeAC_MSG_NOTICE([Yg supsedeL_faseorea_a$CC5$CXX $FCEaryouEy "CoL,oVpMPI as rEX ]) ellydalskAC_MSG_ERROR([CpsedeitsreocgnizaseegX"MPI re|rc,aw # if: $1]) fi ]) synappm-1.2.1/m4/ax_f90_module_flag.m40000644000175200017530000000420111616003520017354 0uktyo tkeardontkeardon# =========================================================================== #eeeeeeehttp://www.nongnu.org/rcdiconf- 7 ive/ax_f90_module_flag.html # =========================================================================== # # SYNOPSIS # #eeeAX_F90_MODULE_FLAG # #eDESCRIPd be # #eeeFi wsF ocran5905eodules A's t X" orlag.Aare eodule A's t X" orlag ""i#eeestoroiar r "" cac007 varAneu eax_f90_modrlag.AAn errsaaUD triggs is"pf #eee. uerlag _DIe zrorssf CE eSu rEX uPcbX"esse-Iesk rouEy "Crserlags"ed.W#eee-M SUNrouEy "Crserlags"it_a. ue-p Ab rrgs araF ocran5ouEy "Crorlag. # #eeeNote (Omyo Aw "C): Iseegnkesk rh' Trc-Jerlag m I' T fl esse-Ierlag. #eLICENSE # #eeeT keeuwnd(c) "To9 Luc Maisonoors #eeeT keeuwnd(c) "To9 Juoc.b C. Cum wtes #eeeT keeuwnd(c) "To9 Alexaof.ocPletz.oc # #eeeT kan yd.dated.br---od= kv }rxifn, r,zssosOmrozoraaryhyr uwn Appl,wsxde#eee #tar pedaorface oftrurczoraaryh#-o- Ligou"oeiCr _riES; keerappc)pYoue#eeef HaE^\.rc)pYoudR)rs rv _ awe Trxifn, raUD sxar,moias-urwszoraaryhte[d#eeew--o t" "E #sofcrr611 AC_DEFUN([AX_F90_MODULE_FLAG],[ AC_CACHE_CHECK([sfocran5905eodules A's t X" orlag], ax_cv_f90_modrlag, [AC_LANG_PUSH(F ocran) i=0 wh, rwnoso \( -v }mpdir_$i \) -o \( -d }mpdir_$i \) ;gca i=`tosp $i + 1` dimitmkdw_ smpdir_$i cd }mpdir_$i AC_COMPILE_IFELSE([ !234567wr eodule confnoso_modulewr ours a fur _:sro_ps_ehconfnoso_ro_ps_eur tanpe(*,'(a)') 'gotcha!'ur teSt_:sro_ps_ehconfnoso_ro_ps_eur teSteodule confnoso_modulewr ],[],[]) cd .. ax_cv_f90_modrlag="its f CE"Vondsex_rlag "n "-I" "-J" "-M" "-p";gca ik "oso "$ax_cv_f90_modrlag" = "its f CE" ngs)"bMeeeax_save_FCFLAGS="$FCFLAGS"bMeeeFCFLAGS="$ax_save_FCFLAGS ${ex_rlag}}mpdir_$i" ' TrAC_COMPILE_IFELSE([ !234567wr orefo esnfnoso_bXrE Aor use confnoso_modulewr oarxsinufnoso_ro_ps_eur teSt orefo esnfnoso_bXrE Aor ],[ax_cv_f90_modrlag="$ex_rlag"],[]) MeeeFCFLAGS="$ax_save_FCFLAGS" ' fi dimitrm -v_ smpdir_$i ik "oso "$ax_cv_f90_modrlag" = "its f CE" ngs)"bMeAC_MSG_ERROR([unofcg agV i wsouEy "Crorlag_p"pualdules A's t X" ]) fi AC_LANG_POP(F ocran) ])])synappm-1.2.1/NOTICE0000644000175200017530000000114211616003520014053 0uktyo tkeardontkeardonLIABILITY NOTICE aN NO EVENT SHALL aHE ETH BE LIABLE TO AlY PARTY FORADIRECT, INDIRECT, SPECI w, INCIDENTAL, ORACONSEQUENTIAL DAMAGES, INCLUDINGALST PROFITS, ARISINGAOUT OF_aHE USE OF_aHIS SOFTWARE_al.pITS DOCUMENTAd be, EVEN IF aHE ETH HAS BEEN ADVISED OF aHE POSSIBILITY OF SUCH DAMAGE. aHE ETH SPECIFICALLYADISCLAINS_alY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, aHE IMPLIED WARRANTIES OF_MERCHANTABILITY al. FITNESS FORAA PARTICULAR PURPOSE. aHE SOFTWARE_PROVIDED HEREUNDER IS ON AN "AS IS" BASIS,_al.paHE ETH HAS NO OBLIGAd beS TOAPROVIDEAMAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, ORAMODIFICAd beSusynappm-1.2.1/esnfig.guess0000755000175200017530000012753411616003516015512 0uktyo tkeardontkeardon#! /bin/sh #eAsy, bua supuic Li canontbrr6s kexgTf,dr. #eeeT keeuwnd(C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, #eee"To0,e"To1,e"To2,e"To3,e"To4,e"To5,e"To6,e"To7,e"To8 #eeeFght (C) .si0If CEO oc.,@Inc"E toc.ktymp='"To8-01-23'E # Trxifn, raUD ssers rrgrbje; $(thred mwor se _ so it.Libs gcis org itb#Liof.ocrecrqrpedr.iturtssk roc hn wLen Xs dropirly_ast" ne 2007 #tcayright (C) .si0If CEO oc.;@t_tofshse" refe2s tosqrp tc,oofoooon#a(s#.Tpskas_ acu)Lib t_tofshli use.b# # Trxif orefo iPoor se _ soiar r "" hlic epoe bute}rxs cryllfutLhsts # WITHOUT AlY WARRANTY;ozoraaryhtrw,r "" gsearAamC--o t" or #tMERCHANTABILITY gcFITNESS FORAA PARTICULAR PURPOSE. ASeafoonssk #toc hn wLen Xs dropirly_p"pualicTooo) us# # /lib,opsedeogcaforlis uPco cod=sa=_ Cosk roc hn wLen Xs dropirlyd#kabmooa byo eegX" orefo ;ia an)ptktanpeftoc.Libight (C) .si #0If CEO oc.,@Inc", 51biganklr rStghtt - Fifyo Flowe aBostc.,@MA #002110-13o1,eUSAus# # Asrneacres Trg.stm; .ftoc.Libsk roc hn wLtk _:sstrgcaou--|^\.re # or se _ so }rxifn, r_ast" icagi orefo . Ofa,net a--r #ecsnfigu itk etrinfbuagc hn t07 CAcdiconf--s yy "t A's tEOotELiof.o #tcayrr a_mted.br---od= Mgoas_ec'4incos"ornfigx"sIR)thli toc.Lp ec_s rrg #eOnagcoyrr #tanplxif CPfshBothn.oc. #eP$bspgcsteSt atchtlftocLiibsbar Mat.sts_xt # orff=zorac pr _ orEaryma pedaCg.s ALog=iat C-i# # Trxifrinfbuansy, busa supuic Li canontbrr6s kexgTf,drrits: $trto #ecsnfig.subt""aec u,kucceeds,c u,prinaoarpsks kexgTf,drr etrtdarys"it_ #eexiaoa byo art"Oe aga _,c u,exiaoa byo 1-i# # TreOm rny " r av }rxif grr crcda" orfaccsnfigu efrinfbus-|^\.re # oon'si-V, --qrnic Liyourhstiede( kexgTtyicrrgme=`echo "$0" | kmd,-e 's,.*/,,'` usage="\ Usage: $0 [OPd be] Opsboc _allinufigu itk ets,dr=otkrpsks kexgT\`$me' " liurcasrrgO_ itk etona=s: -h, --help prina }rxifhelptngs)" exia -t, --toc.-ktymp prina dcr o ft_tsyhyr uwn Appl,wgs)" exia -v, --se" refe prina License" refer,wgs)" exia Reptk sbugsnoi"ToatchtlftocL" vernfig="\ sk rounfig.guess ($toc.ktymp)rgOnagcoyrr #tanplxif CPfshBothn.o. T keeuwnd(C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,e"To0,e"To1, "To2,e"To3,e"To4,e"To5,e"To6,e"To7,e"To8eFght (C) .si0If CEO oc.,@Inc"E T gX"iPossers rrgrbje;k,pe rpsks ttkuwnoited.o bymsnu. IR) e h_ACEd"iPoNO iv--sll uitstrw,r.*"eMERCHANTABILITY gcFITNESS FORAA PARTICULAR PURPOSE." help=" TryT\`$me --help'_p"pualicTttrectorour." #eParse coh_,ysmsnd wh, rwnoso $# -gt 0 ;gca ssw_a$1E act".s--toc.-ktymp |s--toc.* |s-t )wr echo "$toc.ktymp" nexia ;;ct".s--License"|s-v )wr echo "$M) @//, nexia ;;ct".s--help |s--h* |s-h )wr echo "$usage" nexia ;;ct".s-- ) #rStopas_ acuausruk _rngwr shify; break ;;ct".s- ) #.shaTrtdifssu,inboc.wr break ;;ct".s-* )wr echo "$me: inet_L,as_ acua$1$help" >&2wr exia 1 ;;ct".s* )wr break ;;ct"esac dimit ik "oso $# != 0 ngs)"bMeecho "$me: to"Ad tenrgis_ "s$help" >&2wr exia 1 fi iva p 'exia 1' 1 2 15 #eCC_FOR_BUILDs-- ouEy "Croyll v }rxifrinfbu.eNote _rwocfursig.so U #ecsEy "Croaryriiar rs kexgTooo_e"sahriPoor " ueagerh#ceikas_b7""i"i#ey, bomd.ywn, eoX"edto6c.i0"ocmanfsss $(thred ,pe below,d-a;i" #eheadac00 eor prr6 byo gd okptk a p5.ashiasrrg# Histor baors, `CC_FOR_BUILD'oyll "edto6s,drd `HOST_CC'. WaTrt}rx #sig.s`HOST_CC'-|^\s_essl a_stsd-a;i" peses.s#drrg# Ptk a p5tmp og@ `o.ywc.i0"sahriny=we07 CrpyrAcdiconfey,s rrgset_cc_rec_stied='iva p "exiacna==\$?; (rm -v \$tmpn, eoX2>/dev/null; rmdw_ \$tmpX2>/dev/null) && exia \$exiacna=" 0 ;iva p "rm -v \$tmpn, eoX2>/dev/null; rmdw_ \$tmpX2>/dev/null nexia 1" 1 2 13ifss; : ${TMPDIR=/tmp}s; {5tmp=`(umask 077 && mky, b -d "$TMPDIR/cgXXXXXX")X2>/dev/null` && "oso -n "$tmp" && "oso -d "$tmp" ; } || {5toso -n "$RANDOM" && "mp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdw_ $tmp) ; } || {5tmp=$TMPDIR/cg-$$ && (umask 077 && mkdw_ $tmp) && echo "Wac.iua:wc.i0"suagsgseg=bX"aemp og@ `o.y" >&2 ; } || {5echo "$me: eDIe zre.i0"orpskd bomd.ywog@ `o.ywgd $TMPDIR" >&2 ; exia 1 ; }s; dummy=$tmp/dummy ;ivmpn, eo="$dummy.c $dummy.o $dummy.rel $dummy" ; ssw_a$CC_FOR_BUILD,$HOST_CC,$CC5 act,,) echo "ina x;" > $dummy.c ; noitenrnec gcc5c89 c99 ;gca ik ($c -c -o $dummy.o $dummy.c) >/dev/nullX2>&1 ngs)"b CC_FOR_BUILD="$c"; break ;b fi ;b dimi ;b ik "oso x"$CC_FOR_BUILD" = x ngs)"b CC_FOR_BUILD=no_csEy "Cr_sf CE ; ni ;;ct,,*) CC_FOR_BUILD=$CC5;;ct,*,*) CC_FOR_BUILD=$HOST_CC5;;cesac ;k,pt_cc_rec_stied= ;'E # Trxif\.rceedl "ed i wsuf,drr eta Py_s iiaOSx"sasyeiurcr r "" BSDsufowetsr. #e(ghazi@noc.rutgets.edu 1994-08-24) ik (toso -f /.nsybin/uf,dr) >/dev/nullX2>&1 ngs)"b PATH=$PATH:/.nsybin ; exptk sPATH fi iUNAME_MACHINE=`(uf,drr-m)X2>/dev/null` || UNAME_MACHINE=un rpsniUNAME_RELEASE=`(uf,drr-r)X2>/dev/null` || UNAME_RELEASE=un rpsniUNAME_SYSTEM=`(uf,drr-s)X2>/dev/null` || UNAME_SYSTEM=un rpsniUNAME_VERS be=`(uf,drr-v)X2>/dev/null` || UNAME_VERS be=un rpsni #eNote:esesupixifrig uwn nt - "" ca _, -slchtlfy scra_lyour"c yorrgca _,"${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERS be}"E act".s*:NetBSD:*:*) #.NetBSD (nbsd) tcrsrss"" psede(ai=bX" ||$"cpoee)tsttch_codm"p #.alicToc.etPotu||$=s: *-*-netbsdelf*, *-*-netbsdaary*, #.*-*-netbsdecoff*noi"T*-*-netbsd*"gd Vrptcrsrss"_rwocorli " l #.s byc007 "edELF, *-*-netbsd*supsedes " .a.etPooldl #.or_=ds'n, r_rector.eeT gX" oroeiCss authreciv-dl #.orie tiorn,ebn.ndbdsa my)rimooameig.sismibalu" " .a '$ rary #.or_=ds'n, r_rector.y # #.Note:eNetBSD yxxen'soa Eo bT=flck gr ofe oc _allrw,d"p #.ussooa snou_allf,dr. WaTalwaftpseqy_cX"ed"un rpsn".y s kctl="s kctl -n hw.mirhMne_ 7 " UNAME_MACHINE_ARCH=`(/sbin/$s kctl 2>/dev/null || \b /usr/sbin/$s kctl 2>/dev/null || echo un rpsn)` ca _,"${UNAME_MACHINE_ARCH}"E ac armeb)tstrhMne=armeb-un rpsn5;;c arm*)tstrhMne=arm-un rpsn5;;c sh3el)tstrhMne=shl-un rpsn5;;c sh3eb)tstrhMne=sh-un rpsn5;;c sh5el)tstrhMne=sh5le-un rpsn5;;c *)tstrhMne=${UNAME_MACHINE_ARCH}-un rpsn5;;c esac # TreOO_ itklyr kexgTreffigutanor_=ds'nector,_"edh' Ts byc007 # "edELFcorli " ,Omrozollcr r "" gca l. ca _,"${UNAME_MACHINE_ARCH}"E ac arm*|i386|m68k|ns32k|sh3*|soa c|vax) eet_ $,pt_cc_rec_stied "edecho __ELF__ |s$CC_FOR_BUILDs-E - 2>/dev/null \b |ug.ip __ELF__ >/dev/nullb gs)"b #rOLibrarxsutrn,e" b grr crECOFF (netbsdecoff)mXtka. oc (netbsdaary).b #rReca p5netbsdAnpsk _tofs"gd IX?b os=netbsd ellyd os=netbsdelfd ni ;;c *)b os=netbsd ;;c esac # TreOOSaermbspg # Debc.b GNU/NetBSD strhMnea SbubxaieTrcumooosig.rlanfssn7 # "hus,rceedis xitsi.a.enfbler.eorlis_a rtasy-----ourceed # kernel n-----s-ttrectorour, soi grr cr.iplacAamC,oVpel #.sui a p5tags"r r "" styl o ft_inux-gnu. ca _,"${UNAME_VERS be}"E ac Debc.b*)b ermbspg='-gnu' ;;c *)b ermbspg=`echo ${UNAME_RELEASE}|kmd,-e 's/[-_].*/\./'` ;;c esac # SiLibrCPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:l #.oret a--re07 CEO tarorectorour, "" soprtr .urm:l #.CPU_TYPE-MANUFACTURER-OPERATING_SYSTEMixifyll . echo "${strhMne}-${os}${ermbspg}" exia ;;ct".s*:OicnBSD:*:*) UNAME_MACHINE_ARCH=` 7 | kmd,'s/OicnBSD.//'` echo ${UNAME_MACHINE_ARCH}-un rpsn-licnbsd${UNAME_RELEASE} exia ;;ct".s*:ekkoBSD:*:*) echo ${UNAME_MACHINE}-un rpsn-ekkobsd${UNAME_RELEASE} exia ;;ct".s*:SolidBSD:*:*) echo ${UNAME_MACHINE}-un rpsn-solidbsd${UNAME_RELEASE} exia ;;ct".sstrppc:MirBSD:*:*) echo prlirpc-un rpsn-mirbsd${UNAME_RELEASE} exia ;;ct".s*:MirBSD:*:*) echo ${UNAME_MACHINE}-un rpsn-mirbsd${UNAME_RELEASE} exia ;;ct".salpha:OSF1:*:*) ssw_a$UNAME_RELEASEE ac *4.0)b UNAME_RELEASE=`/usr/sbin/siz.oc-v | awk '{prina $3}'` ;;c *5.*)b UNAME_RELEASE=`/usr/sbin/siz.oc-v | awk '{prina $4}'` ;;c esac # A.str7lEag C-C Eyaq, /usr/sbin/psrroreh' Tbeh"iska_tofcg on # OSF/1n.ndbTru64rs kexgsGd "dEmd,siLibr1995t""a hlic epoel #.orn---A kst"s kexgsGiurnlEag Cday.eeT gX"cna= pipoc.etPoCPU # "ypoc.etasa oahead -n 1, soiwe "ac iooo_e".etPotyic CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrrore-v | kmd,-n,-e 's/^"Aare alpha \(.*\)ausruk _or.*$/\1/p' | head -n 1` ca _,"$ALPHA_CPU_TYPE"E ac "EV4 (21064)")b UNAME_MACHINE="alpha"5;;c "EV4.5 (21064)")b UNAME_MACHINE="alpha"5;;c "LCA4 (21066/21068)")b UNAME_MACHINE="alpha"5;;c "EV5 (21164)")b UNAME_MACHINE="alphaev5"5;;c "EV5.6 (21164A)")b UNAME_MACHINE="alphaev56"5;;c "EV5.6 (21164PC)")b UNAME_MACHINE="alphapca56"5;;c "EV5.7 (21164PC)")b UNAME_MACHINE="alphapca57"5;;c "EV6 (21264)")b UNAME_MACHINE="alphaev6"5;;c "EV6.7 (21264A)")b UNAME_MACHINE="alphaev67"5;;c "EV6.8CB (21264C)")b UNAME_MACHINE="alphaev68"5;;c "EV6.8AL (21264B)")b UNAME_MACHINE="alphaev68"5;;c "EV6.8CX (21264D)")b UNAME_MACHINE="alphaev68"5;;c "EV6.9A (21264/EV69A)")b UNAME_MACHINE="alphaev69"5;;c "EV7 (21364)")b UNAME_MACHINE="alphaev7"5;;c "EV7.9 (21364A)")b UNAME_MACHINE="alphaev79"5;;c esac # A Pn.n n-----s-t=faToatchtdhli use.b # A Vn.n n-----s-t=faTermbspgdhli use.b # A Tn.n n-----s-t=faTermbspgdhfieedetoso li use.b # A Xn.n n-----s-t=fan unermbspgdhex_ i,aw looooalcdir.b # 1.2fylls "1.2"gs)" uf,drr-r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | kmd,-e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` exia ;;ct".sAlpha\s*:Wi,d"ws_NT*:*) #.H Edoiwe rpsi'spr vaoix ith.ocrea r "" gc hnic POSIXt_:ss kexg? # S psedewe ig.s ApUNAME_MACHINEooooa itcrkeirupsboc uf,drr he eady #.otkrpskscresNFIGAlphatona=l? echo alpha-pc-i vaoix exia ;;ct".s21064:Wi,d"ws_NT:50:3) echo alpha-dec-winnt3.5 exia ;;ct".sAmiga*:UNIX_ kexg_V:4.0:*) echo m68k-un rpsn-sysv4 exia ;;ct".s*:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-un rpsn-amigaos exia ;;ct".s*:[Mm]orph[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-un rpsn-morphos exia ;;ct".s*:OS/390:*:*) echo i370-ibm-licne. IR) exia ;;ct".s*:z/VM:*:*) echo s390-ibm-zvmoe exia ;;ct".s*:OS400:*:*) echo prlirpc-ibm-ls400 exia ;;ct".sarm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-astrn-riscix${UNAME_RELEASE} exia ;;ct".sarm:riscos:*:*|arm:RISCOS:*:*) echo arm-un rpsn-riscos exia ;;ct".sSR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) echo hppa1.1-hiyaoci-hiuxmpp exia ;;ct".sPy_s ii*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) #.akee@wpxit03.wpafb.af.mil (Earcg F. Ake)ssneouorrya iMISn.ndbNILE.b ik "oso "`(/bin/ufowetsr)X2>/dev/null`" = att ngs)"b echo py_s ii-py_s ii-sysv3 ellyd echo py_s ii-py_s ii-bsd ni exia ;;ct".sNILE*:*:*:dcosx) echo py_s ii-py_s ii-svr4 exia ;;ct".sDRS?6000:ufox:4.0:6*) echo soa c-icl-nx6 exia ;;ct".sDRS?6000:UNIX_ V:4.2*:7* | DRS?6000:isis:4.2*:7*) ssw_a`/usr/bin/uf,dr -p`E ac soa c) echo soa c-icl-nx7 nexia ;;c esac ;;ct".ssun4H:SunOS:5.*:*) echo soa c-hal-solaris2`echo ${UNAME_RELEASE}|kmd,-e 's/[^.]*//'` exia ;;ct".ssun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo soa c-sun-solaris2`echo ${UNAME_RELEASE}|kmd,-e 's/[^.]*//'` exia ;;ct".si86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) echo i386-pc-solaris2`echo ${UNAME_RELEASE}|kmd,-e 's/[^.]*//'` exia ;;ct".ssun4*:SunOS:6*:*) #.A.str7lEag C-csnfig.sub,p}iityo(rku e)ar|r kgrnuplcanontbrriz. # SunOS6* noarda supuic Lexaclforwetl:SunOS6te}rxs crL_faLhsts # 'spL_fa keepybe.alicTL_fasSolariscrea rSunOS4. echo soa c-sun-solaris3`echo ${UNAME_RELEASE}|kmd,-e 's/[^.]*//'` exia ;;ct".ssun4*:SunOS:*:*) ssw_a"`/usr/bin/ 7 -k`"E ac Saoies*|S4*)b UNAME_RELEASE=`uf,drr-v` ;;c esac # Japanc iiL.s uagasvernfig.sSbubxaiLicense" refersL_fas`4.1.3-JL'. echo soa c-sun-sunos`echo ${UNAME_RELEASE}|kmd,-e 's/-/_/'` exia ;;ct".ssun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exia ;;ct".ssun*:*:4.2BSD:*) UNAME_RELEASE=`(kmd,1q /etc/motd | awk '{prina _:sstr($5,1,3)}')X2>/dev/null` "oso "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 ssw_a"`/bin/ 7 `"E ac sun3)d echo m68k-sun-sunos${UNAME_RELEASE} ;;c sun4)d echo soa c-sun-sunos${UNAME_RELEASE} ;;c esac exia ;;ct".saushp:SunOS:*:*) echo soa c-auspex-sunos${UNAME_RELEASE} exia ;;ct".s# TreOsitu0"sahr.*"eMiNT-t=faTlittle confttkygpesare strhMnelf,drct".s# grr crvirtu0"a moake roiuag(oake roiuagk Eary " -outt".s# "atarist"mXtk"atariste"f$m's he w,opsedeogcaf$ausruk _ortt".s# > m68000)pesare s kexgTf,drr rois_p;x'S"MiNT"mXweto"FghtMiNT"tt".s# toc.Liblrlirssw_aLicense""mina"limii"ssermina")pesFcoyrr tt".s# tre s kexgTf,drr"TOS" de-ouesrnea kexgTk Eary " aclu0"a m-outt".s# MiNT.oaroaeMiNT-t=fd"wniv-d.orie tiocg agVTOS, soi}rxifropsedtt".s# to6soscer r .wr atarist[e]:*MiNT:*:* | atarist[e]:*mina:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mina${UNAME_RELEASE} exia ;;ct".satari*:*MiNT:*:* | atari*:*mina:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mina${UNAME_RELEASE} exia ;;ct".s*falcon*:*MiNT:*:* | *falcon*:*mina:*:* | *falcon*:*TOS:*:*) echo m68k-atari-mina${UNAME_RELEASE} exia ;;ct".ss: $n*:*MiNT:*:* | s: $n*:*mina:*:* | *s: $n*:*TOS:*:*) echo m68k-s: $n-mina${UNAME_RELEASE} exia ;;ct".shades*:*MiNT:*:* | hades*:*mina:*:* | *hades*:*TOS:*:*) echo m68k-hades-mina${UNAME_RELEASE} exia ;;ct".s*:*MiNT:*:* | *:*mina:*:* | *:*TOS:*:*) echo m68k-un rpsn-mina${UNAME_RELEASE} exia ;;ct".sm68k:strhten:*:*) echo m68k-a||$=-strhten${UNAME_RELEASE} exia ;;ct".sprlirpc:strhten:*:*) echo prlirpc-a||$=-strhten${UNAME_RELEASE} exia ;;ct".sRISC*:Mtrh:*:*) echo mips-dec-strh_bsd4.3 exia ;;ct".sRISC*:ULTRIX:*:*) echo mips-dec-ulouox${UNAME_RELEASE} exia ;;ct".sVAX*:ULTRIX*:*:*) echo vax-dec-ulouox${UNAME_RELEASE} exia ;;ct".s2020:CLIX:*:* | 2430:CLIX:*:*) echo cli||r -i vaograph-clix${UNAME_RELEASE} exia ;;ct".smips:*:*:UMIPS | s:ps:*:*:RISCos) eet_ $,pt_cc_rec_stied kmd,'s/^ //' << EOF >$dummy.c #ifdef __cplusplus #i's tEOo /*r.*"eprinaf()ausrtotyic */b iooamdefm(iooaargc, ig.r *argv[]) { #ellyd iooamdefm(argc, argv) iooaargc; ig.r *argv[]; { #endif #|^\s_essl (hoso_m:ps) && s_essl (MIPSEB) #|^\s_essl (SYSTYPE_SYSV)b prinaf ("mips-mips-riscos%ssysv\n", argv[1]) nexia (0);c #endif #|^\s_essl (SYSTYPE_SVR4)b prinaf ("mips-mips-riscos%ssvr4\n", argv[1]) nexia (0);c #endif #|^\s_essl (SYSTYPE_BSD43) || s_essl (SYSTYPE_BSD)b prinaf ("mips-mips-riscos%sbsd\n", argv[1]) nexia (0);c #endif #endif exia (-1);c } EOF $CC_FOR_BUILDs-o $dummy $dummy.c && dummyarg=`echo "${UNAME_RELEASE}" | kmd,-n,'s/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`$dummy $dummyarg` && {5echo "$SYSTEM_NAME" nexia; } echo mips-mips-riscos${UNAME_RELEASE} exia ;;ct".sMrtorola:PrlirMAX_OS:*:*) echo prlirpc-mrtorola-prlirmax exia ;;ct".sMrtorola:*:4.3:PL8-*) echo prlirpc-g.rris-prlirmax exia ;;ct".sNeuwn_Hawk:*:*:PrlirMAX_OS | Synaogy:PrlirMAX_OS:*:*) echo prlirpc-g.rris-prlirmax exia ;;ct".sNeuwn_Hawk:Prlir_UNIX:*:*) echo prlirpc-g.rris-prlirufox exia ;;ct".sm88k:CX/UX:7*:*) echo m88k-harris-cxux7 exia ;;ct".sm88k:*:4*:R4*) echo m88k-mrtorola-sysv4 exia ;;ct".sm88k:*:3*:R3*) echo m88k-mrtorola-sysv3 exia ;;ct".sAViiON:dgux:*:*) # DG/UXlreca pssAViiON .urcstrpr7 io_e"u"i"i UNAME_PROCESSOR=`/usr/bin/uf,dr -p`b ik [a$UNAME_PROCESSOR = mc88100 ] || [a$UNAME_PROCESSOR = mc88110 ] gs)"b ik [a${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \b [a${TARGET_BINARY_INTERFACE}x = x ] gs)"b echo m88k-dg-dgux${UNAME_RELEASE} ellyd echo m88k-dg-dguxbcs${UNAME_RELEASE} ni ellyd echo i586-dg-dgux${UNAME_RELEASE} ni exia ;;ct".sM88*:DolpoiuOS:*:*) # DolpoiuOS (SVR3) echo m88k-dolpoiu-sysv3 exia ;;ct".sM88*:*:R3*:*) #.Delta 88kea kexgTiurnlEagSVR3 echo m88k-mrtorola-sysv3 exia ;;ct".sXD88*:*:*:*)s# TekarontxsXD88ea kexgTiurnlEagUTekV (SVR3) echo m88k-tekarontx-sysv3 exia ;;ct".sTek43[0-9][0-9]:UTek:*:*)s# Tekarontxs4300ea kexgTiurnlEagUTek (BSD)b echo m68k-tekarontx-bsd exia ;;ct".s*:IRIX*:*:*) echo mips-sgi-iuox`echo ${UNAME_RELEASE}|kmd,-e 's/-/_/g'` exia ;;ct".s????????:AIX?:[12].1:2) # AIX 2.2.1mXtkAIX 2.1.1mxifRT/PCkAIX. echo ;x'p-ibm-atxs # uf,drr-mupowe=fan 8 hex-cna= CPU id exia ;; #eNote _rwo:5echo "'`uf,drr-s`'"upowe=f'AIX 'ur i*86:AIX:*:*) echo i386-ibm-atx exia ;;ct".sia64:AIX:*:*) ik [a-x /usr/bin/oslcdir ] ngs)"b IBM_REV=`/usr/bin/oslcdir` ellyd IBM_REV=${UNAME_VERS be}.${UNAME_RELEASE} ni echo ${UNAME_MACHINE}-ibm-atx${IBM_REV} exia ;;ct".s*:AIX:2:3) ik g.ip bos325 /usr/i's tEO/rtdio.h >/dev/nullX2>&1 ngs)"b eet_ $,pt_cc_rec_stied kmd,'s/^ //' << EOF >$dummy.c #i's tEOo mdef()d {d ik (!__prlir_pc())d exia(1);c puts("prlirpc-ibm-atx3.2.5");c exia(0);c } EOF ik $CC_FOR_BUILDs-o $dummy $dummy.c && SYSTEM_NAME=`$dummy`b gs)"b echo "$SYSTEM_NAME" ellyd echo ;s6000-ibm-atx3.2.5d ni elsk g.ip bos324 /usr/i's tEO/rtdio.h >/dev/nullX2>&1 ngs)"b echo ;s6000-ibm-atx3.2.4 ellyd echo ;s6000-ibm-atx3.2 ni exia ;;ct".s*:AIX:*:[456])d IBM_CPU_ID=`/usr/sbin/lsdev -C -c usruk _or -Siska_tofcg | kmd,1q | awk '{ prina $1 }'` sk /usr/sbin/lsattr -E_ ${IBM_CPU_ID} | g.ip ' POWER' >/dev/nullX2>&1 ngs)"b IBM_ARCH=;s6000 ellyd IBM_ARCH=prlirpc ni ik [a-x /usr/bin/oslcdir ] ngs)"b IBM_REV=`/usr/bin/oslcdir` ellyd IBM_REV=${UNAME_VERS be}.${UNAME_RELEASE} ni echo ${IBM_ARCH}-ibm-atx${IBM_REV} exia ;;ct".s*:AIX:*:*) echo ;s6000-ibm-atx exia ;;ct".sibmrt:4.4BSD:*|;x'p-ibm:BSD:*) echo ;x'p-ibm-bsd4.4 exia ;;ct".sibmrt:*BSD:*|;x'p-ibm:BSD:*) #eorn---ART/PCkBSD n7 echo ;x'p-ibm-bsd${UNAME_RELEASE} #e4.3mC,oVpuf,drraddl "e exia ;; #ereptk : ;x'p-ibmkBSD 4.3 t".s*:BOSX:*:*) echo ;s6000-bull-bosx exia ;;ct".sDPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exia ;;ct".s9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exia ;;ct".shp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exia ;;ct".s9000/[34678]??:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|kmd,-e 's/[^.]*.[0B]*//'` ca _,"${UNAME_MACHINE}"E ac 9000/31? ) HP_ARCH=m680005;;c 9000/[34]?? ) HP_ARCH=m68k5;;c 9000/[678][0-9][0-9]) ik [a-x /usr/bin/getconfe] ngs)"b sc_cpu_vernfig=`/usr/bin/getconfeSC_CPU_VERS beX2>/dev/null` sc_kernel_bits=`/usr/bin/getconfeSC_KERNEL_BITSX2>/dev/null` ca _,"${sc_cpu_vernfig}"E act".sssssssssssssssssss523) HP_ARCH="hppa1.0"5;; #.CPU_PA_RISC1_0ct".sssssssssssssssssss528) HP_ARCH="hppa1.1"5;; #.CPU_PA_RISC1_1ct".sssssssssssssssssss532)t".sssssssssssssssssss#.CPU_PA_RISC2_0ct".sssssssssssssssssss ca _,"${sc_kernel_bits}"E act".sssssssssssssssssssssss32)tHP_ARCH="hppa2.0n" ;;ct".sssssssssssssssssssssss64)tHP_ARCH="hppa2.0w"5;;c '')tHP_ARCH="hppa2.0" ;; # HP-UX 10.20ct".sssssssssssssssssss esac ;;ct".sssssssssssssss esacd ni ik [a"${HP_ARCH}" = ""e] ngs)"b eet_ $,pt_cc_rec_stied kmd,'s/^ssssssssssss //' << EOF >$dummy.c ct".sssssssssss#s_essl _HPUX_SOURCEct".sssssssssss#i's tEOo t".sssssssssss#i's tEOo t".sssssssssssiooamdefm() t".sssssssssss{ t".sssssssssss#i^\s_essl (_SC_KERNEL_BITS) t".sssssssssssssssbmooabits = s kconf(_SC_KERNEL_BITS);ct".sssssssssss#endif t".sssssssssssssssbmooacpu = s kconf (_SC_CPU_VERS be);c t".ssssssssssssssss byc0 (cpu) t".sssssssssss { t".sssssssssss ca _,CPU_PA_RISC1_0: puts ("hppa1.0"); break;ct".sssssssssss ca _,CPU_PA_RISC1_1: puts ("hppa1.1"); break;ct".sssssssssss ca _,CPU_PA_RISC2_0: t".sssssssssss#i^\s_essl (_SC_KERNEL_BITS) t".sssssssssss sssss byc0 (bits) t".sssssssssss { t".sssssssssss ca _,64: puts ("hppa2.0w"); break;ct".sssssssssss ca _,32: puts ("hppa2.0n"); break;ct".sssssssssss s_eault: puts ("hppa2.0"); break;ct".sssssssssss } break;ct".sssssssssss#elly /*r!s_essl (_SC_KERNEL_BITS) */bt".sssssssssss ssssputs ("hppa2.0"); break;ct".sssssssssss#endif t".sssssssssss s_eault: puts ("hppa1.0"); break;ct".sssssssssss } t".sssssssssssssssexia (0);cssssssssssssss} EOF ssss(CCOPTS= $CC_FOR_BUILDs-o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`b sssstoso -za"$HP_ARCH" && HP_ARCH=hppad ni5;;c esac ik [a${HP_ARCH} = "hppa2.0w"5] gs)"b eet_ $,pt_cc_rec_stied #rhppa2.0w-hp-hpux*rh' Trc64-bit kernel .ndbdsa Ey "Crogc hn trngw #r32-bit cna=. rhppa64-hp-hpux*rh' Tcayrr a_mkernel .ndbdsa Ey "Crw #rgc hn trngc64-bit cna=. rsk r.ndbHPsig.seTrcumooosnome's a"u"i:w #w #r$ CC_FOR_BUILD=cc ./esnfig.guessw #r=>rhppa2.0w-hp-hpux11.23w #r$ CC_FOR_BUILD="cc +DA2.0w"5./esnfig.guessw #r=>rhppa64-hp-hpux11.23wb ik echo __LP64__ |s(CCOPTS= $CC_FOR_BUILDs-E - 2>/dev/null) |d g.ip __LP64__ >/dev/nullb ssssts)"b HP_ARCH="hppa2.0w" ellyd HP_ARCH="hppa64" ni ni echo ${HP_ARCH}-hp-hpux${HPUX_REV} exia ;;ct".sia64:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|kmd,-e 's/[^.]*.[0B]*//'` echo ia64-hp-hpux${HPUX_REV} exia ;;ct".s3050*:HI-UX:*:*) eet_ $,pt_cc_rec_stied kmd,'s/^ //' << EOF >$dummy.c #i's tEOo ioo mdefm() {d ssbmooacpu = s kconf (_SC_CPU_VERS be);c /*rare sesupima pers, becau _,CPU_IS_HP_MC68K errsneouslylreca psb truuwnoitCPU_PA_RISC1_0. rCPU_IS_PA_RISClreca psscor@ `b results, hrlis_a. r*/b ik (CPU_IS_PA_RISCl(cpu))b {b s byc0 (cpu) {d ca _,CPU_PA_RISC1_0: puts ("hppa1.0-hiyaoci-hiuxwe2"); break;c ca _,CPU_PA_RISC1_1: puts ("hppa1.1-hiyaoci-hiuxwe2"); break;c ca _,CPU_PA_RISC2_0: puts ("hppa2.0-hiyaoci-hiuxwe2"); break;c s_eault: puts ("hppa-hiyaoci-hiuxwe2"); break;c } } elly ik (CPU_IS_HP_MC68K (cpu))b puts ("m68k-hiyaoci-hiuxwe2"); elly puts ("un rpsn-hiyaoci-hiuxwe2"); exia (0);c } EOF $CC_FOR_BUILDs-o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && {5echo "$SYSTEM_NAME" nexia; } echo un rpsn-hiyaoci-hiuxwe2 exia ;;ct".s9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exia ;;ct".s9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exia ;;ct".s*9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) echo hppa1.0-hp-mpetx exia ;;ct".shp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exia ;;ct".shp8??:OSF1:*:*) echo hppa1.0-hp-osf exia ;;ct".si*86:OSF1:*:*) ik [a-x /usr/sbin/sysLicense"] ngs)"b echo ${UNAME_MACHINE}-un rpsn-osf1mk ellyd echo ${UNAME_MACHINE}-un rpsn-osf1 ni exia ;;ct".sparisc*:Lites*:*:*) echo hppa1.1-hp-lites exia ;;ct".sC1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd ssssssssexia ;;ct".sC2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) ik srssysrore-f scalar_acc gs)" echo c32-convex-bsd elly echo c2-convex-bsd ni sssssssexia ;;ct".sC34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd ssssssssexia ;;ct".sC38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd ssssssssexia ;;ct".sC4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd ssssssssexia ;;ct".sCRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | kmd,-e 's/\.[^.]*$/.X/' exia ;;ct".sCRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | kmd,-e 's/CRAY.*\([A-Z]90\)/\1/' \b -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \b -e 's/\.[^.]*$/.X/' exia ;;ct".sCRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} | kmd,-e 's/\.[^.]*$/.X/' exia ;;ct".sCRAY*T3E:*:*:*) echo alphaev5-cray-unicosmk${UNAME_RELEASE} | kmd,-e 's/\.[^.]*$/.X/' exia ;;ct".sCRAY*SV1:*:*:*) echo sv1-cray-unicos${UNAME_RELEASE} | kmd,-e 's/\.[^.]*$/.X/' exia ;;ct".s*:UNICOS/mp:*:*) echo craynv-cray-unicosmp${UNAME_RELEASE} | kmd,-e 's/\.[^.]*$/.X/' exia ;;ct".sF30[01]:UNIX_ kexg_V:*:* | F700:UNIX_ kexg_V:*:*) FUJITSU_PROC=`uf,drr-m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` ssssssssFUJITSU_SYS=`uf,drr-p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | kmd,-e 's/\///'` ssssssssFUJITSU_REL=`echo ${UNAME_RELEASE} | kmd,-e 's/ /_/'` ssssssssecho "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" ssssssssexia ;;ct".s5000:UNIX_ kexg_V:4.*:*) FUJITSU_SYS=`uf,drr-p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | kmd,-e 's/\///'` ssssssssFUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | kmd,-e 's/ /_/'` ssssssssecho "soa c-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exia ;;ct".si*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embeddl /OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exia ;;ct".ssoa c*:BSD/OS:*:*) echo soa c-un rpsn-bsdi${UNAME_RELEASE} exia ;;ct".s*:BSD/OS:*:*) echo ${UNAME_MACHINE}-un rpsn-bsdi${UNAME_RELEASE} exia ;;ct".s*:FghtBSD:*:*) ssw_a${UNAME_MACHINE}E ac pc98)d echo i386-un rpsn-sserbsd`echo ${UNAME_RELEASE}|kmd,-e 's/[-(].*//'`5;;c amd64)d echo x86_64-un rpsn-sserbsd`echo ${UNAME_RELEASE}|kmd,-e 's/[-(].*//'`5;;c *)d echo ${UNAME_MACHINE}-un rpsn-sserbsd`echo ${UNAME_RELEASE}|kmd,-e 's/[-(].*//'`5;;c esac exia ;;ct".si*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwi exia ;;ct".s*:MINGW*:*) echo ${UNAME_MACHINE}-pc- wtew32 exia ;;ct".si*:wi,d"ws32*:*) # uf,drr-mui's tEOs "-pc"itcrkexifr kexg.wr echo ${UNAME_MACHINE}- wtew32 exia ;;ct".si*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exia ;;ct".s*:r vaoix*:[3456]*) ssw_a${UNAME_MACHINE}E ac x86)d echo i586-pc-i vaoix${UNAME_RELEASE} exia ;;c EM64T | augs)"ticamd)d echo x86_64-un rpsn-i vaoix${UNAME_RELEASE} exia ;;c IA64)d echo ia64-un rpsn-i vaoix${UNAME_RELEASE} exia ;;c esac ;;ct".s[345]86:Wi,d"ws_95:* | [345]86:Wi,d"ws_98:* | [345]86:Wi,d"ws_NT:*) echo i${UNAME_MACHINE}-pc- ks exia ;;ct".si*:Wi,d"ws_NT*:* | P)"tium*:Wi,d"ws_NT*:*) #.H Edoiwe rpsi'spr vaoix ith.ocrea r "" gc hnic POSIXt_:ss kexg? # It alsC-csnflicaoa byo pre-2.0svernfig.sof AT&T UWIN. S psedewe # UNAME_MACHINEooooa itcrkeirupsboc uf,drr he ead i386? echo i586-pc-i vaoix exia ;;ct".si*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwi exia ;;ct".samd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-un rpsn-cygwi exia ;;ct".sp*:CYGWIN*:*) echo prlirpcle-un rpsn-cygwi exia ;;ct".sprep*:SunOS:5.*:*) echo prlirpcle-un rpsn-solaris2`echo ${UNAME_RELEASE}|kmd,-e 's/[^.]*//'` exia ;;ct".s*:GNU:*:*) #..Libsk rs kexg echo `echo ${UNAME_MACHINE}|kmd,-e 's,[-/].*$,,'`-un rpsn-gnu`echo ${UNAME_RELEASE}|kmd,-e 's,/.*$,,'` exia ;;ct".s*:GNU/*:*:*) #.oth.ocs kexgsG byo sk rlibcr.ndbig.rlanf echo ${UNAME_MACHINE}-un rpsn-`echo ${UNAME_SYSTEM} | kmd,'s,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|kmd,-e 's/[-(].*//'`-gnu exia ;;ct".si*86:Mifox:*:*) echo ${UNAME_MACHINE}-pc- wtix exia ;;ct".sarm*:Linux:*:*) eet_ $,pt_cc_rec_stied ik echo __ARM_EABI__ |s$CC_FOR_BUILDs-E - 2>/dev/null \b t".s| g.ip -q __ARM_EABI__ gs)"b echo ${UNAME_MACHINE}-un rpsn-_inux-gnu ellyd echo ${UNAME_MACHINE}-un rpsn-_inux-gnueabi ni exia ;;ct".savr32*:Linux:*:*) echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".scris:Linux:*:*) echo cris-axis-_inux-gnu exia ;;ct".scrisv32:Linux:*:*) echo crisv32-axis-_inux-gnu exia ;;ct".sfrv:Linux:*:*) r echo frv-un rpsn-_inux-gnu exia ;;ct".sia64:Linux:*:*) echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".sm32r*:Linux:*:*) echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".sm68*:Linux:*:*) echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".sm:ps:Linux:*:*) eet_ $,pt_cc_rec_stied kmd,'s/^ //' << EOF >$dummy.c #iof.foCPU #iof.fom:ps #iof.fom:psel #|^\s_essl (__MIPSEL__) || s_essl (__MIPSEL) || s_essl (_MIPSEL) || s_essl (MIPSEL) CPU=m:psel #ellyd #|^\s_essl (__MIPSEB__) || s_essl (__MIPSEB) || s_essl (_MIPSEB) || s_essl (MIPSEB) CPU=m:ps #ellyd CPU=c #endif #endif EOF eet_ "`$CC_FOR_BUILDs-E $dummy.c 2>/dev/null | kmd,-n,'b /^CPU/{d s: ::gd p }'`" "oso x"${CPU}" != x && {5echo "${CPU}-un rpsn-_inux-gnu" nexia; } ;;ct".sm:ps64:Linux:*:*) eet_ $,pt_cc_rec_stied kmd,'s/^ //' << EOF >$dummy.c #iof.foCPU #iof.fom:ps64 #iof.fom:ps64el #|^\s_essl (__MIPSEL__) || s_essl (__MIPSEL) || s_essl (_MIPSEL) || s_essl (MIPSEL) CPU=m:ps64el #ellyd #|^\s_essl (__MIPSEB__) || s_essl (__MIPSEB) || s_essl (_MIPSEB) || s_essl (MIPSEB) CPU=m:ps64 #ellyd CPU=c #endif #endif EOF eet_ "`$CC_FOR_BUILDs-E $dummy.c 2>/dev/null | kmd,-n,'b /^CPU/{d s: ::gd p }'`" "oso x"${CPU}" != x && {5echo "${CPU}-un rpsn-_inux-gnu" nexia; } ;;ct".sor32:Linux:*:*) echo or32-un rpsn-_inux-gnu exia ;;ct".sppc:Linux:*:*) echo prlirpc-un rpsn-_inux-gnu exia ;;ct".sppc64:Linux:*:*) echo prlirpc64-un rpsn-_inux-gnu exia ;;ct".salpha:Linux:*:*) ssw_a`kmd,-n,'/^cpu ona=l/s/^.*: \(.*\)/\1/p' < /usru/cpurore`E ac EV5)t".UNAME_MACHINE=alphaev5 ;;c EV56)".UNAME_MACHINE=alphaev56 ;;c PCA56)"UNAME_MACHINE=alphapca56 ;;c PCA57)"UNAME_MACHINE=alphapca56 ;;c EV6)t".UNAME_MACHINE=alphaev6 ;;c EV67)".UNAME_MACHINE=alphaev67 ;;c EV68*)"UNAME_MACHINE=alphaev68 ;;ct".sssssesac objdump --private-head---A/bin/shs| g.ip ld.so.1 >/dev/nullb ik "oso "$?" = 0 ngs)" LIBC="libc1, nelly LIBC=", nni echo ${UNAME_MACHINE}-un rpsn-_inux-gnu${LIBC} exia ;;ct".sparisc:Linux:*:* | hppa:Linux:*:*) # LookwnoitCPU lcdir ssw_a`g.ip '^cpu[^a-z]*:' /usru/cpurore 2>/dev/null | cuo -d' ' -f2`E ac PA7*) echo hppa1.1-un rpsn-_inux-gnu ;;c PA8*) echo hppa2.0-un rpsn-_inux-gnu ;;c *) echo hppa-un rpsn-_inux-gnu ;;c esac exia ;;ct".sparisc64:Linux:*:* | hppa64:Linux:*:*) echo hppa64-un rpsn-_inux-gnu exia ;;ct".ss390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-_inux exia ;;ct".ssh64*:Linux:*:*) r echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".ssh*:Linux:*:*) echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".ssoa c:Linux:*:* | soa c64:Linux:*:*) echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".svax:Linux:*:*) echo ${UNAME_MACHINE}-dec-_inux-gnu exia ;;ct".sx86_64:Linux:*:*) echo x86_64-un rpsn-_inux-gnu exia ;;ct".sxtensa*:Linux:*:*) r echo ${UNAME_MACHINE}-un rpsn-_inux-gnu exia ;;ct".si*86:Linux:*:*) # are BFDt_ink.oc rpssrwetl:.Libs_eault.or_=ds'n, r_rector is, so # fire w,ee_"ede}rxsterxsus. cd toc.Librootwog@ `o.ywtoscetrw,s # cer r sG byo oth.ocp ec_s smXtkog@ `o." b ga" or`ld' r r "" path.b # Set LC_ALL=Cwtosens=bX"ldrupsbocs messageu,in Enge 20.b ld_supptk ed_tcrsrss=`cd /; LC_ALL=Cwldr--help `(uf,alphaeuge t".io-solaris:/!d_prlinu e/[ ][ ]*/ /g_prlinu e/.*uge t".io-solaris: ,-e_prlinu e/ .,-e_prlinu pd,-e 's/ /_sssssssn Enge 20.b ld_supptAME_MACHelf:*)r he;;c Tl.pITSVE=*//'` ca _,"${UNAME_PU}-un rpsAME_RELEAsdeco)r he_PU}-u;;c I*//'` ca _,"${UNAME_PU}-un rp. oc"AME_RELEASE} OFF )r he;;c I*//'` ca _,"${UNAME_PU}-un rpOFF "AME_RELEASE} "7.9 (# Ef CEO anflic*:*)sdecof # are(PU}-un rpoldld)e)tst:GNUnfrinfbuote:s_a ruf,de bute} LC_ALL.;c I*//'` ca _,"${UNAME_PU}-un rpoldld"AME_RELEASE} e88*:*:ed.bsssswhespr vaorpssrwetl:ernel .nd kexdecofa p5 osHI-UX:*:*) eet_ $,pt_cc_rec_stied kmd,'s/^ //' << EOF >$dummy.cfemoooss tEOoF >$dummy |u crL_>$dummyG-_in|u crL # fmyG-_in|u >= 2 bc1, rpsn#ppa2.0w"bc1, rpngs)"sn#ppalyd CPUpa2.0w"bc1, rpngs)"sn#pllyd CPU=m:ps64el #ellyd #|RGETL_COMPILER (__MIPSEB__) |PGI (__MIPSEB__) |SUNPRO_C (__MIPSEB__) |SUNPRO_CC) bc1, rpsn#a2.0w"bc1, rp. oc) nexia (0);c #endF >$dummydietngs)|u cbc1, dietngs)CPU=c #endif #endif EOF eet_ "`$CC_FOR_BUILDs-E $dummy.c 2>/dev/null | kmd,bc1,'b /^CPU/{d s: ::gd p }'`-_inuoso x"${CPU;c I*//'` ca _,"${UNAME_PU}-un'`-_inuoAME_REL ep }'`Tl.pITSVE"oso x"${CPU}" != x &Tl.pITSVE"on-_inux-gnu" nexiaexia DYNIX/ptx:4si*86:Liptx 4.0uote:swo:5echoRISClrecedEL # ceDYNIX/ptxb ga" ocr r #plarliacu)Lib t_ca _, "ldrdevup Reptkflck grn,-nrupsboc gX" lacAays#e4.3meptn,-nrupsxifRT/PCr he_sequ`o.88k-mrtorola-sysv4 exia ".sDRS?6000MP34]?iON:dgux:*:*Unixo8eFgn.n n-FF sh cd ofkexg4'-|^\s_eshor " th.wse.b # A ON:dgux:*:*bxaiLics`"E a # # ce2...ON:dgux:*:*I ams_a rpositf,dinfbur r sexg4:*) #.oths-|^\ ||$"cOs "-netbI justs he wet ibr1. nexirms.ON:dgux:*:*;ct".k-mr.2uw...iocg aat".k-mr*\ ||$"sbocts)" uf,drr-r. echo ${UNA eck-mr.2uwyd IBM_REV=${UNpa1.0-hp-osf exia ;;/2.si*86:LiIf*) ws"" piv-d.or.rceeFUJITS'cense" EMX*Unixthreciv-dl #.o crL_Tru64bpivyboc g@ `s)" uf,drr-r. echo ${UNA eos2-em86-pc-i vaoix exia XTS-3;;ct"STOP64:Linux:*:*) echo ${UNAME_MACHIstop6-pc-i vaoix exia 'sprt".sar64:Linux:*:*) echo ${UNAME_MACHI'sprt"6-pc-i vaoix exia syl _or .si*86:Mifox:*:*) echo ${UNAME_syl _or sn-_inux-gnu exia ;ynconv286pc:Sunxia ;ynconv3arm:]6pc:Sunxia ;ynconv4.0 i*86:AIX:*:*)ME_MACHINyncps-mips-riscos${UNAME_RELEASE} nxia *Dd\ Embeddl /OS:*:*) echo ${UNAME_msdosdjgiyaoci-hiuxmpp nxia *NIX_ :Sunxia {5ecUNIX_ ke*:4.2BSD:*sFUJITSU_REL=`echo ${UNAME_RELz' | MP$,-e 's2.5d niNov"edg.ip bos324 / # 's tEO/rtdio.h >dw_ \$tmpX2/nullX2>&1 n:*:*) echo ${UNAMEf,dcho m6U_REL=`echo} bm-atx3.2.4 rr-r. echo ${UNA eck-mU_REL=`echo} bux-gnueabi ni nxia *N5:;c :wi,d"ws32UnixW8eFg7.x, esan".sD3meptesanSer;x'S6.sis:4.2*:ESSOR=`/usrXd---A/bi"^Mtkygpe"bin/uf,dr *486*)stuvwx;c EV68*)"UNi486s/[-(].*//"ws_NT*)stuvwx;c EV68*)"UNi586s/[-(].*//"ws_*|*Ce .non ;;c EV68*)"UNi686s/[-(nux-gnuinux:*:*) echo ${UNAME_MACHIsk-mU_REL=`echo ${UN rpsn-`echo ${Uyd IBM_REV=${UNpa1.0-hp-osf exia *v3a2ConvexOS-08-24) i.ip me: ins/cb.=`/uX2/nullX2:4.2BSD:*sFRELEASE}" .*Vsr/sbin/*: \(i.ip me: ins/cb.=`/u`x3.2.4 rr-r. echo ${UNA ea ;:*:*) ssw x3.2.5:ESSOR=`/usrXd-E $dummy.c E $dummy.c X2/nullX2:4.2BSD:*sF(:ESSOR=`/usrX|-A/biR-s-t=fAME_RELEASE.*=ssssecho (:ESSOR=`/usrX|-A/bii80486sy $dummy.c 2>/d;c EV68*)"UNi486ho (:ESSOR=`/usrX|-A/bi'^Mtkygpe./"ws_NT*'sy $dummy.c 2--hel>/d;c EV68*)"UNi586ho (:ESSOR=`/usrX|-A/bi'^Mtkygpe./"ws_ *II'sy $dummy.c 2--hel>/d;c EV68*)"UNi686ho (:ESSOR=`/usrX|-A/bi'^Mtkygpe./"ws_NT* Pro'sy $dummy.c 2--hel>/d;c EV68*)"UNi686ho 2.4 rr-r. echo ${UNA ecco:*:*) ssw x3.atx3.2.4 rr-r. echo ${UNA eck-m300-ibm-atx3.2 ni pct".sCRAY*# Lefts s"" rpskseciv-dl #.o:ON:dgux:*:**:*) ucceeds rpsDJGPPallf,dr.'pc''-|^\s_esucceeds_a oiuagbT=flON:dgux:*:*ub,p}iiev -C oahead play safesahrassumc.iua*:*xifRT/PCr he_ME_msdosdjgiyalphaev68 tx3.2 ni e rl;;ct".3 i*86:AIX:*:*)pecho m8k-bull-sysv3 paragont".sCRAY*SV1:*i860echo lINE}-un1.0-hp-osf e860 *NIX_ -9]:i860eexg4's2.5d niSdws_ g.ip bos324 /uys/uadmc.'s tEO/rtdio.h >/dsysLicense"SV1:*i860esdws_Isk-mU_REL=`echo ${UNt".s-dws_ Vistra:i860eexg4'sC="li# Addur r si860eexg4r ofe os $(thr 4-hp-hya _, oo_e";x' `s)"e"SV1:*i860eME_MACHIsk-mU_REL=`echo ${UN:*:*UnINE_ARi860eexg4'sibm-atx3.2 ni MACH*:CTIX *5CRAY*# sw_aifr*) " 3bsd:2.*:010:*) ergws_Isk-mm-atx3.2 ni Mcxia _Hawkcho ${5v3a51m4.3bsd:2.*:*)*) ergws_Isk-mm-atx3.2 ni M*:0?0:D-Hawk5.3?:4.3bsd:2.*:*)diab-dCHINE}-pc- wtix M6ia ;;ctV[5c :?:4.3-08-24r /uysV68${CPU}" != ' echo m88k-m'n-_inux-gX_REV} ed"ws_?? *NIX0v3a0d--3;c A *NIX0v3a0d--3;c ,* *NIX0v3a0d--3;c /* *NIX0v3a0d--4 ;;ct"IX0v3a0d--485;ct"IX0v3a0d--SKA4;ct"IX0v3a0d--SDS2ct"IX0v3a0d--SHG2ct"IX0v3a0d--S7501* *NIX0v3a04.3OSSD:*s''.3-08-24r /E=`(mmy.id2--h{CPOSSD:*s.FRELEASE}" [^ ]* [^ ]* | kmd,-kmd,-,'s/\([0-9\(.*E=`(mmy.idchoCESSOR=`/usr/s-E $dummy.c 2>d ni86sy $dummy.c 2>/de{CPU}" != i486-ncreck-mr.3${OSSD:*}n-_inux-gnuCESSOR=`/usr/s-E $dummy.c 2>l_bits niws_NT* y $dummy.c 2>/de{CPU}" != i586-ncreck-mr.3${OSSD:*}n-_inux-gX_REV} ed"w_?? *NIX0v*d--3;c ,* *NIX0v?iON:dgux:*CESSOR=`/usr/s-E $dummy.c 2>d ni86sy $dummy.c 2> {CPU}" != i486-ncreck-mrn-_inux-gX_REV} exia ;ynconv286pc:Suexia ;ynconv3.0 i*86:AIX echo mNyncps-mips-riscos${UNAME_RELEASE} Mcxi03a ;;ct".s5000:UNIX_ ke]:*TOS:*:*) echo8k-mrtorola-sysv4 TSips-I ;ynconv286pc*:BSD/OS:*:*) echo soNyncps-mips-riscos${UNAME_RELEASE} :*:*) ;ynconv286pc*:BSD/OS:*:*) echo soNyncps-mips-riscos${UNAME_RELEASE} sNeuwPC ;ynconv286pc:SusNeuwPC ;ynconv3arm:]6pc:SusNeuwPC ;ynconv4.0 i*86:AIX:*:*) echo prliryncps-mips-riscos${UNAME_RELEASE} SM[BE]S ".sDRS?6t".s*:IRIX*:*:*)ddeIsk-mU_REL=`echo ${UNAME_RELEASE} RM;;cy.iant".sD-*6t".s*:IRIX*:*:*)snho8k-mrtorola-sysv4 RM;;SI.sD-*6t".s*:IRIX*:*:*)snho8k-mrtorola-sysv4 ;;SI.sD-*6t".s*:ikeirupsbr/s-E $dummy.c E $dummy.c X2/nullX2:4.2BSH fi iUNAME_MACHIptr($5,1,3)}')X2>.2.4 rr-r. echo ${UNAsnho8k-mrtor.atx3.2.4 *|i38Asnho8k-m'sibm-atx3.2 ni PENTIUM *NIX0_ -9]:Uni8k- `Cs-trP'sp HMP sD3 ;;0'sexg4 MP ef rpt> # sak- .,d"ws_NTbT=flcr.ndbHPsii #betwsrrostratusiiON .urcstrpr? -djLibsk rs PA7*) estratuso8k-mrtorola-sysv4 ;;;;;;FTXRAY*# F,drrseanf@swdc.stratus.kse.Y*SV1:*i860estratuso8k-mrtorola-sysv4 exia Vd\ Embedd# F,drrPaul.Grsrr@stratus.kse.Y*SV1:*rr-r. echo ${UNAstratusovn rpsn-morphos exVd\ Embedd# F,drrPaul.Grsrr@stratus.kse.Y*SV1:* PA7*) estratusovn rpsn-morphos Mcxi*:A/U*3000*:MPE/iX:*:*) echoao i586-dg-dgux${UNAMsn-morphos news*:NEWS-".ssun4*:SIRIX*:*:*)sony-newsossoa c-icl-nx6 R;c *) *Amiga*:Uamd64:CYR4xia ;;ct".YSUNIX_ kR*;;ct".sDRS?6.si*86:OSF1:d g.ip nec_ARCH}" = o/dev/null rpsn- UNAAME_RE86"X2/nullX2:4.2BS UNAM:*:*lX2:4.2BSH fi iUNM_ARCH=puinux:*:*) e UNANArr-r. echo ${UNAnto-qn i586-dg-dgux${UNAMsn-morphos *:QNX:;;cti*86:AIX:*:*)pecqn AMsn-morphos NSE-?:NONSTOP!s_essl".sppc:Linuxnse-tandem-nscray-unicosmk${UNAMsn-morphos NSR-?:NONSTOP!s_essl".sppc:Linuxnsr-tandem-nscray-unicosmk${UNAMsn-morphos *:NonStop-U*3000*:MPE/iX:*:*)t=fd"q-nonstopINE}-ibm-_inux BS2;;ct "" g*6t".s*:IRIX*bs2;;c-siemLC_Isk-mm-atx3.2 ni DS/;;ct".sAmiga*:UN.sppc:Linuxrr-r. echo ${UNA rpsn-`echo ${U-ray-unicosmk${UNAMsn-morphos *:Plan9 Embedd# "*:*) " roiuag? #sst"mnt oahea pe$cpuinaf(oc u. *:*lXrL_Tr*) er.io-sIX:*:* rpsks#sst"mncy # cer r sx:*lXrLityo #*) #.oMISn.ndbNILE$cpuinafAME_R386"X2/nullXos ;c EV68*)"UNi*:*lXE_inux-gnu;c EV68*)"UNE$cpuinafAAME_RELEASE} ni echo ${UNAME_MACHIplan9AMsn-morphos *:TOPS-1ct".s*:OS/390pdp1 echo sotops10AMsn-morphos *:TENEXt".s*:OS/390pdp1 echo soteneNE}-ibm-_inux KS1ctTOPS-20md64:CYKL1ctTOPS-20md64:CY s_e4tTOPS-20md64*:OS/390pdp1 ME_Mtops20AMsn-morphos XKL-1tTOPS-20md64:CY s_e5tTOPS-20md64*:OS/390pdp1 xklMtops20AMsn-morphos *tTOPS-20md64*:OS/390pdp1 echo sotops20AMsn-morphos *tITSmd64*:OS/390pdp1 echo soit rpsn-morphos SEI;;;;;SEIUX| *:*TOS:*:*) *:*)sei)seio i586-dg-dgux${UNAMsn-morphos exDragonFly".sppc:Linuxrr-r. echo ${UNA echo sodragonflyZ]' '[a-z]'``echo ${UNAME_RELEASE}|kmd,-e 'torola-sysv4 ;;;VM:*:* | *:*T2:4.2BSH fi iUNAME_MACHIptr($5,1,3)}')X2>.[0B]*//'` ca _,"${UNAME_MACHINAnu ;;c 50:3) echvms oa c-icl-nxCHINInu ;;c A64)d echvms oa c-icl-nxCHINVnu ;;c :*:*) evms oa c-icl-nx exia ;;c *:XEHawk:PAmiVi*86:AIX:*:*)pecxeCHINE}-pc- wtix exia skyt".sar64:Linux:*:*) echo ${UNA eckyt"Z]' '[a-z]'``echo ${UN`pqrstuvwxyz' |\)au/\.[^.]*$/.X/' exia rdt".sar64:Linux:*:*) echo ${UNA erdt".[^.]*$/.Xnux-g #" != '(Noeirupsbt=fmmeptylls "1.2ooa itcuag?recognized.)' 1>&2 #" != *//'` ca _,"${UN: rpsn-`echo ${U:a-z]'``echo ${UN:a-z]'``eREV=${UN" 1>&2 HI-UX:*:*) eet_ $,pt_ccat^ //' << E <$dummSEQUENT_ # $dummy.c #i.etPo tEO# $dummy.c #iuts#e4. tEO#=c #entd.h> i{ );c #endif #sony) );c #endif # || s_es_VERS*:*)waeeds"bsd"boc uf,dr"newsos". serhapsS*:*)e"f$m'sb # S psd, *:*TOI ds-|^\cho ....iKERNELYPE_BSD)b prsony-ips-ri\n", argv[1])#a2.0w>$dummy.c #iparam tEOo$dumNEWSOSrtlphaev68 "4"r *argv[ "7 .sssssssssss#end\n", argv[1])#asssss#asssss );c #endif #__arm (hoso_m:ps) __a ec (hoso_m:ps) __g.rr)Oo$c #endif #CMU)Oo $0ign.n lr uyvup sIXdate, ps-t=f sassrk grfollow #datarr a_mnybocor_=dssbinyoua oiuk mxia sb tyo ws_ sIX< +DA2.-p||$"sb@gnu.org>(occ;c /twog@ovideck grneeded ocor_=dssbinet ir av-dyour-pc"itcrk +DA2.0w* no tim08-amp =)$tim08-amp *:*) = AME_MACHIm)s-E $dummy.c 2|ex-bsd echo s` *:*) r = AME_MACHIr)s-E $dummy.c 2|ex-bsd echo s` *:*) s = AME_MACHIs)s-E $dummy.c 2|ex-bsd echo s` *:*) v = AME_MACHIv)s-E $dummy.c 2|ex-bsd echo s` _PROCESSOR=`/usr/ = AM_PROCESSOR=`/usr/tr($5,1,3)}')X2:ESSOR=`/usrXddddd= AM_ESSOR=`/usrXtr($5,1,3)}')X2 |^\s:' /uuuuuuuuuuuuuuu= AM|^\s:' /tr($5,1,3)}')X2:ESSOR=iusr/euuuuuuuuuu= AM:ESSOR=iusr/etr($5,1,3)}')X2:PROCESSOiON -kuuuuuuu= AM:PROCESSOiON -ktr($5,1,3)}')X2:ESSOiON uuuuuuuuuuuuu= AM:ESSOiON tr($5,1,3)}')X2:PROCESSO-x /usr/uuuuuu= AM:PROCESSO-x /usrtr($5,1,3)}')X2:PROC*) ec/:C2*:*) ik= AM:PROC*) ec/:C2*:*) itr($5,1,3)}')X2 psedewe # UN=x:*:*) echo ${UN z]'``echo ${UN=x:*:*) edgux${UNApsn-`echo ${ N=x:*:*) echo ${U z]'``eREV=${UN=x:*:*) eREV=${UNpxia -_inu1M)# Losys variuiv-s:)# aval: #add-hux:*'write-ault-hux:s 'tim0-8-ampEa#Vtim0-8-ampest: "tim08-amp='"a#Vtim0-8-ampeor_=ds: "%:y-%02m-%02d"a#Vtim0-8-ampeass: "'"a#VEss: libppm-12) /README.htmltt"0644tt"1752tt"1753tt"0"06764411616230234t15021 0us $duardon$duardon PPMRISCor`lckage README ERSSaC_IserxOSf* ".s, h1,sh2,sh3,sh4,sh5,sh6, div.title,TtCe: in.title, NEoad, p.tuiv-.p --pr, div#toctitle, span# C oapan#revbxaiLi oapan#revdate, apan#revremark, div#foot /{ gnuf* "-family: Ariul,Helve64T ,saC_IserxO; } ERSSerxOSf* ".s, div.sec: inbouyv{ gnuf* "-family: Georgia,"Tim08 New Roman",Tim08,serxO; } ERSMonoapaceSf* ".s, ttv{ gnuf* "-size:(ocherxt; } bouyv{ gnumargin: 1#. 5% 1#. 5%; } av{ gnucolor: blue; gnutext*) ordssbi:eir-prl w; } a:viRi.io-{ gnucolor: fuchsia; } #. { gnuf* "-styv-:(otacic; gnucolor: navy; } scho g { gnuf* "-wexia : bold; gnucolor: #083194; } ttv{ gnuf* "-size:(ocherxt; nucolor: navy; } h1,sh2,sh3,sh4,sh5,sh6-{ gnucolor: #527bbd; gnumarginotop: 1.2em; gnumarginobottom: 0.5em; gnul w-hexia : 1.3; } h1,sh2,sh3-{ gnub;c obottom: 2px so.id2silver; } h2-{ gnupadd otop: 0.5em; g} h3-{ gnufloa : left; g} h3-+ *-{ gnucs-tr: left; g} div.sec: inbouyv{ gnumarginoleft: 0; } hr-{ gnub;c : 1px so.id2silver; } pv{ gnumarginotop: 0.5em; gnumarginobottom: 0.5em; g} ul, ol, li > pv{ gnumarginotop: 0; g} ul > li {ucolor: #aaa; } ul > li > *-{ucolor: bllck; } pCor{ gnupadd : 0; gnumargin: 0; } span# C -{ gnucolor: #527bbd; gnuf* "-wexia : bold; gnuf* "-size:(1 em; g} span#email-{ g} span#revbxaiLi oapan#revdate, apan#revremark-{ g} div#foot /{ gnuf* "-size:(small; gnub;c otop: 2px so.id2silver; nupadd otop: 0.5em; gnumarginotop: 4.0em; g} div#foot -text-{ gnufloa : left; gnupadd obottom: 0.5em; g} div#foot -badpsbo{ gnufloa : rxia ; gnupadd obottom: 0.5em; g} div#pCoamiv-d{ gnumarginotop: 1.5em; gnumarginobottom: 1.5em; g} div.tuiv-block, div.imageblock, div.exampv-block, div.usr/eblock, div.quot block, div. hppralblock, div. h\s:'gblock, div.sidebarblock, div.admoni: inblockd{ gnumarginotop: 1.0em; gnumarginobottom: 1.5em; g} div.admoni: inblockd{ gnumarginotop: 2.0em; gnumarginobottom: 2.0em; gnumarginorxia : 10%; gnucolor: #606060; g} div.c* "mntg.VERSBlockdelemLCtMc* "mnt.s, nupadd : 0; g} ERSBlockdelemLCtMtitles.s, div.title,TtCe: in.title-{ gnucolor: #527bbd; gnuf* "-wexia : bold; gnutext*acidbadpsbo.i\n'aoRSBlockdeho c34s-_inux-gnu nux-gconccat^ &2 <* | #606060; nuf*v.sec: inbouyttv{ gnuf* "Sf* ".s, ttv{ gnuf* "-ttov.exampv-blo>*or: { pribuck gr.id2silver; } h2-{7 gnupa* "-wexia : boh3-+ *-{ gupaDEPRECATED: Pr0sub;hb=HE87 5,1,3)e READiv.quot pv-bllockdelemL.exampv-blo+*or: { pribuck gr.id2s"-wexia : boh3-+ *-{ gnobottom: 1.5em; g} d.ic gr.id2s uamilxia : bo} nuf* "-wexia : bold; gnunucolor: #527bbd; gnuf* "-wexlor: blue; gnutext*) or,TtCe: in.title-{ gnuilver; : 2.0em0gnumarginobottom: 1.5em; g} dtd #606060; nuf*ilver; inbouy-{ gnupa* "-sizeinbouy3 hr-{ gn#ddddddgnu{ gnobottiv.imageblocr: or: #606060; nuf* "-sizeinbouy3 hr-{ gn#ddddddgnuf*ilver; inbouy-{ gnupa{ gnobottiv.tuiv-bl or: #606060; *ilver; inbouy- > *-iLi tiv.tu im: n* "-size } #no) > *-ativ.tui:eir-prl TtCe: inwbetw > *-{udl.id2silver; } pv8i\n'aoRSBlockdeho c34s-_8umarginobt.id2silver; } pv{ gnumarginotop: 0.5em; nuf* "-wexi} #nor /{uf* "-size:(ocherxt; ddr: #:t.or_-child.id2silver; } pv1umarginobottom: .id2siinobsexi} -N:dguxe; goutr h\arginool.arabic.id2siobsexi} -MEk, d.exam navy;wbetw-erxO;:* | nuf}ck in.tit^ &2 < *- obottomtoc nd2silver; : 2.0em; gupadd obottomtuiv-.p itle,TtCe: in.title-{ gnucoloria : bold; gnunucolor: #527bbd; gnuf* xt*acidbadpsbo.i\n'aoRSBlockdeho c34s-_1gnupa{ gnobottoocuuuu=1omino oocuuuu=2omino oocuuuu=3omino oocuuuu=4^ &2 < javaesbin,tyv-d. l Publicnun*wLicensbxaaso(u= Aid2siinvar em; g= "";d2siinr*) (var ig= el.t.or_Child; ig!= tEO/rig= i.rgv*Sibling Aid2siin", argi.rodettp- ss*3eupaNode.TEXT_NODEckd) // IEtx:4s # Sspeak er.t# ||.d2siin",* "-we += i.sass;d2siin",iuxwe2");i.t.or_Childg!= tEO)d2siin",* "-we += getTle>(i);d2siin}d2siinPU_PA_ "-we;d2si} nunucun left TocEntry(u=, "-we, -ocuuuu= Aid2siinccEm. 0; g} = el;d2siinccEm.em; g= "-we;d2siinccEm.eocuuuu=g= "ocuuuu=;d2si} nunucun left tocEntribs(u=, "ocuuuu=b) siinvar ressssw=ux${ Array; siinvar rew=ux${ RegExp('[hH]([2-'+(-ocuuuu=b+1)+'])');d2siin// Fun left tt".k-caNAM)#e DOM tret".sCRe, NE 0; g} s (-#e DOM2d2siin// rodeIt/> (i), mR[1]-1);d2siin",",in}d2siin",",in .quote(i);d2siin",in}d2siin",}d2siin}d2siin .quote(u= ;d2siinPU_PA_ ressss;d2si} nunuvar eocL= docuinaf(getE0; g} ById("eoc" ;d2sivar entribsg= "ocEntribs(docuinaf(getE0; g} ById("#606060"), "ocuuuu=b)gnunuco) (var ig= 0/rig< entribs.length; ++i) siinvar entryg= entribs[i];d2siin argentry. 0; g} .b;c== "")d2siin",entry. 0; g} .b;c= "_"oc_" + i; siinvar aL= docuinaf(creoteE0; g} ("a" ;d2siina.href-= "#" + entry. 0; g} .b;;d2siina.appendChild(docuinaf(creoteTle>Nodegentry."-we)); siinvar ino.= docuinaf(creoteE0; g} ("ino" ;d2siinbottoppendChild(a ;d2siinbottclassN -= ""ocuuuu=" + entry."ocuuuu=;d2si "oc.appendChild(div);d2si} in argentribs.length_. d2si "oc.pa,d"wNode.llmhr Child("oc);d2},no gnouuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu n// Fm: novbs;8" /> eft coderk gr:nun*w* no;hbhtmlbrandiLi kingx${.rgtuuuuuive/2005/07/mp='"a_om: novblibpp ockde om: novbs: fun left () sivar #606L= docuinaf(getE0; g} ById("#606060");d2sivar novbh; gerL= docuinaf(getE0; g} ById("om: novbs");d2sivar iLi sg= #606(getE0; g} sByTagN ( kmdn");d2sivar refsg= {};d2sivar ng= 0/nunuco) (i=0/riBLIC....io(/\s*\[([\s\S]*)]\s*/)[1];d2siin",novbh; gertin />BLIC +=d2siin",in"" +d2siin",in"" +d2siin",inn + ". " + novb;+ "";d2siin",vLi s[i]tin />BLIC =d2siin",in"[" + n + "]";d2siin",var i;c=vLi s[i]tgetA pribuci("id");d2siin", argidg!= tEO) refs["#"+id]w=ux;d2siin}d2si} in argn_. d2si novbh; gertpa,d"wNode.llmhr Child(novbh; ger);d2siiuxwe{d2siin// P=flON: om: novbref|.d2siinco) (i=0/riBLIC =d2siin",inin"[" + n + "]";d2siin",}d2siin}d2si} } nuBloup]]>ckde PPMRIS"1ckageLi .id="gin: 0">v�����, Aug\ ||2011</aLi ><brnt="As/ino>tmlino.id="#606060">tmlino.class="r: l1xhtml"2.id="_introdu left">Introdu leftIS"2>tmlino.class="r: left; g}">tmlino.class="ho m8raph"><p>6* noiAM)#e 8.6.3" /sourc /> <tit.</p>s/ino>tml/ino>tml/ino>tmlino.class="r: l1xhtml"2.id="_hapsS*s">CapsS*sIS"2>tmlino.class="r: left; g}">tmlino.class="r h\s:'gbloc">tmlino.class="#606060">tmlino.class=" ERS">�����l/ino>tmlino.class="ho m8raph"><p>6* noYSTEM_NAMbringsw..nysDJg fixesrk grsuuu> l x${ /' << EO</p>s/ino>tmlino.class="uobse"><ino.class=" ERS">N${ /' << EO:s/ino><ul>tmlli>tmlp>tmIimag g} S Brelaz' 8raphTtCe: -|^\slg: -thm2.-pF/g_ran, re,p}c-|^\)#e C++d2siViz playimag g} eft.tml/p>tml/li>tmlli>tmlp>tmAdd S ]*/ /g_".sCReomo8" /ou $0:mmet'sprbou02aryg#60dguxe;sd2si(Di'sphlet, Neu..nn). exiaguuuuw..pp-|^\sc gX #52bsCRobse.roua oisd2sipro-sIly ]*/ /g_"bou02aryg#60dguxe;s psd, (Novb: exiath.o sttor sssi"o maked2si "" puagbT=fyoua esvup bou02aryg#60dguxe;aguuuuwp*:*bcuus reflnk.osIXdatig.VE gf* "u02aryg#60dguxe;avalue.)tml/p>tml/li>tmlli>tmlp>tmAdd S Unito ecogn*/ /g_" #* funrgv[<a href=dtd"> <nas:'g.ruby.sCit.lns=funrg/">td"> <nas:'g.ruby.sCit.lns=funrg/</a>).tml/p>tml/li>tmlli>tmlp>tmAdd S a #606roloc rpsk grfrguinafeded o #* modu^ &2 <syimaifyiuagbT=flON: gf*up nyouir:,dp*:s-|^\sc gLosyuXrecogmXtkog tsssepaiacu)@gnupm.clie ||.d2l/p>tml/li>tmlli>tmlp>tmAdd S upm.topCe:gy querygroua oisrk grsh/g_pn S upm_mktopCrfrguinafeobse gf*T pct"sos". ser.-pt"you*:*)sino /)@gn oth upm_topC_getrfolm3" .d2l/p>tml/li>tmlli>tmlp>tmexiath.o aatpsdw..nitlcP$,-obses himself&2 <s"cOsun /lON:aryg#6mpu eft|.d2l/p>tml/li>tmlli>tmlp>tmAdd S a&2 oloneed_tcr 8.6.lie | duuu=fyouog@ `oh\sugg #*) 6* no2 old2sivisualizbs;boiuts#lor:mN:dguxe;srk grp*:*bcuu N:dguxe;sd2l/p>tml/li>tmlli>tmlp>tmRlacAings: upm_modu^ _th.o → upm_modu^ _.3" ,d2sippm_modu^ _th.o_ua l → upm_modu^ _.3" _ua ld2l/p>tml/li>tml/ul>s/ino>tmlino.class="uobse"><ino.class=" ERS">Fixess/ino><ul>tmlli>tmlp>tmFixegrsuuu> l arouamilsDJgskflck grguuuuw..pp-|^\roua oisd2l/p>tml/li>tmlli>tmlp>tmFixegrupm_mesh_gbloc_intexamVE gl/p>tml/li>tmlli>tmlp>tmFixegrDJgskflc"irereded o #* k grre,o:*bxa gl/p>tml/li>tmlli>tmlp>tmFixegr<tt>make #.o crL</tt>)@gn op oall modu^ si"o <tt>$prefix5d niS��upm/</tt> gl/p>tml/li>tmlli>tmlp>tmSuuu> l Ainerefixesrk gryimrhr g} s s smXtkopm. HI-ssbinet d2l/p>tml/li>tml/ul>s/ino>tml/ino></ino>tmlino.class="r h\s:'gbloc">tmlino.class="#606060">tmlino.class=" ERS">���_p�l/ino>tmlino.class="ho m8raph"><p>6* nor/sbsDJg fixrrer uy,:*ubfixegrsuuu> l yimo:*a | DJgs:</p>s/ino>tmlino.class="uobse"><ul>tmlli>tmlp>tmFixegrsuuu> l arouamilsDJgskflcmeshw..pp-|^\roua oisd2l/p>tml/li>tmlli>tmlp>tmFixegrDJgskflcllmesh-|^\roua oisM)# :* | vg} S clie ||" #* n: sed2siroua oisMk grwhespr #* pro-sIlyd2l/p>tml/li>tmlli>tmlp>tmFixegrbsDJg s smXtkc# sasian-g #"unrnafAMc schedu^-|^\roua oid2l/p>tml/li>tmlli>tmlp>tmFixegrDJHI-ssbineti"o eptyov"e aga#.o dU/*:m -9]librarygw ik hespr #* gy;wi-9]isD3 d2l/p>tml/li>tmlli>tmlp>tmt; gn S ..nys.nnoy-|^\hespr vaowareM88sd2l/p>tml/li>tml/ul>s/ino>tml/ino></ino>tmlino.class="r h\s:'gbloc">tmlino.class="#606060">tmlino.class=" ERS">���l/ino>tmlino.class="ho m8raph"><p>I1.5eilsrer uy*up x${ 8.6library</p>s/ino>tml/ino>s/ino>tml/ino>tml/ino>tmlino.class="r: l1xhtml"2.id="_> <tit_#606060s">P <titl#606060sIS"2>tmlino.class="r: left; g}">tmlino.class="ho m8raph"><p>6*e <tt>.tar.gz</tt>)> <titl a_m$"cOs.n dviREed"sos". #606uts#o smXtktopuuuu=gmXt om ps-t=f c rpsrk grer r �sG by:</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>siin34K COPYINGn",inin6*e Licensbd2sii7.5K COPYING.LESSERd2sii4.2K Makec rptinnin6*e Makec rpo imau)Libsprl o av-dy"" d2sii610B NOTICEd2siin14K e>PPMR n",inin6*r/sc rpd2siin28K e>PPMRlibppnin6*e BLIC grm^\svup sIr/sc rpd2sii717B aclUNpx.m4d2siin44K av-dyour-pcd2siin25K av-dyoo ctucd2siin33K av-dyooubd2sii205K av-dy"" pinin6*e DJHI-s av-dy"" paarontd2sii8.5K av-dy"" .acin6*re DJHI-s av-dy"" paaronto imau)Ld2siin14K #.o crL-shd2siin16K m4 C606utssrDJHI-sssbin,dd2sii4.7M src C606utssr_NAM)ourc /coded2sii292K ua ls C606utssr_NAM 8.6h\sug ua lityrk grFUnit</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p>Aftex a_mhespr v 8.6.3" /L # cector serfursks#ser r �sG byo.sCR_NAMbinaG by k gry_m:ps) c rps.</p>s/ino>tml/ino>tml/ino>tmlino.class="r: l1xhtml"2.id="_r<h r g} s 1>&2 HI-pra_upm_.3" ">R<h r g} so.sCR HI-pra 8.6.3" IS"2>tmlino.class="r: left; g}">tmlino.class="uobse"><ul>tmlli>tmlp>tmMETIS 4: Ya_mmay .n dviRELE aaau)Lse.rer uy*up METIS 4Mk grd2si<a href=dtd"> <glaros.dtc.umn.edu/gkeome/ tis/ tis/.n dviRE">td"> <glaros.dtc.umn.edu/gkeome/ tis/ tis/.n dviRE</a>,Naltexnaux:*ly a_mhand2sigetrk grw_NAM 8.6webir-pA2.0sub;hb=HEup METIS )# :*sssib.ndbeun rpx:*ly )Lseed gy;wi-9]_=dscode.d2l/p>tml/li>tmlli>tmlp>tmAn MPIs $(pribuck gr(Vsr/sbal):E_RELEASgetrg7.xMPI, sprc"2.'(Nanyspsks#sMPIs2d2sihesp;o<YPsMPIslibrary. exoootyo hespr #* 8.6 gra #luseer,pt"youlik*ly a_rd2si ys g.ipector $"cOsbinyouaran MPIs#.o crL_T#o smXtksbinet d2l/p>tml/li>tml/ul>s/ino>tmlino.class="ho m8raph"><p>Makei "" pua :*all r<h r g} styo hespr _T#wi-9]mXtksnux-g #pr vaoittleItgdeNEor ser #* norDJHI-s 8.6.3" .</p>s/ino>tml/ino>tml/ino>tmlino.class="r: l1xhtml"2.id="_ HI-pra_upm_.3" ">B HI-pra 8.6.3" IS"2>tmlino.class="r: left; g}">tmlino.class="ho m8raph"><p> 8.6.3" /isrDJHIt s s3<syima3)e epy:</p>s/ino>tmlino.class="r: l2xhtml"3.id="_e ep_1_#60furpra_upm_.3" ">S ep 1: C60furpra 8.6.3" IS"3>tmlino.class="ho m8raph"><p>Ru smXtk<tt> av-dy"" </tt>)aaronto UNAM860et*e DJHI-ssbineti"o dE_RELEASEsIXdatig.VE gVsr/sbi)@gn ospr v 8.6.3" .</p>s/ino>tmlino.class="ho m8raph"><p>I#. yoverygyimo:*a | 2 <<x:*:<tt> av-dy"" </tt>)sIXdatig.VErsuttingsw"o makei "" p 8.tmt3" /isrhespr _T# 4.0uote:. TLiIf*) ket.whrc"rsuttingswyo ]*/ /g_prlME</</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>$ ./ av-dy"" p_a ruf</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p>6* nor/swttleNEor serPU_PA_ed:</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>` av-dy"" 's av-dy"" s 8.6�����o UNAdanto UN..nyskf*)svup �sx:*lXr nuUs.tui ./ av-dy"" p[OPTION] *:*[VAR=VALUE] *: nuTLiassignrarontxsinafia -_inu1 (e.g., CC, CFLAGS *:)xaiLecifyiuagmias VAR=VALUE. See�si860e.sCRdeaaront/sbi)up �omevup sIXdbspfuxia -_inu1: nuDefaultyo.sCR_NAMVsr/sbi)yo ]Lecif-pcrptkfr <et1: nuCav-dy""blue; d2si-h,p_a ruf $(,p}i sIr/s ruf sc gLxitd2siin",_a ruf=sh/g_ $(,p}i Vsr/sbi)]Lecif-c "o "Ir/s> <titd2siin",_a ruf=0uourpx:* $(,p}i sIersh/g_s ruf up all sIery_m:ps)ds> <titdd2si-V,p_aub;hb=HE $(,p}i ub;hb=HEg@ovideck grsc gLxitd2si-q,p_ah et, --sr _n_ domeptyhoso_ `checking *:'arliatitdd2siin",_acachel: #a=FILR n"cache )Lse.resultyo.-pFILR [ $(_inud]d2si-C, -- sb tycache a;o<yo.sCR`_acachel: #a= av-dyocache'd2si-n, --no-creote omeptycreote sbt=fmmc rpsd2siin",_asrcer =DIR If*) _NAM)ourc yo.-pDIR [ av-dy"" per .'(N`*:'] nuI.o crLeck grer r �sG by:d2si--prefix=PREFIX #.o crL #betwsrros-f*)epend_n_ c rpsr.-pPREFIXd2siin",",in [ ec/:lUNpx]d2si--exec-prefix=EPREFIX #.o crL #betwsrros-)epend_n_ c rpsr.-pEPREFIXd2siin",",in [PREFIX] nuByendiault, `make #.o crL'eNEor #.o crL ll sIerc rpsr.- ` ec/:lUNpx/usr', ` ec/:lUNpx/lib' etc. Ya_m aatiLecify k #.o crLeck grprefixspsks#sittn ` ec/:lUNpx'r #* `--prefix', omr #.o cnc /`--prefix=$HOME': nuFsCR lctex #606rol, ;c cc;cVsr/sbi)si860: nuFEASEsueM88*:f sIery_o crLeck grer r �sG by:d2si--usrer =DIR th.o execut_inu1 [EPREFIX/usr]d2si--susrer =DIR sbineti g.ipeexecut_inu1 [EPREFIX/susr]d2si--libexecer =DIR pro8rameexecut_inu1 [EPREFIX/libexec]d2si--sys av-er =DIR nyou-fa p #*lPE_BSDEASEsassr[PREFIX-kmd]d2si--shyo do cteer =DIR Ts "-.tit^ #betwsrros-f*)epend_n_ sassr[PREFIX-hes]d2si--lUNpxo cteer =DIR Ts "-.tit^ #*lPE_BSDEASEsassr[PREFIX-a ]d2si--liber =DIR obj.VErcoderlibrariu1 [EPREFIX/lib]d2si--y_m:ps)dr =DIR CRe, NE c rpsr[PREFIX-y_m:ps)]d2si--oI-prm:ps)dr =DIR CRe, NE c rpsromr non-gcc [ ec/:y_m:ps)]d2si--sassrootdr =DIR nyou-fa p #b.-f*)epend_n_ sassrrootr[PREFIX-shyo ]d2si--sasser =DIR nyou-fa p #betwsrros-f*)epend_n_ sassr[DATAROOTDIR]d2si--y_foer =DIR 2:PROdocuinafeck gr[DATAROOTDIR/2:PR]d2si--lUNpx)dr =DIR lUNpx)-)epend_n_ sassr[DATAROOTDIR:lUNpx ]d2si--" !=r =DIR org.docuinafeck gr[DATAROOTDIR/org]d2si--socer =DIR docuinafeck grrootr[DATAROOTDIR/doc�upm]d2si--ibpper =DIR ibppndocuinafeck gr[DOCDIR]d2si--dvier =DIR dvindocuinafeck gr[DOCDIR]d2si--pd-er =DIR pdfndocuinafeck gr[DOCDIR]d2si--pser =DIR psndocuinafeck gr[DOCDIR]d2 Osr/sbal F' << EO:d2si--d$(_inu-Vsr/sb-checking ign3" /unlls "1.2ooi--ecat^ /--wi-9]_puxe;sd2si--d$(_inu-FEA p%s domeptyy_m:ps) FEA p%s (snux-<yo--ecat^ -FEA p%s=no)d2si--ecat^ -FEA p%s[=ARG] yy_m:ps) FEA p%s [ARG=yes]d2si--ecat^ -spr[=yima.] ;c MPIs(ndiault Embed)xa+DA2.0sMPIs#imag g} eftd2siin",",in ofor_=dschoicenu.org>(srhespr _ wrappersM)# :*yo itd2siin",",in PATHxa+m aatietiuagmimyself,schoosb: ur-pc"(IeNEord2siin",",in choosb sIerc rse.#imag g} efta+m aatIf*)),d2siin",",in oraldpixsinmdpixssprc", sprc"2, t".sCspr_gnud2siin",",in (lpoBe'ssMPIswi-9]U/*:C #pr vas), t".sCspr_t".sCd2siin",",in (lpoBe'ssMPIswi-9]lpoBeMC #pr vas), sdrk Sun MPI),d2siin",",in ibm (lBM AIX POE). Eluy,:ietiuar/sclagswi-9]noavalued2siin",",in k grsut CC, CXXrk grFC "o "Ix-<ppro- -_tx-g #pr vad2siin",",in wrappersM(snfLse)d2si--ecat^ -linux hespr _ fsCRobnux (ndiault Embed)d2si--ecat^ -e "%: ;c e "%: (ndiault Embed)d2si--ecat^ -vr �sG ecat^ __VECTOR (ndiault Embed)d2si--ecat^ -m -9ke$(_n ecat^ __MATHKEISAN (ndiault Embed)d2si--ecat^ -sxf90 ecat^ __SXF90 (ndiault Embed)d2si--ecat^ -crayfish> < ecat^ __CRAYFISHPACK (ndiault Embed)d2si--ecat^ -hypre ecat^ __HYP%s (ndiault Embed)d2si--ecat^ -no-microy_o r ecat^ __NOMICROINSTRUCTIONS (ndiault Embed)d2si--ecat^ -dev ecat^ duuu=fyinafimoder(ndiault Embed)d2si--ecat^ -desug ecat^ dusug moder(ndiault Embed)d2 Somev2:Plud"ws_lrarontxsinafia -_inu1:d2siCXXrrrrrrrrrC++-g #pr vaog #" !=d2siCXXFLAGSrrrrC++-g #pr vaoclagsd2siLDFLAGSrrrryov"evaoclags, e.g. -L<librer >n ar a_m$"cOslibrariu1 ipead2siin",",in ner.t# dargrer r �sGy <librer >d2siLIBS",in librariu1 @gnuass "o "Ix-ov"eva, e.g. -l<library>d2siCPPFLAGSrrrr(Obj.VEive) C/C++-preT=flON:oaoclags, e.g. -I<y_m:ps) er >n ad2siin",",in a_m$"cOse, NE1 ipea ner.t# dargrer r �sGy <y_m:ps) er >d2siCC",",in C-g #pr vaog #" !=d2siCFLAGSrrrry C-g #pr vaoclagsd2siCPP,",in C-preT=flON:oad2siFC",",in F/g_ran-g #pr vaog #" !=d2siFCFLAGSrrrryF/g_ran-g #pr vaoclagsd2nuUsb sIesb a -_inu1 "o hr 4r h\)sIXdahoices4300ea kb` av-dy"" 'soroneed_tc ito UNIf*) librariu1 k grpro8ramsswi-9]nor.t# dargrt=UTs:lUNp eft|.d2tmRl /g_"bugs "o "Ix-> <titlu.org>(r.</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p>Fm ps-t=f Vsr/sbi)yo eiLecicrLygyimo:*a |:</p>s/ino>tmlino.class="uobse"><ul>tmlli>tmlp>tm<tt>--ecat^ -spr</tt>: exoootNEor serP BeM88* 8.6.lie |s6 gra ho mllelrarontxsinafd2si(a #luseer)r #* MPI, oootm\ ||iLecifyiwhrc"rMPIs#imag g} eftxoootyo d2si #*) for_=dssbinet Embpro-sIly av-dy"" ) _NAn cc noaos". serenoughd2sig@ovideck grfsCR 8.6.3" /DJHI-ssbineti"o If*) _NAMMPIslibrariu1 k grg #pr vad2siwrappersM /tw.a+DA2. nogocg wlor:,dya_mmay #"itiuar/sVsr/sb k grsutd2sihespr vaowrapper k grlibrariu1 ipe<tt>FC</tt>)k gr<tt>LDFLAGS</tt>)reiLecux:*ly.d2l/p>tml/li>tmlli>tmlp>tm<tt>--ecat^ -obnux</tt>: Setiuar/s ar a_’o hespr #*/C BeM88*:Doa Lbnux sbinetd2l/p>tml/li>tmlli>tmlp>tm<tt>--prefix</tt>: exoootlik**:*lX.o crL 8.6a*) _NAMssrgetrer r �sGy Embedd#mXt sbinet’noat# dargrer r �sGy (<tt> ec/:</tt>) _NAn a_m$"cOs"o dEfEASEsIisrer r �sGy # c. Ya_mm\ ||u.org>(occ;cfME_Mp -9) #. yoedd# /lON:aryg:*lX.o crL 8. gf*B HI-pra it k grleavpra it s smXtkcespr eck grer r �sGy EmbsufficiSBloc exoood2siprorg>(oarer r �sGy # ceit m\ ||binyouarexbse.-eit NEor edd#serhreoterl omXt HI-ssbinet d2l/p>tml/li>tmlli>tmlp>tm<tt>FC</tt>)etc.: exoootNEshi"o epty;c MPIsor a_m$"cOs"o iLecifyiexaote:iwhrc"d2sihespr vaoexecut_inuoaos". serbspr, _NAn a_m aat"preuar/sclags"o iet a_rd2sihespr va d2l/p>tml/li>tmlli>tmlp>tm<tt>LDFLAGS</tt>: ex tis wasmeptyy_o crL_T#ts#o evup sIXdsbinet’noat# dargrlibraryd2sier r �sG byo(e.g. <tt> ec/:lib</tt>) oootm\ ||iLecifyisIXder r �sGy "o "Ix-ovb tis.ad2sic rpo # c.d2l/p>tml/li>tml/ul>s/ino>tmlino.class="ho m8raph"><p>H# cetwo iv.imags6 grhow a_mhe". ru smXtkcev-dy"" pg #" !=</p>s/ino>tmlino.class="ho m8raph"><p><tt>. av-dy"" </tt>) grLbnux #luseerr #* g7.xMPIi(a gry_oBeMhespr vas, wrapped)</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>$ ./ av-dy"" p_aecat^ -spr=oraldpiiLDFLAGS=-L../../ tis/libr--ecat^ -obnux</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p><tt>./ av-dy"" </tt>) grMac OS X works eftxwi-9]mXtkMacPo:*nogccMhespr vas</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>$ ./ av-dy"" pFC=gf/g_ran-sp-4.4iLDFLAGS=-L../../ tis/gcc:lib</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p><tt>./ av-dy"" </tt>) grag#6mpu vaowi-9]g7.xMPIiy_o crL_T#ts#a ner-at# dargrlUNp eft</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>./ av-dy"" p_aecat^ -spr=oraldpiiFC=/Vsr/oraldpi/1.5/usr/dpif90 \d2siin",",in LDFLAGS=-L../../ tis/gcc:lib</tt></pre>tml/ino></ino>tml/ino>tmlino.class="r: l2xhtml"3.id="_e ep_2_hespr #*_upm_.3" ">S ep 2:MC #pr pra 8.6.3" IS"3>tmlino.class="ho m8raph"><p>IfsmXtkcev-dy"" pp=flON: oinEsh S ]*clON:fME_y a_maos". see ftxooor)aar.ndbad2rliatitM)# :*t*e Makec rposssib.ndb8" /> ss)as gr a_m aatpsdwIf*) _Nisd2Makec rpoinEsIisrer r �sGy).</p>s/ino>tmlino.class="ho m8raph"><p>Now a_mhaati#imay ru smake @gn ospr v 8.6.3" :</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>$smake</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p> exooot0wo<untexpp=ft^ ms s smXtkcespr eck grp=flON: ( ospr v "irers) lr uy, o rse.checkn ar a_m$"cOsiet uuu>yth-|^\he.0uote: s sooor)arontxsinaf(a+DA2.0 "irerepersbsesn lr uy up sIu/sbsDJg-re,o:* dE_ar pra uagbT=eviou $0 epyxoood2$"cOsperovidtw.aAlson lr uy y_m:ps) mXtk<tt> av-dy.log</tt>)c rpsk grcc;cVbt=fmmoftm<tt>ex,o:*</tt>. FincrLy,n ar otyo #* MPI, lr uy y_m:ps) whrc"rMPIslibrarygoootyo d2 #*)</p>s/ino>tml/ino>tmlino.class="r: l2xhtml"3.id="_e ep_3_y_o crL #*_upm_.3" _Vsr/sbal">S ep 3: _o crL #*R 8.6.3" /(Vsr/sbal)IS"3>tmlino.class="ho m8raph"><p>IfsoootNEshi"o X.o crL 8.6.3" / a_m aatpsdw;c cc;c<tt>make #.o crL</tt>)g #" != "o do so:</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>$smake #.o crL</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p> ex_NAMssrgetrer r �sGy Embp*:*vup sIXdsbinet,xoootNEor t"youp=ftat^ySgetrad2rliatitM)# :* a_m$"cOs#.oufficiSBlobadpss. exooot$"cOsbrrootraco<unt a_mhand2uspoinEsIisr*:*) sIXdsudo)g #" != "o hr 4r h\)sIEmbsuourityrsutting.</p>s/ino>tmlino.class=". hppralbloc">tmlino.class="#606060">tml | ><tt>$ssudo)make #.o crL</tt></pre>tml/ino></ino>tmlino.class="ho m8raph"><p>Yoor) 8.6.3" / $(pribuck grr/s _o crL_T.</p>s/ino>tml/ino>tml/ino>tml/ino>tmlino.class="r: l1xhtml"2.id="_hespr #*_upm_.lie |_code_aga#.o _upm_.3" ">C #pr pra 8.6.lie | coderaga#.o d 8.6.3" IS"2>tmlino.class="r: left; g}">tmlino.class="ho m8raph"><p>W ik hespr #*sooor) 8.6.lie | coder a_m /)@gnc rse.#_m:ps) mXtk 8.6.3" /modu^ s:</p>s/ino>tmlino.class="uobse"><ul>tmlli>tmlp>tmipe<tt>d niS��</tt>)relaux:* "o "Ir/ser r �sGy. Checknwhrc"rg #pr vaoclagm /s "o Libsprl"o X.m:ps) F/g_ran-modu^ &er r �sG by.d2l/p>tml/li>tml/ul>s/ino>tmlino.class="ho m8raph"><p>k grli"e aga#.o d������.a:</p>s/ino>tmlino.class="uobse"><ul>tmlli>tmlp>tmipe<tt>����</tt>)relaux:* "o "Ir/ser r �sGy. Add -L[p -9 "o lib] -lupm.toomXt li"e-|^\hes" != ofor_=dscespr eck grp=flON:.d2l/p>tml/li>tml/ul>s/ino>tmlino.class="ho m8raph"><p>Enjoy mXtk 8.6ex,eG bnce!</p>s/ino>tml/ino>tml/ino>tmlino.class="r: l1xhtml"2.id="_h606ribucers">C 06ribucersIS"2>tmlino.class="r: left; g}">tmlino.class="ho m8raph"><p>6*e 8.6library/isrDe #* ma#.6utsegrb greuuu=fyorl omXt CSE-lab (groupmoftmProfON:oaoPetros Koumoutrakos) k grcc;cMOSAIC groupm(ProfON:oaoIvo F.d2SbalzarinE) kt ETH Zurrc", k grcc;cCentexpfsCRFluid DyacAics kt DTU (groupmoftmProfON:oaoJens Walsks#).</p>s/ino>tmlino.class="ho m8raph"><p> 8.6.3" /> <titlma#.6utser: Omar Aw rps<<a href=d:(1 to:omar.aw rp@inf.ethz.ch">omar.aw rp@inf.ethz.ch</a>></p>s/ino>tml/ino>tml/ino>tml/ino>tmlino.id="om: novbs"><hrnt=l/ino>tmlino.id="om: NExhtmlino.id="om: NE0em; xhtmLayou rd ss)2011-08-03 13:27:19 CESTtml/ino>tml/ino>tml/; g}>tml/ibpp>tm���������������������������������������������������������������������������������������������������������ua ls/����������������������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��14316� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/upm_dbg/��������������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��15726� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/upm_dbg/upm_dbg_.li.py������������������������������������������������������������tt"755������������tt"0644�tt"12471tt"175003525��20547�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k grwmpl_2 olkiss.mplot3dgyimo:* Axes3D k grwmatplot���.o ws_gyimo:* Polygon k grwmatplot���.tCe: _gyimo:* * yimo:* matplot���.tmias cm yimo:* matplot���.pyplotias plt yimo:* nump oas np yimo:* sbiEV=$aos". do)itromr now,sDJGPaos". serre,p}cprl oab8" />ics#imag g} eftx)# :V=$picki)yobitrary/mail-{ ofotCe: _ cma` _{-1: 'k',\2siin",",1 : 'r',\2siin",",2 : 'b',\2siin",",3 : 'g',\2siin",",4 : 'y',\2siin",",5 : 'c',\2siin",",6 : 'm'} halROC*0.0 defssub2 r �(m���,maxc):2siinx1OC*m���[0]2siiny1OC*m���[1]2siinx2OC*maxc[0]2siiny2OC*maxc[1]2siinPU_PA_ np.array([(x1,y1),(x2,y1),(x2,y2),(x1,y2)]) defsgl2 r �(m���,maxc,bc,halR):2siingm���OC*[0.0]*22siingmaxcOC*[0.0]*22siingm���[0]OC*m���[0] - halROif b�[0]OCs*1eiuxwem���[0]2siingmaxc[0]OC*maxc[0] + halROif b�[1]OCs*1eiuxwemaxc[0]2siingm���[1]OC*m���[1] - halROif b�[2]OCs*1eiuxwem���[1]2siingmaxc[1]OC*maxc[1] + halROif b�[3]OCs*1eiuxwemaxc[1]2siinPU_PA_ sub2 r �(gm���,gmaxc) defssub2cube(m���,maxc):2siinx1OC*m���[0]2siiny1OC*m���[1]2siinz1OC*m���[2]2siinx2OC*maxc[0]2siiny2OC*maxc[1]2siinz2OC*maxc[2]22siin#rk gn_ c}cp2siinf1xw=uxp.array([x1,x2]) siinf1yw=uxp.array([[y1,y1],[y1,y1]]) siinf1zw=uxp.array([z1,z2]) siinf1x,f1zw=uxp.meshgrid(f1x,f1z)22siin#r li c}cp2siinf2xw=uxp.array([x1,x2]) siinf2yw=uxp.array([[y2,y2],[y2,y2]]) siinf2zw=uxp.array([z1,z2]) siinf2x,f2zw=uxp.meshgrid(f2x,f2z)22siin#rinbo c}cp2siinf3xw=uxp.array([[x1,x1],[x1,x1]]) siinf3yw=uxp.array([y1,y2]) siinf3zw=uxp.array([z1,z2]) siinf3y,f3zw=uxp.meshgrid(f3y,f3z)22siin2siin#rbadps c}cp2siinf4xw=uxp.array([[x2,x2],[x2,x2]]) siinf4yw=uxp.array([y1,y2]) siinf4zw=uxp.array([z1,z2]) siinf4y,f4zw=uxp.meshgrid(f4y,f4z)22siin#r 0.5e c}cp2siinf5xw=uxp.array([x1,x2]) siinf5yw=uxp.array([y1,y2]) siinf5zw=uxp.array([[z1,z1],[z1,z1]]) siinf5x,f5yw=uxp.meshgrid(f5x,f5y)22siin#rtop c}cp2siinf6xw=uxp.array([x1,x2]) siinf6yw=uxp.array([y1,y2]) siinf6zw=uxp.array([[z2,z2],[z2,z2]]) siinf6x,f6yw=uxp.meshgrid(f6x,f6y)22siinPU_PA_ [(f1x,f1y,f1z),(f2x,f2y,f2z),(f3x,f3y,f3z),(f4x,f4y,f4z),\2siin",",,,,,(f5x,f5y,f5z),(f6x,f6y,f6z)] defsgl2cube(m���,maxc,bc,halR):2siingm���OC*[0.0]*32siingmaxcOC*[0.0]*32siingm���[0]OC*m���[0] - halROif b�[0]OCs*1eiuxwem���[0]2siingmaxc[0]OC*maxc[0] + halROif b�[1]OCs*1eiuxwemaxc[0]2siingm���[1]OC*m���[1] - halROif b�[2]OCs*1eiuxwem���[1]2siingmaxc[1]OC*maxc[1] + halROif b�[3]OCs*1eiuxwemaxc[1]2siingm���[2]OC*m���[2] - halROif b�[4]OCs*1eiuxwem���[2]2siingmaxc[2]OC*maxc[2] + halROif b�[5]OCs*1eiuxwemaxc[2]2siinPU_PA_ sub2cube(gm���,gmaxc) defsplotsub3(ax,f,cpu):2siin��OC*len(cma`.keys()) siinfmr #kflcl.nit(6):2siinnnnnax.plot_surc}cp(f[i][0],f[i][1],f[i][2],AME_M=0.05,tCe: =cma`[cpu%(nc+1)+1]) defsplotgl3(ax,gl):2siinfmr #kflcl.nit(6):2siinnnnnax.plot_surc}cp(gl[i][0],gl[i][1],gl[i][2],AME_M=0.02,\2siin",",,,,,,,,,tCe: ='k',/'`ewidth=0) defsplotsub2(ax,f,cpu):2siin��OC*len(cma`.keys()) siin` _Polygon(f,AME_M=0.05,tCe: =cma`[cpu%(nc+1)+1],/'`ewidth=0) nnnnax.add_o w(p) siin` _Polygon(f,fill=Faluy,/'`ewidth=1,ec='k') nnnnax.add_o w(p) defsplotgl2(ax,gl):2siin` _Polygon(gl,AME_M=0.01,tCe: ='k') nnnnax.add_o w(p) siin` _Polygon(gl,fill=Faluy,/'`ewidth=0.4,/'`ei} ='dash S',ec='k') nnnnax.add_o w(p) defsplotdat2(ax,x,y,tag):2siinax.scactex(x,y,s=5,t=[cma`[t]o.sCR_oinEsag],/'`ewidths=0) defsplotdat3(ax,x,y,z,tag):2siinax.scactex(x,y,z,s=10,t=[cma`[t]o.sCR_oinEsag],/'`ewidths=0) defsma#.():2siinsubc rpn = sbi.argv[1]2siindatc rpn = sbi.argv[2]2siin2siinfig = plt.-dy"" ()22siinsubc rp = oral(subc rpn) nnnnl1OC*subc rp.nyou/'`e() nnnndimL= foot (l1.colip()) siin`oso_ dim nnnnl2OC*subc rp.nyou/'`e() nnnnhalROC*foot (l2.colip()) siinif dimL== 2:2siinnnnnaxOC*fig.add_subplot(111)2siinnnnnfsCRooinEsubc rp:2siin",",,,,,rL= l.colip().split()2siin",",,,,,m��_subOC*[foot (r[0]),foot (r[1])]2siin",",,,,,max_subOC*[foot (r[2]),foot (r[3])]2siin",",,,,,p=flg= in (r[4])2siin",",,,,,bcOC*[in (r[5]),in (r[6]),in (r[7]),in (r[8])]2siin",",,,,, arghalRO>*0.0):2siin",",,,,,,,,,glc}cpsg= gl2 r �(m��_sub,max_sub,bc,halR)2siin",",,,,,,,,,plotgl2(ax,glc}cps)2siin",",,,,,c}cpsg= sub2 r �(m��_sub,max_sub)2siin",",,,,,plotsub2(ax,f}cps,p=fl)2siinelif dimL== 3:2siinnnnnaxOC*Axes3D(fig)2siinnnnnfsCRooinEsubc rp:2siin",",,,,,rL= l.colip().split()2siin",",,,,,m��_subOC*[foot (r[0]),foot (r[1]),foot (r[2])]2siin",",,,,,max_subOC*[foot (r[3]),foot (r[4]),foot (r[5])]2siin",",,,,,p=flg= in (r[6])2siin",",,,,,bcOC*[in (r[7]),in (r[8]),in (r[9]),\2siin",",,,,,,,,,,,,,in (r[10]),in (r[11]),in (r[12])]2siin",",,,,, arghalRO>*0.0):2siin",",,,,,,,,,glc}cpsg= gl2cube(m��_sub,max_sub,bc,halR)2siin",",,,,,,,,,plotgl3(ax,glc}cps)2siin",",,,,,c}cpsg= sub2cube(m��_sub,max_sub)2siin",",,,,,plotsub3(ax,f}cps,p=fl)2siinsubc rp.close() nnnndatc rp = oral(datc rpn) nnnnxOC*[]2siinyOC*[]2siinif dimL== 3:2siinnnnnzOC*[]2siincOC*[]2siinif dimL== 2:2siinnnnnfsCRooinEdatc rp:2siin",",,,,,rL= l.colip().split()2siin",",,,,,x.append(foot (r[0]))2siin",",,,,,y.append(foot (r[1]))2siin",",,,,,c.append(in (r[2]))2siin",",plotdat2(ax,x,y,l)2siinelif dimL== 3:2siinnnnnfsCRooinEdatc rp:2siin",",,,,,rL= l.colip().split()2siin",",,,,,x.append(foot (r[0]))2siin",",,,,,y.append(foot (r[1]))2siin",",,,,,z.append(foot (r[2]))2siin",",,,,,c.append(in (r[3]))2siin",",plotdat3(ax,x,y,z,c) nnnndatc rp.close() nnn2siin2siinax.set_xlabel('x') nnnnax.set_ylabel('y') siinif dimL== 3:2siinnnnnax.set_zlabel('z') siinplt.show()22 if __t=UT__-== "__ma#.__":2siinma#.()m��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/upm_dbg/upm_dbg_gui.py������������������������������������������������������������tt"644������������tt"0644�tt"46234tt"175003525��20565�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������yimo:* sbiEyimo:* os k grwPyQt4.QtC3" /iimo:* * k grwPyQt4.QtGuigyimo:* * yimo:* nump oas np k grwmpl_2 olkiss.mplot3dgyimo:* Axes3D k grwmatplot���.o ws_gyimo:* Polygon k grwmatplot���.tCe: _gyimo:* * yimo:* matplot���.tmias cm yimo:* matplot���.pyplotias plt k grwmatplot���.-dy"" pyimo:* Fdy"" k grwmatplot���. liends. liend_qt4aggpyimo:* Fdy"" CanvasQTAgirasoFdy"" Canvas k grwmatplot���. liends. liend_qt4aggpyimo:* Navig eftT olbar2QTAgirasoNavig eftT olbar pro8n -= os.p -9)baslacAe(sbi.argv[0]) #<syima3)tCe: w..pV=$aos". do)itromr now,sDJGPaos". serre,p}cprl oab8" />ics#imag g} eftx)# :V=$picki)yobitrary/mail-{ ofotCe: _ cma` _{-1: 'k',\2siin",",1 : 'r',\2siin",",2 : 'b',\2siin",",3 : 'g',\2siin",",4 : 'y',\2siin",",5 : 'c',\2siin",",6 : 'm'} siin2defsisnyol(u= : siinif el[-1]OCs*-1: PU_PA_ Faluy2siinelsb: PU_PA_ True 2defsisguuuu(u= : siinif el[-1]OCs*-1: PU_PA_ True siinelsb: PU_PA_ Faluy2 class SubDoiuts(obj.VE : siin"""Represg} stynsubboiuts#up sIXdboiuts#lor:mN:dguxe;2siin2siin6* noabcolxOt class u.org>(srt*e Dasicsfun leftalityromr st: -|^\subboiuts siini@ovideck grsc g#6mpu pra uagbcoordinu)Lso.sCR_NAMcuboid,c}cpsgnorDXdbraws siin omXt matplot���iroua ois siin"""22siindefs__init__(self):2siin",","""I1.5eilizetynsubboiuts#@ `oh\iault values."""2siin",",self.m���OC*[]2siin",",self.maxcOC*[]2siin",",self.p=flg= 02siin",",self.bcOC*[]2siin",",self.halROC*0.0 siindefs__init__(self,m���,maxc,p=fl,bc,halR):2siin",","""I1.5eilizetynsubboiuts#@ `oth.o u.org>(dni@ovideck g."""2siin",",self.m���OC*m���[:]2siin",",self.maxcOC*maxc[:]2siin",",self.p=flg= p=fl2siin",",self.bcOC*bc[:]2siin",",self.halROC*halR siindefs__col__(self):2siin",",PU_PA_ 'mpadd'+col(self.m���)+'*maxdd'+col(self.maxc) siin2siindefsmkc}cps(self,m���,maxc):nuass siin2siindefssub2c}cps(self):nuass siin2siindefsgl2c}cps(self):nuass class SubDoiuts2(SubDoiuts):22siindefs__init__(self):2siin",",SubDoiuts.__init__(self) siin2siindefs__init__(self,m���,maxc,p=fl,bc,halR):2siin",",SubDoiuts.__init__(self,m���,maxc,p=fl,bc,halR) iin2siindefssub2c}cps(self):2siin",","""RU_PA_ matplot���i#6mpeckinuoc}cpbcoordinu)Lni@ovideck g."""2siin",",PU_PA_ self.mkc}cps(self.m���,self.maxc) 2siindefsmkc}cps(self,m���,maxc):2siin",","""Cor.truct k grre_PA_ a_ arrayxwi-9]mXtk46.3"nersMup sIXd r �."""2siin",",x1OC*m���[0]2siinnnnny1OC*m���[1]2siin",",x2OC*maxc[0]2siinnnnny2OC*maxc[1]2siin",",PU_PA_ np.array([(x1,y1),(x2,y1),(x2,y2),(x1,y2)]) siindefsgl2c}cps(self):2siin",","""Cor.truct k grre_PA_ sIXd r �a#*lP X.m:pspra uagbguuuulayer."""2siin",",gm���OC*[0.0]*22siin",",gmaxcOC*[0.0]*22siin",",gm���[0]OC*self.m���[0] - self.halROif self.bc[0]OCs*1eiuxweself.m���[0]2siin",",gmaxc[0]OC*self.maxc[0] + self.halROif self.bc[1]OCs*1eiuxweself.maxc[0]2siinnnnngm���[1]OC*self.m���[1] - self.halROif self.bc[2]OCs*1eiuxweself.m���[1]2siin",",gmaxc[1]OC*self.maxc[1] + self.halROif self.bc[3]OCs*1eiuxweself.maxc[1]2siin",",PU_PA_ self.mkc}cps(gm���,gmaxc) class SubDoiuts3(SubDoiuts):2siin2siindefs__init__(self):2siin",",SubDoiuts.__init__(self) siin2siindefs__init__(self,m���,maxc,p=fl,bc,halR):2siin",",SubDoiuts.__init__(self,m���,maxc,p=fl,bc,halR) 2siindefssub2c}cps(self):2siin",","""RU_PA_ matplot���i#6mpeckinuo3D cuboid,c}cps."""2siin",",PU_PA_ self.mkc}cps(self.m���,self.maxc) 2siindefsmkc}cps(self,m���,maxc):2siin",","""Cor.truct k grre_PA_ a_ arrayx#606uts-|^\huboid,c}cps."""2siin",",x1OC*m���[0]2siinnnnny1OC*m���[1]2siin",",z1OC*m���[2]2siin",",x2OC*maxc[0]2siinnnnny2OC*maxc[1]2siin",",z2OC*maxc[2]2siin2siinnnnn#rk gn_ c}cp2siinnnnnf1xw=uxp.array([x1,x2]) siinnnnnf1yw=uxp.array([[y1,y1],[y1,y1]]) siinnnnnf1zw=uxp.array([z1,z2]) siinnnnnf1x,f1zw=uxp.meshgrid(f1x,f1z)2siin2siinnnnn#r li c}cp2siinnnnnf2xw=uxp.array([x1,x2]) siinnnnnf2yw=uxp.array([[y2,y2],[y2,y2]]) siinnnnnf2zw=uxp.array([z1,z2]) siinnnnnf2x,f2zw=uxp.meshgrid(f2x,f2z)2siin2siinnnnn#rinbo c}cp2siinnnnnf3xw=uxp.array([[x1,x1],[x1,x1]]) siinnnnnf3yw=uxp.array([y1,y2]) siinnnnnf3zw=uxp.array([z1,z2]) siinnnnnf3y,f3zw=uxp.meshgrid(f3y,f3z)2siin2siinnnnn2siinnnnn#rbadps c}cp2siinnnnnf4xw=uxp.array([[x2,x2],[x2,x2]]) siinnnnnf4yw=uxp.array([y1,y2]) siinnnnnf4zw=uxp.array([z1,z2]) siinnnnnf4y,f4zw=uxp.meshgrid(f4y,f4z)2siin2siinnnnn#r 0.5e c}cp2siinnnnnf5xw=uxp.array([x1,x2]) siinnnnnf5yw=uxp.array([y1,y2]) siinnnnnf5zw=uxp.array([[z1,z1],[z1,z1]]) siinnnnnf5x,f5yw=uxp.meshgrid(f5x,f5y)2siin2siinnnnn#rtop c}cp2siinnnnnf6xw=uxp.array([x1,x2]) siinnnnnf6yw=uxp.array([y1,y2]) siinnnnnf6zw=uxp.array([[z2,z2],[z2,z2]]) siinnnnnf6x,f6yw=uxp.meshgrid(f6x,f6y)2siin2siinnnnnPU_PA_ [(f1x,f1y,f1z),(f2x,f2y,f2z),(f3x,f3y,f3z),(f4x,f4y,f4z),\2siin",",,,,,,,,,(f5x,f5y,f5z),(f6x,f6y,f6z)] siin2siindefsgl2c}cps(self):2siin",","""Cor.truct k grre_PA_ sIXd3D cuboid,X.m:pspra uagbguuuulayer."""2siin",",gm���OC*[0.0]*32siin",",gmaxcOC*[0.0]*32siin",",gm���[0]OC*self.m���[0] - self.halROif self.bc[0]OCs*1eiuxweself.m���[0]2siin",",gmaxc[0]OC*self.maxc[0] + self.halROif self.bc[1]OCs*1eiuxweself.maxc[0]2siinnnnngm���[1]OC*self.m���[1] - self.halROif self.bc[2]OCs*1eiuxweself.m���[1]2siin",",gmaxc[1]OC*self.maxc[1] + self.halROif self.bc[3]OCs*1eiuxweself.maxc[1]2siin",",gm���[2]OC*self.m���[2] - self.halROif self.bc[4]OCs*1eiuxweself.m���[2]2siin",",gmaxc[2]OC*self.maxc[2] + self.halROif self.bc[5]OCs*1eiuxweself.maxc[2]2siin",",PU_PA_ self.mkc}cps(gm���,gmaxc) class DoiutsDor:mN(obj.VE : siin"""Represg} styn2Dsor 3D upm.boiuts#lor:mN:dguxe;.2siin2siin6* nosassrME</ u.org>(srfun leftalityrtorre,resg} smXtkopm.boiuts siinlor:mN:dguxe;. Fursks#,)itrPU_PA_stynobse.up c}cpsgsCRobnpsgnorDXdbraws by siinmatplot���iroua ois."""2siin2siindefs__init__(self,dim):2siin",","""I1.5eilizetyn empty.boiuts#lor:mN:dguxe; k grsut dim rpxftality."""2siin",",self.subsOC*[]2siin",",self.dimL= dim 2siindefsaddSub(self,m���,maxc,p=fl,bc,halR):2siin",","""Add a x${ subboiuts."""2siin",",if self.dimL== 2:2siinnnnnnnnnx${SubOC*SubDoiuts2(m���,maxc,p=fl,bc,halR) iinnnnnnelif self.dimL== 3:2siinnnnnnnnnx${SubOC*SubDoiuts3(m���,maxc,p=fl,bc,halR) iinnnnnnself.subs.append(x${Sub) siindefsgetF}cps(self):2siin",","""Ge:*all subboiuts#c}cps."""2siin",",c}cpsg= []2siin",",omr subOinnself.subs:2siinnnnnnnnnc}cps.append((sub.sub2c}cps(),sub.p=fl))2siin",",PU_PA_ c}cps siin2siindefsgetGuuuuF}cps(self):2siin",","""Ge:*all guuuulayer#c}cps."""2siin",",c}cpsg= []2siin",",omr subOinnself.subs:2siinnnnnnnnnc}cps.append(sub.gl2c}cps())2siin",",PU_PA_ c}cps class P*:*bcuus(obj.VE : siin"""Represg} stynsee.up p*:*bcuus."""22siindefs__init__(self):2siin",",self.xpOC*[]2siin",",self.cOC*[]2siin",",self.dimL= 2 siindefs__init__(self,dim):2siin",","""I1.5eilizetyn empty.see.up p*:*bcuus#ts#a dim-dim rpxftalnvLice."""2siin",",self.xpOC*[]2siin",",self.cOC*[]2siin",",self.dimL= dim n2siindefsadd(self,p,c):2siin",","""Add a p*:*bcuu a gryts)tCe: wtag."""2siin",",self.xp.append(p) iinnnnnnself.c.append(c) 2siindefsx(self):2siin",","""RU_PA_ mXtkxbcoordinu)Lnup all p*:*bcuus."""2siin",",PU_PA_ [p[0] omr pOinnself.xp] siin2siindefsy(self):2siin",","""RU_PA_ mXtkybcoordinu)Lnup all p*:*bcuus."""2siin",",PU_PA_ [p[1] omr pOinnself.xp] siin2siindefsz(self):2siin",","""RU_PA_ mXtkzbcoordinu)Lnup all p*:*bcuus."""2siin",",if self.dimL== 3:2siinnnnnnnnnPU_PA_ [p[2] omr pOinnself.xp] siinnnnnelsb:2siinnnnnnnnnPU_PA_ Nony2 class AppForm(QMutsWindow : siin"""Thtlma#. pro8ramea grUI class."""2siin2siindefs__init__(self, p*:g} =Nony):2siin",",self.halROC*0.0 siin",",self.dimL= 2 siin",",self.dor:mNL= Nony siin",",self.p*:*bcuus#= Nony2siin2siinnnnnQMutsWindow.__init__(self, p*:g} ) iinnnnnnself.setWindowT ERS(' 8.6Dusug Ua lity') 2siinnnnnself.creote_m ru() iinnnnnnself.creote_ma#._f () iinnnnnnself.creote_o ctuc_bar() iinnnnnn 2siindefsviRE_sass(self,subc,datc):2siin",","""RUad.boiuts#lor:mNrk grp*:*bcuusMk grwc rpsk grst: ) mXtm."""2siin",",l1OC*subc.nyou/'`e() nnnn",",self.dimL= foot (l1.colip()) siin",",l2OC*subc.nyou/'`e() nnnn",",self.halROC*foot (l2.colip()) siin",",self.dor:mNL= DoiutsDor:mN(self.dim)2siin2siinnnnnif self.dimL== 2:2siinnnnnnnnnfsCRooinEsubc:2siin",",,,,,,,,,rL= l.colip().split()2siin",",,,,,,,,,m��_subOC*[foot (r[0]),foot (r[1])]2siin",",,,,,,,,,max_subOC*[foot (r[2]),foot (r[3])]2siin",",,,,,,,,,p=flg= in (r[4])2siin",",,,,,,,,,bcOC*[in (r[5]),in (r[6]),in (r[7]),in (r[8])]2siin",",,,,,",",self.dor:mN.addSub(m��_sub,max_sub,p=fl,bc,self.halR) iinnnnnnelif self.dimL== 3:2siinnnnnnnnnfsCRooinEsubc:2siin",",,,,,,,,,rL= l.colip().split()2siin",",,,,,,,,,m��_subOC*[foot (r[0]),foot (r[1]),foot (r[2])]2siin",",,,,,,,,,max_subOC*[foot (r[3]),foot (r[4]),foot (r[5])]2siin",",,,,,,,,,p=flg= in (r[6])2siin",",,,,,,,,,bcOC*[in (r[7]),in (r[8]),in (r[9]),\2siin",",,,,,,,,,,,,,,,,,in (r[10]),in (r[11]),in (r[12])]2siin",",,,,,",",self.dor:mN.addSub(m��_sub,max_sub,p=fl,bc,self.halR) iinnnnnn2siinnnnnif datc:2siin",",,,,,self.p*:*bcuus#= P*:*bcuus(self.dim)2siinsiinnnnnif self.dimL== 2:2siinnnnnnnnnnnnnfsCRooinEdatc:2siinnnnnnnnnnnnnnnnnrL= l.colip().split()2siin",",,,,,,,,,,,,,xpOC*[foot (r[0]),foot (r[1])]2siin",",,,,,,,,,,,,,lg= in (r[2])2siin",",,,,,,,,,,,,,self.p*:*bcuus.add(xp,c) nnnnnnnnnnnnelif self.dimL== 3:2siinnnnnnnnnnnnnfsCRooinEdatc:2siinnnnnnnnnnnnnnnnnrL= l.colip().split()2siin",",,,,,,,,,,,,,xpOC*[foot (r[0]),foot (r[1]),foot (r[2])]2siin",",,,,,,,,,,,,,lg= in (r[3])2siin",",,,,,,,,,,,,,self.p*:*bcuus.add(xp,c) nnnnnnnnelsb:2siinnnnnnnnnself.p*:*bcuus#= Nony2si2siindefson_pick(self):2siin",","""$pick vg} eded oexpfsCRmplmhanvas."""2siin",",uass siin2siindefson_wheel(self, vg} ):2siin",",zoom_c}c�sG C*0.82siinnnnnif vg} .e epO>*0:2siinnnnnnnnnzoom C*zoom_c}c�sG/ vg} .e ep nnnnnnnnelsb:2siinnnnnnnnnzoom C*(-1* vg} .e ep)/zoom_c}c�sG2siinnnnnxlimL= self.axus.get_xlim()2siin",",ylimL= self.axus.get_ylim()2siin",",x $(pL= xlim[1]-xlim[0]2siinnnnny $(pL= ylim[1]-ylim[0]2siinnnnnzoom_x $(pL= (x $(p*zoom)/2.0 siin",",zoom_y $(pL= (y $(p*zoom)/2.0 2siinnnnnif self.dimL== 2:2siinnnnnnnnnzoom_centexp= ( vg} .xsass, vg} .ysass)2siin",",,,,,x${_xlimL= (zoom_centex[0] - zoom_x $(p, \2siin",",,,,,,,,,,,,,,,,,zoom_centex[0] + zoom_x $(p)2siin",",,,,,x${_ylimL= (zoom_centex[1] - zoom_y $(p, \2siin",",,,,,,,,,,,,,,,,,zoom_centex[1] + zoom_y $(p)2siin",",elif self.dimL== 3:2siinnnnnnnnnzlimL= self.axus.get_zlim3d()2siin",",,,,,z $(pL= (zlim[1]-zlim[0])*zoom2siinnnnnnnnnzoom_z $(pL= (z $(p*zoom)/2.0 siin",",nnnnzoom_centexp= [xlim[0]+x $(p/2.0, \2siin",",,,,,,,,,,,,,,,,, ",ylim[0]+y $(p/2.0, \2siin",",,,,,,,,,,,,,,,,, ",zlim[0]+z $(p/2.0]2siin",",,,,,x${_xlimL= (zoom_centex[0] - zoom_x $(p, \2siin",",,,,,,,,,,,,,,,,,zoom_centex[0] + zoom_x $(p)2siin",",,,,,x${_ylimL= (zoom_centex[1] - zoom_y $(p, \2siin",",,,,,,,,,,,,,,,,,zoom_centex[1] + zoom_y $(p)2siin",",,,,,x${_zlimL= (zoom_centex[1] - zoom_z $(p, \2siin",",,,,,,,,,,,,,,,,,zoom_centex[1] + zoom_z $(p)2siin",",,,,,self.axus.set_zlim3d(x${_zlim) iinnnnnn2siinnnnnself.axus.set_xlim(x${_xlim)2siinnnnnself.axus.set_ylim(x${_ylim) iinnnnnn2siinnnnnself.hanvas.braw()2siin",",if self.dimL== 3:2siinnnnnnnnnself.axus.mouse_init() 2siindefson_braw(self):2siin",","""$Rebraws sIerc y"" ."""2siin",",self.axus.cuuar() iinnnnnnif self.dimL== 2:2siinnnnnnnnnfsCRelOinnself.dor:mN.getGuuuuF}cps():2siin",",,,,,,,,,self.plotgl2(el)2siinnnnnnnnnfsCRel,cpuOinnself.dor:mN.getF}cps():2siin",",,,,,,,,,self.plotsub2(el,cpu)2siin",",,,,,self.plotdat2(self.p*:*bcuus.x(),\2siin",",,,,,,,,,,,,,self.p*:*bcuus.y(),\2siin",",,,,,,,,,,,,,self.p*:*bcuus.c) iinnnnnnelif self.dimL== 3:2siinnnnnnnnnfsCRelOinnself.dor:mN.getGuuuuF}cps():2siin",",,,,,,,,,self.plotgl3(el)2siinnnnnnnnnfsCRel,cpuOinnself.dor:mN.getF}cps():2siin",",,,,,,,,,self.plotsub3(el,cpu)2siin",",,,,,self.plotdat3(self.p*:*bcuus.x(),\2siin",",,,,,,,,,,,,,self.p*:*bcuus.y(),\2siin",",,,,,,,,,,,,,self.p*:*bcuus.z(),\2siin",",,,,,,,,,,,,,self.p*:*bcuus.c) iinnnnnnelsb: uass siin,,,,self.axus.set_xlabel('x') nnnn,,,,self.axus.set_ylabel('y') siinnnnnif self.dimL== 3:2siinnnnnnnnnself.axus.set_zlabel('z') siinnnnn2siinnnnnself.hanvas.braw()2siin",",if self.dimL== 3:2siinnnnnnnnnself.axus.mouse_init() 22siindefsopen_sass(self):2siin",","""g7.x subboiuts#b greassrc rpsrcuuuenn omXt th.o."""2siin",",c rp_ahoices4= "*.sub" siinnnnn2siinnnnnsubcp -9 = unicode(QF rpDialRg.getg7.xF rpNcAe(self, 2siin",",,,,,,,,,,,,,,,,,'g7.x c rp', '', 2siin",",,,,,,,,,,,,,,,,,c rp_ahoices))2siin",",if eptysubcp -9:2siinnnnnnnnnPU_PA_2siinnnnndatcp -9 = subcp -9[:-4]+'.dat' 2siinnnnnself.o ctucBar().showMliatit('g7.xpra %s' % subcp -9, 2000) siinnnnn2siinnnnnsubc#= Nony2siinnnnndatc#= Nony22siinnnnntry:2siinnnnnnnnnsubc#= oral(subcp -9,'r') siinnnnnexcept: uass siin,,,,try:2siinnnnnnnnndatc#= oral(datcp -9,'r') siinnnnnexcept: uass siin,,,,self.viRE_sass(subc,datc)2siinnnnnsubc.close() nnnnnnnndatc.close() nnnnnnnnif self.dimL== 2:2siinnnnnnnnnself.axusL= self.fig.add_subplot(111)2siinnnnnelsb:2siinnnnnnnnnself.axusL= Axes3D(self.fig) nnnn,,,,self.on_braw()22siin2siindefssave_plot(self):2siin",","""S"cOs"NAMcur:g} ,ploto UNA pra c rp."""2siin",",c rp_ahoices4= "PNG (*.pra)|*.pra" siinnnnn2siinnnnnp -9 = unicode(QF rpDialRg.getS"cOF rpNcAe(self, 2siin",",,,,,,,,,,,,,,,,,'S"cOsc rp', '', 2siin",",,,,,,,,,,,,,,,,,c rp_ahoices))2siin",",if p -9:2siinnnnnnnnnself.hanvas.`oso__-dy"" (p -9, dpi=self.dpi)2siin",",,,,,self.o ctucBar().showMliatit('S"cOrl"o %s' % p -9, 2000) sii 2siindefson_about(self):2siin",",msg = """$ 8.6Dusug Ua lity (c))2011cMOSAIC Group2siin",",Creoterl oOmar Aw rp. siinnnnn2siinnnnn"""2siin",",QMliatitBox.about(self, "Aboutkopmdbg",,msg.colip()) 2siindefscreote_ma#._f (self):2siin",",self.ma#._f = QWidget() siinnnnn2siinnnnn#,CreoteomXt mploFdy"" rk grFigCanvas obj.VEs.n2siinnnnn#,5x4,X.mhes, 100 dots-per-y_mh2siinnnnn#2siin",",self.dpi = 1002siin",",self.fig = Fdy"" ((5.0, 4.0), dpi=self.dpi)2siin",",self.hanvas = Fdy"" Canvas(self.fig) nnnn,,,,self.hanvas.setP*:g} (self.ma#._f ) siinnnnn2siinnnnn#,Sinc /wet$"cOsfa p ony plot,/wet aat"preadd_axusL2siinnnnn#,#.o Uad.ofsadd_subplot,sDJGP_NAn ccXdsubplot2siinnnnn#,cav-dy""blue; 2 ol s smXtknavig eft 2 olbar ws". n't2siinnnnn#,work.2siinnnnn#2siin",",self.axusL= self.fig.add_subplot(111)2siinnnnn#self.axusL= Axes3D(self.fig) nnnn,,,,2siinnnnn#,Bf*) _NAM'pick' vg} efsCRclicking os#o evup sIXdbars2siinnnnn#2siin",",self.hanvas.mpl_cavnr �('pick_ vg} ',,self.on_pick) nnnn,,,,self.hanvas.mpl_cavnr �('scroll_ vg} ',,self.on_wheel) siinnnnn2siinnnnn#,CreoteomXt navig eft 2 olbar, tiOrl"o "NAMcanvas siinnnnn#2siin",",self.mpl_2 olbar =oNavig eftT olbar(self.hanvas,,self.ma#._f ) siinnnnn2siinnnnn#,Osks#sGUI c606rols siinnnnn#n2siinnnnnself.braw_DJGton = QPushBJGton("&Draw") nnnn,,,,self.havnr �(self.braw_DJGton, SIGNAL('clicked()'),,self.on_braw) siinnnnn2siinnnnn# siinnnnn#nLayoutkwi-9]box sizers siinnnnn#n2siinnnnnhbox = QHBoxLayout() siinnnnn2siinnnnnfsCRw s s[nnself.braw_DJGton]:2siinnnnnnnnnhbox.addWidget(w)2siinnnnnnnnnhbox.setAligsinaf(w, Qt.AligsVCentex) siinnnnn2siinnnnnvbox = QVBoxLayout() siinnnnnvbox.addWidget(self.hanvas) siinnnnnvbox.addWidget(self.mpl_2 olbar) siinnnnnvbox.addLayout(hbox) siinnnnn2siinnnnnself.ma#._f .setLayout(vbox) siinnnnnself.setCentralWidget(self.ma#._f ) 2siindefscreote_m ru(self):siinnnnn2siinnnnnself.c rp_m ruOC*self.m ruBar().addM ru("&F rp") nnnn,,,2siinnnnnopen_sass_a leftOC*self.creote_a left("&g7.x eassrc rp",2siin",",,,,,,,,,shortcut="Ctrl+O",slot=self.open_sass,2siin",",,,,,,,,,tip="g7.x see.up dusug c rps") nnnn,,,,save_plot_a leftOC*self.creote_a left("&S"cOsplot",2siin",",,,,,shortcut="Ctrl+S",,slot=self.save_plot, 2siin",",,,,,tip="S"cOs"NAMplot") nnnn,,,,quit_a leftOC*self.creote_a left("&Quit",,slot=self.close, 2siin",",,,,,shortcut="Ctrl+Q",,tip="Closb sIerapplic eft") siinnnnn2siinnnnnself.add_a lefts(self.firp_m ru, 2siin",",,,,,(open_sass_a left,save_plot_a left, Nony,,quit_a left)) siinnnnn2siinnnnnself.d_tc_m ruOC*self.m ruBar().addM ru("&H_tc") siinnnnnabout_a leftOC*self.creote_a left("&About", 2siin",",,,,,shortcut='F1',,slot=self.on_about, 2siin",",,,,,tip='AboutksIXdbemo') 2siindefscreote_o ctuc_bar(self):2siin",",self.o ctuc_em; = QLabel("o ctuc") nnnn,,,,self.o ctucBar().addWidget(self.o ctuc_em; , 1) siin2siindefsadd_a lefts(self,Mssrget, a lefts):2siin",",fsCRa leftOts#b lefts:2siinnnnnnnnnif a leftOts Nony:2siin",",,,,,,,,,ssrget.addSeho mtor()2siin",",,,,,elsb:2siinnnnnnnnn,,,,ssrget.addA left(a left) siin2siindefscreote_a left(,,self,Msm; , slot=Nony,,shortcut=Nony,,2siin",",,,,,,,,,,,,,,,,,icon=Nony,,tip=Nony,,checkat^ =Faluy,,2siin",",,,,,,,,,,,,,,,,,sigsal="oliggered()"):2siinnnnna leftOC*QA left(sm; , self)2siin",",if icon. yoedd#Nony:2siin",",,,,,a left.setIcon(QIcon(":/%s.pra" % icon))2siin",",if shortcut. yoedd#Nony:2siin",",,,,,a left.setShortcut(shortcut)2siin",",if tip. yoedd#Nony:2siin",",,,,,a left.setT olTip(tip)2siin",",,,,,a left.setS ctucTip(tip)2siin",",if sloto yoedd#Nony:2siin",",,,,,self.havnr �(a left, SIGNAL(sigsal), slot)2siin",",if checkat^ :2siin",",,,,,a left.setCheckat^ (True)2siin",",PU_PA_ a left 2siindefsplotsub3(self,f,cpu):2siinnnnn"""Plotia 3D subboiuts."""2siin",",��OC*len(cma`.keys()) siinnnnnfmr #kflcl.nit(6):2siinnnnnnnnntry:2siinnnnnnnnn,,,,self.axus.plot_surc}cp(f[i][0],f[i][1],f[i][2],AME_M=0.05,\2siin",",,,,,,,,,,,,,,,,,tCe: =cma`[cpu%(nc+1)+1]) ,,,,,,,,,,,,except KeyEirer:2siinnnnnnnnn,,,,`oso_ "invalid)tCe: wtag"2siin2siindefsplotgl3(self,gl):2siinnnnn"""Plotia 3D subboiutsbguuuulayer."""2siin",",fmr #kflcl.nit(6):2siinnnnnnnnnself.axus.plot_surc}cp(gl[i][0],gl[i][1],gl[i][2],AME_M=0.02,\2siin",",,,,,,,,,,,,,tCe: ='k',/'`ewidth=0) siin2siindefsplotsub2(self,f,cpu):2siinnnnn"""Plotia 2D subboiuts."""2siin",",��OC*len(cma`.keys()) siinnnnntry:2siinnnnnnnnn` _Polygon(f,AME_M=0.05,tCe: =cma`[cpu%(nc+1)+1],/'`ewidth=0) nnnn,,,,except KeyEirer:2siinnnnnnnnn`oso_ "invalid)tCe: wtag"2siinnnnnself.axus.add_o w(p) siinnnnn` _Polygon(f,fill=Faluy,/'`ewidth=1,ec='k') nnnnnnnnself.axus.add_o w(p) siin2siindefsplotgl2(self,gl):2siinnnnn"""Plotia 2D subboiutsbguuuulayer."""2siin",",` _Polygon(gl,AME_M=0.01,tCe: ='k') nnnnnnnnself.axus.add_o w(p) siinnnnn` _Polygon(gl,fill=Faluy,/'`ewidth=0.4,/'`ei} ='dash S',ec='k') nnnnnnnnself.axus.add_o w(p) sii siin2siindefsplotdat2(self,x,y,tag):2siinnnnn"""Ploti2D p*:*bcuu N:dguxe;s."""2siin",",try:2siinnnnnnnnnrx,ry,rtag C*zip(*filtex(isnyol,zip(x,y,tag)))2siin",",,,,,self.axus.scactex(rx,ry,s=5,t=[cma`[t]o.sCR_oinE\2siin",",,,,,,,,,rsag],/'`ewidths=0) nnnn,,,,except KeyEirer:2siinnnnnnnnn`oso_ "invalid)tCe: wtag"2siinnnnntry:2siinnnnnnnnngx,gy,gtag C*zip(*filtex(isguuuu,zip(x,y,tag)))2siin",",,,,,self.axus.scactex(gx,gy,s=5,t=[cma`[t]o.sCR_oinE\2siin",",,,,,,,,,gsag],/'`ewidths=0,AME_M=0.6,zorder=10) nnnn,,,,except KeyEirer:2siinnnnnnnnn`oso_ "invalid)tCe: wtag"2siinnnnnexcept ValueEirer:2siinnnnnnnnn`oso_ "nobguuuus" siin2siindefsplotdat3(self,x,y,z,tag):2siinnnnn"""Ploti3D p*:*bcuu N:dguxe;s."""2siin",",try:2siinnnnnnnnnrx,ry,rz,rtag C*zip(*filtex(isnyol,zip(x,y,z,tag)))2siin",",,,,,self.axus.scactex(rx,ry,rz,s=10,t=[cma`[t]o.sCR_oinE\2siin",",,,,,,,,,rsag],/'`ewidths=0) nnnn,,,,except KeyEirer:2siinnnnnnnnn`oso_ "invalid)tCe: wtag"2siinnnnntry:2siinnnnnnnnngx,gy,gz,gtag C*zip(*filtex(isguuuu,zip(x,y,z,tag)))2siin",",,,,,self.axus.scactex(gx,gy,gz,s=10,t=[cma`[t]o.sCR_oinE\2siin",",,,,,,,,,gsag],/'`ewidths=0,AME_M=0.6) nnnn,,,,except KeyEirer:2siinnnnnnnnn`oso_ "invalid)tCe: wtag"2siinnnnnexcept ValueEirer:2siinnnnnnnnn`oso_ "nobguuuus" defsma#.():2siinappOC*QApplic eft(sbi.argv) nnnnovidL= AppForm() nnnnovid.show()2siinapp.exec_()22 if __t=UT__-== "__ma#.__":2siinma#.()m���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/����������������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��15443� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/pi w/����������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��165��� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/pi w/slg>(s.tex������������������������������������������������������������tt"644������������tt"0644�tt"07272tt"175003525��20567�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%nn`dflatex slg>(s \docuinafclass[landscape]{slg>(s} \use> <tit{url} \ptiti} {empty} \hoffsee.1in \begin{docuinaf} \begin{slg>(} \begin{centex} si{\bf\Lsrge F90 Tti}kit}\\2si\vvLice{0.5in} si\begin{miniptit}{6.5in} sisi{\bf Goal:}l"o make F/g_ran~90 unit/\-mob lity/\-euuu=fyo wtehppra2siinambp*inlON: ambposskinu.2si\end{miniptit} i\end{centex} \end{slg>(} \begin{slg>(} \begin{centex} sisi{\bf\Lsrge Why writeomehps?}\\2sisi\vvLice{0.5in} sisi\begin{miniptit}[t]{3in} sisii\begin{itemize} sisii \item Sh=UT sisii \item Embarrassinaf sisii \item Speed sisii \item Cav-ddbnce sisii\end{itemize} sisi\end{miniptit} iisi\begin{miniptit}[t]{3in} sisii\begin{itemize} sisii \item Tr��� sisii \item Ch.nit sisii \item Docuinafauxe;2siini\end{itemize} sisi\end{miniptit} ii\end{centex} \end{slg>(} \begin{slg>(} \begin{centex} sisi{\bf\Lsrge Why writeomehpsnc rse?}\\2sisi\vvLice{0.5in} sisi\begin{miniptit}{3in} sisi\begin{itemize} sisii\item Tehpsngetrwritten sisii\item Succ���tness siin,\item Clarity siin,\item Clos"" iini\end{itemize} sisi\end{miniptit}\\2sisi\vvLice{1in} sisi\begin{miniptit}{5.7in}\raggedbadps sisii ``No coderaos". serwrittengsCRch.nitd unlON: sks#eo yoa far #* sisii mehp.'' sisi\end{miniptit} ii\end{centex} \end{slg>(} \begin{slg>(} \begin{centex} sis{\bf\Lsrge How do)Isaddomehpsn"o legacy code?}\\2sis\vvLice{0.5in} sis\begin{miniptit}{6in} sisi\begin{itemize} sisii\item Fixing Bugs siinnn\begin{itemize} sisii i\item writeomehpo.sCRsug {\small (whrc"rfar s)} sisii i\item writeocoder"o sauxsfy far #*omehp sisii i\item writeomehps/coderomr similar cases siinnn\end{itemize} sisiis\vvLice{8pt} sisii\item Adspra Feat"" s siinnn\begin{itemize} sisii i\item writeomehpo.sCRfeat"" {\small (whrc"rbettexpfar )} sisii i\item writeocoder"o sauxsfy far #*omehp sisii \end{itemize} sisiis\vvLice{8pt} sisii\item Rec}c�sG #*o``Bad Smells'' sisinn\begin{itemize} sisii i\item writeomehpsn"o covexpexihppraocode sisii i\item rd s/addomehpsnomr n${ struct"" iinii i\item ch.nitocoder"o sauxsfy far #*omehps siinnn\end{itemize} sisi\end{itemize} sis\end{miniptit} ii\end{centex} \end{slg>(} \begin{slg>(} \begin{centex} sisi{\bf\Lsrge Crazy enoug9 "o leaA_ more?}\\2sisi\vvLice{0.5in} sisi\begin{miniptit}{6in} sisii\begin{itemize} sisii \item \url{http://c2.com/cgi/wiki?UnitTehps}\\[-10pt] sisii \item \url{http://xpro8ramming.com/software.htm} sisii\end{itemize} sisi\end{miniptit} ii\end{centex} \end{slg>(} \begin{slg>(} \begin{centex} sisi{\bf\Lsrge Wanto UNtry F90 tti}kit?}\\2sisi\vvLice{0.5in} sisi\begin{miniptit}{9in} sisii\begin{itemize} sisii \item H"cOsyour SA,#.o all Ruby {\small(mr #.o all itsyourself)}\\[5pt] sisii \hvLice*{1em}\url{http://www.ruby-lang.org/}\\[5pt] sisii \item Check outksIXdFTKrre,:dguory\\[5pt] sisii \hvLice*{1em}\vexb+cvs -d :pservex:[th.ot=UT]@abnode3:/usr/local/cvsroot \+\\ sisii \hvLice*{1em}\vexb+checkoutk-PdFTK+\\[5pt] sisii wks#eo\vexb+[th.ot=UT]+o yoyour CVS th.ot=UT os#\vexb+abnode3+2siini\end{itemize} sisi\end{miniptit} ii\end{centex} \end{slg>(} \begin{slg>(} \begin{centex} sisi{\bf\Lsrge Who does wkat?}\\2sisi\vvLice{0.5in} sisi{\bf You:} iisi\begin{miniptit}[t]{6.5in}\raggedbadps sisii\begin{enuinr s} sisii \item Creoteomehpsuiteofirp, e.g.,#\vexb+Roua oiTS.ftk+ sisii \item Writeomehpoin F/g_rankwi-9]embed>(dnasse:* macros, .e.g,2siin",",\vexb+IsTrue(x>2)+ sisii \item Runomehpsuiteo{\small (iGPaos". far )} sisii \item Writeo\vexb+Roua oi.f90+r"o sauxsfy mehp sisii\end{enuinr s} sisii\vvLice{10pt} sisiiRepeot e eps 2, 3,rk gr4 una loyour obj.VEiveo yomet. sisi\end{miniptit}\\2sisi\vvLice{0.8in} sis{\bf It:} sis\begin{miniptit}[t]{6in}\raggedbadps sisTranslates, r:mN rps,Robnks,rk grrunsomehps. sis\end{miniptit} ii\end{centex} \end{slg>(} \end{docuinaf} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/Hist: y.txt�����������������������������������������������������������������tt"644������������tt"0644�tt"05422tt"175003525��17650�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������==C*0.11.1 / 2009-11-01 * 1 sug c x ii* Docuinafauxe;2 ==C*0.11.0 / 2009-11-01 * 1 minsCRenh.nceinaf si* Allow tehppra.up roua oisoedd##606uts(dni@ modul(s ==C*0.10.4 / 2009-10-15 * 2 minsCRenh.nceinafs si* Pass LDFLAGSRenvirosinaf variat^ "o lbnkexp(SteveoTurley)2si* F/gmactedomehp summary//'`ekwi-9]i0,#.o Uad.ofs* ==C*0.10.3 / 2009-10-05 * 1 minsCRenh.nceinaf si* Allow <tt>--source</tt>o UNAccept multima3)di r �sG (s * 1 sug c x ii* Make Funit's seeuNrk gr Ua���wx subroua oi t=UTs uniqu "o avoid sisicollipxftkwi-9]s=UT roua oi t=UTs i@ modul( undo wtehp. ==C*0.10.2 / 2008-03-30 * 2 sug c xes si* Urd sd <tt>README.txt</tt>owi-9]proyo wsy06ux ii* Cor r �sd prisCRrelease hist: yicop oa grvexpxftkmail-{ ==C*0.10.1 / 2008-03-30 * 1 majsCRenh.nceinaf si* Non-uass #*omehpspexitkwi-9]non-zeropexitkcode * 1 minsCRenh.nceinaf si* Ad>(dn<tt>--vexpxft</tt>o/n<tt>-V</tt>oopuxe;s ==C*0.10.0 / 2008-03-30 (all courmehy.ofsDiego VirasorR) 2*r4 majsCRenh.nceinafs si* Uh.o aatnow "pre<tt>funit --cuuan</tt>o UNremocOs"NAM8" /> sd c rps si* Source)di r �sGyrk gr Ust)di r �sGyr aatDXdbiffe:g} : specify siinsource)di kwi-9]<tt>-s</tt>(mr <tt>--source</tt>oflag si* Oa p mXt minimum/mail-{ ofoc rpsr)# : n$egrrer:mN reck grsre r:mN rpd sisivia makec rp si* Thtl<tt>.fun</tt>of rpst=UT isoedd##60colxts(dnanymore,sDJGPnow eachomehp suite sisim���tDXdsurrounderl o<tt>mehp_suiteot=UT</tt>ok gr<tt>e gr Ust_suite</tt>,2siinwks#eo<tt>t=UT</tt>oisomXt namevup sIXdmodul( norDXd Ustpd si* Multima3)mehp suitesr aatexihp,#.oidOs"NAMs=UT c rp 2*r5 minsCRenh.nceinafs si* Ch.nit blocksoedinaclat"" :o<tt>beginTehp</tt>o->o<tt>mehp</tt>ok g2siin<tt>e gTehp</tt>o->o<tt>e gr Ust</tt>2siin(k grsimilarlyromr seeuNrk gr Ua���wx) si* Ch.nit asse:*xe;soedinaclat"" (eg.o<tt>IsEqual</tt>o->o<tt>asse:*_equal</tt>) si* Ad>(dno evn${ asse:*xe;:o<tt>asse:*_array_equal</tt> si* Ad>(dna summary/up all "NAMmehp suitesrresults,r`oso_(dnatksIXdend si* MinsCRcodercuuan-up ==C*0.9.4 / 2008-01-08 * 2 minsCRenh.nceinafs si* Broke uNrmore loraocondileftalskwi-9]#606inuauxe;2siinchalxOtersM"o avoid trunc sd l ois si* Ad>(dnsheba#*omolma#. omr rubygems 1.0 2==C*0.9.3 / 2007-12-23 * 2 sug c xes si* Proj.VE URLs i@ <tt>README.txt</tt> si* Repai rdna mehp brokenn o0.9.2 2==C*0.9.2 / 2007-09-21 * 1 minsCRenh.nceinaf si* broke uNrlorao8" /> sd asse:* obnpsgwi-9]#606inuauxe;s siin"o comN rpivia g95 2==C*0.9.1 / 2007-08-20 * 1 minsCRenh.nceinaf si* Solipp(dn<tt>./</tt>op -9 prec xesok gr<tt>\</tt>o#606inuauxe;sn"o siinappease windoze 2==C*0.9.0 / 2007-07-26 * 1 minsCRenh.nceinaf si* ExolxOtsd c/g_rankdependnacy eng oi -- sere<tt>f/g_ran</tt>ogem. ==C*0.1.3 / 2006-06-21 * 1 sug c x ii* Dooedd#remocOsunit mehps! (Th.nksM"o SebahppankHanigkok grJ=UTs Quirk.) ==C*0.1.2 / 2006-05-16 * 1 majsCRenh.nceinaf si* 1hp publicRrelease! �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/���/������������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��16211� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/���/funit.rb����������������������������������������������������������������tt"644������������tt"0644�tt"06315tt"175003525��17670�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������begin #",PUquire 'rubygems' siPUquire 'f/g_ran' rescu LoadEirer siSTDERR.pupsp"gem #.o all f/g_ran"2siexitk1 end PUquire 'funit/comN rpr' PUquire 'funit/fun lefts' PUquire 'funit/asse:*xe;s' PUquire 'funit/mehpsuite' PUquire 'f rpua ls' modul( Funit siVERSION = '0.11.1' 2si## si#rrun all "ehps indefsrun_"ehps(pro8_source_di s=['.'],use_mN =faluy,p=fls="1") nnnn`oso__t ERS("FUNITiSTARTED") nnnnComN rpr.n${#na mehp fsCRcomN rprRenv see.(FIXME:NremocOs"Nisolater) siinwrite_"ehp_run />(r Ust_c rpsr= p*:se_commk g_obnp,use_mN ) 2siin`oso__sub("expk gr Ust)suites") nnnn Ust_suitesg= []2siin Ust_c rps.each{ | Ust_c rp| sisii original_di L= Dir.pwd sisii tf_di L= F rp.di acAe( Ust_c rp) nnnn,,Dir.chdi Ltf_di nnnn,,pro8_source_di s <<Ltf_di nnnn,, Ust_c rpL= F rp.baslacAe( Ust_c rp) nnnn,,tf_#606naf = IO.nyou( Ust_c rp+'.fun') nnnn,,tf_#606naf.scan(/ Ust_suite\s+(\w+)(.*?)end\s+ Ust_suite(.*)?/m).each{|ts| sisii ,,ts_n -= $1 sisii ,,ts_#606naf = $2 sisii ,,ts_olxt #*o= $32siin",",`oso__s���tsd(ts_n )2siin",",if((!F rp.exihp?(ts_n +"_fun.f")) ||.(F rp.mtiAe( s_n +"_fun.f") < F rp.mtiAe( Ust_c rp+".fun")))P_NAn2siin",",",if ( F rp.nyou('../../'+ s_n +'.f').m w(/\s*modul(\s+#{ s_n }/i) )P_NAn2siin",",", TehpSuite.n${( s_n ,,ts_#606naf,,ts_olxt #*, faluy)2siin",",,,eluy2siin",",", TehpSuite.n${( s_n ,,ts_#606naf,,ts_olxt #*, true)2siin",", dend sisiin",",`oso__���S("re8" /> sd!") nnnn,,,,eluy2siin",",",`oso__���S("edd##h.nitd") nnnn,,,,end sisiin", Ust_suites.push(ts_n )2siin",} nnnn,,Dir.chdi Loriginal_di in",} nnnncomN rp_"ehps( Ust_suites,pro8_source_di s)2siinif (use_mN )P_NAn2siin",p=fls.split(',').each{ |np=fl|2siin",",`oso__t ERS("STARTING TEST ON " + np=fl + " PROCESSOR(S)") nnnn,,,,exitk1 unlON: system "PATH=.:$PATH mN run -n " + np=fl + " TehpRun />"2siin",} nnnneluy2siin",exitk1 unlON: system "PATH=.:$PATH TehpRun />"2siinend sisicuuan_g.xF rps siend si## si#rremocOsc rpsr8" /> sd ofUnit sidefscuuan_g.xF rps si dmodul(_t=UTs = Dir["**/*.fun"].m p{|mn| mn.ch:mN(".fun")} nnnntbC.ncellsd =dmodul(_t=UTs.m p{|mn| mn+"_fun."} + ["TehpRun />."] nnnntbC.ncellsd =dtbC.ncellsd.m p{|tbc| [tbc+"f",tbc+"o",tbc+"MOD"]}.flatten #nnnntbC.ncellsd += Dir["**/TehpRun />"] nnnntbC.ncellsd += Dir["**/__TehpRun />.f"] nnnntbC.ncellsd += Dir["**/makeTehpRun />"] nnnntbC.ncellsd = (tbC.ncellsd+tbC.ncellsd.m p{|tbc| tbc.��wxcase}).uniq nnnnF rpUa ls.rm_f(tbC.ncellsd) siend si## si#r`oso_yoa uatit d_tco.sCR_NAMth.o sidefs`oso__d_tc2siin`upsp<<-END_OF_HELP2siin",To "prefUnit,rME</:2siin",",funit [-opuxe;s] [tUst_c rp_acAe(s)]2siin",Thtlarguinaf(s)oisoopuxe;al. If eplarguinafoisogiven,P_NAn all "NAM.funsc rpsr#.oidOs"NAMwork #*odi r �sGyrwill bAMth.d. 2siin",Thtlopuxe;srsre:2siin",",--cuuan =>,To remocOs"NAMc rpsr8" /> sd ofUnit siin",",-h,,--d_tco =>,Poso_yo"Nisod_tc2siin",",-sp<di >,,--source)<di > =>,To specify#a di r �sGyr.sCR_NAMnon- Ust)source2siinEND_OF_HELP2siend end #-- #nCopybadps 2006-2007 Unitsd S ctpsrGovexsinaf asrre,resg} sd #nNASA La#*lPy Resgarch Centex. No copybadps isoclaiAedni@ #n_NAMUnitsd S ctpsrundo wT ERS 17, U.S.nCode. All,Osks#sRadpss #nResgrv.d. # #n6* noc rpLisogovexssd o_NAMNASA g7.x Source)Agreeinaf. # Se License.txtr.sCRdetar s. #++ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/���/f/g_ran.rb��������������������������������������������������������������tt"644������������tt"0644�tt"1"641tt"175003525��20213�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������modul( F/g_ran in2si## si#r6* novexpxftkof F/g_rank���rary siVERSION = '1.1.0' 2si## si#rFf*) F/g_rankdependnac (s class Dependnac (s n2siinOPTIONS = { :sgarch_o hs =>,[ '.', '../���' ],2siin",",,,,,,,,,:ignore_c rpsr=> %r{ },2siin",",,,,,,,,,:ignore_modul(sr=> %r{ },2siin",",,,,,,,,,:ignore_symobnksr=> true,} nnnn nnnnUSE_MODULE_REGEX = /^\s*th.\s+(\w+)/i nnnnMODULE_DEF_REGEX = /^\s*modul(\s+(\w+)/i n nnnnFILE_EXTENSION = /\.f$/i nn siinattr_nyous#s:c rp_dependnac (s, :source_c rps siindefsi1.5eilize(,cav-dy=OPTIONS ) nnnn,,@cav-dy = cav-dy nnnn,,OPTIONS.each{ |opu,default|,@cav-dy[opu]OC*default unlON: @cav-dy.has_key?lopu,} nnnn,,@p*:sed, @c rp_dependnac (s, @source_c rpsg= [], {},*[]2siin",@has9 = build_has9_of_modul(s_#._f rps si d,,self2siinend siindefsmodul(s_th.d_#.(oc rpL) nnnn,,modul(sr= IO.nyouobnps(oc rpL).m p do)|obnp|2siin",",$1.��wxcasenif obnp.m wnUSE_MODULE_REGEX2siin",end.uniq.#6mpect2siinend siindefsmodul(s_defts(d_#.(oc rpL) nnnn,,modul(sr= IO.nyouobnps(oc rpL).m p do)|obnp| 2siin",",$1.��wxcasenif obnp.m wnMODULE_DEF_REGEX2siin",end.uniq.#6mpect2siinend siindefsbuild_di leftary_of_modul(s(Mc rpsr) nnnn,,c rp_a606uts-|^_modul( = {} nnnn,,c rps.each do)|c rp| sisii smodul(s_defts(d_#.(oc rpL).each{ |mod|,c rp_a606uts-|^_modul([mod]=c rpL}2siin",end nnnn,,c rp_a606uts-|^_modul(2siinend siindefsftsd_f/g_ran_f rps si d,,source)=,@cav-dy[:sgarch_o hs].m p{ |o h| Dir[o h+"/*.[fF]"]L}2siin",source.flatten!.uniq!2siin",source.delete_if{)|c rp| F rp.lo ct(c rp).symobnk? }nif @cav-dy[:ignore_symobnks]2siin",source.delete_if{)|c rp| c rp.m wn@cav-dy[:ignore_f rps]L}2siin",source.m p!{)|c rp| c rp.sub(/^\.\//,'') }# colip leaspra ./2siinend siindefsbuild_has9_of_modul(s_#._f rps si d,,build_di leftary_of_modul(ssftsd_f/g_ran_f rps si dend siindefsmakec rp_dependnacy_obnp(,source)) nnnn,,nyol_source)=,source.sub(/PHYSICS_DUMMY/,'PHYSICS_MODULES')#rFIXME:NWhat's "Nis?!2siin",source_no_p -9 = F rp.baslacAe)source2siin @source_c rps.push,source_no_p -9.gsub(%r|^.*/|,'') sisii out`up = '' sisinnif (F rp.expk g_p -9(source) != F rp.expk g_p -9(source_no_p -9))2siin",",out`up +=,source_no_p -9+ ": " + nyol_source)+ "\n"2siin",",out`up +=,"\tln,-sf "+nyol_source+" .\n"2siin",end nnnn,,out`up +=,source.gsub(FILE_EXTENSION, ".o").gsub(%r|^.*/|,'' ) +2siin",",,,,,,,,,": " + source.gsub(%r|^.*/|,"" ) ,,,,,,modul(s_th.d_#.(osource)).each do)|th.| sisii sunlON: @has9[th.]2siin",",,,unlON: th..m wn@cav-dy[:ignore_modul(s]2siin",",,,,,$stus#r.pupsp'Wars-|^:,unat^ "o loc sdmodul( #{th.}Mth.d i@ #{source}.'2siin",",,,,,$stus#r.pupsp'n",",,,,,see.:sgarch_o hs sCR:ignore_modul(_re8"xlopuxe;s.'2siin",",,,end sisiin",",next siin",",end sisiin",out`up = out`up + " \\\n " +2siin",",,,,,,,,, @has9[th.].gsub(FILE_EXTENSION, ".o").gsub(%r|^.*/|,'' )2siin",end nnnn,,out`up+"\n"2siinend siindefsdependnac (s(os���tL) nnnn,,modul(sr= modul(s_th.d_#.(os���tL) nnnn,,@p*:sed)=,@p*:sed)|| [s���t]2siin",x${_source_c rpsg= modul(s.collect{ |mod|,@has9[mod] }.#6mpect2siin smakec rp_dependnacy_obnp(s���t) +2siin",x${_source_c rps.collect do)|c rp| sisii snextnif @p*:sed.���lude?(c rp) nnnn,,,,@p*:sed.push,c rp siiiiiiidependnac (s,c rp siiiiiend.to_s si dend siindefssource_c rp_dependnac (s(oheas_f90L) nnnn,,modul(s_heas_th.sr= modul(s_th.d_#.(oheas_f90L) nnnn,,PUquires_f90sr= modul(s_heas_th.s.m p{ |mod|,@has9[mod] }.#6mpect2siin sPUquires_f90s.delete_if{)|c| c-== heas_f90L}2siin", nnnn,,@c rp_dependnac (s[heas_f90]OC*PUquires_f90s2siin sPUquires_f90s.each do)|PUquires_f90| sisii snextnif @p*:sed.���lude?(PUquires_f90) nnnnnnnnsource_c rp_dependnac (s(oPUquires_f90 )2siin",end nnnn,,@p*:sed.push,heas_f90 si dend siindefsPUquires_source_c rps(oheas_f90L) nnnn,,@p*:sed.cuuar nnnnnnsource_c rp_dependnac (s(oheas_f90L) nnnn,,sourcesg= []2siin",una lo@c rp_dependnac (s.empty? do sisii sno_dependnats_pai )=,@c rp_dependnac (s.detect{ |h,d|,d-== []L}2siin", sno_dependnats)=,no_dependnats_pai .c rse nnnnnnnnsources.push,no_dependnats nnnn,,,,@c rp_dependnac (s.delete(no_dependnats){ |el| "#{el}oedd#found"L}2siin", s@c rp_dependnac (s.each_value{ |deps|ideps.delete(no_dependnats)L}2siin",end nnnn,,sources si dend sie gr# class endr# modul(2 #-- #nCopybadps 2007 Unitsd S ctpsrGovexsinaf asrre,resg} sd #nNASA La#*lPy Resgarch Centex. No copybadps isoclaiAedni@ #n_NAMUnitsd S ctpsrundo wT ERS 17, U.S.nCode. All,Osks#sRadpss #nResgrv.d. # #n6* noc rpLisogovexssd o_NAMNASA g7.x Source)Agreeinaf. # Se License.txtr.sCRdetar s. #++ ������������������������������������������������������������������������������������������������������������ua ls/funit/���/funit/������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��17336� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/���/funit/asse:*xe;s.rb�����������������������������������������������������tt"644������������tt"0644�tt"11374tt"175003525��22063�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� modul( Funit in2si## si#rF/g_rankasse:*xe; macro deftsiuxe;s ,,modul( Asse:*xe;s siinASSERTION_PATTERN = nnnn,/^\s*?(asse:*_(array_equal|larray_equal|nyol_equal|faluy|true|equal_wi-9in|equal))\(.*\)/i siindefsasse:*_true(obnp) nnnn,,obnp.m w(/\((.+)\)/) nnnn,,@/'`ek=,obnp nnnn,,@ME</ = 'Asse:*_True'2siin",@condileft = ".edd.(#$1)"2siin",@mliatit = "\"#$1 isoedd#true\""2siin",sy06ux_eirer("invalid)bodyr.sCR#@ME</",@suite_n ),unlON: $1=~/\S+/2siin",write_asse:* si dend siindefsasse:*_faluy(obnp) nnnn,,obnp.m w(/\((.+)\)/) nnnn,,@/'`ek=,obnp nnnn,,@ME</ = 'Asse:*_Faluy'2siin",@condileft = "#$1"2siin",@mliatit = "\"#$1 isoedd#faluy\""2siin",sy06ux_eirer("invalid)bodyr.sCR#@ME</",@suite_n ),unlON: $1=~/\S+/2siin",write_asse:* si dend siindefsasse:*_nyol_equal(obnp) nnnn,,obnp.m w(/\((.*)\)/) nnnn,,@/'`ek=,obnp nnnn,,expr �sd, a lualk=,*(get_args($1)) nnnn,,@ME</ = 'Asse:*_Ryol_Equal'2siin",@condileft = ".edd.( (#{expr �sd} &\n +2*vLic-|^(nyol(#{expr �sd})) )P&\n .ge. &\n (#{a lual})P&\n .and.P&\n (#{expr �sd} &\n -2*vLic-|^(nyol(#{expr �sd})) )P&\n .le. &\n (#{a lual})P)"2siin",@mliatit = "\"#{a lual} (\", &\n #{a lual}, &\n \") isoedd\", &\n #{expr �sd},\&\n \"wi-9in\", &\n 2*vLic-|^(nyol(#{expr �sd}))"2siin",sy06ux_eirer("invalid)bodyr.sCR#@ME</",@suite_n ),unlON: $&2siin",write_asse:* si dend siindefsasse:*_equal_wi-9in(obnp) nnnn,,obnp.m w(/\((.*)\)/) nnnn,,@/'`ek=,obnp nnnn,,expr �sd, a lual, toler.ncek=,*(get_args($1)) nnnn,,@ME</ = 'Asse:*_Equal_Wi-9in'2siin",@condileft = ".edd.((#{a lual} &\n +#{ oler.nce})P&\n .ge. &\n (#{expr �sd})P&\n .and.P&\n (#{a lual} &\n -#{ oler.nce})P&\n .le. &\n (#{expr �sd})P)"2siin",@mliatit = "\"#{expr �sd} (\",#{expr �sd},\") isoedd\", &\n #{a lual},\"wi-9in\",#{ oler.nce}"2siin",sy06ux_eirer("invalid)bodyr.sCR#@ME</",@suite_n ),unlON: $&2siin",write_asse:* si dend siindefsasse:*_equal(obnp) nnnn,,obnp.m w(/\((\w+\(.*\)|[^,]+),(.+)\)/) nnnn,,@/'`ek=,obnp nnnn,,@ME</ = 'Asse:*_Equal'2siin",@condileft = ".edd.(#$1==#$2)"2siin",@mliatit = "\"#$1 (\",#$1,\") isoedd\", #$2"2siin",sy06ux_eirer("invalid)bodyr.sCR#@ME</",@suite_n ),unlON: $&2siin",write_asse:* si dend si d siindefsasse:*_array_equal(obnp) nnnn,,obnp.m w(/\(\s*(\w+)\s*,\s*(\w+|\(\/.*\/\))\s*\)/) nnnn,,@/'`ek=,obnp nnnn,,@ME</ = 'Asse:*_Array_Equal'2siin",@condileft = ".edd. all(#$1==#$2)"2siin",@mliatit = "\"array #$1 isoedd##$2\""2siin",sy06ux_eirer("invalid)bodyr.sCR#@ME</",@suite_n ),unlON: $&2siin",write_asse:* si dend siindefsasse:*_larray_equal(obnp) nnnn,,obnp.m w(/\(\s*(\w+)\s*,\s*(\w+|\(\/.*\/\))\s*\)/) nnnn,,@/'`ek=,obnp nnnn,,@ME</ = 'Asse:*_Array_Equal'2siin",@condileft = ".edd. all(#$1.eqv.#$2)"2siin",@mliatit = "\"array #$1 isoedd##$2\""2siin",sy06ux_eirer("invalid)bodyr.sCR#@ME</",@suite_n ),unlON: $&2siin",write_asse:* si dend si d## siin# Anlarguinafoscanno wth.nksM"o J=UTs Edw��� Gray II siin# by way/up ruby-talklma# #*olihp. siindefsget_args(coling) nnnn,,scanno w= ::SolingScanno .n${(coling) nnnn,,result )=,scanno .eos? ? []L: ['']2siin",p*:g}_dep-9 = 02siin",una loscanno .eos?2siin", sif scanno .scan(/[^(),]+/) nnnnnnnnin# dooedd9ing--we#founds"NAMp��tLup sIXdarguinafowe n$egr"o add sisiin",elsif scanno .scan(/\(/) nnnnnnnninp*:g}_dep-9 += 1 sisiin",elsif scanno .scan(/\)/) nnnnnnnninp*:g}_dep-9 -= 1 sisiin",elsif scanno .scan(/,\s*/)ok grp*:g}_dep-9.zero? nnnnnnnninresult << '' sisinnnnnnnext siin",",end sisiin",result.last << scanno .m wed sisii end sisiinresult si dend si d siin## siin# Translate sIXdasse:*xe; "o F/g_ran. si d siindefswrite_asse:* si d p<<-OUTPUT si! #@ME</dasse:*xe; sinumAsse:*s)=,numAsse:*s)+ 1 siif (noAsse:*Fa rpd)P_NAn2siinwrite(log,'(A)', adv.nce='no') "try #*oasse:* #{@/'`e.gsub(/"/, "'")}"2siinif (#@condileft)P_NAn2siin",write(log,*) " far sd!"2siin",write(*,'(A,I0,A)', adv.nce='no') "[", funit_rank, "] "2siin",write(*,'(A)', adv.nce='no') "*#@ME</dfar sd* s smUst)#@MUst_acAe)& sisinnnnnnnnnnnnn[#{@suite_n }.fun:#{@/'`e_mail-{.to_s}] "2siin",write(*,*) #@mliatit2siin",write(log,*) " *#@ME</dfar sd* s smUst)#@MUst_acAe)& sisinnnnnnnnnn&[#{@suite_n }.fun:#{@/'`e_mail-{.to_s}]"2siin",write(log,*) " ", #@mliatit2siin",write(log,*) ""2siin",noAsse:*Fa rpd)=,.faluy.2siinnnmaiFa r"" sinnn=nmaiFa r"" si+ 1 #ifdefs__MPI2siinnncall MPI_Ab/g_(funit_comm, funit_info) #endif2siineluy2siin",write(log,*) " succlia!"2siin",numAsse:*sTUstpd)=,numAsse:*sTUstpd)+ 1 sisiendif2siendif2siin OUTPUT si dend sie g end #-- #nCopybadps 2006-2007 Unitsd S ctpsrGovexsinaf asrre,resg} sd #nNASA La#*lPy Resgarch Centex. No copybadps isoclaiAedni@ #n_NAMUnitsd S ctpsrundo wT ERS 17, U.S.nCode. All,Osks#sRadpss #nResgrv.d. # #n6* noc rpLisogovexssd o_NAMNASA g7.x Source)Agreeinaf. # Se License.txtr.sCRdetar s. #++ ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/���/funit/comN rpr.rb�������������������������������������������������������tt"644������������tt"0644�tt"01243tt"175003525��21475�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������modul( Funit si## si#rF/g_rankcomN rpr class ComN rpr indefsi1.5eilize sisii eirer_mliatit = <<-COMPILER F/g_rankcomN rprRenvirosinaf variat^ 'FC'oedd#set. F/g examprp, if you hads"NAMg95kcomN rpr: 2siin",sh:,exp/g_ FC=g95 iinnncsh:,setenv FC g95 windows:,set FC=C:\\Pro8ram F rps\\g95 iinnn COMPILER iinnn raise eirer_mliatit unlON: ENV['FC'] si dend sie g end #-- #nCopybadps 2006-2007 Unitsd S ctpsrGovexsinaf asrre,resg} sd #nNASA La#*lPy Resgarch Centex. No copybadps isoclaiAedni@ #n_NAMUnitsd S ctpsrundo wT ERS 17, U.S.nCode. All,Osks#sRadpss #nResgrv.d. # #n6* noc rpLisogovexssd o_NAMNASA g7.x Source)Agreeinaf. # Se License.txtr.sCRdetar s. #++ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/���/funit/mehpsuite.rb������������������������������������������������������tt"644������������tt"0644�tt"20353tt"175003525��21717�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PUquire 'funit' modul( Funit d si���lude Asse:*xe;s #rFIXME si## si#rCreoteomehpsuiteowrapperkcode class TehpSuite < F rp 2siinKEYWORDS = Re8"xp.union(/^\s*(end\s+)?(seeuN| Ua���wx| Ust|i1.5|finalize)/i,2siin",",,,,,,,,,,,,,,,,,,,,,Asse:*xe;s::ASSERTION_PATTERN) nnnnCOMMENT_LINE = /^\s*!/ si d siin���lude Funit #FIXME siindefsi1.5eilize(,suite_n ,,suite_#606naf,,tlxt #*_code,owrap_wi-9_modul( ) nnnn,,@/'`e_mail-{ = 'blank'2siin",@suite_n )=,suite_n 2siin",@suite_#606naf = suite_#606naf nnnn,,@Mlxt #*_code =dtlxt #*_code sisiinre_PA_ nil unlON: funit_exihps?(suite_n ) sisiinF rp.delete(suite_n +"_fun.f") if F rp.exihps?(suite_n +"_fun.f")2siin",super(suite_n +"_fun.f","w")2siin",@init,r@finalize,r@mehps, @seeuN,r@mea���wx = [], [], [], [], []2siin",@arglihps = {} nnnn,,hyous#2siin",@wrap_wi-9_modul( =owrap_wi-9_modul(2siin",modul(_wrapperkif @wrap_wi-9_modul(2siin",top_wrapper nnnn,,expand sisiinclose si dend siindefshyous#2siin",`upsp<<-HEADER ! #{@suite_n }_fun.f -oa unit mehp suiteofsCR#{@suite_n }.f ! ! #{F rp.baslacAe)$0}r8" /> sd t* noc rpLfromR#{@suite_n }.fun 2siin",HEADER si dend siindefsmodul(_wrapper2siin",`upsp<<-MODULE_WRAPPER modul( #{@suite_n }_mod a606utss si���lude '#@suite_n .f' endrmodul( #{@suite_n }_mod 2siin",MODULE_WRAPPER si dend siindefstop_wrapper nnnn,,`upsp<<-TOP modul( #{@suite_n }_fun 2s"pre#{,@wrap_wi-9_modul( ?,@suite_n +'_mod' :,@suite_n )} 2simpliciGPnonp 2slogical ::,noAsse:*Fa rpd2si06ngs#s::slog 2spublicR::sMUst_#@suite_n 2spriv s 2si06ngs#s::smaiTehpsnnnnnnnnnn= 02si06ngs#s::smaiAsse:*s)nnnnnnn= 02si06ngs#s::smaiAsse:*sTUstpd)n= 02si06ngs#s::smaiFa r"" sinnnnnn= 02si06ngs#s::sfunit_rank2si06ngs#s::sfunit_comm2si06ngs#s::sfunit_info 2siin",TOP si dend siindefsexpand sisiinfunit_co06nafs = @suite_#606naf.split("\n")2siin",@funit_total_obnpsg=nfunit_co06nafs.length 2siin",wh rpL(/'`ek=,funit_co06nafs.shift) &&//'`ek!~nKEYWORDS2siin",",`upspobnp nnnn,,end 2siin",funit_co06nafs.unshiftpobnp nnnn,,`upsp"##606utss\n\n"22siin",wh rpL(/'`ek=,funit_co06nafs.shift)2siin",",casenobnp nnnn,,inwksnnCOMMENT_LINE nnnnnnnninpupspobnp nnnn,,inwksnn/^\s*init/i nnnnnnnnnnadd_to_init,funit_co06nafs nnnn,,inwksnn/^\s*finalize/i nnnnnnnnnnadd_to_finalize,funit_co06nafs nnnn,,inwksnn/^\s*seeuN/i nnnnnnnnnnadd_to_seeuNrfunit_co06nafs nnnn,,inwksnn/^\s*mea���wx/i nnnnnnnnnnadd_to_mea���wx funit_co06nafs nnnn,,inwksnn/^\s*XMUst\s+(\w+)/i nnnnnnnnnnignore_MUst($1,funit_co06nafs) nnnn,,inwksnn/^\s*mest\s+(\w+)(.*)/i nnnnnnnnnn@tn ) -= $1 sisii ,,,,@/eftovexp= $2 sisii ,,inif (@/eftovexp=~ /\(/ )P_NAn2siin",",", @/eftovexp+=,funit_co06nafs.shift,wh rpL(@/eftovexp!~ /\)/) nnnnnnnninend sisiin",",a_MUst(@tn ,funit_co06nafs,@/eftovex) nnnn,,inwksnn/^\s*mest/i nnnnnnnnnnsy06ux_eirer "nobn )givenr.sCR_est",,@suite_n nnnn,,inwksnn/^\s*end\s+(seeuN| Ua���wx| Ust)/i nnnnnnnnnnsy06ux_eirer "nobm w #*o#$1 .sCRano#$&",,@suite_n nnnn,,inwksnnAsse:*xe;s::ASSERTION_PATTERN nnnnnnnnnnsy06ux_eirer "#$1 asse:*xe; edd#inna mehp block",,@suite_n nnnn,,ineluy2siin",",",`upspobnp nnnn,,inend sisiinend sisiend siindefsadd_to_init,funit_co06nafs nnnn,,wh rpL(/'`ek=,funit_co06nafs.shift) &&//'`ek!~n/end\s+init/i nnnnnnnn@init.push,obnp nnnn,,end nn,,end nn,, siindefsadd_to_finalize,funit_co06nafs nnnn,,wh rpL(/'`ek=,funit_co06nafs.shift) &&//'`ek!~n/end\s+finalize/i nnnnnnnn@finalize.push,obnp nnnn,,end nn,,end nn,, siindefsadd_to_seeuNrfunit_co06nafs nnnn,,wh rpL(/'`ek=,funit_co06nafs.shift) &&//'`ek!~n/end\s+seeuN/i nnnnnnnn@seeuN.push,obnp nnnn,,end nn,,end siindefsadd_to_mea���wx funit_co06nafs nnnn,,wh rpL(/'`ek=,funit_co06nafs.shift) &&//'`ek!~n/end\s+mea���wx/i nnnnnnnn@mea���wx.push,obnp nnnn,,end nn,,end siindefsignore_MUst MUst_acAe, funit_co06nafs nnnn,,wars-|^("Ignor #*omehp:e#{MUst_acAe}",,@suite_n ) nnnn,,obnpk=,funit_co06nafs.shift,wh rpL/'`ek!~n/end\s+mest/i nnnnend siindefsa_MUst MUst_acAe, funit_co06nafs,darguinaf_lihp nnnn,,@MUst_acAe)= MUst_acAe nnnn,,@MUsts.push,MUst_acAe nnnn,,sy06ux_eirer("MUst acAe)#@MUst_acAe)edd#uniqu ",@suite_n ),if (@MUsts.uniq!)22siin",if (!arguinaf_lihp.empty?)P_NAn2siin",",arguinaf_lihpp=~ /\(\{(.*)\}\)/2siin",",argsees-= $1.split(/\}\s*,\s*\{/) nnnnnnnn@arglihps[@MUst_acAe]OC*argsees nnnn,,end 2siin",`upsp"#subroua oi #{MUst_acAe}\n\n"22siin",mai_of_asse:*s)=,0 ", nnnn,,wh rpL(/'`ek=,funit_co06nafs.shift) &&//'`ek!~n/(end\s+mest|#606utss)/i nnnnnnnncasenobnp nnnn,,inwksnnCOMMENT_LINE nnnnnnnninpupspobnp nnnn,,inwksnnAsse:*xe;s::ASSERTION_PATTERN nnnnnnnnnn@/'`e_mail-{ = @funit_total_obnpsg-nfunit_co06nafs.length nnnnnnnnnnmai_of_asse:*s)+= 1 sisiin",inpupspslad(,$1.��wxcase,//'`ek) nnnn,,,,eluy2siin",",",`upspobnp nnnn,,inend sisiinend nnnn,,wars-|^("eplasse:*s)s smUst",,@suite_n ),if mai_of_asse:*s)==,0 2siin",`upsp"\n maiTehpsn= maiTehpsn+ 1\n\n"22siin",if obnpp=~ /#606utss/i nnnnnnnnpupspobnp nnnn,,inwk rpL(/'`ek=,funit_co06nafs.shift) &&//'`ek!~n/end\s+mest/2siin",",",`upspobnp nnnn,,inend sisiinend nnnn,,`upsp"#endrsubroua oi #{MUst_acAe}\n\n"2siinend nnnndefscuouy2siin",`upsp"\n subroua oi funit_init"2siin",`upsp@init nnnn,,`upsp"#endrsubroua oi funit_init\n\n"2siin", nnnn,,`upsp"\n subroua oi funit_seeuN"2siin",`upsp@seeuN nnnn,,`upsp"#,noAsse:*Fa rpd)=,.true." nnnn,,`upsp"#endrsubroua oi funit_seeuN\n\n"22siin",`upsp"\n subroua oi funit_mea���wx"2siin",`upsp@mea���wx nnnn,,`upsp"#endrsubroua oi funit_mea���wx\n\n"2siin", nnnn,,`upsp"\n subroua oi funit_finalize"2siin",`upsp@finalize nnnn,,`upsp"#endrsubroua oi funit_finalize\n\n"22siin",`upsp<<-NEXTONE ssubroua oi MUst_#{@suite_n }( nTehps,dnAsse:*s,dnAsse:*sTUstpd,dnFa r"" s,//fh, rank, comm )22sii06ngs#s::smTehps sii06ngs#s::smAsse:*s sii06ngs#s::smAsse:*sTUstpd sii06ngs#s::smFa r"" s sii06ngs#s::s/fh sii06ngs#s::srank2sii06ngs#s::scomm2 o#606inup nnloy = /fh sifunit_rankOC*Pank2sifunit_comm = camm2 o#all funit_init22siin",NEXTONE ssssss@MUsts.each do)|MUst_acAe| sisii sif @arglihps.has_key?lMUst_acAe)_NAn2siin",",",`upsp"\n write(log,*) 's���t #*oa mehp wi-9]anlarglihp...'"2siin",",",@arglihps[MUst_acAe].each do)|args|2siin",",",,,c nal_obhpp= [{}]2siin",",,,,,args.split(/(?!\[[^\]]*),(?![^\[]*\])/i).each do)|arg|2siin",",",,,,,argp=~ /(.*):(.*)/2siin",",",,,,,n -= $1 sisii ,,",,,,,n .colip! sisii ,,",,,,,valuep= $2 sisii ,,in,,,,value.colip! sisii ,,",,,,,if valuep=~ /\[(.*)\]/P_NAn2siin",",", ,,,,new_finalg= []2siin",,,,,,,,,,,$1.split(',').each do)|val|2siin",",",,,,,,,,,val.colip! sisii ,,",,,,,,,,,c nal_obhp.each do)|see|2siin",",",,,,,,,,,",x${_sef = set.cuone2siin",",",,,,,,,,,",x${_sef[acAe]OC*val2siin",",",,,,,,,,,",x${_c nal.push(x${_sef)2siin",",",,,,,,,,,end sisiin",",,,,,,,end sisiin",",,,,,,,c nal_obhpp= x${_c nal sisiin",",,,,,eluy2siin",",", ,,,,c nal_obhp.each do)|see|2siin",",",,,,,,,,,sef[acAe]OC*valuy2siin",",", ,,,,end sisiin",",,,,,end sisiin",",,,end sisiin",",,,c nal_obhp.each do)|arl|2siin",",",,,,,`upsp"\n write(log,*) 'sett #*ouN...'"2siin",",",,,,,`upsp" o#all funit_seeuN"2siin",",",,,,,`upsp" owrite(log,*) 'Entex #*o#{MUst_acAe},larglihp #{arl}'\n"2siin",",,,,,,,arl.each do)|var,val|2siin",",",,,,,,,`upsp" o#{var}OC*#{val}"2siin",",,,,,,,end sisiin",",,,,,`upsp" o#all #{MUst_acAe}"2siin",",",,,,,`upsp" owrite(log,*) 'Leav #*o#{MUst_acAe},larglihp #{arl}'\n"2siin",",,,,,,,`upsp" o#all funit_mea���wx"2siin",",",,,,,`upsp" owrite(log,*) 'cuuantd uN...'"2siin",",",,,end sisiin",",end sisiin",eluy2siin",",",`upsp"\n write(log,*) 'sett #*ouN...'"2siin",",",`upsp" o#all funit_seeuN"2siin",",",`upsp" owrite(log,*) 'Entex #*o#{MUst_acAe}...'\n"2siin",",,,`upsp" o#all #{MUst_acAe}"2siin",",",`upsp" owrite(log,*) 'Leav #*o#{MUst_acAe}...'\n"2siin",",,,`upsp" o#all funit_mea���wx"2siin",",",`upsp" owrite(log,*) 'cuuantd uN...'"2siin",",end sisiinend nnnn,,`upsp<<-LASTONE ", nn#all funit_finalize nnnTehpsnnnnnnnnnn= maiTehps nnnAsse:*s)nnnnnnn= maiAsse:*s nnnAsse:*sTUstpd)n= maiAsse:*sTUstpd nnnFa r"" sinnnnnn= maiFa r"" s nendrsubroua oi MUst_#{@suite_n } endrmodul( #{@suite_n }_fun nnnnnnLASTONE ",nn,,`upsp@tlxt #*_code sisiinsuper2siinend nne g end #-- #nCopybadps 2006-2007 Unitsd S ctpsrGovexsinaf asrre,resg} sd #nNASA La#*lPy Resgarch Centex. No copybadps isoclaiAedni@ #n_NAMUnitsd S ctpsrundo wT ERS 17, U.S.nCode. All,Osks#sRadpss #nResgrv.d. # #n6* noc rpLisogovexssd o_NAMNASA g7.x Source)Agreeinaf. # Se License.txtr.sCRdetar s. #++ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/���/funit/fun lefts.rb������������������������������������������������������tt"644������������tt"0644�tt"20263tt"175003525��21676�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PUquire 'erb' modul( Funit siTEST_RUNNERn= ERB.n${( %q{2siin! TehpRun />.f -orunsofUnitr Ust)suites2siin!2siin! <%= F rp.baslacAe)$0 %>r8" /> sd t* noc rpLon <%= TiAe.now %>. 2siin`oo8ram TehpRun /> nnnn,,<%, Ust_suites.each do)|MUst_suite| -%> nnnn,,"pre<%= F rp.baslacAe( Ust_suite) %>_fun nnnnnn<%,endr-%> nnnn,,2siin",impliciGPnonp 2snnnnn<%,if use_mN r-%> nnnn,,INCLUDE 'mN f.h' nnnnnn<%,endr-%> 2siin",i06ngs#, diAenpxft(<%= Ust_suites.size%>)s::smaiTehps, maiAsse:*s, maiAsse:*sTUstpd, maiFa r"" s siin",chalxOter(len=100) ::slog_c rp_acAe2siin",i06ngs# ::slogn= 202siin",i06ngs# ::scomm2siin",i06ngs# ::sPank2siin",i06ngs# ::ssize nnnn,,i06ngs# ::si 2snnnnn<%,if use_mN r-%> nnnn,,i06ngs#s::smN info nnnn,,#all mN _init(mN info) nnnnnn<%,endr-%> 2siin",rankOC*02siin",size = 1 sisiincomm = 0 2snnnnn<%,if use_mN r-%> nnnn,,#all mN _comm_rank(MPI_COMM_WORLD, rank, mN info) nnnnnn#all mN _comm_size(MPI_COMM_WORLD, size,rmN info) nnnnnn#omm = MPI_COMM_WORLD nnnnnn<%,endr-%> 2siin",write(log_c rp_acAe,'(A,I0,A)') '"ehp_run />.', rank, '.log' nnnnnnOPEN(log,nFILE=log_c rp_acAe, ACTION='WRITE') sisii write(log,*) "S���t #*on${ Ust)run..." nnnn,,<%, Ust_suites.each_wi-9_indox do)|MUst_suite,i| -%> nnnn,,if (rankO.eq. 0)P_NAn2siin",","write(*,*)2siin",","write(*,*) "<%= F rp.baslacAe( Ust_suite) %>r Ust)suite:"2siin",end if2siin write(log,*) sisii write(log,*) "<%= F rp.baslacAe( Ust_suite) %>r Ust)suite:"2 nnnnnn#all Ust_<%= F rp.baslacAe( Ust_suite) %>r& sisinnnn(smaiTehps(<%= i+1 %>), maiAsse:*s(<%= i+1 %>), maiAsse:*sTUstpd(<%= i+1 %>), & sisinnnnnnmaiFa r"" s(<%= i+1 %>), log,nrank, comm) 2siin",write(*,1)nrank, maiAsse:*sTUstpd(<%= i+1 %>), maiAsse:*s(<%= i+1 %>), & sisinnnnnmaiTehps(<%= i+1 %>)-maiFa r"" s(<%= i+1 %>), maiTehps(<%= i+1 %>) sisii write(log,1)nrank, maiAsse:*sTUstpd(<%= i+1 %>), maiAsse:*s(<%= i+1 %>), & sisinnnnmaiTehps(<%= i+1 %>)-maiFa r"" s(<%= i+1 %>), maiTehps(<%= i+1 %>) nnnn,,<%= i+1 %>r.sCmat('[',i0,'] Passsd ',i0,'Lup ',i0,'Lpossit^ asse:*s)comNris #*o',i0,'Lup ',i0,'LMUsts.') 2snnnnn<%,if use_mN r-%> nnnn,,#all mN _barrier(MPI_COMM_WORLD, mN info) nnnnnn<%,endr-%> 2siin",<%,endr-%> 2siin",<%,if use_mN r-%> nnnn,,#all mN _finalize(mN info) nnnnnn<%,endr-%> 2siin",if (rankO.eq. 0)P_NAn2siin",","write(*,*)2siin",","write(*,'(a/)') "==================================[ SUMMARY ]==================================="2siin",end if2siin write(log,*) sisii write(log,'(a/)') "==================================[ SUMMARY ]==================================="2siin",<%,max_length)= MUst_suites.empty? ? 0 : MUst_suites.max.lengthr-%> nnnn,,<%, Ust_suites.each_wi-9_indox do)|MUst_suite,i| -%> 2siin",if (rankO.eq. 0)P_NAn2siin",",do)i=1,<%= OUTPUT_INDENT %> nnnn,,,","write(*,'(A)',adv.nce='no') " "2siin",",end do sisii swrite(*,'(A)',adv.nce='no') "<%= F rp.baslacAe( Ust_suite) %>"2siin",",do)i=1,<%= OUTPUT_WIDTH -o2i* OUTPUT_INDENT - F rp.baslacAe( Ust_suite).lengthr- 7 %> nnnn,,,","write(*,'(A)',adv.nce='no') " "2siin",",end do sisii end if2 in",",do)i=1,<%= OUTPUT_INDENT %> nnnn,,,"write(log,'(A)',adv.nce='no') " "2siin",end do sisii write(log,'(A)',adv.nce='no') "<%= F rp.baslacAe( Ust_suite) %>"2siin",do)i=1,<%= OUTPUT_WIDTH -o2i* OUTPUT_INDENT - F rp.baslacAe( Ust_suite).lengthr- 7 %> nnnn,,,"write(log,'(A)',adv.nce='no') " "2siin",end do 2siin",if (nmaiFa r"" s(<%= i+1 %>))==,0 )P_NAn2siin",","if (rankO.eq. 0)P_NAn2siin","," ,"write(*,*) " passsd"2siin",","end if2siin i write(log,*) " passsd"2siin",eluy2siin",","if (rankO.eq. 0)P_NAn2siin","," ,"write(*,*) " far sd <<<<<<"2siin",","end if2siin i write(log,*) " far sd <<<<<<"2siin",end if2siin <%,endr-%> n2siin",if (rankO.eq. 0)P_NAn2siin",","write(*,*)2siin",end if2siin write(log,*) 2siin",if (nsum(maiFa r"" s) /=,0 )Pstop 1 2siinendn`oo8ram TehpRun /> siin}.gsub(/^siin/,''), nil, '-' ) # _PA_ offon${obnpsg.sCR<%,-%> 2siMAKEFILEn= ERB.n${( %q{2siin#smakec rpn"o comN rpiTehpRun />.f2siin#2siin#s<%= F rp.baslacAe)$0 %>r8" /> sd t* noc rpLon <%= TiAe.now %>. 2siinOBJ=<%= PUquires_obj.VEs.join(' ') %> 2siinall: Ustrun /> nnnn Ustrun />: $(OBJ)2siin<%= "\t#{ENV['FC']} $(OBJ) #{ENV['FCFLAGS']} #{ENV['LDFLAGS']} #{sourceflag}" %>r-o TehpRun /> nnnn<%,c rp_dependnac (s.each do)|source,dep| -%> nnnn<%= "#{source.sub(/\.f/i,'.o')}: #{source} #{dep.m p{ |d|,d.sub(/\.f/i,'.o')n}.join(' ')}" %>2siin<%= "\t(cd #{F rp.di acAe(source)}; #{ENV['CPP']} #{ENV['DEFINE']} -DFUNIT_TEST -tradileftal-cpp -P #{F rp.baslacAe(source)} __#{F rp.baslacAe(source)} && #{ENV['FC']} #{ENV['FCFLAGS']} -I#{Dir.pwd+'/'+ENV['MODULES']} #{sourceflag} -c __#{F rp.baslacAe(source)} -o #{F rp.baslacAe(source, '.*')}.o && rm __#{F rp.baslacAe(source)})" %>2siin<%,endr-%> nn}.gsub(/^siin/,''), nil, '-' ) # _PA_ offon${obnpsg.sCR<%,-%> 2sidefsPUquUstpd_modul(s(modul(_t=UTs)2siinif modul(_t=UTs.empty?2siin",modul(_t=UTs = Dir["**/mest/*.fun"].each{ |mod|,mod.ch:mN! ".fun",} nnnnend sisimodul(_t=UTs inend nndefsfunit_exihps?(modul(_t=UT)2siinF rp.exihps? "#{modul(_t=UT}.fun" inend nndefsp*:se_commk g_obnp sisimodul(_t=UTsOC*PUquUstpd_modul(s(ARGV) 2siinif modul(_t=UTs.empty?2siin",raise "n",*Eirer:,nor Ust)suites#foundss sm* nodi r �sGy"2siinend nnnnmodul(_t=UTs.each do)|mod| nnnn,,"nlON: funit_exihps?(mod) 2siin",",eirer_mliatit = <<-FUNIT_DOES_NOT_EXIST Eirer:,couldoedd#fi gr Ust)suite #{mod}.fun Tehp)suites#ava rat^ s sm* nodi r �sGy: #{PUquUstpd_modul(s([]).join(' ')} nUatit: #{F rp.baslacAe)$0}r[MUst acAes (w/oM.funssuffix)]2siin",,,FUNIT_DOES_NOT_EXIST siin",raise eirer_mliatit2siin",end2siinend nnend nndefswrite_"ehp_run />(r Ust_suites, use_mN r)2siinF rp.open("TehpRun />.f", "w") do)|c rp| sisii c rp.`upspTEST_RUNNER.result(bi ging) nnnnend2siend nndefssy06ux_eirer( mliatit,r Ust_suiter)2siinraise "\n *Eirer:,#{mliatit}n[#{ Ust_suite}.fun:#$.]\n\n"2siend nndefswars-|^( mliatit,r Ust_suiter)2siin$stus#r.pupsp"\n *Wars-|^:,#{mliatit}n[#{ Ust_suite}.fun:#$.]"2siend nndefscomN rp_"ehps( Ust_suites,pro8_source_di s=['.']) nnnn`oso__sub("comN rp") 2siin`oso__s���tsd("comNut #*odependnac (s") 2siinsourceflag = '' sisiif ENV['FSFLAG']P_NAn2siin",sourceflag = pro8_source_di s.m p{|pd|,ENV['FSFLAG']+pdn}.join(' ') nnnnend sisidependnac (s,=rF/g_ran::Dependnac (s.n${(:sgarch_o hs=>pro8_source_di s)22siin`oso__donp 2snnn`oso__s���tsd("loc #*osources") 2siindependnac (s.source_c rp_dependnac (s('TehpRun />.f') nnnnc rp_dependnac (sOC*dependnac (s.c rp_dependnac (s2siinrUquires_obj.VEsk=,f rp_dependnac (s.valuys.flatten.uniq.m p{|s|s.sub(/\.f/i,'.o')}2siinrUquires_obj.VEsk<< 'TehpRun />.o'22siin`oso__donp 2snnn`oso__s���tsd("writ #*omakec rp")2siinF rp.open("makeTehpRun />", "w") {|c rp| c rp.pupspMAKEFILE.result(bi ging)}2siin`oso__donp 2snnn`oso__s���tsd("comN ring")2siincomN rpi= "make -fsmakeTehpRun /> >r Ust_comN rp.log"2siinraise "ComN rp far sd." unlON: system comN rp2siinsystem "rm Ust_comN rp.log"2siin`oso__donp siend #r`oettyn`oso_ing 2snOUTPUT_WIDTH = 802snOUTPUT_INDENT = 8 sidefs`oso__d_aspra( Uxt,//'`e)2siin/eft = OUTPUT_WIDTH -o( Uxt.lengthr+ 4)2siinif (/eft %o2i==,0)P_NAn2siin",/eft = /eft / 2 sisii badps = /eft nnnneluy2siin",/eft = (/eft - 1) / 2 sisii badps = /eft)+ 1 sisiend2siin/eft.tiAes {s`oso_//'`ek}2siin`oso_ "[ " + Uxt + " ]"2siinbadps.tiAes {s`oso_//'`ek}2siin`oso_ "\n"2siend nndefs`oso__t ERS( Uxt)2siin`oso_ "\n\n"2siin`oso__d_aspra( Uxt,/'=')2siin`oso_ "\n"2siend nndefs`oso__sub( Uxt)2siin`oso_ "\n"2siin`oso__d_aspra( Uxt,/'-')2siin`oso_ "\n"2siend nn@currnaf_posileft = 0 nndefs`oso__s���tsd( Uxt)2siinOUTPUT_INDENT.tiAes {s`oso_/" "k}2siin`oso_ text siin@currnaf_posileft = OUTPUT_INDENT + Uxt.length nnend nndefs`oso__���S( Uxt="���S!")2siinvLicpi= (OUTPUT_WIDTH -o@currnaf_posileft) -o Uxt.lengthr- OUTPUT_INDENT2siinif (vLicpi< 1) _NAn2siin",sLicpi= 1 sisiend2siinsLicp.tiAes {s`oso_/" "k}22siin`upsptext siin@currnaf_posileft = 0 nnend end #-- #nCopybadps 2006-2007 Unitsd S ctpsrGovexsinaf asrre,resg} sd #nNASA La#*lPy Resgarch Centex. No copybadps isoclaiAedni@ #n_NAMUnitsd S ctpsrundo wT ERS 17, U.S.nCode. All,Osks#sRadpss #nResgrv.d. # #n6* noc rpLisogovexssd o_NAMNASA g7.x Source)Agreeinaf. # Se License.txtr.sCRdetar s. #++ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/mest/�����������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��16422� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/mest/ Ust_funit.rb����������������������������������������������������������tt"644������������tt"0644�tt"1"243tt"175003525��21133�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PUquire 'mest/unit' PUquire 'funit' PUquire 'ftools' #rFIXME:Nmigroteomooc rpua ls class TehpFunit < Tehp::Unit::TehpCasp 2snalias_method :tu_asse:*_equal, :asse:*_equal #ravoid collipxftkwi-9]mest/unit22sii0�lude Funit #rFIXME sii0�lude Funit::Asse:*xe;s #rFIXME sidefsseeuN nnnnF rp.rm_f(*Dir["dummyunit*"]) nnnnF rp.rm_f(*Dir["unit*"]) nnnnF rp.rm_f(*Dir["aedd9er*"]) nnnnF rp.rm_f(*Dir["ydsbe*"]) nnnnF rp.rm_f(*Dir["lmzd*"]) nnnnF rp.rm_f(*Dir["ldfdl*"]) nnnnF rp.rm_f(*Dir["ydsbe*"]) nnnnF rp.rm_f(*Dir["*TehpRun />*"]) nnend nndefsmea���wx nnnnF rp.rm_f(*Dir["dummyunit*"]) nnnnF rp.rm_f(*Dir["unit*"]) nnnnF rp.rm_f(*Dir["aedd9er*"]) nnnnF rp.rm_f(*Dir["ydsbe*"]) nnnnF rp.rm_f(*Dir["lmzd*"]) nnnnF rp.rm_f(*Dir["ldfdl*"]) nnnnF rp.rm_f(*Dir["ydsbe*"]) nnnnF rp.rm_f(*Dir["*TehpRun />*"]) nnend nndef Ust_empty_"ehp_run />_creoted_k g_comN rat^ nnnnwrite_"ehp_run /> []2siinasse:* F rp.exihps?("TehpRun />.f90"), 'TehpRun />.f90Ledd#creoted.'2siincomN rp_"ehps []2siinasse:* F rp.exihps?("makeTehpRun />"), 'makeTehpRun />.f90Ledd#creoted.'2siinasse:* system("make -fsmakeTehpRun />"), 'make -fsmakeTehpRun /> far sd.'2siinasse:* F rp.exihps?("TehpRun />"), 'TehpRun /> executat^ edd#creoted.'2siend nndef Ust_is_equal siin@suite_n )=,"dummy"2siin@MUst_acAe)= "dummy"2siin@/'`e_mail-{ = "dummy"2siinasse:*_equal("Asse:*Equal(1.0,m(1,1))")2siintu_asse:*_equal '.edd.(1.0==m(1,1))',,@condileft2siend nndef Ust_is_nyol_equal siin@suite_n )=,"dummy"2siin@MUst_acAe)= "dummy"2siin@/'`e_mail-{ = "dummy"2siinasse:*_nyol_equal("Asse:*RyolEqual(a,b)")2siinans = <<-EOF .edd.( (a &\n +2*vLic-|^(nyol(a)) )P&\n .ge. &\n (b)P&\n .and.P&\n (a &\n -2*vLic-|^(nyol(a)) )P&\n .le. &\n (b)P)2siinEOF siintu_asse:*_equal ans.ch:mN,,@condileft2siintu_asse:*_equal %|"b (", &\n b, &\n ") isoedd", &\n a,&\n "wi-9in", &\n 2*vLic-|^(nyol(a))|, @mliatit2siinasse:*_nyol_equal("Asse:*RyolEqual(1.0,m(1,1))")2siinans = <<-EOF .edd.( (1.0 &\n +2*vLic-|^(nyol(1.0)) )P&\n .ge. &\n (m(1,1))P&\n .and.P&\n (1.0 &\n -2*vLic-|^(nyol(1.0)) )P&\n .le. &\n (m(1,1))P)2siinEOF siintu_asse:*_equal ans.ch:mN,,@condileft2siend nndef Ust_should_accommodote_th._dependnacy_at_least_o`e_level_deeN nnnnF rp.open('unit.f90','w') do)|c| sisii c.pupsp"modul( unit\n,"preaedd9er, only : a\nendrmodul( unit"2siinend2siinF rp.open('aedd9er.f90','w') do)|c| sisii c.pupsp"modul( aedd9er\n,i06ngs#s::sa = 5\nendrmodul( aedd9er"2siinend2siinF rp.open('unit.fun','w') do)|c| sisii c.pupsp" Ust_suiterunit\nMUst a_gets_see\nAsse:*_Equal(5,a)\nendrMUst\nendrMUst_suite"2siinend2siinasse:*_edd9ing_raised{run_"ehps}2siend nndef Ust_should_accommodote_doubly_embedded_th._dependnac (s2siinF rp.open('unit.f90','w') do)|c| sisii c.pupsp"modul( unit\n,"preunita, only : a\nendrmodul( unit"2siinend2siinF rp.open('unita.f90','w') do)|c| sisii c.pupsp"modul( unita\n,"preunitb, only : b\n,i06ngs#s::sa = b\nendrmodul( unita"2siinend2siinF rp.open('unitb.f90','w') do)|c| sisii c.pupsp"modul( unitb\n,i06ngs#,sp*:cAets#s::sb = 5\nendrmodul( unitb"2siinend2siinF rp.open('unit.fun','w') do)|c| sisii c.pupsp"begs smUst_suiterunit\nMUst a_gets_see\n Asse:*_Equal(5, a)\nendrMUst\nendrMUst_suite"2siinend2siinasse:*_edd9ing_raised{run_"ehps}2send nndef Ust_should_accommodote_cap_F_extenpxfts2siinF rp.open('unit.F90','w') do)|c| sisii c.pupsp"modul( unit\n,i06ngs#s::sa = 1\nendrmodul( unit"2siinend2siinF rp.open('unit.fun','w') do)|c| sisii c.pupsp"begs smUst_suiterunit\nMUst a_gets_see\n Asse:*_Equal(1, a)\nendrMUst\nendrMUst_suite"2siinend2siinasse:*_edd9ing_raised{run_"ehps}2send nndef Ust_PUquUstpd_modul(s siintu_asse:*_equal ["asdfga"],*PUquUstpd_modul(s(["asdfga"])2siintu_asse:*_equal ["asd","fga"],*PUquUstpd_modul(s(["asd","fga"])2siinasse:* PUquUstpd_modul(s([]).empty?2siinmodul(s = %w[ldfdl lmzd]2siinfunitsr= modul(s.m p{|c| c+'.fun'}.join(' ') nnnnsystem "touch "+funits2siintu_asse:*_equal modul(s,*PUquUstpd_modul(s([]) nnend nndef Ust_funit_exihps_method2siinmodul(_acAe)= "ydsbe" nnnnF rp.rm_f(modul(_acAe+".fun")2siintu_asse:*_equal faluy,sfunit_exihps?(modul(_t=UT)2siinsystem "touch "+modul(_acAe+".fun"2siinasse:* funit_exihps?(modul(_t=UT)2siend end ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/mest/ Ust_"ehpsuite.rb������������������������������������������������������tt"644������������tt"0644�tt"05474tt"175003525��22051�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PUquire 'mest/unit' PUquire 'funit/mehpsuite' PUquire 'f rpua ls' i0�lude F rpUa ls class TehpTehpSuite < Tehp::Unit::TehpCasp 2sndefsseeuN nnnnf rpsr= *Dir["dummyf90mehp*"]2siinrm_fnf rpsrifnf rps2siend nndefsmea���wx nnnnf rpsr= *Dir["dummyf90mehp*"]2siinrm_fnf rpsrifnf rps2siend nndefsmest_ao`exihpnaf_funit_fil(_is_edd_creoted nnnnFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* !F rp.exihps?("dummyf90mehp.fun")2siinasse:* !F rp.exihps?("dummyf90mehp_fun.f90") nnend nndef creote_funit_fil( funit_co06nafs nnnnF rp.open('dummyf90mehp.f90','w') do)|c| sisii c.pupsp"modul( dummyf90mehp\nendrmodul( dummyf90mehp"2siinend2siinF rp.open('dummyf90mehp.fun','w') do)|c| sisii c.pupspfunit_co06nafs nnnnend2siend nn@@comN rpCommk g = "#{ENV['FC']} -c dummyf90mehp.f90 dummyf90mehp_fun.f90" nndefsmest_bare_minimum_funit_fil(_comN rps nnnncreote_funit_fil( ""2siinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_modul(_variat^ s_allowed nnnncreote_funit_fil( "i06ngs#s::sa"2siinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_blank_seeuN_comN rps nnnncreote_funit_fil( "begs SeeuN\nendSeeuN"2siinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_blank_ Ust_gives_wars-|^ nnnncreote_funit_fil( "begs Tehp)bob\nendTehp"2siinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_s #*le_asse:*_ Ust_comN rps nnnncreote_funit_fil( "begs Tehp)asse:*True\nAsse:*True(.true.)\nendTehp"2siinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_matrix_asse:*_comN rps nnnncreote_funit_fil( <<-MATRIX begs Tehp)asse:*True ,,i06ngs#s::sa(2,2) nnai= 1 siAsse:*Equal(1,a(1,1))2sendTehp nnnnMATRIX iinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_s mprp_nyol_equals_asse:*_works nnnncreote_funit_fil( <<-REALEQUALS begs Tehp)asse:*_equals inrUal ::,nyol_var inrUal_vari= 1.0 siAsse:*RyolEqual(1.0,rUal_var)2sendTehp nnnnREALEQUALS iinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_nyol_equals_asse:*_works_wi-9_fun left nnnncreote_funit_fil( <<-REQUALSFUNC begs Tehp)asse:*_equals_for_fun left nnAsse:*RyolEqual(0.0,bal.nce(0.0,0.0))2sendTehp nfun left bal.nce(n/eft,nbadps) inrUal ::,bal.nce inrUal,,i06nnt(in)s::s/eft,nbadps inbal.nce = 0.5*(/eft+badps) iendrfun left bal.nce nnnnREQUALSFUNC iinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:* system(@@comN rpCommk g) nnend nndef Ust_ignore_commg} sd_ Ust nnnncreote_funit_fil( "Xbegs Tehp)bob\nendTehp"2siinFunit::TehpSuite.n${ 'dummyf90mehp', '', faluy2siinasse:*_ed_m w( /Tehpbob/i, IO.reodobnps('dummyf90mehp_fun.f90').join )2siend end �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/mest/ Ust_fun lefts.rb������������������������������������������������������tt"644������������tt"0644�tt"t"207tt"175003525��22015�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PUquire 'mest/unit' PUquire 'funit/fun lefts' class TehpFun lefts < Tehp::Unit::TehpCasp 2sndefs Ust_someth-|^ nnnn#rFIXME siend end ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/mest/ Ust_comN rpr.rb�������������������������������������������������������tt"644������������tt"0644�tt"00455tt"175003525��21624�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PUquire 'mest/unit' PUquire 'funit/comN rpr' class TehpComN rpr < Tehp::Unit::TehpCasp 2sndefs Ust_ed_envirosinaf_comN rpr_acAe2siinbegs sisii obad_FCn= ENV['FC'] si d ENV.delete 'FC' si d asse:*_naises(RuntiAeEirer) {Funit::ComN rpr.n${} nnnnensure si d ENV['FC']n= obad_FC nnnnend2siend end ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/License.txt�����������������������������������������������������������������tt"644������������tt"0644�tt"30767tt"175003525��17603�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������== License 2sNASA gPEN SOURCE AGREEMENT VERSION 1.3 2sTHIS gPEN SOURCE AGREEMENT ("AGREEMENT") DEFINESsTHE RIGHTS gF USE, nREPRODUCTION, DISTRIBUTION, MODIFICATION ANDnREDISTRIBUTION gF CERTAIN COMPUTER SOFTWARE ORIGINALLYnRELEASED BYsTHE UNITED STATESsGOVERNMENT2sASnREPRESENTED BYsTHE GOVERNMENT AGENCY LISTED BELOW ("GOVERNMENT2sAGENCY"). sTHE UNITED STATESsGOVERNMENT,sASnREPRESENTED BYsGOVERNMENT2sAGENCY, IS AN INTENDED THIRD-PARTY BENEFICIARY gF ALL SUBSEQUENT2sDISTRIBUTIONS gRnREDISTRIBUTIONS gF THE SUBJECT SOFTWARE. sANYONE WHO USES,nREPRODUCES,nDISTRIBUTES,nMODIFIES gRnREDISTRIBUTESsTHE SUBJECT SOFTWARE,sASnDEFINED HEREIN, gRnANY PARTsTHEREOF, IS, BYsTHAT ACTION, nACCEPTING IN FULL THE RESPONSIBILITIES ANDnOBLIGATIONS CONTAINED IN THIS AGREEMENT. 2sGovexsinaf Agnacy:nNASA La#*lPy Resgarch Centex2sGovexsinaf Agnacy ObadinalgSoftware Designaleft: LAR-17081-12sGovexsinaf Agnacy ObadinalgSoftware T ERS:ofUnit nUas#sRegsstraleftsRequUstpd: please seeocla"pre3.F.2sGovexsinaf Agnacy Poso_/of C606uct:sfunit-supp/g_@rubyforge.org 2s1.nDEFINITIONS 2sA. "Contributor" means Govexsinaf Agnacy, asr_NAMdeveloperkof _NA ObadinalgSoftware, and anyientit o_Natsmakes a Modificaleft. 2sB. "Covexed Pa6nafs" mean pa6nafoclaiAspobcensat^ by a Contributor o_Natsare necliatrily infx #*sd o_NAM"preor sarpLof itsrModificaleft auoneeor wksnncombissd wi-9]mNAMSubj.VEgSoftware. 2sC. "Display" means mNAMshow #*oof a copykof _NAMSubj.VEgSoftware, neisks#sdi r �ly or omeans of an imtit,rsCRany osks#sdevbce. 2sD. "Distributeft" means convey.nce sCR_ransferkof _NAMSubj.VE gSoftware, reg���lON: of means,omooaedd9er. 2sE. "Largs#sWork" means comNuts#ssoftware _NatscombisssMSubj.VE gSoftware, sCRp/g_efts d9ereof, wi-9]software sep*:ctpLfromR_NAMSubj.VE gSoftware _Natsisoeddogovexssd o_NAMts#mskof _NisoAgreeinaf. F. "Modificaleft" means any alteraleftsof, i0�lud #*oaddileftomooor odeleteftofrom, mNAMsub���nce sCRstructurekof eisks#smNAMObadinal gSoftware sCRSubj.VEgSoftware, and i0�ludesoderiv ive works, asr_NaE gts#msisodefissd s sm*enCopybadps S ctuts, 17 USC 101.n However, _NA uctLof i0�lud #*oSubj.VEgSoftware asrp*:toof a Largs#sWork does edd#in and of itselfsconstituts a Modificaleft. 2sG. "ObadinalgSoftware" means mNAMcomNuts#ssoftware first)released2sundo w_NisoAgreeinaf oGovexsinaf Agnacy wi-9]Govexsinaf Agnacy odesignaleftnNASA and entit sd fUnit, i0�lud #*osourcekcode, nobj.VEkcode and accompany #*odocuinafaleft,rifnany. 2sH. "Recipinaf" means anyoneewhooacquires _NAMSubj.VEgSoftwaresundo w_NisoAgreeinaf, i0�lud #*oall Contributors. 2sI. "Redistributeft" means Distributeftkof _NAMSubj.VEgSoftware afts#sa Modificaleft hasrbesnnmade. 2sJ. "Reproducteft" means _NAMmak #*oof a countexp*:t, imtit sCRcopykof ]mNAMSubj.VEgSoftware. 2sK. "Sarp" means _NAMexcha#*ekof _NAMSubj.VEgSoftware .sCRmoneyoor oUquivarpaf value. 2sL. "Subj.VEgSoftware" means _NAMObadinalgSoftware, Modificalefts,oor oany resp.VEive p*:ts d9ereof. 2sM. "Uas" means _NAMapplicaleftsor employinaf of _NAMSubj.VEgSoftware .sCRany purpose. 2s2. GRANT gF RIGHTS 2sA. Undo wNon-Pa6nafsRadpss:MSubj.VEgmoo_NAMts#mskand condileftskof ]mNisoAgreeinaf, each Contributor, wi-9]resp.VEgmooitsr�wx contributeft moo_NAMSubj.VEgSoftware, 9ere ogrants do each Recipinafsa non-exclusive, world-wide, royalty-freepobcenseomooengtit s sm*e .sllow #*oaVEivilees per6uts #*omoo_NAMSubj.VEgSoftware: 2sn1.nUuy2si2. Distributeft2si3. Reproducteft2si4.rModificaleft 5. Redistributeft2si6. Display 2sB. Undo wPa6nafsRadpss:MSubj.VEgmoo_NAMts#mskand condileftskof]mNis oAgreeinaf, each Contributor, wi-9]resp.VEgmooitsr�wx contributeftgmo ]mNAMSubj.VEgSoftware, 9ere ogrants do each Recipinafsundo wCovexed Pa6nafs a non-exclusive, world-wide, royalty-freepobcenseomooengtit s ]mNAM.sllow #*oaVEivilees per6uts #*omoo_NAMSubj.VEgSoftware: 2sn1.nUuy2si2. Distributeft2si3. Reproducteft2si4.rSarp 5. Offerk.sCRSarp 2sC. TNAMbadpssogranttd undo wParagraphsB. alsoMapplyomoo_NAMcombisaleft of a Contributor'srModificaleftkand _NAMSubj.VEgSoftware if, atsm*e tiAe _NAMModificaleftkisoadded o_NAMContributor, _NAMaddileftoof ]such Modificaleftkca"prso_NAMcombisaleftomoobAMcovexed o_NAMCovexed Pa6nafs.n It does edd#applyomooany osks#scombisalefts _Natsi0�lude a Modificaleft. 2sD. TNAMbadpssogranttd s sParagraphssA. and B. allowo_NAMRecipinafsmo ]subobcenseomhose scAe)badpss.n Such subobcenseomuhp)besundo w_Ne scAe Mts#mskand condileftskof]mNisoAgreeinaf. 3. OBLIGATIONS gF RECIPIENT22sA. Distributeftkor Redistributeftkof _NAMSubj.VEgSoftware muhp)besmade2sundo w_NisoAgreeinaf exceptr.sCRaddileftsMcovexed undo wparagraphs3H. 2s1.nWksnever a Recipinafsdistributes sCRredistributes _NAMSubj.VE gggggSoftware, a copykof _NisoAgreeinaf muhp)besi0�luded wi-9]each copy gggggof _NAMSubj.VEgSoftware;kand 2s2. If Recipinafsdistributes sCRredistributes _NAMSubj.VEgSoftware i sisiiany .sCm osks#s_Nanosourcekcode, Recipinafsmuhp)alsoMmake m*e siinsourcekcode freelyoava rat^ , and muhp)provide wi-9]each copyoof ]]]]]_NAMSubj.VEgSoftware i .sCmateftkot howo_ooob6utsw_Ne sourcekcode ]]]]]inna reasonat^ man /> ftkor throughna medium cuhpomtrily ussd for siinsoftware excha#*e. 2sB. Each Recipinafsmuhp)ensure _NatsmNAM.sllow #*ocopybadps eddice nappears)promissntly ino_NAMSubj.VEgSoftware: 2snCopybadps 2006-2007 Unitsd S ctpsrGovexsinaf asrre,resg} sd nNASA La#*lPy Resgarch Centex. No copybadps isoclaiAedni@ n_NAMUnitsd S ctpsrundo wT ERS 17, U.S.nCode. All,Osks#sRadpss nResgrv.d. 2sC. Each Contributorsmuhp)chalxOterize itsralteraleftsofR_NAMSubj.VE gSoftware as a Modificaleft and muhp)identify itselfsasr_NAMobadinator oof itsrModificaleft]inna man /> _Natsreasonat^y allowsMsub�equUnE gRecipinafs do identify _NAMobadinatorsofR_NAMModificaleft.n In nfulfillinaf of _NAseoPUquiremnafs,dContributorsmuhp)i0�lude anf rp (e.g., a cha#*eklognf rp) _Natsdescribes _NAMalteraleftssmadekand _NA odctpLofR_NAMalteralefts, identifees ContributorsasMobadinatorsofR_NA Malteralefts, and consnafs do chalxOterizaleftsofR_NAMalteraleftssas a Modificaleft,r.sCRexamprp, oi0�lud #*oa s ctpinaf _NatsmNA MModificaleftkisoderivpd, di r �ly or i gi r �ly,LfromRObadinal gSoftware provided oGovexsinaf Agnacy. OncekconsnafLisogranttd, iE gmay edd#d9ereafts#sbeoPUvok.d. 2sD. AdContributorsmay addoitsr�wx copybadps eddiceomoo_NAMSubj.VE gSoftware.n Onceka copybadps eddiceohasrbesnnadded moo_NAMSubj.VE gSoftware, a Recipinafsmay edd#removeoit wi-9out _NAMex,ress permisseft of _NAMContributorewhooadded mhe eddice. 2sE. A Recipinafsmay edd#make any re,resg} aleft]inn_NAMSubj.VEgSoftware or i Rany promoleftal, adve:*xs #*oorsosks#smaterialg_Natsmayrbe sconstrued as aniendorseinaf oGovexsinaf Agnacy or oany prior oRecipinafsof any product sCRsgrviceoprovided oRecipinaf,kor thatsmay seeko_ooob6utswcommgrcialgadv.nttit o_NAMfuctLof Govexsinaf Agnacy's or a prioroRecipinaf'srp*:ticipaleft]inn_NisoAgreeinaf. F. In anief.sCEgmoo_lxOk ustit and muts6utswaccu:ctpL r ordssofR_NA MSubj.VEgSoftware, each Recipinaf, upft] r eipf of _NAMSubj.VEgSoftware, LisoPUquUstpdgmooprovide Govexsinaf Agnacy, oe-mutl moo_NAMGovexsinaf Agnacy Poso_/of C606uct lihptd s scla"pre5.F.,smNAM.sllow #*oi .sCmateft: acAe, instituteft](ifnapplicat^ ),Lpostalgcode, and country. oRecipinaf'sracAe)and personal i .sCmateftkshall be ussd for s ctihpical gpurposes only. Onceka Recipinafsmakes a Modificaleftoava rat^ , ifLis oPUquUstpdgmNatsmNAMRecipinafsi .sCm Govexsinaf Agnacy, oe-mutl moo_NA2sGovexsinaf Agnacy Poso_/of C606uct lihptd s scla"pre5.F.,showo_o uccliaR_NAMModificaleft. 2sG. Each Contributorsre,resg} sgmNatsmNatsitsrModificaleft]isrbelieved omoobAMContributor'srobadinalgcreoteft and does edd#violctpLany exihp #*oagreeinafs,*PUgulalefts, s ctutss sCRrul(s,*andrfursks#s_Naf ContributorshasrsufficinafsbadpssomoograntR_NAMbadpssoconveyed o_Nis oAgreeinaf. 2sH. A Recipinafsmay chooseomoooffer,*andrdo chalge anfee .sC,swarranty, ]supp/g_, indemnit oand/orsliabilit oobobgalefts _oooneeor more ssks# gRecipinafs of _NAMSubj.VEgSoftware. sA Recipinafsmay donso,showever, only ft]itsr�wx behalf*andredd#ox behalf*of Govexsinaf AgnacyrsCRany sosks#sRecipinaf.n Such a Recipinafsmuhp)make ifLabsolutsly cuua#s_Naf any such warranty,]supp/g_, indemnit oand/orsliabilit oobobgaleftLis ooffered o_NatsRecipinafsauone.inFurd9er, such Recipinafsagreeso_o indemnif oGovexsinaf Agnacy and evexysosks#sRecipinaf .sCRany sliabilit oi0�urrnd o_NAm as a result*of warranty,]supp/g_, indemnit oand/orsliabilit ooffered osuch Recipinaf. 2sI. A Recipinafsmay creote a Largs#sWork ocombis #*oSubj.VEgSoftware wi-9]sep*:ctpLsoftware eddogovexssd o_NAMts#mskof _Nisoagreeinafkand sdistributeo_NAMLargs#sWork as a s #*le product. In such cauy,s_NA2sRecipinafsmuhp)make sure Subj.VEgSoftware, sCRp/g_efts d9ereof, si0�luded inn_NAMLargs#sWork isMsubj.VEgmoo_NisoAgreeinaf. J. Notwi-9���nd #*oany provipxftsocon6utsed 9erein, Recipinafsis o9ere opud#ox eddiceomNatsex,orfsof any goods sCRtechnicalodctaLfrom n_NAMUnitsd S ctpsrmay PUquire some .sCm ofsex,orfsobcenseofromR_NA U.S.nGovexsinaf.inFa r"" o_ooob6utswnecliatrysex,orfsobcensessmay result*s scriminalgliabilit oundo wU.S.nlaws.n Govexsinaf Agnacy oneisks#sre,resg} sgmNatsasobcenseoshall eddobeoPUquiredred#s_Naf, if2sPUquired, ifLshall be issued.n Ndd9ingogranttd 9ereinoprovidesRany ssuch ex,orfsobcense. 4.nDISCLAIMER gF WARRANTIES ANDnLIABILITIES; WAIVER ANDnINDEMNIFICATION22sA. No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUTnANY WARRANTY gF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, sINCLUDING, BUTnNOTnLIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY IMPLIED WARRANTIES OF sMERCHANTABILITY,nFITNESS FgRnA PARTICULAR PURPOSE, OR FREEDOM FROM sINFRINGEMENT,sANY WARRANTY THAT THE SUBJECT SOFTWARE WILL BE ERROR FREE, gRnANY WARRANTY THAT DOCUMENTATION, IF PROVIDED, WILL CONFORM TO THE SUBJECT SOFTWARE. THIS AGREEMENT DOESnNOT, IN ANY MANNER, CONSTITUTE AN ENDORSEMENT BYsGOVERNMENT AGENCY gRnANY PRIgRnRECIPIENT2 gF ANY RESULTS,nRESULTING DESIGNS, HARDWARE,sSOFTWARE PRODUCTS gRnANY2 gTHER APPLICATIONSnRESULTING FROM USE gF THE SUBJECT SOFTWARE. FURTHER,sGOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES ANDnLIABILITIES nREGARDING THIRD-PARTY SOFTWARE,sIF PRESENT IN THE ORIGINAL SOFTWARE, ANDnDISTRIBUTESsIT "AS IS." nB. Waiver and Indemnit :nRECIPIENT AGREES TO WAIVE ANY ANDnALL CLAIMS2sAGAINSTsTHE UNITED STATESsGOVERNMENT,sITS CONTRACTORS AND SUBCONTRACTORS,sASnWELL ASnANY PRIgRnRECIPIENT.n IF RECIPIENT'S USE gF THE SUBJECT SOFTWARE RESULTS IN ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES gRnLOSSES ARISING FROM SUCH USE,sINCLUDING ANY DAMAGES FROM sPRODUCTS BASED ON, gRnRESULTING FROM, RECIPIENT'S USE gFsTHE SUBJECT SOFTWARE,sRECIPIENT SHALL INDEMNIFY ANDnHOLD HARMLESS THE UNITED STATESsGOVERNMENT,sITS CONTRACTORS AND SUBCONTRACTORS,sASnWELL ASnANY PRIgRnRECIPIENT, TO THE EXTENT PERMITTED BYsLAW. RECIPIENT'S SOLE nREMEDY FgRnANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION gF THIS AGREEMENT. 2s5.nGENERAL TERMS 2sA. Terminaleft: TNisoAgreeinaf and _NAMbadpssogranttd 9ereundo wwill Mts#minale aupomtpically if a Recipinafsfar sn"o comNly wi-9]mNAse Mts#mskand condilefts,*andrfar sn"o c"" osuch noncomNli�nce wi-9in ]mNirt o(30)odcyskof becomis*oaware sfosuch noncomNli�nce. Upft merminaleft, a Recipinafsagreeso_o immediatsly cease "preaed sdistributeftkof _NAMSubj.VEgSoftware. sAll subobcenses moo_NAMSubj.VE gSoftwareoproperlyogranttd o_NAMbreachis*oRecipinafsshall survive any ssuch merminaleftkof]mNisoAgreeinaf. B. Sevexabilit : If any provipxftkof _NisoAgreeinaf isoinvalidoor oune .sCceablesundo wapplicat^ nlaw, ifLshall edd#affectR_NAMvalidit osCRe .sCceabilit oof _NAMbemutsderkof _NAMts#mskof _NisoAgreeinaf. C. Applicat^ nLaw: TNisoAgreeinaf shall be subj.VEgmooUnitsd S ctps nfederalglaw only .sCRall purposes, i0�lud #*, but edd#limitpdgmo, odemermin #*omNAMvalidit kof _NisoAgreeinaf,smNAMmean #*oof its2sprovipxftsoand _NAMbadpss,oobobgalefts and remndees of _NAMp*:ties. 2sD. Entire Undo ���nd #*: TNisoAgreeinaf constitutss _NAMentire2sundo ���nd #*oandoagreeinafkof _NAMp*:ties)rel #*omooreleasesofR_NA MSubj.VEgSoftware and muy eddobeosupo �eded, modifiedrsCRamendnd except ofursks#swrittsnnagreeinafkduly executtd o_NAMp*:ties. 2sE. Bi ging Authorit : By ucclpt #*oandous #*omNAMSubj.VEgSoftware undo w_NisoAgreeinaf, a Recipinafsaffi#mskitsrauthorit omoobind _NA oRecipinafsmo all U#mskand condileftskof]mNisoAgreeinafoand _NatsmNat oRecipinafs9ere oagreeso_o all U#mskand condileftsk9erein. F. Poso_/of C606uct:sAn oRecipinafocon6uct wi-9]Govexsinaf Agnacysis omoobAMgi r �ed moo_NAMdesignaled re,resg} aleve as .sllows: sfunit-supp/g_@rubyforge.org. ����������������������ua ls/funit/Rakec rp��������������������������������������������������������������������tt"644������������tt"0644�tt"01526tt"175003525��17114�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# -*- ruby -*- PUquire 'rubygems' PUquire 'hoe' $LOAD_PATH.unshif* F rp.join( F rp.di acAe(__FILE__), '���') 2PUquire 'funit.rb' Hoe.n${('funit',nFunit::VERSION) do)|cunit| sifunit.rubyforge_acAe) = 'nasarb' sifunit.remote_���c_di = 'funit' sifunit.extra_depsk<< [ 'f/g_ran', '>= 1.1.0' ] sifunit.sp.V_extras[:PUquiremnafs]n= "ArF/g_ran comN rpr." sifunit.author = sii[ 'Karen Bibb', 'Bil Kleb', 'Be-9]Lee-Rausch', 'MikesPark', 'Bill Wood' ] sifunit.emutl = 'nasarb-developers@rubyforge.org' sifunit.cuuan_globs. nnnnconcats%w[ **/*_fun.f90 **/makeTehpRun /> examprps/**/TehpRun />* **/*.o **/*.mod **/*.MOD ] sifunit.rsync_argsr= '-rpv --delete' #rmoopresgrv.ogroup permissefts end desc "run all examprps" task :examprps do siDir['examprps/*'].each do)|di | sisicdMgi do sisii ruby "-I��� ../../bin/funit"2siinend2siend2end #rvim:ssy06ux=Ruby ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/�������������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��17261� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CFD/���������������������������������������������������������������tt"755������������tt"0644�tt""""""tt"175003525��17655� 5�����������������������������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CFD/TehpRun />�����������������������������������������������������tt"755������������tt"0644�tt"55470tt"175003525��21727�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ïúíþ����€������x��…����������H���__PAGEZERO��������������������������������������������������������Ø��__TEXT������������������@���������������@�������������������__text����������__TEXT����������ä�����ü#������ä���������������€������������__symbol_stub1��__TEXT����������à5�����6�������à5��������������€�����������__stub_help/>���__TEXT����������6�����j�������6����������������€������������__const���������__TEXT����������€6����� ������€6�����������������������������__eh_f:cAe������__TEXT���������� <�����È������ <������������� ��`���������������ˆ��__DATA�����������@�������������@��������������������������__nl_symbol_ptr�__DATA�����������@�������������@���������������� �����������__la_symbol_ptr�__DATA����������@�����H�������@���������������� �����������__dyld����������__DATA����������X@�����8�������X@�����������������������������__data����������__DATA����������@�����D�������@��������������������������������H���__LINKEDIT�������P�������������P������8 ��������������������"��€1616230234�t1P��16230234�t1P�����Q��X�����162pS��-���V��¨�� ���P����������������#��� ���������������������������@V������������������������ ��� ���/usr/���/dyld����������162õ"ImÆ?V>Z_ } W†���¸������*�����������������������������������������������������������������������������������������������������������������������������������ä������������������������������������� ���H���162���������/usr/�ocal/gf/g_ran/���/���gf/g_ran.3.dylib����� ���8���162�����g����/usr/���/���gcc_s.1.dylib������� ���H���162���������/usr/�ocal/gf/g_ran/���/���gcc_s.1.dylib�������� ���8���162��� }����/usr/���/���System.B.dylib������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������j�H‰åHƒäðH‹}Hu‰úƒÂÁâHòH‰ÑëHƒÁHƒ9�uöHƒÁè†#��‰Çèñ#��ôASL×íÿÿASÿ%'.���ÿ%&.��UH‰åH‰}èH‰uàH‹EèóH‹Eàó�óXÁ(Èó$��óYÁóEü‹Eü‰EÜóEÜÉÃUH‰åH‰}èH‹Eèó�óYÀó é#��óYÁóEü‹Eü‰EÜóEÜÉÃUH‰åHƒì H‰}øH‰uðH‰UèH‹EøH‰Çè®ÿÿÿóEäH‹EðH‰ÇèÿÿÿóXEä(Èó’#��(ÑóYÐóUàH‹UðH‹EøH‰ÖH‰Çè-ÿÿÿó k#��óYÁH‹EðóH‹Eøóó\ÊóYÁóMàó\È(ÁH‹Eèó�ÉÃUH‰åHƒì H‰}øH‰uðH‰UèH‹EøH‰ÇèÿÿÿóEäH‹EðH‰ÇèÿÿÿóXEä(Èóø"��óYÁH‹Eèó�ÉÃUH‰åHƒì H‰}øH‰uðH‰UèH‰Mà¸����è���¸����èÎ��¸����èæ���¸����èâ���¸����è��¸����èÈ���¸����èÄ���¸����è��¸����èª���¸����è¦���¸����è��¸����èŒ���¸����èˆ���¸����è¶��¸����èn���¸����èj���¸����èF��¸����èP���¸����èL���¸����èh���¸����è2���‹B,��H‹Eø‰‹*,��H‹Eð‰‹",��H‹E艋,��H‹Eà‰ÉÃUH‰åÉÃUH‰å¸����‰í+��¸��€?‰ú+��ÇÜ+�����ÉÃUH‰åHìð��¸����‰Ø+��Hµ+��H5Ê+��H=«+��èŸýÿÿ‹¨+��ƒÀ‰Ÿ+��‹•+��…À„S��‹+��‰…þÿÿóþÿÿó­%��.Á“À¶Àƒð…Àu,‹S+��‰…þÿÿó…þÿÿ.†%��“À¶Àƒð…À„ì��Hþ ��H‰…(þÿÿÇ…0þÿÿ.��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè. ��H… þÿÿºF���H5Ï ��H‰Çè% ��H… þÿÿH‰Çè ��H™ ��H‰…(þÿÿÇ…0þÿÿ4��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰ÇèÉ��H… þÿÿº���H5° ��H‰ÇèÀ��H… þÿÿº���H5— ��H‰Çè¥��H… þÿÿº���H5D*��H‰Çè–��H… þÿÿº���H5q ��H‰Çèo��H… þÿÿº���H5^ ��H‰ÇèZ��H… þÿÿº���H5G ��H‰Çè9��H… þÿÿº���H54 ��H‰Çè*��H… þÿÿH‰Çè��H’��H‰…(þÿÿÇ…0þÿÿ5��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰ÇèÂ��H… þÿÿº����H5Ó��H‰Çè¹��H… þÿÿH‰Çèž��ÇZ)������‹`)��ƒÀ‰W)��ë‹K)��ƒÀ‰B)��‹8)��ƒÀ‰/)��‹%)��…À„ò��ó )��WÉ.Á›À¶Ð¸����WÉ.ÁDƒð…À„¶��H¹��H‰…(þÿÿÇ…0þÿÿA��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çèé��H… þÿÿºA���H5��H‰Çèà��H… þÿÿH‰ÇèÅ��HT��H‰…(þÿÿÇ…0þÿÿB��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè„��H… þÿÿº���H5k��H‰Çè{��H… þÿÿº���H5Ã��H‰Çè`��H… þÿÿº���H5O��H‰ÇèK��H… þÿÿº���H5,��H‰Çè*��H… þÿÿº���H5É'��H‰Çè��H… þÿÿH‰Çèô��Hƒ��H‰…(þÿÿÇ…0þÿÿC��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè³��H… þÿÿº����H5Ä��H‰Çèª��H… þÿÿH‰Çè��ÇK'������‹Q'��ƒÀ‰H'��ë‹<'��ƒÀ‰3'��‹5'��ƒÀ‰,'��ÉÃUH‰åHìà��¸��€¿‰�'��Hõ&��H5 '��H=ë&��èßøÿÿ‹è&��ƒÀ‰ß&��‹Õ&��…À„ô��ó½&��.†��›À¶Ð¸����.t��Dƒð…À„¶��Hg��H‰…(þÿÿÇ…0þÿÿ��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè—��H… þÿÿºK���H5ø��H‰ÇèŽ��H… þÿÿH‰Çès��H��H‰…(þÿÿÇ…0þÿÿ��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè2��H… þÿÿº���H5��H‰Çè)��H… þÿÿº���H5Ã��H‰Çè��H… þÿÿº���H5±��H‰Çèÿ��H… þÿÿº���H5Ú��H‰ÇèØ��H… þÿÿº���H5w%��H‰ÇèÉ��H… þÿÿH‰Çè¢��H1��H‰…(þÿÿÇ…0þÿÿ��Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çèa��H… þÿÿº����H5r��H‰ÇèX��H… þÿÿH‰Çè=��Çù$������‹ÿ$��ƒÀ‰ö$��ë‹ê$��ƒÀ‰á$��‹ã$��ƒÀ‰Ú$��ÉÃUH‰åHìà��H®$��H5Ã$��H=¤$��è2÷ÿÿ‹¡$��ƒÀ‰˜$��‹Ž$��…À„V��ó v$��óº��óXÁ.³��“À¶Àƒð…Àu3óN$��ó ’��ó\Á(Èó‡��.Á“À¶Àƒð…À„ì��Hô��H‰…(þÿÿÇ…0þÿÿÐ���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè$��H… þÿÿºM���H5Ý��H‰Çè��H… þÿÿH‰Çè���H��H‰…(þÿÿÇ…0þÿÿÒ���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè¿��H… þÿÿº���H5¦��H‰Çè¶��H… þÿÿº���H5ª��H‰Çè›��H… þÿÿº���H5–��H‰ÇèŒ��H… þÿÿº���H5g��H‰Çèe��H… þÿÿº���H5#��H‰ÇèV��H… þÿÿº���H5=��H‰Çè/��H… þÿÿº���H5.��H‰Çè ��H… þÿÿH‰Çèù��Hˆ��H‰…(þÿÿÇ…0þÿÿÓ���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè¸��H… þÿÿº����H5É��H‰Çè¯��H… þÿÿH‰Çè”��ÇP"������‹V"��ƒÀ‰M"��ë‹A"��ƒÀ‰8"��‹."��ƒÀ‰%"��‹"��…À„V��ó "��óO��óXÁ.@��“À¶Àƒð…Àu3óÛ!��ó '��ó\Á(Èó��.Á“À¶Àƒð…À„ì��H��H‰…(þÿÿÇ…0þÿÿç���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè±��H… þÿÿºM���H5Ê��H‰Çè¨��H… þÿÿH‰Çè��H��H‰…(þÿÿÇ…0þÿÿé���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰ÇèL��H… þÿÿº���H53��H‰ÇèC��H… þÿÿº���H57��H‰Çè(��H… þÿÿº���H5#��H‰Çè��H… þÿÿº���H5ô��H‰Çèò��H… þÿÿº���H5‘ ��H‰Çèã��H… þÿÿº���H5Ê��H‰Çè¼��H… þÿÿº���H5��H‰Çè­��H… þÿÿH‰Çè†��H��H‰…(þÿÿÇ…0þÿÿê���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰ÇèE��H… þÿÿº����H5V��H‰Çè<��H… þÿÿH‰Çè!��ÇÝ������‹ã��ƒÀ‰Ú��ë‹Î��ƒÀ‰Å��‹»��ƒÀ‰²��‹¨��…À„ô��ó��.Ù��›À¶Ð¸����.Ç��Dƒð…À„¶��H:��H‰…(þÿÿÇ…0þÿÿö���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çèj��H… þÿÿºF���H5Û��H‰Çèa��H… þÿÿH‰ÇèF��HÕ��H‰…(þÿÿÇ…0þÿÿ÷���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè��H… þÿÿº���H5ì��H‰Çèü��H… þÿÿº���H5ð��H‰Çèá��H… þÿÿº���H5Ü��H‰ÇèÒ��H… þÿÿº���H5­��H‰Çè«��H… þÿÿº���H5J��H‰Çèœ��H… þÿÿH‰Çèu��H��H‰…(þÿÿÇ…0þÿÿø���Ç… þÿÿ€���Ç…$þÿÿ���H… þÿÿH‰Çè4��H… þÿÿº����H5E��H‰Çè+��H… þÿÿH‰Çè��ÇÌ������‹Ò��ƒÀ‰É��닽��ƒÀ‰´��‹¶��ƒÀ‰­��ÉÃUH‰åHìð��‹Ž��ƒÀ‰…��‹{��…À„l��H5€��H=a��èâîÿÿ(Èó¥��.Á“À¶Àƒð…Àu+H5R��H=3��è´îÿÿ.��“À¶Àƒð…À„��Hã��H‰…þÿÿÇ… þÿÿž���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè��H…þÿÿºF���H5Ì��H‰Çè ��H…þÿÿH‰Çèï��H~��H‰…þÿÿÇ… þÿÿ¤���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè®��H…þÿÿº���H5•��H‰Çè¥��H…þÿÿº���H5”��H‰ÇèŠ��H5Q��H=2��è³íÿÿóEüHMüH…þÿÿº���H‰ÎH‰Çèc��H…þÿÿº���H5>��H‰Çè<��H…þÿÿº���H5ß��H‰Çè-��H…þÿÿº���H5��H‰Çè��H…þÿÿº���H5��H‰Çè÷��H…þÿÿH‰ÇèÐ��H_��H‰…þÿÿÇ… þÿÿ¥���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè��H…þÿÿº����H5 ��H‰Çè†��H…þÿÿH‰Çèk��Ç'������‹-��ƒÀ‰$��ë‹��ƒÀ‰��‹��ƒÀ‰ü��‹ò��…À„ž��H5÷��H=Ø��èYìÿÿWÉ.Á—À¶Àƒð…À„e��H‰��H‰…þÿÿÇ… þÿÿ±���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè¹��H…þÿÿº@���H5â��H‰Çè°��H…þÿÿH‰Çè•��H$��H‰…þÿÿÇ… þÿÿ²���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰ÇèT��H…þÿÿº���H5;��H‰ÇèK��H…þÿÿº.���H5¢��H‰Çè0��H…þÿÿH‰Çè��H¤��H‰…þÿÿÇ… þÿÿ³���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰ÇèÔ��H…þÿÿº����H5å��H‰ÇèË��H…þÿÿH‰Çè°��Çl������‹r��ƒÀ‰i��ë‹]��ƒÀ‰T��‹V��ƒÀ‰M��ÉÃUH‰åHìð��‹.��ƒÀ‰%��‹��…À„l��H5ì��H=å��è‚êÿÿ(Èó1��.Á“À¶Àƒð…Àu+H5¾��H=·��èTêÿÿ. ��“À¶Àƒð…À„��Hƒ��H‰…þÿÿÇ… þÿÿm���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè³ ��H…þÿÿºE���H5T��H‰Çèª ��H…þÿÿH‰Çè ��H��H‰…þÿÿÇ… þÿÿs���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰ÇèN ��H…þÿÿº���H55��H‰ÇèE ��H…þÿÿº���H5��H‰Çè* ��H5½��H=¶��èSéÿÿóEüHMüH…þÿÿº���H‰ÎH‰Çè ��H…þÿÿº���H5Þ ��H‰ÇèÜ ��H…þÿÿº���H5Ë ��H‰ÇèÇ ��H…þÿÿº���H5´ ��H‰Çè¦ ��H…þÿÿº���H5¡ ��H‰Çè— ��H…þÿÿH‰Çèp ��Hÿ ��H‰…þÿÿÇ… þÿÿt���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè/ ��H…þÿÿº����H5@ ��H‰Çè& ��H…þÿÿH‰Çè ��ÇÇ������‹Í��ƒÀ‰Ä��닸��ƒÀ‰¯��‹¥��ƒÀ‰œ��‹’��…À„©��H5c��H=\��èùçÿÿó §��.ÁŠv��ó –��.Á…e��H ��H‰…þÿÿÇ… þÿÿ€���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰ÇèN ��H…þÿÿº@���H5G��H‰ÇèE ��H…þÿÿH‰Çè* ��H¹ ��H‰…þÿÿÇ… þÿÿ���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çèé ��H…þÿÿº���H5Ð ��H‰Çèà ��H…þÿÿº!���H5��H‰ÇèÅ ��H…þÿÿH‰Çèª ��H9 ��H‰…þÿÿÇ… þÿÿ‚���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çèi ��H…þÿÿº����H5z ��H‰Çè` ��H…þÿÿH‰ÇèE ��Ç������‹��ƒÀ‰þ��ë‹ò��ƒÀ‰é��‹ë��ƒÀ‰â��ÉÃUH‰åHìð��‹Ã��ƒÀ‰º��‹°��…À„o��H=¹��è_æÿÿó ì��óXÁ.Q ��“À¶Àƒð…Àu7H=��è3æÿÿó À��ó\Á(Èó! ��.Á“À¶Àƒð…À„ý��H ��H‰…þÿÿÇ… þÿÿN���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè> ��H…þÿÿºD���H5Ÿ ��H‰Çè5 ��H…þÿÿH‰Çè ��H© ��H‰…þÿÿÇ… þÿÿP���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰ÇèÙ��H…þÿÿº���H5À ��H‰ÇèÐ��H…þÿÿº���H5j ��H‰Çèµ��H…þÿÿº���H5X ��H‰Çè¦��H…þÿÿº���H5 ��H‰Çè��H=J��èðäÿÿóEüHMüH…þÿÿº���H‰ÎH‰Çè_��H…þÿÿº���H5F ��H‰Çè8��H…þÿÿº���H5Ë ��H‰Çè)��H…þÿÿH‰Çè��H‘��H‰…þÿÿÇ… þÿÿQ���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰ÇèÁ��H…þÿÿº����H5Ò��H‰Çè¸��H…þÿÿH‰Çè��ÇY������‹_��ƒÀ‰V��ë‹J��ƒÀ‰A��‹C��ƒÀ‰:��ÉÃUH‰åHìð��¸����‰Eü‹��ƒÀ‰ ��‹���…À„i��HEüH‰Çè¯ãÿÿó < ��óXÁWÉ.Á“À¶Àƒð…Àu2HEüH‰Çè„ãÿÿó  ��ó\Á(ÈWÀ.Á“À¶Àƒð…À„ý��Hd��H‰…þÿÿÇ… þÿÿ.���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè”��H…þÿÿºE���H5= ��H‰Çè‹��H…þÿÿH‰Çèp��Hÿ��H‰…þÿÿÇ… þÿÿ0���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè/��H…þÿÿº���H5��H‰Çè&��H…þÿÿº���H5n��H‰Çè ��H…þÿÿº���H5ú��H‰Çèö��H…þÿÿº���H5×��H‰ÇèÕ��HEüH‰ÇèFâÿÿóEøHMøH…þÿÿº���H‰ÎH‰Çèµ��H…þÿÿº���H5œ��H‰ÇèŽ��H…þÿÿº���H5! ��H‰Çè��H…þÿÿH‰ÇèX��Hç��H‰…þÿÿÇ… þÿÿ1���Ç…þÿÿ€���Ç…þÿÿ���H…þÿÿH‰Çè��H…þÿÿº����H5(��H‰Çè��H…þÿÿH‰Çèó��ǯ������‹µ��ƒÀ‰¬��ë‹ ��ƒÀ‰—��‹™��ƒÀ‰��ÉÃUH‰åSHì8��HÓ ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ���H…ÀýÿÿH‰Çèk��H…ÀýÿÿH‰Çèb��H‰ ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ���H…ÀýÿÿH‰Çè!��H…Àýÿÿº���H5Q ��H‰Çè��H…ÀýÿÿH‰Çèý��HMÀHUÐH]àHE°H‰ÞH‰Çè†áÿÿH ��H‰…ÈýÿÿÇ…Ðýÿÿ���H ��H‰…þÿÿÇ…þÿÿO���Ç…Àýÿÿ���Ç…Äýÿÿ���H…ÀýÿÿH‰Çè‰��HMÐH…Àýÿÿº���H‰ÎH‰Çè†��HMàH…Àýÿÿº���H‰ÎH‰Çèk��‹U°‹EÀ‰Ñ)Á‰È‰E¬HM¬H…Àýÿÿº���H‰ÎH‰ÇèA��HM°H…Àýÿÿº���H‰ÎH‰Çè&��H…ÀýÿÿH‰Çè��H,��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ���H…ÀýÿÿH‰ÇèÄ��H…ÀýÿÿH‰Çè»��Hâ��H‰…ÈýÿÿÇ…Ðýÿÿ���HA��H‰…þÿÿÇ…þÿÿ���Ç…Àýÿÿ���Ç…Äýÿÿ���H…ÀýÿÿH‰Çèb��H…Àýÿÿº���H5��H‰ÇèY��H…ÀýÿÿH‰Çè>��He��H‰…ÈýÿÿÇ…Ðýÿÿ���Hì��H‰…þÿÿÇ…þÿÿ���HÖ��H‰…þÿÿÇ…þÿÿ���Ç…Àýÿÿ�0��Ç…Äýÿÿ���H…ÀýÿÿH‰ÇèÍ��H…Àýÿÿº���H5”��H‰ÇèÄ��H…ÀýÿÿH‰Çè©��‹EÀ…ÀugHÉ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ���H…ÀýÿÿH‰Çèa��H…Àýÿÿº���H57��H‰ÇèX��H…ÀýÿÿH‰Çè=��ëeHb��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ���H…ÀýÿÿH‰Çèú���H…Àýÿÿº���H5×��H‰Çèñ���H…ÀýÿÿH‰ÇèÖ���Hý��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ���H…ÀýÿÿH‰Çè•���H…ÀýÿÿH‰ÇèŒ���º����¸���HƒøHHÿ‹LÀÊHƒÀëê…Òt ¿���èd���HÄ8��[ÉÃUH‰åHƒì‰}üH‰uðH‹Uð‹EüH‰Ö‰Çè"���H5;��¿���è���¸����èaûÿÿ¸����ÉÃÿ%* ��ÿ%, ��ÿ%. ��ÿ%0 ��ÿ%2 ��ÿ%4 ��ÿ%6 ��ÿ%8 ��ÿ%: ��Lë ��ASÿ%Û ��h����éæÿÿÿh���éÜÿÿÿh7���éÒÿÿÿhQ���éÈÿÿÿhp���é¾ÿÿÿhŽ���é´ÿÿÿh²���éªÿÿÿhÔ���é ÿÿÿhó���é–ÿÿÿ���?����FluxFun lefts_fun.f90��� *Asse:*_Real_Equalrfar ed* inn_est RoeFluxZero [FluxFun lefts.fun:47]]]interfaceFlux ()sisoedd����wi-9in������������� *Asse:*_Equalrfar ed* inn_est RoeFluxZero [FluxFun lefts.fun:48] 0 (��� *Asse:*_Equalrfar ed* inn_est RoeFluxExpanseftShock [FluxFun lefts.fun:41] 0.5 (������? *Asse:*_Equal_Wi-9inrfar ed* inn_est CentralFluxKn�wx [FluxFun lefts.fun:33] 0.25 (��€>oƒ:���� *Asse:*_Equal_Wi-9inrfar ed* inn_est CentralFluxKn�wx [FluxFun lefts.fun:34]���wÌ+2���� *Asse:*_Equalrfar ed* inn_est CentralFluxKn�wx [FluxFun lefts.fun:35]�� *Asse:*_Real_Equalrfar ed* inn_est RoeAvgKn�wx [FluxFun lefts.fun:27]��RoeAvg(leftS ctp,badpsS ctp) (����4���� *Asse:*_Truerfar ed* inn_est RoeAvgKn�wx [FluxFun lefts.fun:28] RoeAvg(leftS ctp,badpsS ctp) > 0 sisoeddotrue���������� *Asse:*_Real_Equalrfar ed* inn_est RoeAvgZero [FluxFun lefts.fun:22]RoeAvg(0.0,0.0) (� *Asse:*_Falserfar ed* inn_est RoeAvgZero [FluxFun lefts.fun:23] RoeAvg(0.0,0.0)==1 sisoeddofalse������� *Asse:*_Equal_Wi-9inrfar ed* inn_est FluxOne [FluxFun lefts.fun:18]¬Å'7 *Asse:*_Equal_Wi-9inrfar ed* inn_est FluxZero [FluxFun lefts.fun:13]�����€?������oƒ:��€>wÌ+2��?üÿÿ>¬Å'7������������TehpRun />.f90�FluxFun leftsn_est suite:('Passed ',i0,'/of ',i0,'/possit^ nasse:*s comNrxs #*o',i0,'/of ',i0,'/_ests.')(a)������==========[ SUMMARY ]==========no(a15) FluxFun lefts: passed far ed <<<<<���������������������D���ÿ��������������������������������zR�x ��4������úÕÿÿÿÿÿÿA�����������†��� <��� �������4���T���Öÿÿÿÿÿÿ2�����������†��� -��� �������4���Œ���ýÕÿÿÿÿÿÿš�����������†��� •��� �������4���Ä���_ÖÿÿÿÿÿÿO�����������†��� J��� ��������������zR�x ��4������^Öÿÿÿÿÿÿ����������†��� �� �������4���T���B×ÿÿÿÿÿÿ�����������†��� ��� �������4���Œ���×ÿÿÿÿÿÿ&�����������†��� !��� �������4���Ä���þÖÿÿÿÿÿÿÀ����������†��� »�� �������4���ü���†ÛÿÿÿÿÿÿR����������†��� M�� �������4���4�� Ýÿÿÿÿÿÿ-����������†��� (�� �������4���l��•äÿÿÿÿÿÿ`����������†��� [�� �������4���¤��½èÿÿÿÿÿÿk����������†��� f�� �������4���Ü��ðìÿÿÿÿÿÿ¨����������†��� £�� �������4�����`ïÿÿÿÿÿÿª����������†��� ¥�� ��������������zR�x ��4������ºñÿÿÿÿÿÿd����������†��� ���ƒW�� 4���T���æõÿÿÿÿÿÿB�����������†��� =��� �����������������������������������������������&6�����06�����:6�����D6�����N6�����X6�����b6�����l6�����v6������À_ÿ��À_ÿ���������@�����˜@����� @�����¨@�����������������������������������������������������������������������€?��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������@dyld_stub_btsder�Qr��r@__gf/g_ran_set_args��r@__gf/g_ran_set_oplefts��r @__gf/g_ran_st_write��r(@__gf/g_ran_st_write_done��r0@__gf/g_ran_stop_numeric��r8@__gf/g_ran__ransfer_chalxOter��r@@__gf/g_ran__ransfer_integer��rH@__gf/g_ran__ransfer_real��rP@_exit����_� ����t�F�_�*muts�ÀNXArg�Åenviron�Û�mh_executt_header�B_�K����ä#��fluxfun lefts_�hprogacAe�á�MOD_�{fun_MOD_�»�roe�˜flux�¬centralflux�¶�avg�§flux�±�º$��û$��­%��Ç&��_est_fluxfun lefts�f�’r�Ácentralfluxkn�wx�‡interfaceflux�çlefts ctp�ín�ó�–'��unit_�¢lux�§�te����wx�·setup�¼�²)��¸)��oe�Ôadpss ctp�Ð�flux�ãavg�Œ�zero�ýexpanseftshock�‚�Þ)��ž3��ð7��kn�wx�zero�¢�F��ýN��one�¶zero�»�èW��]��žk��c�Ïv�Õ���˜�� ��¨��°��´��oasse:*far ed�Šum��¸��asse:*s�¯fa r"" s�Ä_ests�Ê�¼tUstpd�¾�À��Ä��È��Ì��2����� ����������4�����.�����:1�����6�����6�����D������<�����U��� ��Ð@�����a��� ��@�����i��� ��˜@�����q�����G�����’�����{�����¬�����:�����È�����­�����å�����ð���������è+�����0����.�����R����¸�����w����²�����Ÿ�� ��°@�����Æ�� ��´@�����é�� ��¸@������� ��¼@�����5�� ��À@�����_�� ��Ä@�����„�� ��È@�����¦�� ��Ì@�����Ê����#�����ï����}'���������ž�����B����Þ�����g����–�����“�� ��¨@�����Ÿ�����������³�� �� @�����¼����ž5�����Â����ä�����È�����������Ü�����������ó���������������������� �����������8�����������V�����������r�����������‹�����������‘������������#���$���%���&���'���(���)���*���+������@���@#���$���%���&���'���(���)���*���+��� �dyld_stub_btsding_help/>�__dyld_func_lookup�_MAIN__� stub help/>s�_oplefts.11.1558�_s ctp.1619�_NXArgc�_NXArgv�___fluxfun lefts_MOD_centralflux�___fluxfun lefts_MOD_flux�___fluxfun lefts_MOD_roeavg�___fluxfun lefts_MOD_roeflux�___fluxfun lefts_fun_MOD_centralfluxkn�wx�___fluxfun lefts_fun_MOD_fluxone�___fluxfun lefts_fun_MOD_fluxzero�___fluxfun lefts_fun_MOD_funit_setup�___fluxfun lefts_fun_MOD_funit_te����wx�___fluxfun lefts_fun_MOD_interfaceflux�___fluxfun lefts_fun_MOD_lefts ctp�___fluxfun lefts_fun_MOD_noasse:*far ed�___fluxfun lefts_fun_MOD_numasse:*s�___fluxfun lefts_fun_MOD_numasse:*stUstpd�___fluxfun lefts_fun_MOD_numfa r"" s�___fluxfun lefts_fun_MOD_num_ests�___fluxfun lefts_fun_MOD_radpss ctp�___fluxfun lefts_fun_MOD_roeavgkn�wx�___fluxfun lefts_fun_MOD_roeavgzero�___fluxfun lefts_fun_MOD_roefluxexpanseftshock�___fluxfun lefts_fun_MOD_roefluxzero�___fluxfun lefts_fun_MOD__est_fluxfun lefts�___progacAe�__mh_executt_header�_environ�_muts�����t�__gf/g_ran_set_args�__gf/g_ran_set_oplefts�__gf/g_ran_st_write�__gf/g_ran_st_write_done�__gf/g_ran_stop_numeric�__gf/g_ran__ransfer_chalxOter�__gf/g_ran__ransfer_integer�__gf/g_ran__ransfer_real�_exit�dyld_stub_btsder����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CFD/GasModel.f90���������������������������������������������������tt"644������������tt"0644�tt"00460tt"175003525��21670�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module GasModel "preGammas imNlicit edne con6utss subroua ne PerfectP (Densety,]Energy,]P" ssure)2siinreal,]intent(in) :: Densety 2siinreal,]intent(in) :: Energy2siinreal,]intent(oua) :: P" ssure2siinP" ssure = Densety * Energy * (eGamma - 1.0 )2siend subroua ne PerfectP 2end module GasModel �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CFD/FluxFun lefts_fun.f90������������������������������������������tt"644������������tt"0644�tt"21605tt"175003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������! FluxFun lefts_fun.f90 - a unitn_est suite .sCRFluxFun lefts.f90 ! !ifunit generaled mNisoc rpofromRFluxFun lefts.fun module FluxFun lefts_fun "preFluxFun lefts imNlicit edne logicalo:: noAsse:*Far ed pubobco:: _est_FluxFun lefts privale integero:: numTehps = 0 integero:: numAsse:*s = 0 integero:: numAsse:*sTUstpd = 0 integero:: numFa r"" s = 0 2PUalo:: leftS ctp, badpsS ctp,]interfaceFlux con6utss subroua ne FluxZero PUalo:: s ctp s ctp = 0 ! Asse:*_Equal_Wi-9inrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2siinif (.not.((Flux(s ctp) & sisii+0.tt"01 ) & sisii.ge. & sisii( 0) & sisiiiiiiiiii.and. & sisii(Flux(s ctp) & sisii-0.tt"01 ) & sisii.le. & sisii( 0) ))o_NAn2siin print *, " *Asse:*_Equal_Wi-9inrfar ed* inn_est FluxZero & sisiiiiiiiiii &[FluxFun lefts.fun:13]"2siin print *, " ", " 0 (", 0,")sisoedd", & sFlux(s ctp),"wi-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 siesdif siesdif numTehps = numTehps + 1 iend subroua ne FluxZero subroua ne FluxOne PUalo:: s ctp = 1 ! Asse:*_Equal_Wi-9inrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2siinif (.not.((Flux(s ctp) & sisii+0.tt"01 ) & sisii.ge. & sisii( 0.5) & sisiiiiiiiiii.and. & sisii(Flux(s ctp) & sisii-0.tt"01 ) & sisii.le. & sisii( 0.5) ))o_NAn2siin print *, " *Asse:*_Equal_Wi-9inrfar ed* inn_est FluxOne & sisiiiiiiiiii &[FluxFun lefts.fun:18]"2siin print *, " ", " 0.5 (", 0.5,")sisoedd", & sFlux(s ctp),"wi-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 siesdif siesdif numTehps = numTehps + 1 iend subroua ne FluxOne subroua ne RoeAvgZero ! Asse:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2siinif (.not.(i( 0 & sisiiiii+2*spacing(p = permi������������dn lefts.fun:22]Re. & sisii( 0.5)& sisiiiiiiiiiiinif (.not-( 0 & sisiiiii+2*spacing(p = tt"01 ) & si��dn lefts.fun:22]Re. & sisii( 0.5) ))o_NAn2siin prin������ *Asse:*_Real_Equalrfar ed* inn_nn_est FluxOne & sisiiiiiiiiii &[Flu22un lefts.fun:18]"2siin pn lefts.fun:22]Roe, 0.5,n lefts.fun:22]R 0.5, " 0.5 (", 0.5,, ".5,& sFlux(s0.5,,( 0 & sisiiiii+2*spi-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 sne RoeAvgZe0) (�e:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far edn lefts.fun:23] RoeA& sisii( 0.5) ))o_NAn2siin prin0) (� *Asse:*_Falserfar ed* inn_nn_est FluxOne & sisiiiiiiiiii &[Flu2Fun lefts.fun:13]"2siin pr lefts.fun:23] RoeAvg(0.0,0.0)==n lefts.fun:13]"2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 siesdif siesdif numTehps = numTehps + 1 i subroua ua ne FluxOne su inn_a ne RoeAvgZero ! Asse:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2siint if (.not.(i( 0 & sisiiiii+2*.lepacing(p = permi������������dn leftsfun:28] RoeAvg(leftS ce. & sisii( 0.5)& sisiiiiiiiiiiint if (.not-( 0 & sisiiiii+2*.lepacing(p = tt"01 ) & si��dn leftsfun:28] RoeAvg(leftS ce. & sisii( 0.5) ))o_NAn2siin prin������ *Asse:*_Real_Equalrfar ed* inn_enn_est FluxOne & sisiiiiiiiiii &[Flu27un lefts.fun:18]"2siin pn leftsun:27]��RoeAvg(leftS ctp, 0.5,n leftsun:27]��RoeAvg(leftS c 0.5, " 0.5 (", 0.5,, ",.5,& sFlux(s0.5,,( 0 & sisiiiii+2*.lep lefts.fun:13]"2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 sne RoeAvgZe�4���e:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2 lefts.fun:28] RoeAvg(leftS ctp,b & sisii( 0.5) ))o_NAn2siin prin�4���� *Asse:*_Truerfar ed* inn_enn_est FluxOne & sisiiiiiiiiii &[Flu2Fun lefts.fun:18]"2siin pr lefts.fun:28] RoeAvg(leftS ctp,badpsS ctp) >n lefts.fun:13]"2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 siesdif siesdif numTehps = numTehps + 1 i su inn_a ua ne FluxOnear ed* inn_est Csiescend ar ed* inn_( = 0 2PUalo:: leftS ctp, badpsS ctp* (eG:: s ctp = 1 ! Asse:*_Equal_Wi-9inrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2p, badpsS ctp*.((Flux(s ct & sisii+0.tt"01 ) & sisii.2ge. & sisii( 0.5) & sisiiiiiiiiip, badpsS ctp*.((Flux-s ct & sisii+0.tl"01 ) & sisii.2ge. & sisii( 0.5) ))o_NAn2siin print *, " *Asse:*_Equal_Wi-9inrfar ed* inn_est Cenn_est FluxOne & sisiiiiiiiiii &[Flu3Fun lefts.fun:13]"2siin prilefts, " 2", " 0.5 (", 0.5,p, badpsS ctp & sFlux(s ctp"wi-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 seG:: s ctp = 1 ! Asse:*_Equal_Wi-9inrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2p, badpsS ctp*.((Flux(s ct0ctp) & sisii+0.tt"01 ) & sisii.2ge. & sisii( 0.5) & sisiiiiiiiiip, badpsS ctp*.((Flux-s ct0ctp) & sisii+0.tl"01 ) & sisii.2ge. & sisii( 0.5) ))o_NAn2siin print *, " *Asse:*_Equal_Wi-9inrfar ed* inn_est Cenn_est FluxOne & sisiiiiiiiiii &[Flu34un lefts.fun:13]"2siin prilefts, " 2", " 0.5 (", 0.5,p, badpsS ctp & sFlux(s ctp0tp),"wi-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 seG:: s ctp = 1 �e:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2 2"==tp, badpsS ctp* & sisii( 0.5) ))o_NAn2siin print *, :*_Equal_Wi-9inrfar ed* inn_est Cenn_est FluxOne & sisiiiiiiiiii &[Flu35un lefts.fun:13]"2siin prilefts, " 2", " 0.5 (", 0tp, badpsS ctp*i-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 siesdif siesdif numTehps = numTehps + 1 iar ed* inn_est Csiua ne FluxOne ed* inn_est RoeFlusies= 0 2PUdif-1iescend ed* ( = 0 2PUalo:: leftS ctp, badpsS ctp* (eG:: s ctp = 1 �e:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2 "==tp, badpsS ctp* & sisii( 0.5) ))o_NAn2siin print *, :*_Equal_Wi-9inrfar ed* inn_est RoeFluxnn_est FluxOne & sisiiiiiiiiii &[Flu41un lefts.fun:18]"2siin print *, " ", " 0.5 (", 0tp, badpsS ctp*i-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 siesdif siesdif numTehps = numTehps + 1 i ed* inn_est RoeFlusiua ne FluxOne ed* subroua n:: leftS : s ctpcend ed* ( = 0 2PUalo:: leftS ctp, badpsS ctp* (eG:: s ctp ro ! Asse:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2siinif (.not.(i( 0 & sisiiiii+2*spacing(p = permi������������dp, badpsS ctp* . & sisii( 0.5)& sisiiiiiiiiiiinif (.not-( 0 & sisiiiii+2*spacing(p = tt"01 ) & si��dp, badpsS ctp* . & sisii( 0.5) ))o_NAn2siin prin������ *Asse:*_Real_Equalrfar ar ed* inn_est FluxZero & sisiiiiiiiiii &[Flu47un lefts.fun:18]"2siin plefts.fun:47]]]i, 0.5,p, badpsS ctpR 0.5, " 0.5 (", 0.5,, ".5,& sFlux(s0.5,,( 0 & sisiiiii+2*spi-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 sne RoeAvgZe= 1 �e:*_Real_Equalrasse:*ift numAsse:*s = numAsse:*s + 1 if (noAsse:*Far ed)o_NAn2 ==tp, badpsS ctp* & sisii( 0.5) ))o_NAn2siin print *, :*_Equal_Wi-9inrfar ed* d* inn_est FluxZero & sisiiiiiiiiii &[Flu4Fun lefts.fun:18]"2siin print *, " ", " 0 (",tp, badpsS ctp*i-9in",0.tt"01 2siin print *, ""2siin noAsse:*Far ed = .false.2siin numFa r"" s = numFa r"" s + 1 sielse2siin numAsse:*sTUstpd = numAsse:*sTUstpd + 1 siesdif siesdif numTehps = numTehps + 1 i ed* broua ua ne FluxOne lefts_fun_ies= 0 2PUd: s ctpn:: leftS : ssse:nt *, ""2siin noAp) >.= numTehps + 1 i lefts_fun_i ua ne FluxOne lefts_fun_MOD= numTehps + 1 i lefts_fun_MOD= ua ne FluxOneed pubobco:: _es( n numT, n:*sTUst, n:*sTUstpd = n, n r"" s )el sTUstpd = numTl sTUstpd = :*sTUstl sTUstpd = :*sTUstpd = nl sTUstpd = r"" s siesconuxOuesiescend lefts_fun_iescend ed* brouaescend lefts_fun_MOD= escend lefts_fun_iescend ed* subrescend lefts_fun_MOD= escend lefts_fun_iescend subrouaescend lefts_fun_MOD= escend lefts_fun_iescend suest Csescend lefts_fun_MOD= escend lefts_fun_iescend ar ed* inn_est Csescend lefts_fun_MOD= escend lefts_fun_iescend ed* inn_est RoeFlusescend lefts_fun_MOD= escend lefts_fun_iescend ed* brouaescend lefts_fun_MOD= esn integero:: numTe numT esn integero:: numAssse:*sTUst esn integero:: numAssse:*sTUstpd = n esn integero:: numFamFa r"" s = numTehps + 1 ied pubobco:: _est_a ne Perfects.fun module Flu�������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprpsudon������������������������$duardon��������������������������������tt"644����������764t"0644�tt"21605207175003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������ed - a u��������moda ne FFFFFFFFFFFFl,]intent(o, a ne PerfectP ( 9inrfend subrbrou n es :: Enparamettpd =fun_: s ctpcend subroufun_, fun_, nsety,]Energn prin������ *Asn2 , nsety,]E nergn print *, " sFluxn2 , nsety,]E " ��������) & _a ne9inr 9inrfWarbler_a ne9inr 9inrf subrest Cses ne FluxsiinP" s ssse:re = Des ssse:cend subr( a ne PerfectP (, nsety,]E nergn prin������ *Asn2 .4, nsety,]E nergn prin�4��( nsety,]E tp,b ergn prin0) (( nsety,]E <p,b ea ne9inr a ne9inr - a u����������������������������������������ua ls/funit/sModps/CFD/GasModel.f90�����������������������������������������������������tt"644����������126t"0644�tt"00460t40175003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������� PerfectPsModel "preGammas es :: Enparamettpd =y * En ss.4oua ne PerfectPsMode����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funiÅ'7���������������������������������������������������������������������������tt"644������������tt"0644�tt"21605231175003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ! Å'7����������� - runs fUs_fun.f90 - a suxFun lefts.f90 ! !ifunit generon W!ifApr 27 14:23:08 +0200 2011. uxfuram Å'7������� se:*sun lefts_fun "pe Flu esluxFun lefts i sTUstp, dimeest R(1)ivale inte,ssse:*sTUst,ssse:*sTUstpd = n,amFa r"" s = �__gf(*,* erg�__gf(*,* "TehpRun />.f90�FluxFun le"se:cend ed pubobco:: _esnn_est (le inte(1),ssse:*sTUst(1),ssse:*sTUstpd = n(1),ssse r"" s (1)i erg�__gf(*,1)isse:*sTUstpd = n(1),ssse:*sTUst(1),sn_est e inte(1)-sse r"" s (1), e inte(1) 1unitmatftsn_est suite:('Passed ',i0,'/of ',i0,'/possit^ nasse:*s comNrxs #*o',i0,'/of u es�__gf(*,* erg�__gf(*,'(a)' "sts.')(a)������==========[ SUMMiin pri�__gf(*,'(a15)',advance="no" "========no(a15)" numAssssse r"" s (1)i==p,b sisii( 0.�__gf(*,* " FluxFu" nu r"" s + �__gf(*,* " lefts: passed"d + 1 tpd +es�__gf(*,* e numAssssum(sse r"" s ) /=p,b one�ps = 1 uxfuram Å'7������� �������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funiÅ'7��������o������������������������������������������������������������������tt"644���������54�tt"0644�tt"21605214775003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ïúíþ�������������� ���� ������‰Çè!8��� @�����¨@�������������H���T���À������H���T����������������__text����������__TEXT��¨@�������������¦��T���À��������3�����€�����������__ca15t���������__TEXT��¨@��������Ä���þÖ������€����� @�����¨@��������������__eh_frame������__TEXT��¨@�������� @��ˆ@�����€������  ���� ��h��������������È��H‰H… ���€ �þÖ�� ���P��������������������� =��� ������������������������������������™��ƒÀ‰��Éí‰åSHì8��HÓ ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€c‰åSHì8��HÓ ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€���Ç…H‰Çè!��+…Àýÿÿº�Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€…ÀýÿÿH‰Çèý��HMÀHUÐ�Àýÿÿ€ã‰ÞH‰Çè†áÿÿH ��H‰…ÈýóÇ…Ðýÿÿ���H ��H‰…þÿÿÇ…þÿÿO���Ç…Àýÿÿ���Ç…Äýÿÿ�Àýÿÿ€…ÀýÿÿH‰Çè‰��HMÐH…À�Àýÿÿ€…�H‰ÎH‰Çè†��HMàH…À�Àýÿ���H‰ÎH‰Çèk��‹U°‹EÀ‰Ñ)Á‰È‰E¬HM¬H…À�Àýÿÿ€…�H‰ÎH‰ÇèA��HM°H…À�Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€‰ÞH‰Çè†áÿÿH ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€¼ÿÿH‰Çè»��Hâ��H‰…ÈýÇ…Ðýÿÿ���H ��H‰…þÿÿÇ…þÿÿ���Ç…Àýÿÿ���Ç…Äýÿÿ�Àýÿÿ€���Ç…H‰Çèb��Ý…Àýÿÿº�Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€?ÿÿH‰Çè»��Hâ��H‰…ÈýÆÇ…Ðýÿÿ���Hì��H‰…þ°Ç…þÿÿ���HÖ��H‰…þÿÿÇ…þÿÿ���Ç…Àýÿÿ�0��Ç…Äýÿÿ�Àýÿÿ€���Ç…H‰Çèú���n…Àýÿÿº�Àýÿÿ€���Ç…Äýÿÿ�ÀýÿH…ÀýÿÿH‰Ç£��‹EÀ…ÀugHÉ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€���Ç…H‰Çèa��…Àýÿÿº�Àýÿÿ€���Ç…Äýÿÿ�ÀýÿH…Àý<��‹EÀ…ÀugHÉ��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€���Ç…H‰Çèú���±…Àýÿÿº�Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€×�ÿÿH‰ÇèÖ���Hý��H‰…ÈýÿÿÇ…Ðýÿÿ���Ç…Àýÿÿ€���Ç…Äýÿÿ�Àýÿÿ€���Ç…Äýÿÿ�ÀýÿH…ÀýÿÿH‰ÇèŒ���º����¸���HƒøHHÿ‹LÀÊH�Àýÿÿ…Òt ¿���èd���HÄ8��[ÉÃUH‰åHƒì‰}üH‰�Àýÿÿ€5�ÀýÿÖ‰Çè"�…Àýÿ�Çè"�…Àýÿ�Çè"ÉÃ��������������������������Å'7������������TehpRun />.f90�FluxFun leftsn_est suite:('Passed ',i0,'/of ',i0,'/possit^ nasse:*s comNrxs #*o',i0,'/of ',i0,'/_ests.')(a)������==========[ SUMMARY ]==========no(a15) FluxFun lefts: passed far ed <<<<<���������������������D���ÿ����������������������������������zR�xàÿ��4������ºñÿÿÿÿÿÿd����������†��� ���ƒ¨ÿ�� 4���T���æõÿÿÿÿÿÿB�����������†��� ›�����-��…Àý-‡���€����-��…-(��-����-å����Þ��-Ï�� �þ-Ç����´����-€����w��-h�� �þ-`����M����-���� ��-ü�� �þ-ô����á����-­����•����}����v��-g�� �þ-_����L����-���������ù��-ê����-Ç���¯��- �� ��-…�� ��-[�� ��-@�� ��-%����-�����Ù�����Ò����-·���-¨��� �þ- ����������-Y�����R���-C�����-�����X�����^X����� �����^ ��� Ý����444444444����� �� @����H‰����� @�������{������ºL��ÿ������������²��ÿ������������Æ��ÿ��������������ÿ��������������ÿ������������”��ÿ������������.��ÿ������������x��ÿ������������ran_set_oplefts�__gf/g_ran_st_write�__gf/g_ran_st_write_dric�__gf/g_ran__ransf_roefluxzero�___fluxfun lefts_fun_MOD__est_fer_chalxOter�__gf/g_ran__ransfer_inteone�__gf/g_ranader�on�_muts�����t�__gf/g_ran_set_args�__gf/g_rad_func_� stub help/>s�_oEH_frame1�������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CF�o���������������������������������������������������������������tt"644���������257tt"0644�tt"21605265175003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ïúíþ�������������� ���� ������‰Çè!8��� @�����¨@�������������X����`À������X����`�������������__text����������__TEXT��¨@�������������\���`À��������� �����€�����������__l_gfral4������__TEXT��¨@�����\���`�����ºñ����������������������������__eh_frame������__TEXT��¨@�����`���`ø@����� �����h��� ��h��������������È��H‰¨�����ø��€��� ���P���������ÿ��������� @�����¨@������������������������������������������èd���‰}è�[ÉàH‹EèóH‹EàóH‰Çè¯ã��H=åüH‰ÇYÁ��HHƒì‰EÜH=EÜ��èd���‰}è�‹EèóH‰ÇYÀÀu2H����‰ÇYÁ��HHƒì‰EÜH=EÜ��èd���ƒì �‰}ø�[ÉÃU‰Uè�‹EøÄýÿÿ�Àýÿ��Hä�‹EðÄýÿÿ�Àýÿ�XEäã��H=å¨���(щÇYÐ��UàUH‰å�‹EøÄýÖÄýÿÿ�Àýÿ� ���‰ÇYÁ�‹EðóH‹Eøóó\ʉÇYÁ�Màó\È(Á�‹Eèó���èd���ƒì �‰}ø�[ÉÃU‰Uè�‹EøÄýÿÿ�Àýÿ��Hä�‹EðÄýÿÿ�Àýÿ�XEäã��H=å���‰ÇYÁ�‹Eèó������?����������������������zR�xàÿ��4A��������ÿÿÿÿÿÿA�����������†��� <��� ¨ÿ�� 4���T���Öÿÿÿÿÿÿ2�����������†��� -��� pÿ�����4���Œ���ýÕÿÿÿÿÿÿš�����������†��� •��� 8ÿ�����4���Ä���_ÖÿÿÿÿÿÿO�����������†��� JÇ���:Ç���-)Ç���-×�ÿÿ��Ï�����-°�ÿÿ�� �ÿÿ��-�ÿÿ��-Y�����'�����È��� ^È��Ç���� ^����X��� ^X����� �����^ ����u�H‰��`���`� ��{ ���` ��{A������� ��{{{{{{{{{7 ��{s{{{{{{{{lefts_MOD_flux�___fluxfun lefts_MOD_roeavg�___fluxfun lefts_MOD_flux�___fluxfuxfun lefts_MOD_flux�___fluxfun lefts_MEH_frame1����������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CF�sudon������������������������$duardon���������������������������tt"644���������214��"0644�tt"21605t17775003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������ed - a upubobco:: _est_s = 0 2PUalo:: leftS ctp, badpsS ctp,]_fun_ies= 0 2PUd: s ctpn:: leftS : sssnumTefun_i 9inrfar ed* i a ne FluxZero PUalo:: s ctpn print *, " *Assen2 , ")sisoedd", s ctp) & ea ne9inr 9inrfar esubres ne FluxOne PUalon print *, " *Assen2 .5, ")sisoedd", s ctp) & ea ne9inr lserfar ed* innergn prin������ *Asn2 , n lefts.fun:22]Reergn prin0) (( lefts.fun:23] RoeA&ea ne9inr lserfar ed*est Csesn prin������ *Asn2 .5,r lefts.fun:28] RoeAvg(leftS cnergn prin�4��( lefts.fun:28] RoeAvg(leftS ctp,b ea ne9inr lserfar ed* inn_est Csescend ar ed* inn_( = 0 2PUalo:: leftS ctp, badpsS ctp* (eGn print *, " *Assen2 .25ctp, badpsS ctp s ct1* (eGn print *, " *Assen2 .25ctp, badpsS ctp s ct����) & _eGn print *, n2 .25ctp, badpsS ctpA&ea ne9inr lserfar ed* inn_est RoeFluses= 0 2PUdif-1iescend ed* ( = 0 2PUalo:: leftS ctp, badpsS ctp* (eGn print *, n2 .5ctp, badpsS ctpA&ea ne9inr lserfar ed* d* i a n:: leftS : s ctpcend ed* ( = 0 2PUalo:: leftS ctp, badpsS ctp* (eGn prin������ *Asn2 , p, badpsS ctp* (eGn print *, n2 ctp, badpsS ctpA&ea ne9inr a ne9inr - a u�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CF�s���������������������������������������������������������������tt"644����������73tt"0644�tt"21605300575003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������� Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densety 2siinreal,]o:: leftS (eG :: Densety 2siinreal,]p, badpsS ctp,:*Far, badpsS ctp*=2 .5*ii.and= 0 2PU)+i.andeAvg(leftS (eGamma - 1.0 )2siar ed* inn_ edne con6utss ed* ( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densety 2siinreal,]o:: leftS (eG :: Densety 2siinreal,]p, badpsS ctp,:*Far, badpsS ctp*=2 .5*ii.and= 0 2PU)+i.andeAvg(leftS nn_est FluxZero &&&&&-2 .5* lefts.fun:28] RoeAvg(leftS *deAvg(leftS-= 0 2PU)(eGamma - 1.0 )2si ed* ednOD_flux� ")sisxOne (eG :: DeluxZero &&&&&l,] ctp,:*Fa: Densety 2siinreuxZero P ctp*=2 .5*ero **2(eGammaOD_flux� ")si ednOD_flux� lefts. = 0 2PUalo:: leftS (eG :: DeluxZero &&&&&l,] lefts,:*Fa: Densety 2siinreuxZ= 0 2PUalo:: leftS ,:*Fa lefts*=2 .5*i= 0 2PU+eAvg(leftS (eGammaOD_flux� lefts,_a ne Perfects.fun modulu��������������������������������������������������������������������ua ls/funits_MOD_flux�_. Pe�������������������������������������������������������������tt"644���������4532t"0644�tt"21605327175003525��23660�11616230234�t15021� 0����������������������������������������������������������������������������������������������������us��� �$duardon������������������������$duardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������GFORTRANe Perfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb775 -- If you�����������������������������������������������������������������������������������������¨ts*=2 ��������������� mNlic���:ÇmNli��������� mNlic���:ÇmNli��������� mNlic���:ÇmNli��������� mNlic���:ÇmNli��������� mNlic���::ÇmNli������������ä1���eã ed* ednOe,ÇmNli��������� mNlic���:ÇmNli��������� mNlic���:ÇmNli��������� mNlic���:ÇmNli��������� mNlic���::ÇmDmNli��������� mNlic���:ÇmNli���E,d ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWNnn_0 SUBROUTINE��UNKNOWNnn_0 0 UNKNOWN�: 3ne l4 5 6ic��0i���������0 0) 7��������������� mNlic���i���E,d ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWNnn_0 FUNCTION���REAL 4nn_0 REAL �: 80i�9�����7i���������0 0) 10�������� mNlic���i����� mNlic���i����� mNlic��d ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWNnUNKNOWNnn_0��UNKNOWNnn_0 0nUNKNOWN �: 00i������0i���������0 0) 11 '����ua��i����� mNlic�������ua�d ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWNnn_0 FUNCTION���REAL 4nn_0 REAL �: 12�0i�13mNlmNlic11 ���������0 0) 15����������������� mNlic������������d ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWNnn_0 SUBROUTINE��UNKNOWNnn_0 0 UNKNOWN�: 16�0 (1 mN8 19�����0i���������0 0) 4 '_fun_MOD_��' '_fun_MOD_�3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) 5���_muts�����' '��_muts����3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) 6 'fts_fun_MOD_r��' 'fts_fun_MOD_r�3 ((VARIABLE OUT UNKNOWN-PROC UNKNOWNnUNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) 1 m'_fun_MOD_��' '_fun_MOD_�16�((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) N8 ���_muts�����' '��_muts����16�((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) N9 'fts_fun_MOD_r��' 'fts_fun_MOD_r�16�((VARIABLE OUT UNKNOWN-PROC UNKNOWNnUNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) 13m'_fun_MOD_��' '_fun_MOD_�12�((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) 9 '_MOD_��' '_MOD_�8�((VARIABLE IN UNKNOWN-PROC UNKNOWNnUNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) 14 ���_muts�����' '��_muts����12�((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWNnn_0 DUMMY���REAL 4nn_0 REAL �: 00i������0i���������0 0) ic���:ÇmNli���E,0 2�i���E,0 7�������� mNlic��0 10������ua�0 11 '���i���E 0 15)������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������us��� �$ReadData/��������������������������������������������������������������55�������������������������0�����������������0726� 5����������������������������������������������������������������������������������������������������erfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb775 -- If you�����������������������������������������������������������������������������������������¨ts*=�������������������������us��� �$ReadData/time_* ies_data��������������$duardon�����������������������������������������������������5���������������474��������������������������������������������������������������������������������������������� Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densety 2ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssnt *, " *Astime_* ies_data�������������(len=10)���������������FILE = 'values.txt'gn prin��open(8,_esnn=FILE)�����������8uram Å', '2���093����� (eG���00546265E+���'�����������8uram Å', '2���093��132 (eG����1495361E+���'���clos��8)rgn prin0) (( load_time_* ies_data_����_esnn��������Çmd_time_* ies(�FILE ��������������������������2���, ts_data(1)%date_time%ye mo�����������������������������9, ts_data(1)%date_time%montho����������������������������30, ts_data(1)%date_time%dayo�����������������������������0, ts_data(1)%date_time%houmo�����������������������������0, ts_data(1)%date_time%minut (( nsety,]E <p,b s ctpceG��.2, ts_data(1)%valuePUaltS ctp, badpsS ctp* ��������2���, ts_data(2)%date_time%ye mo�����������������������������9, ts_data(2)%date_time%montho����������������������������30, ts_data(2)%date_time%dayo�����������������������������1, ts_data(2)%date_time%houmo����������������������������32, ts_data(2)%date_time%minut (( nsety,]E <p,b s ctpceG�6.0, ts_data(2)%valuePUaltS c������������ lefts_������system('/bin/rm '//FILE)���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������us��� �$ReadData/time_* ies_data��������������$duardon���������������������������������������������������54����������������45���������������������������������������������������������������������������������������������� Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densety 2ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�������time_* ies_data�������������������,ssse:*sT�������������MAX_POINTS.fun����� ! orr"" s���oc2t"064type date_time **2(eGaescend ye m, month, day, houm, minut 0234�t1type date_time *type time_* ies **2type(date_time�����date_time **2rest Cses ne Fluxsivaluene Flu532700234�t1type time_* ies *type(time_* ies)sTUst(1),sn_MAX_POINTS)sTsave Ps_data�* inn_ ed:28] RoeAvg(lÇmd_time_* ies(�esnn_stu����������������(len=*)����������������esnn_stu **2(eGaescend i���os **2open(10,_esnn=esnn_stu���oss��=�os�����������os/=0 1 sielse2siin numA'Þ��to2open_esnn: >>', esnn_stu��'<<'�����D= numTehpsdo i.fun,�MAX_POINTSleftS (Çmd( 10,_emt='(i4,i2,i2,i2,i2,e2alt2)', 4�t=2�����s_data(ip, badps4�t1doielse2siin numA'q���(Çmd���ædata af����',�MAX_POINTSmA' pon s' 2�� iescend ar adps4�t1o:: _es(28] RoeAvg(lÇmd_time_* ies������������time_* ies_data�]= 0 2PU(eG :: Densety 2ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�������������������������us��� �$StopWatch/�������������������������������������������������������������55�������������������������0�����������������1���� 5����������������������������������������������������������������������������������������������������erfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb775 -- �������������������������us��� �$StopWatch/StopWatch��������������$duardon��������������������������������������������������������333����������������3626� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densety 2ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssnt *, " *AsStopWatch ,ssse:*sTUst(1),sn_8�����dateAndTst(1,�dateAndTst(2oedd", ssescedsgn prin��NotI���ializr"" s TRUE+ 1 la( 2 , n lesesceds , HUGE5ctp)rgn prin0) (( SystemDateAndTst(Works �����date_and_time(values=dateAndTst(1p, 25ctp, badpsSdateAndTst(1����/= -huge((eGn 25ctp, badpsSsizr(dateAndTst(1,������8S c����������!�4����ecBetwe si4���OneMSecDifferencr addateAndTst(1 , (/�2��0,_1,_1,_0,_0,_0,_0,_0 /) addateAndTst(2 , (/�2��0,_1,_1,_0,_0,_0,_0,_1 /) adsesceds , SecBetwe s(dateAndTst(1,�dateAndTst(2���126t"0644�tt"00460t401���,dsesceds�����������������Minut Ro��over addateAndTst(1 , (/�2��0,_1,_1,_0,_0,_0,59,_0 /) addateAndTst(2 , (/�2��0,_1,_1,_0,_0,_1,_0,_0 /) adsesceds , SecBetwe s(dateAndTst(1,�dateAndTst(2���126t"0644�tt"00460t41.0, sesceds c����������!�4����ecSe eLa( ������I���ializaNlic532t"06425ctp, badpsnotI���ializr") adsesceds , �ecSe eLa( (n print *, " *AsnotI���ializr") adsesceds , �ecSe eLa( (n print *, " *AsnotI���ializr") ���������������I���iallyRrinrns�������sesceds , �ecSe eLa( (n print *,4�tt"00460t401�, sesceds cxs #*o',st(Delay(sesceds����sesceds , �ecSe eLa( (n print *,badpsSsesceds /53270 c����������n�����������st(Delay (sum) *2(eGaescend i *2rest Cse ssum psdo i.fun,�n�����n lessum , �um + i *2���doiardon�����������st(Delayses= 0 omput sSescedsg��sesceds , �ecSe eLa( (n p #*o',st(Delay (sesceds����sesceds , �ecSe eLa( (n print *,badpsSsesceds >3270 c����������s= 0 omput sSescedsSpecialprin�4��( expectedSescedsg���sesceds , �ecSe eLa( (n pdateAndTst(1 , la( p #*o',st(Delay (sesceds����sesceds , �ecSe eLa( (n pdateAndTst(2 , la( pexpectedSesceds , �ecBetwe s(dateAndTst(1,dateAndTst(2���126t"0644�tt"00460t4expectedSesceds, sesceds c������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ua ls/funit/examprps/CF�s�����������������������������������������������������������������������������������������������������������������������������us��� �$StopWatch/StopWatch��������������$duardon����������������������������������������������������������11���������������3424� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densety 2ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�������StopWatch sse:*sTUstpd = n(1)pubsTUFluxnogic4��( notI���ializr"" s TRUE+ 1),ssse:*sTUst(1),sn_8�����la( * inn_ edne n�4��5021� 0��SecBetwe s(beginDnT, 4�tDnT) **2(eGaescsTUst(1),sn_8�Zero &&&&&l,] ctpbeginDnT, 4�tDnT **2rest ���days, houms, minut s, sesceds **2(eGaescsT�������������yr=1, mo=2, day=3, utc=4, hr=5, mn=6, s=7, ms=8 **2 � iescend ar ��������� 4�tDnT(day�����beginDnT(day�� 1 sielse2s�days , n le��D= numTehps�days , 1 ! note:�ƒum���æ = �day adps4�t n num houms 2 , 4�tDnT(hr) -�beginDnT(hr) + 24*daysnum minut s , 4�tDnT(mn) -�beginDnT(mn) + 60*houmsnum sesceds , 4�tDnT(s) -�beginDnT(s) + 60*minut s num SecBetwe s , �ecceds +�� 4�tDnT(ms) -�beginDnT(ms�� 1/�n���+ 1)4�t15021� 0��SecBetwe s **2 � n�4��5021� 0���ecSe eLa( (n **2(eGaescsTUst(1),sn_8��( now ���������notI���ializr")1 sielse2snotI���ializr"" s FALSE+ 1 i l�ecSe eLa( u53270023� ies����date_and_time(values=la( ) le��D= numTehpss����date_and_time(values=now) 1 i l�ecSe eLa( u53�ecBetwe s(la( , now) 1 i lla( u53now adps4�t n num4�t15021� 0���ecSe eLa( �������������StopWatch ]= 0 2PU(eG :: Densety 2sssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�������������������������bin/sssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�����55�������������������������0����������������16213� 5����������������������������������������������������������������������������������������������������erfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb775 -- �������������������������bin/����� �����55������������������������344���������������17�����������������������������������������������������������������������������������������������GFORTRANe Perfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb775 #! /usr�bin/env rubyse# Ma s/>.f9�������se#begin n�quire 'rubygems'; n�scue LoadError;m4�t $:.push "#{File.dir_stu�$0}/../���" n�quire '�����' n�quire 'getoptlong' ,sclude F����sse:*s_soumce_dirs , ['.'] use_mpi.fuehps se:*cs , "1���� opts , GetoptLong.new( ['--help',adps'-h',aGetoptLong::NO_ARGUMENT], ['--clean',adp'-c',aGetoptLong::NO_ARGUMENT], ['--ea n-mpi','-p',aGetoptLong::NO_ARGUMENT], ['--� mNlic',a'-V',aGetoptLong::NO_ARGUMENT], ['--e:*cs',adp'-P',aGetoptLong::REQUIRED_ARGUMENT], ['--soumce',ad'-s',aGetoptLong::REQUIRED_ARGUMENT] ic�opts.eachsdo |opt,arg|���begin � iesase opt 1 i lw s '--ea n-mpi'leftS (use_mpi.fu sie 1 i lw s '--e:*cs'leftS (e:*cs , arg 1 i lw s '--help'leftS (F����::iin _helpleftS (exit 1 i lw s '--� mNlic'leftS (euts F����::VERSIONleftS (exit 1 i lw s '--clean'leftS (F����::clean_genFilesleftS (exit 1 i lw s '--soumce'leftS (if(ENV['FSFLAG'].nil? 1 sielse2s� (euts <<-EOF Nom4�viront(1t varia���FSFLAG pri+ For us��� nu ���( u4�ilers suchsas ���������eã wi���need: -I 1 i l�h exp����FSFLAG=-I 1 i c�h prienv FSFLAG -I 1windows pri�FSFLAG=-I but nu �sotu�suchsas Sun's f95u4�iler�eã wi���need: -M 1 i l�h exp����FSFLAG=-M 1 i c�h prienv FSFLAG -M 1windows pri�FSFLAG=-Mielse2s� (EOF else2s� (exit 1 i lum4�tleftS (e:*s_soumce_dirs << arg.s*sTtleftS (e:*s_soumce_dirs.flatien!leftS (e:*s_soumce_dirs.���q! lum4�tlefn�scue => err � (euts err � (bn�4knum4�t 4�t F����::run�����s(e:*s_soumce_dirs,use_mpi,e:*cs) #--e# Copy��_mu�2���-2��7 />.fr""532t"s Governt(1t as repn�s(1tr""bys# NASA Langley R�s(archs.5* er. Nomcopy��_mu�is claimed2(es# />.fr""532t"s under�Tit 17, U.S. Code. A���O r 0 2ss# Rd* edd. #s# T:: _esnn_: _governr""by NASA Open_Soumce Agreet(1t. #�See Lic(1)e.txt nu �deta���. #++ ]= 0 2PU(eG :: Densety 2ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�������������������������Manif���.txtsssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss��������������������������������163��������������177���������������������������������������������������������������������������������������������� Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densety 2222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222History.txt Lic(1)e.txt Manif���.txt README.txt Rakeesnn�bin/����� us��� �$duardon�������������� us��� �$duardon������������un us��� �$duardon������� us��� �$duardon��������� us��� �$duardon�������un us��� �$ReadData/time_* ies_data���� us��� �$ReadData/time_* ies_data��un us��� �$StopWatch/StopWatch���� us��� �$StopWatch/StopWatch��un ���/�����.rb ���/�����/i-9in",0.s.rb ���/�����/4�iler.rb ���/�����/����������rb ���/�����/����s�����rb pitch/slides.tex�s= 0/����_4�iler.rb s= 0/����_����������rb s= 0/����_�����.rb s= 0/����_����s�����rb ���������3s un.el �����������-d ed ic-m. Coel �����������-m. Coel al,]= 0 2PU(eG :: Densety 222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222sss����������������������������222222222222222222222222222222222222222222222222222222222222222222222sss�����55�������������������������0���������������606213� 5����������������������������������������������������������������������������������������������������erfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb77555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555sss����������������������������������3s un.el5555555555555555555555555555555555555555555555555555555sss����������������������������6�17�����������������13424� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: DensetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyFi���- Moner.v���23:36:17_mu�1 Pat c�reznor.l�s(.nasa.: _!kaet(l�s(.nasa.: _!logbridge.uoregon.edu!news-peun.gip.net!news.gsl.net!gip.net!newsf��n.mat wt(Wo.��_!cyclone.swbell.net!easynews!sjc-peun.news._goio.net!news._goio.net! R�-g(lÇ.news._goio.net.POSTED!not-xt -mdet Ses un: mikesl@th���n.na.wrq.��_ Newsgroupdow��_.emacs Subject:ss#:ss#-chs.5*um�bucDif baå��one����� l����3s ixpec�3s anot�O bucDif ReDifferedow<3BF03829.826F39CB@LaRC. N."s > Fi��: Michael Sl��/ <mikesl@wrq.��_> Message-IDow<m3wv0vipqe.fsf@th���n.na.wrq.��_>txtnedow68 U/i--Ad et:sGnus/5.09 (Gnus v5.9tp* Emacs/21.1 MIME-V--� mN:60t4 CoZero -Typ#:s���P/ps cn;�����s =us-ascii temD: Mon,���r.v�mu�1 22:33:35 GMT NNTP-Postum-Host:6050.215.90.102 X- 0 s cnts-To: abrs,@_goio.net X-Traceows �-g(lÇ.news._goio.net 1/�56044156050.215.90.102 (Mon,���r.v�mu�1 22:33:35 GMT) NNTP-Postum-temD: Mon,���r.v�mu�1 22:33:35 GMT Orgt MalizaN: Vgoio Xrefc�reznor.l�s(.nasa.: _w��_.emacs:70829 Bil Kleb <W.L.Kleb@LaRC. N."s >������s: >So, I hsTsaa����e"byat execminutaw��_man��onet�O >currrnt(bucDif, an��dis s ys"by resultum��utput >3s anot�O bucDif ('--e��� ynu �so����� messages >which ' ,sclul����numb�ileinet�O original bucDif). > >Wyat I wouldul�ke��hsTsanowsnn_a4�t15021� which >scans"by �utput bucDif xt n�����s (doum�a regs.t>p.flarn mopWa?), an��rechs.5*set�O original bucDif >onet�O firste����� l����3s ixaternr""by �utput bucDif. >(Auxpex����e"han_a4simil�s featne9inI bby c��e >3s mu�sutoo�3svolvmNl�� obco:newbilul�sp br# Mato >ef����iveyndecip�O .) > >AnynuuggesàÿoeginDiffered�� R�s(a, keywt(dsato >orr"durum�a R�s(a, etc.? > >TIA, >-- >bil <http://abweb.l�s(.nasa.: _/~kleb/> Hiff'n_a4quick k,scgeNl�� obco,�������eãon't waet��try��adapt ��_4lizaN����e. It'n_k,scgeyinI b������'rluluckyinu �soofbby gurus ã wigive����e(an��_timA' po5*seaN�hows�mt R it ���snu . (defv�s bk-�����-bucDif "*�����-bucDif* "1�"BucDif dir_sxt n����� messages (rnr""`bk-n��P-�����'") (defv�s bk-�����-message-regs.help"����� at l����\\([0-9]+\\) "1�"Regul�s s.h����zaN� (rnr""`bk-n��P-�����'s�f3s n����� messages. Thsotub-s.h����zaN�becBetwet�O firstecapturum�paffes mustebeet�O l��� numb�i i lreet�O ����� occured") (defun bk-n��P-����� a( (n"Go�l����3s currrnt(bucDif�3s ixaternr""n��Pn����� message�3s `bk-�����-bucDif' A:�ƒed��yat t�O A' posnn_�iizaNernrext eet�O firsteoccur����oof `bk-�����-message-regs.h'einet�O `bk-�����-bucDif'nrext eet�O first p #*obobco::t15021�. #�Salso `bk-�����-message-regs.h'e`bk-�����-bucDif' "1�� ( po5*a��ive( (n(let ((�����-l���-numb�i)now) 1()sTs-currrnt-bucDif w) 1()et-bucDif (�� aget-bucDif bk-�����-bucDif)EOF else2s�������������(�����EOF else2s������������� (codnetEOF else2s������������� "Can't f3s nt�O ����� bucDif: "EOF else2s������������� bk-�����-bucDif))))EOF els(����re- R�s(a-xt we bk-�����-message-regs.h nil t)EOF else2s���s(enEOF else2s���()etq �����-l���-numb�iEOF else2s���������(strum-to-numb�iEOF else2s��������� (bucDif-tubstrum (mopWa-���benum 1)EOF else2s�������������lse2s��������� (mopWa- ���1))))EOF els����� (go�-���� (1+ (mopWa- ���1)))))now) 1(��������-l���-numb�iEOF else2(go�-l���������-l���-numb�i)EOF els(message�"Nmt ee�����s")))no -- M�ke al,]= 0 2PU(eG :: Densety 22222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222sss���������������������������������-m. Coel22222222222222222222222222222222222222222222222222222222sss����������������������������755333�������������120������������������������������������������������������������������������������������������������ed - a upubobco:: _est_s = 0 2PUalo:: leftS ctp, badpsS ctp,]_fun_ies= 0 2PUd: s ctpn:: leftS : sssnumTefun_i 9inrfar ed* i a ne FluxZero PUalo:: ;;ire '��-m. Coel' -_a4 univmNmaj nu d_sxt n�ditum� s/>fenFil;;l;; INSTALLAUNCT:l;;l;; 1)-e# Cire '��-m. Coel' *obobe����sys4sieuxZ�sp direcHist, e.g.,l;;l;; #! /us���e/emacs/sieuxZ�spl;;l;; or,�������eãose2shsTsaro2spermi��zaNinu �si lrees���ll;; a)rgn et�O load-p.fh R�s(a(1t variai�����r ~/.emacs>fenFl;; acct(dumlt, e.g.,l;;l;; ()etq load-p.fh (app ���load-p.fh '("~/Z�sp")))l;;l;; 2) Tautomopnogiyna��iv Pe�e '��-m. C i lw visitum� enFi,l;; ad nt�O ft Rowum�l���d�����r ~/.emacs>fenF:l;;l;; (autoloadire '��-m. C "e '��-m. C"l;; "M d_sxt n�ditum� s/>fenFi.")l;; ()etq auto-m. C-aZ�stl;; (cods '("\\tch�$" .�e '��-m. C) auto-m. C-aZ�st)) (def���- univm-m. C e '��-m. CEOFf90-m. C "e s/ "1�"Maj nu d_sxt n s/>fenFi (dunivmNli����90nu d_).\n\nEOF\\{e '��-m. C-map}"� ( po5*a��ive( (n(message�" s/>m. Co"0 0) ;; ad nu �sonewsxtnt-s��kd��f90'n_��PUst(vlul�st (xtnt-s��k-ad -keywt(dsa'e '��-m. CEO'(("\\< print *, "\\>" .sxtnt-s��k-:t15021�-dir_-s_fu)EOF ("\\< printtt"00\\>" .sxtnt-s��k-:t15021�-dir_-s_fu)EOF ("\\< print0644�tt"00\\>" .sxtnt-s��k-:t15021�-dir_-s_fu)EOF ("\\< print *,b\\>" .sxtnt-s��k-:t15021�-dir_-s_fu)EOF ("\\< printtt"00p,b s \\>" .sxtnt-s��k-:t15021�-dir_-s_fu)EOF ("\\<����������\\>" .sxtnt-s��k-builtu-s_fu)EOF ("\\<��������������\\>" .sxtnt-s��k-builtu-s_fu)EOF ("\\<����\\>" .sxtnt-s��k-builtu-s_fu)EOF ("\\<��������\\>" .sxtnt-s��k-builtu-s_fu)EOF ("\\<��������\\>" .sxtnt-s��k-builtu-s_fu)EOF ("\\<������������\\>" .sxtnt-s��k-builtu-s_fu)EOF ("\\<n pr\\>" .sxtnt-s��k-builtu-s_fu)EOF ("\\<����n pr\\>" .sxtnt-s��k-builtu-s_fu)0 0) idefv�s e '��-bucDif-��_man��"e '�� "1�"Shep #��_man�� (rnr""t�O \\[e '��-����-bucDif]::t15021�."0) ;;idefv�s ��_4lizaN-bucDif-dir_-st15021� "*n s/>�utput *"0) ;; ruMa s/>onet�O currrnt(bucDif: (defun e '��-����-bucDif a( (n"Excmin \\[e '��-bucDif-��_man�] onet�O fi���ociaterEOF '--et�O currrnt(bucDif."� ( po5*a��ive( ; (co_4� e '��-bucDif-��_man�);; (fi-dir_-nondirecHist(bucDif-fi-dir_))now)()sTs-bucDif)EOF(shep -��_man�-aN-reg21� (A' po-m&&&&(A' po-max) e '��-bucDif-��_man��e '��-�����-bucDif)E0) ;; key-b3s ium� t nruMnum� s/>onet�O currrnt(bucDif (def���-key e '��-m. C-map "\C-c\C-c"a'e '��-����-bucDif0) ;; ad n s/>����� regs.����_4lizaN����e:l;; blah, blah, blak [uardon�����������:34] ;(�' n�quirco_4�( ;()etq ��_4lizaN-�����-regs.h-aZ�stl; (cods '("\\[\\(.+\\):\\([0-9]+\\)\\]" 1 2) ��_4lizaN-�����-regs.h-aZ�st( ;0) idefv�s e '��-�����-bucDif "* s/>�utput-bucDif* "1�"BucDif dir_sxt n����� messages (rnr""`e '��-n��P-�����'") (defv�s e '��-�����-message-regs.help"\\[.+:\\([0-9]+\\)\\]""1�"Regul�s s.h����zaN� (rnr""`e '��-n��P-�����'s�f3s n����� messages. Thsotub-s.h����zaN�becBetwet�O firstecapturum�paffes mustebeet�O l��� numb�i i lreet�O ����� occured") (defun e '��-n��P-����� a( (n"Go�l����3s currrnt(bucDif�3s ixaternr""n��Pn����� message�3s `e '��-�����-bucDif' A:�ƒed��yat t�O A' posnn_�iizaNernrext eet�O firsteoccur����oof `e '��-�����-message-regs.h'einet�O `e '��-�����-bucDif'nrext eet�O first p #*obobco::t15021�. #�Salso `e '��-�����-message-regs.h'e`e '��-�����-bucDif' "1�� ( po5*a��ive( (n(let ((�����-l���-numb�i)now) 1()sTs-currrnt-bucDif w) 1()et-bucDif (�� aget-bucDif e '��-�����-bucDif)E�������lse2s��������� (�����EOF else2s������������� (codnetEOF else2s������������� "Can't f3s nt�O ����� bucDif: "EOF else2s������������� e '��-�����-bucDif))))EOF els(����re- R�s(a-xt we e '��-�����-message-regs.h nil t)EOF else2s���s(enEOF else2s���()etq �����-l���-numb�iEOF else2s���������(strum-to-numb�iEOF else2s��������� (bucDif-tubstrum (mopWa-���benum 1)EOF else2s�������������lse2s��������� (mopWa- ���1))))EOF els����� (go�-���� (1+ (mopWa- ���1)))))now) 1(��������-l���-numb�iEOF else2(go�-l���������-l���-numb�i)EOF els(message�"Nmt ee�����s")))no ��s(videa'e '��-m. C0) ;; ���ofire '��-m. Coel' al,]= 0 2PU(eG :: Densety 222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222sss���������������������������������-d ed ic-m. Coel222222222222222222222222222222222222222222222222sss������������������������������17���������������2603626� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy;; Mt R a d ed ic-m. Csxt n s/>fenFi: (�' n�quire ed ic) (def���-d ed ic-m. Cs'�����-d ed ic-m. CEOF (Z�st ?!)EOF (Z�stEOF e"����������"EOF e"��������������"EOF e"����"EOF e"��������"EOF e"n pr"EOF e"����n pr"EOF e"��������"EOF e"������������"EOF )EOF '(("\\( print *, "\\)" 1 'xtnt-s��k-:t15021�-dir_-s_fu)EOF F ("\\( print *,b\\)" 1 'xtnt-s��k-:t15021�-dir_-s_fu)EOF F ("\\( printtt"00p,b s \\)" 1 'xtnt-s��k-:t15021�-dir_-s_fu)EOF F ("\\( printtt"00\\)" 1 'xtnt-s��k-:t15021�-dir_-s_fu)EOF F ("\\( print0644�tt"00\\)" 1 'xtnt-s��k-:t15021�-dir_-s_fu))EOF (Z�st "\\tch�\\'") OF nil OF "G ed icnu d_sxt n s/>fenFi."0)al,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyysss����������������������xt README.yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyysss���������������������������1���0763�������������14������������������������������������������������������������������������������������������������ed - a upubobco:: _est_s = 0 2PUalo:: leftS ctp, badpsS ctp,]_fun_ies= 0 2PUd: s ctpn:: leftS : sssnumTefun_i 9inrfar ed* i a ne FluxZero PUalo:: = FU F���* http://e 'rxt ge.t g/�s(jects/nasarb�* http://nasarb.e 'rxt ge.t g/in/���* mdetto:nasarb-developers@e 'rxt ge.t g == DESCRIPUNCT:l FU F�snn_a4n/�������um� T���wt(Wsxt nF �����. U/�������n_aqui����ttweasnF ������ T�greetd��yat orr"" sm p dsgnoofbb���um-sdsSpficnkeywt(dsaaum4�t15021�s. FU F� ����sxt ms t�Orr" T�greetd� poouxsiidnF ������c��e,f95u4�s,l��ks, an� runs"by m ag inn bby c��et"s undb���.l FU F�snn {opin21�aternsoftwe e}[http://www.t eillynet.95u/pub/a/netwt(W/G���/08/30/e 'r-rdeta-david-he���meiif-h��ss1�.html], which me(val� ieveetzaN� _go� iefigur�021�. SdsSpficgiy, FU F� �' n�qus,��* anF ������s f95u4�i,�* ����n_ooubee2Hisernaoptl sidebby c��et"s undb���, an� * ����>fenFi ooubeedir_rnap�s(priately. == FEATURES/PROBLEMS:��* Enariaset�O ScieetzficnMethodbut nu ftwe enr""makum�n/�������um OFF ������ unaaum4easy.�* Encour�gal� i�Orive, ygnodecoupÞ�c��etpaisern'--e OF<em>execmiaria</em> docureeta021�. == SYNOPSIS:��Supporr"<tt>gas_physicn����</tt>"han_a4n��������yat rlyRrin visc�iiy an_a4�t15021� ofbb�mperatne9ine.g.,l ��������gas_physicn * inn_ �����������visc�iiy(b�mperatne9)EOF F **2rest visc�iiy,bb�mperatne9EOF F visc�iiy = 2.0e-3 *bb�mperatne9**1.5EOF num4�t15021� ��������� T���n_ofbby3s m������wouldube * inec�3s <tt>gas_physicn��un</tt>, an��_py��_ * in_a40) ((ike,l �sssnt *, " gas_physicn �sssn visc�iiy_1t ves_as_b�mperatne9EOF��/i-9_**2r_e�����������0t401visc�iiy(ctp* (eGn��/i-9_e����_w : s ctpc707101visc�iiy(5ctp*, 1e-3 ) ��������� �������������� Ty3s b vef" T�greetsnn_all����e���n. Thso T���wt(Ws�s(vides"by rest ofbby ���ppingi oouyRribby3s poouxsiidnF ������c��e. Yr�eãoulduruMaby3s n/������� '--et�O c�_man�,l �in/�� gas_physicn which ãouldu����sxt m���r T�greetd� * inec�3s <tt>gas_physicn��un</tt> poouxsiidnF ������c��e,f9�:Ç_a40) (ruMnund�s(eT��,f95u4� every: s g, an��ruMabye ����n01viz,t n nGn ium��!�4������: gas_physicn...eãoneRUE+ ���oum�a��ociater *s_sou>fenFi a)rgn ��ium� t n��_4lizaN (n(cd .; gs f -c gas_physicn���_����) (n(cd .; gs f -c T���RuMnun����) (ngs f -o T���RuMnun gas_physicn.o gas_physicn���_�o T���RuMnun.ot n gas_physicn��!�4������: n P��/id 2_ofb2��� en��/i-9sn��_risum 1_ofb1 ����n. Ty3s an��ot�O �� us���n��_e '--et�O FU F� distrbu�����inet�O <tt>�� us���</tt>"direcHist. Thsresnn_also an emacs>u d_sin t�O <tt>�����</tt>"direcHist. � mNlicinn alledt�O FU F� via R 'rubyg, t�Orr"direcHisi��n�aN�be� tundi�����r R 'rubyg((ibrary direcHist, e.g., <tt>#! /us���l/..//e 'r/ubyg</tt>. == g::REQURGUMS:��* F ������s0/95/G��3f95u4�i�* R 'r '--eR 'rubyg(package�managei�* Thso ������R 'ruby == INSTALL:��* <tt>sudo g m inn all�in/��</tt> * S prC Nom4�viront(1t variaoouA' pos�anF ������c�u4�i: n * <tt>h exp��C=/p.fh/of/F ��������/4�i</tt>"(sh) n * <tt>h prienC /p.fh/of/F ��������/4�i</tt>"(csh) *A���O inf(vanI��� Nom4�viront(1t varias:enC�FSFS an��LD�FSFS == LICENSE:l FU F�snn_releaå��"s undby NASA Open_Soumce Agreet����s#�See Lic(1)e.[l��k:fenFi/ee Lic(_)e..html]txt nu �deta�� == ORIGIT:l On OcHib�i 4,�mu�1, M�ke H wi(? 1 _ofb{ObjectnMepoor}[http://www.tbjectmepoor.95u/], nowsofb{Industr�� Luxno}[http://www.industr��luxno.95u]) visit��{s# NASA Langley R�s(archs.5*}[http://www.l�s(.nasa.: _] p H ustaNinVirgin2a an��gsTsaa�����-firstedesignetalk at t�O {In��tmin xt n 0 ompr an��Appli>.frcieecFi a)rgEngine5*um�(ICASE)}[http://www.i ies.edu]. Copien_ofby3s ch/sli_aquiavdetariaat {i ies.edu/me_* /MPP}[http://www.i ies.edu/me_* /MPP/]. M�ke sdsn bby ta afno1� w--eBil Kleb,Bill Wood, KaffeBibb, an� M�ke Pa(Ws�:s1�um��ut�howswe�_py��_ �:Ç_a40) um� T���wt(W xt nF ������s0s�orr"durum�FUN3D[http://in/3d.l�s(.nasa.: _]�c��etdevelopreet(1B""t�O ���ofiby ta afno1� we"harna wt(Wum�proto�t1tybaå� onet�O macro nGn �zaN�techniqval��mployec�3s M�ke H w'�n�pp0) kit[http://*s_souxt ge.net/�s(jects/�pp0) kit]. We4quickly� tundC-pas rocFis�� macroi ooubeetoo�restri��ive an� rewroteet�O fT���wt(Wsi��R 'r[http://www.e 'r-lA L.t g]�� == TODO:��* TavoidnF �����'�n32-���������((imi�, ãon't ad nt!�4�dir_sdurum�����s4lizaN (n�� a Row anot�O methodbut ndirum�lptlundb���n_altoget�O .�* Ad n��/i-9in",��yat capturee2Hipn01we �um�messages, an��ot�O ��i�n. * F �n��_4lizaN,orr" po5*nal rt R task inn ea��ofian exo5*nal mt Rakee.�* Tin �:sO A'riariliiy,b �:Ç_n and-aopte execmiarias w--eErik VeLic���'n_ �R 'rScript2Exe[http://www.e_*kveLi.dds.nl/e 'rscript2exe/]. * Mt R FU F�sself-b���n_mA' gracefuiynifnF ������c�u4�isnn_e2s tund.)al,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyysss����������inn all-sh sss���������������������������3246333��������17�015117�����������������������������������������������������������������������������������������������GFORTRANe Perfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb77777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777#!usr�bsh # inn all�- inn all�ad�s(eT��,fscript,n�� es_dfenFl script'--� mN=mu�2�12-25.00 . #s# T:originainutli���X11R5 (m�������/scripts�inn all.sh), which ãa 2s4lier_releaå��i��X11R6 (xc/ iefig�����/inn all.sh) '--et�O 2sft Rowum�Nomcopy��_an��le Lic(1dd. #e# Copy��_(C) 1994 X#e#nn ��iumdd. #Permi��zaNsnn_hsre'r eT��s(1,tliesoofb����ge,f�anypers1� ob* inum�a Nomc. #ofbby3s u ftwe enan��a��ociater docureeta021�>fenFi (t�O "S ftwe e"),f�. #d*2reinet�O S ftwe e '--e�ut�restri��iaN,' ,scum�'--e�ut�(imi�a021�>t�O 2s' '��_s�orr, Nomcr=1,difcr=1e�ge,f(1)pusonthistrbu�e,fs1)pubLic(, an�/or 2ssep #��pien_ofbt�O S ftwe e, an��oouAermitpers1�_s�wh���t�O S ftwe e i 2sfu �shÞ��do so,fs1)jectn*obobe�ft Rowum�NondiizaNs:dd. #s#enabove�Nomcopy��_e2subL an��oy3s permi��zaN_e2subL shall�be ' ,sclimed2(eap #��pien_or tubstanI��� A'riàÿofbt�O S ftwe eedd. #sHE SOFTWARE IS PROVIDED "AS IS", WITHLE OWARRANTY OF ANY KIND, EXPRESS OR. #IMPLIED, INCLUDING BE ONOT LIMITED TO#sHE WARRANTIES OF MERCHANTABILITY,. #FITNESS FOR A PARTICULAR PURPOSE ANDONONINFRINGURGUM. �NONO EVGUM SHALL#sHE. #X#eONSORTIUM BE LIARIABFOR ANY CLAIM, DAMAGES OR OsHER LIARILITY, WHEsHER IN. #AN ACUNCT OF eONTRACU, TORT OR OsHERWISE, ARISING FROM, LE OOF OR IN eONNEC #--UNCT WITH#sHE SOFTWARE OR sHE USE OR OsHER DEALINGS IN sHE SOFTWAREedd. #Except(1t * inec�3s obco:n2subL,bt�O dir_sofbt�O X#e#nn ��ium shall�n2s. #be uå��i��advi-9isum �� ot�O wisaoouAi��oteet�O sale,orr"�� ot�O #d*2r- # ings�3s obco:S ftwe e '--e�ut�pri�� ����ttweau-e�rMalizaNtli���t�O X#e#nn �- # �iumedd. . #FSFb���ngFi oout# T:: _ese e inet�O (1)pubdom in1dd. #eallum��y3s ucript inn all-shsnn_inDifsern _go�inn all.sh,oouAieveet. #`mt R' sse:*sTUrulnutli��� �:Çum�a : _escalledinn all�ii���it. #i lw thsresnn_no Mt Rakee.�d. #s# T:ucript isn��_:Çria'--et�O BSDinn all�script,nI bãa ����ttw 2sfi���scropWat nl=' ' IFS=" "" $nl" 2sset DOITPROGoouecho oouten bby T:ucript 2sDon't orr":��secSe 4.3BSDaum4earli>r thep s ãon't l�ke�it(1doit=${DOITPROG-} ifbb��� -z "$doit";l? 1 sdoit_exec=exec e��D= ndoit_exec=$doit fi 2sP b�weabsolmin x _esdir_s�������eãon't hsTsaby m i�����r p.fh;. #o! orr"Nom4�viront(1t a�� chgrp�s(g=${CHGRPPROG-chgrp} ch1,d�s(g=${CHMODPROG-ch1,d} chown�s(g=${CHOWNPROG-chown} cmp�s(g=${CMPPROG-cmp} cp�s(g=${CPPROG-cp} mkdir�s(g=${MKDIRPROG-mkdir} mv�s(g=${MVPROG-mv} rm�s(g=${RMPROG-rm} strp�s(g=${STRIPPROG-strp} �ix_glob='?' iotI���ial_�ix_glob='= nb��� "$�ix_glob" != "?" || {EOF F����set -f) 2>/dev/nui;l? 1 sssss�ix_glob=�q! l��D= numTe�ix_glob=:= numf + i} ' �ix_mkdir= 2sDesisernu d_sofbinn alledakee.�u d_=�755� chgrpcmd= ch1,dcmd=$ch1,d�s(g chowncmd= mvcmd=$mv�s(g rmcmd="$rm�s(g -f" strpcmd= src= dst= dir_��g= dst_��g= Nomc_on_���ngF=.fuehpno_t��get_direcHist= usage="\ Usage: $0 [OPUNCT]...e[-T] SRCs(�FIDSTs(�F= nuor: $0 [OPUNCT]...eSRCs(�FS...eDIRECTORY= nuor: $0 [OPUNCT]...e-teDIRECTORYeSRCs(�FS...= nuor: $0 [OPUNCT]...e-deDIRECTORIFS...= Inet�O 1s.txt m, Nomc SRCs(�FIoouDSTs(�F. Inet�O 2n��an��3rd, Nomc all�SRCs(�FSIoouDIRECTORY. Inet�O 4mont �:Ç_DIRECTORIFS. OpizaNs:dnumTes '--hnumTedis s ybby T:'--hnaum4exit(1numTes '--� mNTedis s yb'--� mNTinfonaum4exit(1 -c F els����� (igniser) n -C F els����� inn all�onynifndecDiffet���s# Rd* et�O l lla��æda1,difixat21�>te_ti n -d F els����� �:Ç_direcHisi��ninn ea��ofiinn allum� enFi(1nu-g GROUP����� $chgrp�s(gbinn alledakeei oouGROUP(1nu-m MODE ����� $ch1,d�s(gbinn alledakeei oouMODE(1nu-o USER ����� $chown�s(gbinn alledakeei oouUSER(1nu-s F els����� $strp�s(gbinn alledakeei(1nu-teDIRECTORYe inn all� poouDIRECTORY. nu-T F els����� re exp�ane����� ifnDSTs(�Fsnn_a4direcHist. Eom4�viront(1t variasn _goridebby default c�_man�s:dnuCHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG_ �RMPROG STRIPPROG " while ���� $# -ne 0;4�t1do iesa$1 begin �-c) ;;now ��-C) Nomc_on_���ngF=.fu ;;now ��-d) dir_��g=.fu ;;now ��-g) Nhgrpcmd="$chgrp�s(gb$2" shift;;now ��- '--h)uecho "$usage";lexit $?;;now ��-m)nu d_=$2 iesa$u d_sin *' '* | *' '* | *' '* | *'*'* | *'?'* | *'['*) uecho "$0:�3svsiidn���e:a$u d_" >&2 uexit 1;;n esac shift;;now ��-o) Nhowncmd="$chown�s(gb$2" shift;;now ��-s) strpcmd=$strp�s(g;;now ��-t) dst_��g=$2 shift;;now ��-T) no_t��get_direcHist=.fu ;;now ��- '--� mN)uecho "$0 $script'--� mN";lexit $?;;now ��--) shift (bn;;now ��-*) echo "$0:�3svsiidnopizaN: $1" >&2 exit 1;;now ��*) � (bn;;n uesac i ift dtpd =ifbb��� $# -ne 0 &&bb��� -z "$dir_��g$dst_��g";l? 1 s# W lw -d is (r, all�rem inum�argureetd�e e direcHisi��n���:Ç. s# W lw -t is (r, by de uat21�>nn_alg(lÇy sdsSpfi ed s# Ot�O wisa,et�O l llaargureet>nn_by de uat21�. Remove�s/>fi���$@ed sut n , arg�t1doieifbb��� -n "$dst_��g";l? 1 sssss#�$@snn_e2sempty:�s/> * inn at le lla$<< a sssssset fnisd "$@" "$dst_��g" ssssss ifts#�fnisd= numf + isss ifts#� , arg 1dst_��g=$ , arg�tpd fi ifbb��� $# -eq 0;4? 1 sifbb��� -z "$dir_��g";l? 1 sssecho "$0:�ninput x _essdsSpfi e" >&2 uexit 1 umf + i# It'n_OKn��all�`inn all-shs-d' '--e�ut�argureeted s# s# T:�aN�happ �#i lw �:Çum�NondiizaNal direcHisi��. uexit 0 fi ifbb��� -z "$dir_��g";l? 1 s���p '(exit $?);lexit' 1 2 13 15 d s# S pumask so an_e2s���:Çbb�mps w--etoo-d ed ous>u d_sed s# However, 'strp' �' n�qus bot�vg(lÇnaum4����� acc��snooutemps.1do iesa$u d_sin ssss#�Opizmial c�_m1�> iessa sss*644) Np_umask=133;;n uss*755) Np_umask=22;;now ��*[0-7])EOF elsifbb��� -z "$strpcmd";l? 1 u_plus_rw=EOF elsl��D= u_plus_rw='%�mu�mce'leftf + iss Np_umask=`s.h� '(' 777 -a$u d_s% 1/�n ')' $u_plus_rw`;;n uss*)EOF elsifbb��� -z "$strpcmd";l? 1 u_plus_rw=EOF elsl��D= u_plus_rw=,u+rwce'leftf + iss Np_umask=$u d_$u_plus_rw;;n uesac fi ut nurc �t1do2sProtectsdir_s� Pertum�'--e `-'.1do iesa$urc begin �-*) src=./$urc;;n uesac ieifbb��� -n "$dir_��g";l? 1 sssdst=$urc sssdstdir=$dst sssb��� -d "$dstdir" sssdstdir_ Petus=$? lsl��D= ssss#�Wai�ium� t nby T:ooubeedetexpecnr""t�O "$cp�s(gb$urc $dsttmp" c�_man� ssss#�_py��_ ause direcHisi��n�be �:Çd, which ãouldube esdsSpecynba� ssss#�ifb$urc (an��oyus>$dsttmp)> * inn '*'.1doieifbb��� ! -f "$src" &&bb��� ! -d "$src";l? 1 sssssecho "$0:�$urc doen_e2sexiste" >&2 u uexit 1 umftf +1doieifbb��� -z "$dst_��g";l? 1 sssssecho "$0:�nde uat21�>sdsSpfi e" >&2 u uexit 1 umftf +1doiedst=$dst_��g ssss#�Protectsdir_s� Pertum�'--e `-'.1dodo iesa$dst begin � �-*) dst=./$dst;;n ussesac ie i# If de uat21�>nn_a direcHist, app ���t�O input x _edir_; ãon't wt(W ssss#�ifbdouriasl lhli_aqun't igniser.1doieifbb��� -d "$dst";l? 1 sssssifbb��� -n "$no_t��get_direcHist";l? 1 echo "$0:�$dst_��g: In_a direcHist" >&2 exit 1ce'leftf + iss dstdir=$dst sssiedst=$dstdir/`baådir_s"$src"`+ iss dstdir_ Petus= , n le��D= numTe#�PrnDif le.dir_,nI bfall�back>onea tubsttmin ifnde.dir_sfdeta�� iss dstdir=` (de.dir_s"$dst") 2>/dev/nui || exh� X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ u X"$dst" : 'X\(//\)[^/]' \| \ u X"$dst" : 'X\(//\)$' \| \ u X"$dst" : 'X\(/\)' \| . 2>/dev/nui || echo X"$dst" | uå��'/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; qmce'left` ce'leftb��� -d "$dstdir" sssssdstdir_ Petus=$? lsftf + if +1doobsolete_mkdir_ (r=.fuehp ieifbb��� $dstdir_ Petus != 0;l? 1 sss iesa$�ix_mkdir begin � �'') # C�:Çb po5*medi:Ç_dirs um�m d_s755 an_1,difiecnr""t�O umask. # s# T:is l�ke�FreeBSD'inn all' an_ofb1997-10-28. umask=`umask` iesa$strpcmd.$umask in #�Opizmial c�_m1�> iessa *[2367][2367])nukdir_ mask=$ mask;;n .*0[02][02] | .[02][02] | .[02])nukdir_ mask=22;;no ��*[0-7])E uukdir_ mask=`s.h� $umask + 22 \ u -a$umask % 1/� % 40 + $umask % 20 \ u -a$umask % 1/ % 4 + $umask % 2 u`;;n *)nukdir_ mask=$ mask,go-w;;n esac # ,b -dnt �:Ç_t�O dew direcHist'--et�O u/i--sdsSpfi >m. Co # Ot�O wisa,ereyn1�>$ukdir_ masko ifbb��� -n "$dir_��g";l? 1 uukdir_u d_=-m$u d_n e��D= uukdir_u d_= f +1 �ix_mkdir=.fuehp iesa$umask in *[123567][0-7][0-7])E u#�POSIXuukdir -pssets +wx bitn_regard���snofb mask, which u#�3s p��_:Çria'--eFreeBSD'inn all' i lw (umask & 300) != 0. u;;n *) utmpdir=${TMPDIR-/tmp}/inn$RANDOM-$$ ut��p 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/nui;lexit $ret' 0 u����umask $ukdir_ mask && exec $ukdir�s(gb$ukdir_u d_ -ps-- "$tmpdir/d") >/dev/nui 2>&1 ut 1 udoieifbb��� -z "$dir_��g" || {E # ChecWsxt nPOSIXu p��_:Çriliiias w--e-m.E # HP-UX 11.23naum4IRIXu6.5uukdir -m -pssets group- orE # ot�O -�����ariabinoofbpaffet direcHist' lw F�sshouldn't.E # FreeBSD6.1uukdir -m -pssets u d_sofbexistum�direcHist. ls_ld_tmpdir=`ls -ld "$tmpdir"` iesa$ls_ld_tmpdir in udoid????-?r-*) decDiffet_u d_=700;;n udoid????-?--*) decDiffet_u d_=755;;n udoi*) .fueh;;n udesac && ud$ukdir�s(gb-m$decDiffet_u d_ -ps-- "$tmpdir" &&b{n udoils_ld_tmpdir_1=`ls -ld "$tmpdir"` nb��� "$ls_ld_tmpdir"*cs $ls_ld_tmpdir_1" } } e'leftb lw �ix_mkdir=: e'leftf + e'leftrmdir "$tmpdir/d" "$tmpdir" ue��D= u u#�Remove�anydirs leftebeh3s nr""ancieetuukdir sseereeta021�s.+ e'leftrmdir ./$ukdir_u d_ ./-ps./-- 2>/dev/nui+ e'lef + e'let��p '' 0;;n esac;;n ussesac ie iifgin � �$�ix_mkdir &&b( umask $ukdir_ mask && $doit_exec $ukdir�s(gb$ukdir_u d_ -ps-- "$dstdir" sssss)EOF eb lw :, n le��D== numTe#�T�O umasksnn_ridiculous,n�� mkdir doen_e2s ieft m�POSIX,= numTe#��� itsfdet >��� yndues�anrace�NondiizaN. C�:Çbt�O numTe#�direcHistt�O sRow wayinutepnr""utepnt hecWium� t nracFi as we"go.== numTe iesa$dstdir in /*) inDix='/';;n -*) inDix='./';;n *) �inDix='';;n ussssesac ie isseval "$iotI���ial_�ix_glob" ie issoIFS=$IFS ie issIFS=/gin � �$�ix_glob set -f sssssset fnisd $dstdir ssssss iftgin � �$�ix_glob set +f ie issIFS=$oIFS ie issinDixes= ie issxt nu sssssdo b��� -z "$d" &&b iescend a inDix=$inDix$d ifbb��� -d "$inDix";l? 1 uinDixes= e��D= uifb$�ix_mkdir;ut 1 udo(umask=$ukdir_ mask && n � �$doit_exec $ukdir�s(gb$ukdir_u d_ -ps-- "$dstdir") &&b (bn� u#�Don't mA' ifbbwo inn aecFi arenruMnum�codnurrrntly. nb��� -d "$inDix" || exit 1c ue��D= u iesa$inDix in *\'*) qinDix=`echo "$inDix" |uå��"s/'/'\\\\\\\\''/g"`;;n *) qinDix=$inDix;;n esac issinDixes="$inDixFi '$qinDix'" f + f + inDix=$inDix/ sssssdonD== numTeifbb��� -n "$inDixFi";l? 1 #�Don't mA' ifbbwo inn aecFi arenruMnum�codnurrrntly. �umask $ukdir_ mask && seval "\$doit_exec \$ukdir�s(gb$inDixFi") || ftb��� -d "$dstdir" || exit 1c obsolete_mkdir_ (r=.fu sie 1 f + issf + if +1doifbb��� -n "$dir_��g";l? 1 sss{bb��� -z "$Nhowncmd" || $doit $Nhowncmd "$dst";l} && sss{bb��� -z "$Nhgrpcmd" || $doit $Nhgrpcmd "$dst";l} && sss{bb��� "$obsolete_mkdir_ (r$Nhowncmd$Nhgrpcmd" pi.fueh || ie 1 b��� -z "$Nh1,dcmd" || $doit $Nh1,dcmda$u d_s"$dst";l} || exit 1clsl��D= ssss#�Mt R a coupÞ ofbb�mp x _esdir_s��net�O (roper�direcHist. ssssdsttmp=$dstdir/_inn .$$_ ssssrmtmp=$dstdir/_rm.$$_ ssss#�T��p ��::cl up �horr"b�mp x _en at exit(1numTt��p 'ret=$?; rm -f "$dsttmp" "$rmtmp" &&bexit $ret' 0 ssss#�e# Cit�O fidir_s*obobe�b�mp dir_(1numT�umask $Np_umask &&b$doit_exec $cp�s(gb"$src" "$dsttmp") && ssss#�a)rgn eanyopizaNs;4�t Nh1,d l llaoouAie Rd* en pid bitn(1numT# ie i# If anyofbt�Os_sfdet, we"abexp�obe�whole � s g. � mwe"waet�� ssss#�ignisen�����s fi���anyofbt�Os_, justemt R sureee2s�ignise ssss#������s fi���t#enabove�"$doit $Np�s(gb$urc $dsttmp" c�_man�(1numT# ie i{bb��� -z "$Nhowncmd" || $doit $Nhowncmd "$dsttmp";l} && sss{bb��� -z "$Nhgrpcmd" || $doit $Nhgrpcmd "$dsttmp";l} && sss{bb��� -z "$strpcmd" || $doit $strpcmd "$dsttmp";l} && sss{bb��� -z "$Nh1,dcmd" || $doit $Nh1,dcmda$u d_s"$dsttmp";l} && ie i# If -C, ãon't bot�O #t. Nomcoifbit ãouldn't ���ngFit�O fi.1doieifb$Nomc_on_���ngF && sssissold=`LC_ALL=C ls -dlLs"$dst" 2>/dev/nui` && sssissnew=`LC_ALL=C ls -dlLs"$dsttmp" 2>/dev/nui` && sssisseval "$iotI���ial_�ix_glob" && sssiss$�ix_glob set -f && sssissset X $old &&bold=:$2:$4:$5:$6 && sssissset X $dew &&bnew=:$2:$4:$5:$6 && sssiss$�ix_glob set +f && sssissb��� "$old"*cs $new" && sssiss$cmp�s(gs"$dst" "$dsttmp" >/dev/nui 2>&1 sissb 1 sssssrm -f "$dsttmp", n le��D= numTe#�Rdir_st�O fi*obobe�**2rede uat21�.gin � �$doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/nui || = numTe#�T�O redir_sfdetd, perhapsebe ause mv:�aN't redir_su �s� s gle��D= numTe#��itself,n�� perhapsebe ause mv:3s u "ancieetu�yat F� doen_e2s= numTe#�support -f.gin � �{ #�Now remove� nu ve�asidebanyold:: _eset de uat21�> ���o1�.g # ,etry��y T:owo w ys"secSe rm �aN't unl��kitselfn1�>u �sg # ���syss an��oy de uat21�>: _es_py��_be busysxt not�O g # �:s1�s. Is obco: ies,st�O fiNal �::clup _py��_mA' I bby newg # x _esshould"utill� pn all�succ��sfuiy.g { ftb��� ! -f "$dst" || ft$doit $rmcmd -f "$dst" 2>/dev/nui || ss{b$doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/nui && n � {t$doit $rmcmd -f "$rmtmp" 2>/dev/nui; :; } e'} || ss{becho "$0:��aNe2sunl��k�� redir_s$dst" >&2 u(exit 1);lexit 1c u} } && #�Now redir_st�O fi*obobe�**2rede uat21�.g $doit $mvcmd "$dsttmp" "$dst"gin � �}+ issf || exit 1c1numTt��p '' 0 if +donD==# L���l(1t varias:=# eval: (ad -hook '�����-fi-hooki 'te_t-n amp) # �i_t-n amp- Pert:�"script'--� mN=" # �i_t-n amp-ft mat:�"%:y-%02m-%02d.%02H" # �i_t-n amp-end:�"$" # End:)al,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyysss����������urc�22222222222222222222222222222222222222222222222222222222222222222222222222222222222sss�����55�������������������������0��������66���1374���3� 5����������������������������������������������������������������������������������������������������erfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb77555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555sss����������urc�topo�222222222222222222222222222222222222222222222222222222222222222222222222222222sss�����55�������������������������0�2457455711��14742��3� 5����������������������������������������������������������������������������������������������������erfecverst R '4' c: D !ifaled mNisoc rpofromR90ron W!ifApr 27 14:23:08 2011 MD5:faa520b800bf6e147fdbe3d21dceb775 -- If you ed_funhis, youdbe3d21dceb77555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555sss����������urc�topo����_topo_get_r_shinfo.f5555555555555555555555555555555555555555555555555555555sss���������������������������21���0�2457455711��21473626� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyin � �!-------------------------------------------------------------------------gin � �! Subn������� : ���_topo_get_r_shinfo in � �!-------------------------------------------------------------------------gin � �! e# Copy��_(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), gin � �! chs.5*sxt nFlpid Dydircs (DTU)EOF els!EOF els!EOF els! s# T:finn_ertsofbt�O Parallel Parti�:: M_sh Library (PPM).EOF els!EOF els! PPMnn_liesou ftwe e:����e�aN�rehistrbu�e F� an�/or=1,difcEOF els! it�"s undby o5*mofbt�O GNU Le�/i- G ed �l(P1)pubee Lic( gin � �! asf(1)pusoecnr""t�O Free:S ftwe e FtundlizaN,eit�O #gin � �! '--� mNT3ofbt�O LubLic(, �� aet ���r opizaN)bany4lier_gin � �! '--� mN.EOF els!EOF els! PPMnn_histrbu�ed��net�O hopeu�yat F� ã wibe uåfui,EOF els! I bWITHLE OANY WARRANTY; '--e�ut�evee�t�O impli>.fwe T��syofEOF els! MERCHANTABILITY �� FITNESS FOR A PARTICULAR PURPOSE. #�St�O numTe! GNU G ed �l(P1)pubee Lic( for=1,renu �deta��OF els!EOF els! Yr�eshould"hsTsareceivmNa Nomcofbt�O GNU G ed �l(P1)pubee Lic(gin � �! an��oy GNU Le�/i- G ed �l(P1)pubee Lic( aoptl w--ePPM. If e2s,EOF els! s#�S<http://www.gnu.t g/pubLic(s/>.EOF els!EOF els! Parallel Parti�:: M_sh Library (PPM)EOF els! ETH Zurichgin � �! eH-8092 Zurich, Sw--zerlan� ssss �!-------------------------------------------------------------------------g ssss �SUBRLE INE ���_topo_get_r_shinfo(topoid,r_shid,nm,i Pert,ndlia,maxndlia,& sssis& is1)pust,ns1)pust,info)EOF els!!! s# T:n�������rlyRrint�O subdom in btundlsi��nan��btundlsyEOF els!!! NondiizaNs in � �!-------------------------------------------------------------------------gin � �! M�����s in � �!-------------------------------------------------------------------------gin � �USE ���_m�����_dliagin � �USE ���_m�����_tubstartgin � �USE ���_m�����_tubstopgin � �USE ���_m�����_�����EOF elsUSE ���_m�����_ hecW_idEOF elsUSE ���_m�����_�t1tdefEOF elsUSE ���_m�����_a Roc ie issIMPLICI ONONE in � �!-------------------------------------------------------------------------gin � �! I ,scls in � �!-------------------------------------------------------------------------g #if� �__KIND ==�__SINGLE_PRECISION ie issINTEGER, PARAMETERest MK = ���_kind_ umle #elif�__KIND ==�__DOUBLE_PRECISION ie issINTEGER, PARAMETERest MK = ���_kind_douria #endif in � �!-------------------------------------------------------------------------gin � �! Argureetd in � �!-------------------------------------------------------------------------gin � �INTEGER ,�INTENT(IN )est topoidEOF els!!! sopology IDgin � �INTEGER ,�INTENT(IN )est r_shidEOF els!!! M_sh IDgin � �INTEGER, DIMENSION(: ), POINTER,�INTENT( LE )est nmEOF els!!! glob�l(numb�i ofbr_shuA' pos��nec0 omaizaNal dom ingin � �INTEGER, DIMENSION(:,:), POINTER,�INTENT( LE )est istartgin � �!!! Start�3s ixFi (i,j[,k]) (first bedex) ofbtubbr_shuis1)��seNondgin � �!!! bedex) �ne*glob�l*br_sh.gin � �!!!gin � �!!! [CAUUNCT]EOF els!!! s# T:e T�y holdnt�O sPertum�bedexFi for=*a R*EOF els!!! subdom ins��net�O *whole* physical dom in (i.e. all� rocFis��s).gin � �!!! Uc( `topo%is1)pust`s�f3s nt�O indexFi for=t�O grids>onet�Ogin � �!!! rocFis��gin � �INTEGER, DIMENSION(:,:), POINTER,�INTENT( LE )est ndliagin � �!!! RlyRrinnumb�i ofbgrid POINTS��nex,y[,z] (first bedex) ofbtubbr_shgin � �!!! bs1)��seNond bedex). I ,sclset�O (' pos�ONt�O sub btundlsi��.gin � �!!!gin � �!!! [CAUUNCT]EOF els!!! s# T:e T�y holdnt�O numb�i ofb(' pos�for=*a R* subdom ins��net�OEOF els!!! *whole* physical dom in (i.e. all� rocFis��s).gin � �!!! Uc( `topo%is1)pust`s�f3s nt�O indexFi for=t�O grids>onet�Ogin � �!!! rocFis��gin � �INTEGER, DIMENSION(���_dim) ,�INTENT( LE )est maxndlia gin � �!!! RlyRrinmaximumnumb�i ofbgrid (' pos� _go�all�subdom insgin � �INTEGER, DIMENSION(: ), POINTER,��INTENT( LE )est is1)pustgin � �!!! Z�st ofbtubofbt�O currrnt( rocFis��. gin � �!!! 1st bedex:es���l sub numb�i.gin � �INTEGER ,��INTENT( LE )est ns1)pustgin � �!!! numb�i ofbtubonbt�O currrnt( rocFis��.gin � �INTEGER ,�INTENT( LE )est info in � �!!! RlyRri Petus, 0n1�>uucc��s in � �!-------------------------------------------------------------------------gin � �! L���l(1t varias in � �!-------------------------------------------------------------------------gin � �REAL(���_kind_douria) st t0gin � �INTEGER st i,is1),dgin � �LOGICAL st vsiidgin � �TYPE(���_t_topo), POINTERest topo => NULL()gin � �TYPE(���_t_' n�_r_sh), POINTERest r_sh => NULL()gin � �INTEGER, DIMENSION(2) st ldagin � �INTEGER st iopi in � �!-------------------------------------------------------------------------gin � �! Exo5*nals in � �!-------------------------------------------------------------------------g in � �!-------------------------------------------------------------------------gin � �! IotI���ic(gin � �!-------------------------------------------------------------------------gin � �CALL#tubstart('���_topo_get_r_shinfo',t0,info)E in � �!-------------------------------------------------------------------------gin � �! ChecWsargureetd in � �!-------------------------------------------------------------------------gin � �IF (���_debug .GT. 0) sHEN ie iss �CALL# hecW ie iss �IF (infon.NE. 0) GOTO 9999 ie issENDIF ce'leftbopo => ���_topo(topoid)%i in � �r_sh => topo%r_sh(r_shid)gin � � in � �!-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut nutructures in � �!-------------------------------------------------------------------------g in � �iopi = ���_param_a Roc_fii in � �lda(1) = ���_dim in � �lda(2) = topo%ns1)sgin � �CALL#���_a Roc(nm,lda,iopi,info)EOF elsIF (infon.NE. 0) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_get_r_shinfo', � T& sssi& 'glob�l(r_sh sial NM',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF in � �CALL#���_a Roc(i Pert,lda,iopi,info)EOF elsIF (infon.NE. 0) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_get_r_shinfo', � T& sssi& 'tubbr_shustart�3s ixFi ISTART',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF in � �CALL#���_a Roc(ndlia,lda,iopi,info)EOF elsIF (infon.NE. 0) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_get_r_shinfo', � T& sssi& 'tubbr_shusials NDATA',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF in � � in � �lda(1) = topo%ns1)pustgin � �CALL#���_a Roc(i 1)pust,lda,iopi,info)EOF elsIF (infon.NE. 0) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_get_r_shinfo', � T& sssi& 'tubbr_shusials ISUBLIST',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF in � � in � �!-------------------------------------------------------------------------gin � �! Comcdliagin � �!-------------------------------------------------------------------------gin �gin � �ns1)pust = topo%ns1)pustgin � �FORALL#(i=1:ns1)pust) is1)pust(i) = topo%is1)pust(i)gin � �nm = r_sh%Nmgin � �FORALL(i=1:topo%ns1)s, d=1:���_dim) EOF elsssssndlia(d,i) = r_sh%nn d_s(d,i) ie iss � Tistart(d,i) = r_sh%istart(d,i) ie issEND�FORALL in � �raxndlia = 0gin � �DO i=1,ns1)pustgin � � � Tisubb= is1)pust(i)gin � � � �DO d=1,���_dim in � ���������IF (ndlia(d,is1)).GT.raxndlia(d)) raxndlia(d)b= ndlia(d,is1)) in � �����ENDDO �����ENDDO in � �!-------------------------------------------------------------------------gin � �! RlyRri in � �!-------------------------------------------------------------------------gi9999 eONTINUEgin � �CALL#tubstop('���_topo_get_r_shinfo',t0,info)Ein � �RETURN ie isseONTAINS ie issSUBRLE INE hecW ie iss ���IF (.NOT. ���_iotI���iald) sHEN ie iss � T � Tinfon= ���_�����_�����EOF else2s�����CALL#���_�����(���_���_���_noiotI,'���_topo_get', �& sssi& 'Pleaå�all����_iotI first!',__LINE__,info)EOF elsssssssssGOTO 8888 in � �����ENDIF in � �����CALL#���_ hecW_topoid(topoid,vsiid,info)EOF elsssssIF (.NOT. vsiid) sHEN ie iss � T � Tinfon= ���_�����_�����EOF else2s�����CALL#���_�����(���_���_argureet,'���_topo_get_r_shinfo', �& sssi& 'sopology ID�3s pvsiid!',__LINE__,info)EOF elsssssssssGOTO 8888 in � �����ENDIF in � �����CALL#���_ hecW_r_shid(topoid,r_shid,vsiid,info)EOF elsssssIF (.NOT. vsiid) sHEN ie iss � T � Tinfon= ���_�����_�����EOF else2s�����CALL#���_�����(���_���_argureet,'���_topo_get_r_shinfo', �& sssi& 'M_sh ID�3s pvsiid!',__LINE__,info)EOF elsssssssssGOTO 8888 in � �����ENDIF i8888�����CONTINUEgin � �END�SUBRLE INE hecW ie issEND�SUBRLE INE ���_topo_get_r_shinfo nsetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyysss����������urc�topo����_topo_a Roc.f55555555555555555555555555555555555555555555555555555555555555sss���������������������������50570763�����������20112626� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyie iss!-------------------------------------------------------------------------gin � �! Subn������� : ���_topo_a Roc in � �!-------------------------------------------------------------------------gin � �! e# Copy��_(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), gin � �! chs.5*sxt nFlpid Dydircs (DTU)EOF els!EOF els!EOF els! s# T:finn_ertsofbt�O Parallel Parti�:: M_sh Library (PPM).EOF els!EOF els! PPMnn_liesou ftwe e:����e�aN�rehistrbu�e F� an�/or=1,difcEOF els! it�"s undby o5*mofbt�O GNU Le�/i- G ed �l(P1)pubee Lic( gin � �! asf(1)pusoecnr""t�O Free:S ftwe e FtundlizaN,eit�O #gin � �! '--� mNT3ofbt�O LubLic(, �� aet ���r opizaN)bany4lier_gin � �! '--� mN.EOF els!EOF els! PPMnn_histrbu�ed��net�O hopeu�yat F� ã wibe uåfui,EOF els! I bWITHLE OANY WARRANTY; '--e�ut�evee�t�O impli>.fwe T��syofEOF els! MERCHANTABILITY �� FITNESS FOR A PARTICULAR PURPOSE. #�St�O numTe! GNU G ed �l(P1)pubee Lic( for=1,renu �deta��OF els!EOF els! Yr�eshould"hsTsareceivmNa Nomcofbt�O GNU G ed �l(P1)pubee Lic(gin � �! an��oy GNU Le�/i- G ed �l(P1)pubee Lic( aoptl w--ePPM. If e2s,EOF els! s#�S<http://www.gnu.t g/pubLic(s/>.EOF els!EOF els! Parallel Parti�:: M_sh Library (PPM)EOF els! ETH Zurichgin � �! eH-8092 Zurich, Sw--zerlan� ssss �!-------------------------------------------------------------------------g ssss �SUBRLE INE ���_topo_a Roc(topoid,ns1)s,ns1)pust,raxnepy�,prec,info)EOF els!!! s# T:n�������(re-)al ���oen_a topology tbjectnan��all� ts uemb�is in � �!-------------------------------------------------------------------------gin � �! M�����s in � �!-------------------------------------------------------------------------gin � �USE ���_m�����_dliagin � �USE ���_m�����_tubstartgin � �USE ���_m�����_tubstopgin � �USE ���_m�����_�����EOF elsUSE ���_m�����_a Roc in � �USE ���_m�����_r_sh_a Roc in � �USE ���_m�����_�t1tdefEOF elsIMPLICI ONONE in � �!-------------------------------------------------------------------------gin � �! I ,scls in � �!-------------------------------------------------------------------------gin � �!-------------------------------------------------------------------------gin � �! Argureetd in � �!-------------------------------------------------------------------------gin � �INTEGER ,�INTENT(IN )est ns1)sgin � �!!! sot�l(numb�i ofbtubonball� rocsgin � �INTEGER ,�INTENT(IN )est ns1)pustgin � �!!! L���l(numb�i ofbtubonbt�nn_ioc ie issINTEGER ,�INTENT(IN )est raxnepy�gin � �!!! Maximumnumb�i ofbnepy�b��rs�ofiany sub onbt�nn_iocFis��gin � �INTEGER ,�INTENT(IN )est precgin � �!!! Preci� mNTut nutor�ga. OnÞ of:gin � �!!!gin � �!!! * ���_kind_ umle in � �!!! * ���_kind_douria in � �INTEGER ,�INTENT(INLE )est topoidEOF els!!! sopology idnutructuren�be (re)al ���oedgin � �!!!gin � �!!! ifbbopoid ==�0eb lw a dew topology should"be al ���oed,le��Det�Ogin � �!!! topology w--eid ==�bopoid nn_real ���oedgin � �INTEGER ,�INTENT( LE )est info in � �!!! RlyRri Petus, 1�>uucc��s 0. in � �!-------------------------------------------------------------------------gin � �! L���l(1t varias in � �!-------------------------------------------------------------------------gin � �INTEGER , DIMENSION(3) st ldcgin � �!!! Numb�i ofbeeereets��neall�direesàÿf�� a RoclizaN (n � �INTEGER st iopi in � �!!! a RoclizaN u d_, s#�SonÞ of#���_a Roc_* subn������s.gin � �INTEGER st ns1)rax in � �!!! * inn oy MAXofbtopo%ns1)snan��1gin � �INTEGER st ns1)pustrax in � �!!! * inn oy MAXofbtopo%ns1)pust an��1gin � �INTEGER st topo_idx in � �!!! l���l(1t varia holdum��yO index��net�O (��_topo:e T�y '--et�O in � �!!! topology �yat should"be (re)al ���oedgin � �TYPE(���_t_topo), POINTERest topo => NULL()gin � �TYPE(���_ptr_t_topo), DIMENSION(:), POINTERest temptopo => NULL()gin � �INTEGER st iEin � �REAL(���_kind_douria) st t0g in � �!-------------------------------------------------------------------------gin � �! I tI���ic(gin � �!-------------------------------------------------------------------------gin � �CALL#tubstart('���_topo_al ��',t0,info)E in � �!-------------------------------------------------------------------------gin � �! ChecWsargureetd in � �!-------------------------------------------------------------------------gin � �IF (���_debug .GT. 0) sHEN ie iss �CALL# hecW ie iss �IF (infon.NE. 0) GOTO 9999 ie issENDIF iss �IF (bopoid .EQ. 0) sHEN ie iss �!----------------------------------------------------------------------- ie iss �! ,ehsTsabo_ �:Ç_a4dew topology ie iss �!----------------------------------------------------------------------- ie iss �IF (���_next_avdet_topo:.EQ. ���_param_"s ufinec) sHEN ie iss � T �! s# T:is t�O firllaoopology,' tI���ial�every� s g ie iss � T �ALLOCATE(���_topo(8), STAT=info)EOF elsssssssIF (infon.NE. 0) sHEN ie iss � TTTTTTTinfon= ���_�����_flial ie iss � T iss �CALL#���_�����(���_���_a Roc,'���_topo_al ��', �& sssi& 'Could"e2sal ���oe (��_topo',__LINE__,info)EOF elsssssssssssGOTO 9999 ie issie issENDIF ie iss � T �! mt R sureeall� o po5*i arennuipfi ie iss � T �DO i=1,SIZE(���_topo)EOF elsssssssssssNULLIFY(���_topo(i)%t) ie issie issENDDO ��������������_next_avdet_topo:=�1gin � �ssELSEIF (���_next_avdet_topo:.GT. SIZE(���_topo)) sHEN ie iss � T �! W ne >m.ree2pace��net�O (��_topo:e T�y,lenl��ge ie iss � T �ALLOCATE(temptopo(SIZE(���_topo)),STAT=info)EOF elsssssssIF (infon.NE. 0) sHEN ie iss � TTTTTTTinfon= ���_�����_�����EOF else2s����� �CALL#���_�����(���_���_a Roc,'���_topo_al ��', �& sssi& 'Could"e2sal ���oe temptopo',__LINE__,info)EOF elssssssssssssGOTO 9999 ie issie issENDIF ie iss � T �DO i=1,SIZE(temptopo)EOF elssssssssssstemptopo(i) = ���_topo(i) ie issie issENDDO �����������DEALLOCATE(���_topo,STAT=info)EOF elsssssssIF (infon.NE. 0) sHEN ie iss � TTTTTTTinfon= ���_�����_�����EOF else2s����� CALL#���_�����(���_���_dea Roc,'���_topo_al ��', �& sssi& 'Could"e2sdeal ���oe (��_topo',__LINE__,info)EOF elsssssssENDIF ie iss � T �ALLOCATE(���_topo(2*SIZE(temptopo)),STAT=info)EOF elsssssssIF (infon.NE. 0) sHEN ie iss � TTTTTTTinfon= ���_�����_�����EOF else2s����� CALL#���_�����(���_���_a Roc,'���_topo_al ��', �& sssi& 'Could"e2sreal ���oe (��_topo',__LINE__,info)EOF elsssssssENDIF ie iss � T �DO i=1,SIZE(temptopo)EOF elsssssssssss���_topo(i) = temptopo(i) ie issie issENDDO �����������DO i=SIZE(temptopo)+1,SIZE(���_topo)EOF elsssssssssssNULLIFY(���_topo(i)%t) ie issie issENDDO �����������DEALLOCATE(temptopo,STAT=info)EOF elsssssssIF (infon.NE. 0) sHEN ie iss � TTTTTTTinfon= ���_�����_�����EOF else2s����� CALL#���_�����(���_���_dea Roc,'���_topo_al ��', �& sssi& 'Could"e2sdeal ���oe temptopo',__LINE__,info)EOF elsssssssENDIF ie iss �ENDIF ie iss �bopoid =����_next_avdet_topo ie iss ����_next_avdet_topo:=����_next_avdet_topo:+�1gin � �ss!---------------------------------------------------------------------- ie iss �! s# T:ãa onÞ hep �ofian uglyhscW ie iss �! sODO: re lace�t�nn_r""u �s� s glmuch"betier_4liergin � �ss!---------------------------------------------------------------------- !ie iss �! g ea4dew avdet topo ID !ie iss �! f�� now wehsTsabo_ hecWs'r eoum��yn��gheall�topos !ie iss �! I bby3s uhould"be e2ssuch"a big#d*2rebe ause thsresareee2s !ie iss �! many anyw�y -�s/> an beedonÞ betier_'r um�a queuenutorum�all !ie iss �! free:topos !ie iss �topo_idx:=�MOD(bopoid+1,SIZE(���_topo)+1)+1 !ie iss �DO ! IF (bopo_idx:.EQ. topoid) sHEN ! EXIT ! ENDIF ! IF (.NOT. ���_topo(topo_idx)%t%is ufinec) sHEN ! ���_next_avdet_topo:=�topo_idx ! EXIT ! ENDIF ! topo_idx:=�topo_idx:+�1g! ENDDO ! IF (bopoid .EQ. ���_next_avdet_topo) sHEN ! ���_next_avdet_topo:=�SIZE(���_topo):+�1g! ENDIF ie issENDIF iss �CALL#���_a Roc(���_topo(topoid)%i,���_param_a Roc_fii,info)EOF elsIF (infon.NE. 0) sHEN ie iss � Tinfon= ���_�����_�����EOF else2s�CALL#���_�����(���_���_dea Roc,'���_topo_al ��', �& & 'Could"e2sal ���oe (��_topobeeereets',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF topo => ���_topo(topoid)%i topo%ID =�bopoidE in � �!-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut noy dom ingin � �!-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = ���_dim in � �IF (�rec .EQ. ���_kind_ umle) sHEN ie iss � TCALL#���_a Roc(topo%rin_physs,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rin extrnt(of dom in TOPO%MIN_PHYSS',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����CALL#���_a Roc(topo%rax_physs,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rax extrnt(of dom in TOPO%MAX_PHYSS',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����IF (ASSOCIATED(topo%rin_physd)) DEALLOCATE(topo%rin_physd,STAT=info)EOF elsssssNULLIFY(topo%rin_physd) in � �����IF (ASSOCIATED(topo%rax_physd)) DEALLOCATE(topo%rax_physd,STAT=info)EOF elsssssNULLIFY(topo%rax_physd) ie issELSE ie iss � TCALL#���_a Roc(topo%rin_physd,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rin extrnt(of dom in TOPO%MIN_PHYSD',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����CALL#���_a Roc(topo%rax_physd,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rax extrnt(of dom in TOPO%MAX_PHYSD',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����IF (ASSOCIATED(topo%rin_physs)) DEALLOCATE(topo%rin_physs,STAT=info)EOF elsssssNULLIFY(topo%rin_physs) in � �����IF (ASSOCIATED(topo%rax_physs)) DEALLOCATE(topo%rax_physs,STAT=info)EOF elsssssNULLIFY(topo%rax_physs) in � �ENDIF in � �!-------------------------------------------------------------------------gin � �! Ty MAXofbna1)pust an��1snn_eeededs�avoid a RoclizaN mA'ures in � �!ieifba_iocFis��hss 0 s1)s, sir_sgoFi for=ns1)sgin � �!-------------------------------------------------------------------------gin � �ns1)rax:=�MAX(ns1)s,1)gin � �ns1)pustrax:=�MAX(ns1)pust,1)E in � �!-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut noy subdom insgin � �!-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = ���_dim in � �ldc(2) = ns1)sgin � �IF (�rec .EQ. ���_kind_ umle) sHEN ie iss � TCALL#���_a Roc(topo%rin_s1)s,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rin extrnt(of s1)snTOPO%MIN_SUBS',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����CALL#���_a Roc(topo%rax_s1)s,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rax extrnt(of s1)snTOPO%MAX_SUBS',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����IF (ASSOCIATED(topo%rin_subd)) DEALLOCATE(topo%rin_subd,STAT=info)EOF elsssssNULLIFY(topo%rin_subd) in � �����IF (ASSOCIATED(topo%rax_subd)) DEALLOCATE(topo%rax_subd,STAT=info)EOF elsssssNULLIFY(topo%rax_subd) in � �ELSE ie iss � TCALL#���_a Roc(topo%rin_subd,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rin extrnt(of s1)snTOPO%MIN_SUBD',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����CALL#���_a Roc(topo%rax_subd,ldc,iopi,info)EOF els elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � T � Tinfon= ���_�����_flial ie iss � T issCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'rax extrnt(of s1)snTOPO%MAX_SUBD',__LINE__,info)EOF elsssssssssGOTO 9999 ie issie iENDIF in � �����IF (ASSOCIATED(topo%rin_s1)s)) DEALLOCATE(topo%rin_subs,STAT=info)EOF elsssssNULLIFY(topo%rin_s1)s) in � �����IF (ASSOCIATED(topo%rax_subs)) DEALLOCATE(topo%rax_subs,STAT=info)EOF elsssssNULLIFY(topo%rax_subs) ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut noy sub-to-ioc mapps g ie iss!-------------------------------------------------------------------------gin � �ldc(1) = ns1)sgin � �CALL#���_a Roc(topo%s1)2ioc,ldc,iopi,info)EOF elsIF (infon.NE. 0) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'glob�l(s1)snoouAioc mapnTOPO%SUB2PROC',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut nZ�st ofbs���l subsgin � �!-------------------------------------------------------------------------gin � �ldc(1) = ns1)rax in � �CALL#���_a Roc(topo%i 1)pust,ldc,iopi,info)EOF elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 's���l sub Z�st TOPO%ISUBLIST',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut noy btundlsy NondiizaNs !-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = 2*���_dim in � �CALL#���_a Roc(topo%bcdef,ldc,iopi,info)EOF elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'btundlsy NondiizaNs TOPO%BCDEF',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut noy subdom in costd in � �!-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = ns1)sgin � �IF (�rec .EQ. ���_kind_ umle) sHEN ie iss � TNULLIFY(topo%s1)_costd) in � �����CALL#���_a Roc(topo%s1)_costs,ldc,iopi,info)EOF els elsIF (ASSOCIATED(topo%s1)_costd)) DEALLOCATE(topo%s1)_costd,STAT=info)EOF elsELSE ie iss � TNULLIFY(topo%s1)_costs) in � �����CALL#���_a Roc(topo%s1)_costd,ldc,iopi,info)EOF els elsIF (ASSOCIATED(topo%s1)_costs)) DEALLOCATE(topo%s1)_costs,STAT=info)EOF elsENDIF in � �IF (infon.NE. ���_param_uucc��s) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'subdom in costdnTOPO%SUB_COST',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut noy numb�is ofbnepy�b�is ofbeaches���l sub aN (n � �! bt�O currrnt( rocFis�� i.e, a subsetsofbt�O nnepy�(1:ns1)s) Z�st. in � �!-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = ns1)pustrax in � �CALL#���_a Roc(topo%nnepy�s1)s,ldc,iopi,info)EOF elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'numb�i ofbnepy�b�is ofbs���l subsnTOPO%NNEIGHSUBS',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut noy glob�l(IDs�ofiall�ty nepy�b�is. in � �!-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = raxnepy�gin � �ldc(2) = ns1)pustgin � �CALL#���_a Roc(topo%inepy�s1)s,ldc,iopi,info)EOF elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'nepy�b�is ofbs���l subsnTOPO%INEIGHSUBS',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut nBCut noy subonbt�O currrnt( rocFis�� in � �!-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = 2*���_dim in � �ldc(2) = ns1)rax in � �CALL#���_a Roc(topo%sub_bc,ldc,iopi,info)EOF elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'BCi for=subonbs���l rocFis�� TOPO%SUBS_BC',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Al ���oe�r_mistut nt�O Z�st ofbnepy�b�ium� rocFis��s. in � �!-------------------------------------------------------------------------gin � �iopi = ���_param_a Roc_fii in � �ldc(1) = 26 � �! justeguFisum�:-) FIXME: Why?gin � �CALL#���_a Roc(topo%inepy�ioc,ldc,iopi,info)EOF elsIF (infon.NE. ���_param_uucc��s) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_topo_al ��', � �& sssi& 'Z�st ofbnepy�b�i� rocFis��snTOPO%INEIGHPROC',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF !-------------------------------------------------------------------------gin � �! Nuipf""t�O c�_municlizaN sequence. I� ã wibe al ���oed w 1 sssss! firlla (r. in � �!-------------------------------------------------------------------------gin � �IF (ASSOCIATED(topo%ic�_mseq)) DEALLOCATE(topo%ic�_mseq,STAT=info)EOF elsNULLIFY(topo%ic�_mseq)EOF elstopo%i opizmialdn= .FALSE. !-------------------------------------------------------------------------gin � �! By default thsresareee2 r_shes ufineconba topology ie iss!-------------------------------------------------------------------------gin � �topo%rax_r_shid = 0gin � �iopi = ���_param_dea Rocgin � �CALL#���_r_sh_a Roc_' n�(topo%r_sh,ldc,iopi,info)EOF elsNULLIFY(topo%r_sh) in � �!-------------------------------------------------------------------------gin � �! Mark��y T:oopology asfe2sdefinec ie iss!-------------------------------------------------------------------------gin � �topo%is ufinecn= .FALSE. !-------------------------------------------------------------------------gin � �! Se bby preci� mNTut n�y T:oopology ie iss!-------------------------------------------------------------------------gin � �topo%�rec = precg !-------------------------------------------------------------------------gin � �! RlyRri in � �!-------------------------------------------------------------------------gi9999 eONTINUEgin � �CALL#tubstop('���_topo_al ��',t0,info)Ein � �RETURN ie isseONTAINS ie issSUBRLE INE hecW ie iss ����IF (nsub.LE. 0) sHEN ie iss � TTTTTinfon= ���_�����_�����EOF else2s�����CALL#���_�����(���_���_argureet,'���_topo_al ��', & sssi& 'nsubmustebe >0',__LINE__,info)EOF elsssssssssGOTO 8888 in � �����ENDIF in � �����IF (nsubZ�st .LE. 0) sHEN ie iss � TTTTTinfon= ���_�����_�����EOF else2s�����CALL#���_�����(���_���_argureet,'���_topo_al ��', & sssi& 'nsubZ�st mustebe >0',__LINE__,info)EOF elsssssssssGOTO 8888 in � �����ENDIF in � �����IF (nsub.LT. ns1)pust) sHEN ie iss � TTTTTinfon= ���_�����_�����EOF else2s�����CALL#���_�����(���_���_argureet,'���_topo_al ��', & sssi& 'tot�l(numb�i ofbtub3s umalle n�yanbs���l',__LINE__,info)EOF elsssssssssGOTO 8888 in � �����ENDIF in � �����IF (raxnepy�.LT. 0) sHEN ie iss � TTTTTinfon= ���_�����_�����EOF else2s�����CALL#���_�����(���_���_argureet,'���_topo_al ��', & sssi& 'raxnepy�mustebe >=0',__LINE__,info)EOF elsssssssssGOTO 8888 in � �����ENDIF in � �����IF (bopoid.NE.0) sHEN ie iss � TTTTTIF ((bopoid.GT.SIZE(���_topo)) .OR.�& sssi& (bopoid.LT.1)) sHEN ie iss � T � TTTTTinfon= ���_�����_�����EOF else2s���������CALL#���_�����(���_���_argureet,'���_topo_al ��', & sssi& 'topoid nndexum�outside (��_topo',& sssi& __LINE__, info)EOF elsssssssssssssGOTO 8888 in � ���������ENDIF in � �����ENDIF i8888����CONTINUEgin � �END�SUBRLE INE hecW ie issEND�SUBRLE INE ���_topo_a RocgG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyysss����������urc�topo����_Nomc_imag�_tubs.f555555555555555555555555555555555555555555555555555555555sss���������������������������53526763�����������21133626� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyie iss!-------------------------------------------------------------------------gin � �! Subn������� : ���_Nomc_imag�_tubs !-------------------------------------------------------------------------gin � �! e# Copy��_(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), gin � �! chs.5*sxt nFlpid Dydircs (DTU)EOF els!EOF els!EOF els! s# T:finn_ertsofbt�O Parallel Parti�:: M_sh Library (PPM).EOF els!EOF els! PPMnn_liesou ftwe e:����e�aN�rehistrbu�e F� an�/or=1,difcEOF els! it�"s undby o5*mofbt�O GNU Le�/i- G ed �l(P1)pubee Lic( gin � �! asf(1)pusoecnr""t�O Free:S ftwe e FtundlizaN,eit�O #gin � �! '--� mNT3ofbt�O LubLic(, �� aet ���r opizaN)bany4lier_gin � �! '--� mN.EOF els!EOF els! PPMnn_histrbu�ed��net�O hopeu�yat F� ã wibe uåfui,EOF els! I bWITHLE OANY WARRANTY; '--e�ut�evee�t�O impli>.fwe T��syofEOF els! MERCHANTABILITY �� FITNESS FOR A PARTICULAR PURPOSE. #�St�O numTe! GNU G ed �l(P1)pubee Lic( for=1,renu �deta��OF els!EOF els! Yr�eshould"hsTsareceivmNa Nomcofbt�O GNU G ed �l(P1)pubee Lic(gin � �! an��oy GNU Le�/i- G ed �l(P1)pubee Lic( aoptl w--ePPM. If e2s,EOF els! s#�S<http://www.gnu.t g/pubLic(s/>.EOF els!EOF els! Parallel Parti�:: M_sh Library (PPM)EOF els! ETH Zurichgin � �! eH-8092 Zurich, Sw--zerlan� ssss �!-------------------------------------------------------------------------g #if� �__KIND ==�__SINGLE_PRECISION ie issSUBRLE INE omc_imgsub_s(rin_phys,rax_phys,bcdef, & sssi& rin_s1),rax_sub,ns1)s,s1)id,ns1)splus,info)E#elif�__KIND ==�__DOUBLE_PRECISION ie issSUBRLE INE omc_imgsub_d(rin_phys,rax_phys,bcdef, & sssi& rin_s1),rax_sub,ns1)s,s1)id,ns1)splus,info)E#endif in � �!!! s# T:n������� omient�O sub dom ins�to ghost sub dom ins in � �!!! �net�O caåof#�eri,dic btundlsy NondiizaN an��utores in � �!!! t�O oopyin�l(IDofbt�O sub dom in -n�y T:oo al �wt�O in � �!!! f3s nnepy�b��rs�oo search ('--e�ut�wrapps ge2pace)t�O in � �!!! Z�st ofbtub dom ins�an��ut wiretrev�St�Oreal(IDofbtub dom in.gin � �!!!gin � �!!! [NOTE]EOF els!!! s# T: T:e"hsppr eoum�n������: wee e c0 arum��yO equalisyofEOF els!!! floatum� o po numb�is *I * F� *works* sedn�St�Ovalue ofbtubEOF els!!! e e *assigned*_liombby phys rin/rax an��*e2s*ec0 ommN(byt�� omy). in � �!-------------------------------------------------------------------------gin � �! M�����s� in � �!-------------------------------------------------------------------------gin � �USE ���_m�����_dliagin � �USE ���_m�����_tubstartgin � �USE ���_m�����_tubstopgin � �USE ���_m�����_�����EOF elsUSE ���_m�����_a Roc in � �IMPLICI ONONE #if� �__KIND ==�__SINGLE_PRECISION ie issINTEGER, PARAMETERest MK = ���_kind_ umle #elif�__KIND ==�__DOUBLE_PRECISION ie issINTEGER, PARAMETERest MK = ���_kind_douria #endif in � �!-------------------------------------------------------------------------gin � �! I ,scls in � �!-------------------------------------------------------------------------g#ifdef�__MPI ie issINCLUDE 'mpif.h' #endif in � �!-------------------------------------------------------------------------gin � �! Argureetdn � � in � �!-------------------------------------------------------------------------gin � �REAL(MK), DIMENSION(:) ,�INTENT(IN )est rin_physEOF els!!! Min. extrnt(of by physical dom ingin � �REAL(MK), DIMENSION(:) ,�INTENT(IN )est rax_physEOF els!!! Max. extrnt(of by physical dom ingin � �INTEGER , DIMENSION(:) ,�INTENT(IN )est bcdefEOF els!!! Btundlsy NondiizaN ufiniizaN (n � �REAL(MK), DIMENSION(:,:), POINTER(n � �est rin_tubEOF els!!! Min. extrnt(of by sub dom in i ,scum�aftundby call�ton�y TEOF els!!! n�������oy ghost sub dom ins in � �REAL(MK), DIMENSION(:,:), POINTER(n � �est rax_subEOF els!!! Max. extrnt(of by sub dom in i ,scum�aftundby call�ton�y TEOF els!!! n�������oy ghost sub dom ins in � �INTEGER , DIMENSION(:) ,�POINTER(n � �est s1)idEOF els!!! Real(id of by sub dom in in � �INTEGER ,�INTENT(IN )est ns1)sgin � �!!! sot�l(numb�i ofbtub dom ins in � �INTEGER ,�INTENT( LE )est ns1)splusgin � �!!! sot�l(numb�i ofbtub dom ins plus�oy ghost sub dom ins in � �INTEGER ,�INTENT( LE )est info in � �!!! RlyRris Petus, 0nup1�>uucc��s in � �!-------------------------------------------------------------------------gin � �! L���l(1t varias� in � �!-------------------------------------------------------------------------gin � �REAL(MK), DIMENSION(���_dim)est len_physEOF elsREAL(MK) � �est t0gin � �INTEGER , DIMENSION(���_dim)est ldc ie issINTEGER � �est i,j,k ie issINTEGER � �est iopi,isial in � �!-------------------------------------------------------------------------gin � �! Exo5*nals� in � �!-------------------------------------------------------------------------gin � � in � �!-------------------------------------------------------------------------gin � �! I tI���ic(� in � �!-------------------------------------------------------------------------gin � �CALL#tubstart('���_Nomc_imag�_tubs',t0,info)E in � �!-------------------------------------------------------------------------gin � �! ChecWs�yO in omsargureetd (if�iN ubuggs glmode) in � �!-------------------------------------------------------------------------gin � �IF (���_debug .GT. 0) sHEN ie iss �CALL# hecW ie iss �IF (infon.NE. 0) GOTO 9999 ie issENDIF iss �!-------------------------------------------------------------------------gin � �! Co om��yO extrnd(of by physical system� in � �!-------------------------------------------------------------------------gin � �DO k=1,���_dim in � ����len_phys(k) = rax_phys(k) - rin_phys(k) ie issENDDO in � �!-------------------------------------------------------------------------gin � �! Storebt�O currrnt(sial ofbtubic ie iss!-------------------------------------------------------------------------gin � �isial:=�SIZE(tubic)E in � �!-------------------------------------------------------------------------gin � �! Se bNonstaetd in � �!-------------------------------------------------------------------------gin � �ns1)splus = ns1)sgin � �iopi = ���_param_a Roc_fii_preserve !-------------------------------------------------------------------------gin � �! Add ghost dom ins ut nt�O �eri,dic system in � �!-------------------------------------------------------------------------gin � �IF (bcdef(1).EQ.���_param_bcdef_�eri,dic) sHEN ie iss � !---------------------------------------------------------------------- ie iss ��! Comc�net�O firlladirecizaN (n � � � !---------------------------------------------------------------------- ie iss ��IF (���_dim.EQ.2) sHEN ie iss � T �!------------------------------------------------------------------- ie iss �� ��! Two�direesàÿ ie iss � T �!------------------------------------------------------------------- ie iss �� ��j = ns1)splusgin � �������DO i=1,ns1)splusgin � ������� ��IF (rin_tub(1,i).EQ.rin_phys(1)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� � ie iss � T � TTTTT �ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T � TTTTTs1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i) +�len_phys(1)EOF els elss�������rin_tub(2,j) = rin_tub(2,i)EOF els elss�������rax_sub(1,j) = rax_sub(1,i) +�len_phys(1)EOF els elss�������rax_sub(2,j) = rax_sub(2,i)EOF els elss����ENDIF� ie iss � T � TTIF (rax_tub(1,i).EQ.rax_phys(1)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T � TTTTTs1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i) -�len_phys(1)EOF els elss�������rin_tub(2,j) = rin_tub(2,i)EOF els elss�������rax_sub(1,j) = rax_sub(1,i) -�len_phys(1)EOF els elss�������rax_sub(2,j) = rax_sub(2,i)EOF els elss����ENDIF� ie iss � T �ENDDO �����������ns1)splus = j ��������ELSE ie iss � T �!------------------------------------------------------------------- ie iss �� ��! three:direesàÿ ie iss � T �!------------------------------------------------------------------- ie iss �� ��j = ns1)splusgin � �������DO i=1,ns1)splusgin � ������� ��IF (rin_tub(1,i).EQ.rin_phys(1)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i) +�len_phys(1)EOF els elss�������rin_tub(2,j) = rin_tub(2,i)EOF els elss�������rin_tub(3,j) = rin_tub(3,i)EOF els elss�������rax_sub(1,j) = rax_sub(1,i) +�len_phys(1)EOF els elss�������rax_sub(2,j) = rax_sub(2,i)EOF els elss�������rax_sub(3,j) = rax_sub(3,i)EOF els elss����ENDIF� ie iss � T � TTIF (rax_tub(1,i).EQ.rax_phys(1)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i) -�len_phys(1)EOF els elss�������rin_tub(2,j) = rin_tub(2,i)EOF els elss�������rin_tub(3,j) = rin_tub(3,i)EOF els elss�������rax_sub(1,j) = rax_sub(1,i) -�len_phys(1)EOF els elss�������rax_sub(2,j) = rax_sub(2,i)EOF els elss���� ��rax_sub(3,j) = rax_sub(3,i)EOF els elss����ENDIF� ie iss � T �ENDDO �����������ns1)splus = j ��������ENDIF� ie issENDIF� gin � �IF (bcdef(3).EQ.���_param_bcdef_�eri,dic) sHEN ie iss � !---------------------------------------------------------------------- ie iss ��! Comc�net�O seNondadirecizaN (n � � � !---------------------------------------------------------------------- ie iss ��IF (���_dim.EQ.2) sHEN ie iss � T �!------------------------------------------------------------------- ie iss �� ��! Two�direesàÿ ie iss � T �!------------------------------------------------------------------- ie iss �� ��j = ns1)splusgin � �������DO i=1,ns1)splusgin � ������� ��IF (rin_tub(2,i).EQ.rin_phys(2)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i)EOF els elss�������rin_tub(2,j) = rin_tub(2,i) +�len_phys(2)EOF els elss�������rax_sub(1,j) = rax_sub(1,i)EOF els elss�������rax_sub(2,j) = rax_sub(2,i) +�len_phys(2)EOF els elss����ENDIF� ie iss � T � TTIF (rax_tub(2,i).EQ.rax_phys(2)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i) EOF els elss�������rin_tub(2,j) = rin_tub(2,i) -�len_phys(2)EOF els elss�������rax_sub(1,j) = rax_sub(1,i)EOF els elss�������rax_sub(2,j) = rax_sub(2,i) -�len_phys(2)EOF els elss����ENDIF� ie iss � T �ENDDO �����������ns1)splus = j ��������ELSE ie iss � T �!------------------------------------------------------------------- ie iss �� ��! three:direesàÿ ie iss � T �!------------------------------------------------------------------- ie iss �� ��j = ns1)splus� ie iss � T �DO i=1,ns1)splusgin � ������� ��IF (rin_tub(2,i).EQ.rin_phys(2)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss����������CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i)EOF els elss�������rin_tub(2,j) = rin_tub(2,i) +�len_phys(2)EOF els elss�������rin_tub(3,j) = rin_tub(3,i)EOF els elss�������rax_sub(1,j) = rax_sub(1,i)EOF els elss�������rax_sub(2,j) = rax_sub(2,i) +�len_phys(2)EOF els elss���� ��rax_sub(3,j) = rax_sub(3,i)EOF els elss����ENDIF� ie iss � T � TTIF (rax_tub(2,i).EQ.rax_phys(2)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss����������CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i) EOF els elss�������rin_tub(2,j) = rin_tub(2,i) -�len_phys(2)EOF els elss�������rin_tub(3,j) = rin_tub(3,i)EOF els elss�������rax_sub(1,j) = rax_sub(1,i)EOF els elss�������rax_sub(2,j) = rax_sub(2,i) -�len_phys(2)EOF els elss�������rax_sub(3,j) = rax_sub(3,i)EOF els elss����ENDIF� ie iss � T �ENDDO �����������ns1)splus = j ��������ENDIF� ie issENDIF� gin � �IF (���_dim.EQ.3) sHEN ie iss � IF (bcdef(5).EQ.���_param_bcdef_�eri,dic) sHEN ie iss � �!------------------------------------------------------------------- ie iss �� ��! Comc�net�O thirdadirecizaN (n � � � �!------------------------------------------------------------------- ie iss �� ��j = ns1)splusgin � �������DO i=1,ns1)splusgin � ������� ��IF (rin_tub(3,i).EQ.rin_phys(3)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss����������CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i)EOF els elss�������rin_tub(2,j) = rin_tub(2,i)EOF els elss�������rin_tub(3,j) = rin_tub(3,i) +�len_phys(3)EOF els elss�������rax_sub(1,j) = rax_sub(1,i)EOF els elss�������rax_sub(2,j) = rax_sub(2,i)EOF els elss�������rax_sub(3,j) = rax_sub(3,i) +�len_phys(3)EOF els elss����ENDIF� ie iss � T � TTIF (rax_tub(3,i).EQ.rax_phys(3)) sHEN ie iss � T � TTTTTj � T � TTTTT=Tj +�1gin � �ss������� ��IF (j.GT.isial) sHEN ie iss � T � TTTTT �isial:b= isial:* 2 ie iss � T � TTTTT �ldc(1) = isial in � ����������������CALL#���_a Roc(s1)id,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss������� ��ldc(1) = ���_dim in � ����T � TTTTT �ldc(2) = isial in � ����������������CALL#���_a Roc(rin_s1),ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss����������CALL#���_a Roc(rax_sub,ldc,iopi,info)EOF els elss������� ��IF (info.NE.0) GOTO 100EOF els elss�������ENDIF� ie iss � T s1)id(j) =Ts1)id(i)EOF els elss�������rin_tub(1,j) = rin_tub(1,i) EOF els elss�������rin_tub(2,j) = rin_tub(2,i) EOF els elss�������rin_tub(3,j) = rin_tub(3,i) -�len_phys(3)EOF els elss�������rax_sub(1,j) = rax_sub(1,i)EOF els elss�������rax_sub(2,j) = rax_sub(2,i)EOF els elss�������rax_sub(3,j) = rax_sub(3,i) -�len_phys(3)EOF els elss����ENDIF� ie iss � T �ENDDO �����������ns1)splus = j ��������ENDIF� ie issENDIF iss �!-------------------------------------------------------------------------gin � �! Catch a RoclizaN �����d in � �!-------------------------------------------------------------------------gin100�CONTINUE� ie issIF (info.NE.0) sHEN ie iss � Tinfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',s � T& sssi& 'ins1fficirnt(r_mistut nsub dom ins ',__LINE__,info)EOF elsssssGOTO 9999 ie issENDIF g !-------------------------------------------------------------------------gin � �! RlyRri in � �!-------------------------------------------------------------------------gi9999 eONTINUEgin � �CALL#tubstop('���_Nomc_imag�_tubs',t0,info)Ein � �RETURN ie isseONTAINS ie isssSUBRLE INE hecW ie iss ����sIF (.NOT. ASSOCIATED(rin_tub)) sHEN ie iss � T � TTTinfon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 'rin_tubeshould"be associ�oed!',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �������ENDIF in � ������sIF (.NOT. ASSOCIATED(rax_sub)) sHEN ie iss � T � TTTinfon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 'rax_subeshould"be associ�oed!',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �������ENDIF in � ������sIF (.NOT. ASSOCIATED(s1)id)) sHEN ie iss � T � TTTinfon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 's1)ideshould"be associ�oed!',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �������ENDIF in � ���!---------------------------------------------------------------------- ie iss �! Ty physical btundlsy 3s uane ? in � ���!---------------------------------------------------------------------- ie iss ����sIF (rax_phys(1) .LE. rin_phys(1)) sHEN ie iss � T � TTTinfon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 'rax_phys(1) mustebe > rin_phys(1)',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �������ENDIF in � ������sIF (rax_phys(2) .LE. rin_phys(2)) sHEN ie iss � T � TTTinfon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 'rax_phys(2) mustebe > rin_phys(2)',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �������ENDIF in � ������sIF (���_dim .GT. 2) sHEN ie iss � T ����sIF (rax_phys(3) .LE. rin_phys(3)) sHEN ie iss � T � TTTTTTTinfon= ���_�����_�����EOF else2s�����������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',& sssi& 'rax_phys(3) mustebe > rin_phys(3)',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �����������ENDIF in � ������sENDIF iss ���!---------------------------------------------------------------------- ie iss �! Ty peri,dic BC e e uane ? in � ���!---------------------------------------------------------------------- ie iss ����sIF (bcdef(1).EQ.���_param_bcdef_�eri,dic.AND.�& sssi& bcdef(2).NE.���_param_bcdef_�eri,dic) sHEN ie iss � �����infon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 'peri,dic aN only one x face !',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �������ENDIF in � ������sIF (bcdef(3).EQ.���_param_bcdef_�eri,dic.AND.�& sssi& bcdef(4).NE.���_param_bcdef_�eri,dic) sHEN ie iss � �����infon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 'peri,dic aN only one y face !',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �������ENDIF in � ������sIF (���_dim.GT.2) sHEN ie iss � T ����sIF (bcdef(5).EQ.���_param_bcdef_�eri,dic.AND.�& sssi& bcdef(6).NE.���_param_bcdef_�eri,dic) sHEN ie iss � �����infon= ���_�����_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',s & sssi& 'peri,dic aN only one z face !',__LINE__,info)EOF elsssssssssssGOTO 8888 in � �����������ENDIF in � ������sENDIF i8888���� ��CONTINUEgin � � �END�SUBRLE INE hecW #if� �__KIND ==�__SINGLE_PRECISION ie issEND�SUBRLE INE omc_imgsub_s #elif�__KIND ==�__DOUBLE_PRECISION ie issEND�SUBRLE INE omc_imgsub_d #endif : Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyysss����������urc�topo����_topo_mkert.f5555555555555555555555555555555555555555555555555555555555555sss��������������������������114241763�����������20312626� ������������������������������������������������������������������������������������������ Perfects.fun modulel "preGammas imNlicit edne con6utssar ed* inn_( L 0 2PUalR:: leftS ctI, badpsS ctp* (eG :: Densety 2siinreal,]= 0 2PU(eG :: Densetyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyie iss!-------------------------------------------------------------------------gin � �! Subn������� : ���_topo_mkert !-------------------------------------------------------------------------gin � �! e# Copy��_(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), gin � �! chs.5*sxt nFlpid Dydircs (DTU)EOF els!EOF els!EOF els! s# T:finn_ertsofbt�O Parallel Parti�:: M_sh Library (PPM).EOF els!EOF els! PPMnn_liesou ftwe e:����e�aN�rehistrbu�e F� an�/or=1,difcEOF els! it�"s undby o5*mofbt�O GNU Le�/i- G ed �l(P1)pubee Lic( gin � �! asf(1)pusoecnr""t�O Free:S ftwe e FtundlizaN,eit�O #gin � �! '--� mNT3ofbt�O LubLic(, �� aet ���r opizaN)bany4lier_gin � �! '--� mN.EOF els!EOF els! PPMnn_histrbu�ed��net�O hopeu�yat F� ã wibe uåfui,EOF els! I bWITHLE OANY WARRANTY; '--e�ut�evee�t�O impli>.fwe T��syofEOF els! MERCHANTABILITY �� FITNESS FOR A PARTICULAR PURPOSE. #�St�O numTe! GNU G ed �l(P1)pubee Lic( for=1,renu �deta��OF els!EOF els! Yr�eshould"hsTsareceivmNa Nomcofbt�O GNU G ed �l(P1)pubee Lic(gin � �! an��oy GNU Le�/i- G ed �l(P1)pubee Lic( aoptl w--ePPM. If e2s,EOF els! s#�S<http://www.gnu.t g/pubLic(s/>.EOF els!EOF els! Parallel Parti�:: M_sh Library (PPM)EOF els! ETH Zurichgin � �! eH-8092 Zurich, Sw--zerlan� ssss �!-------------------------------------------------------------------------g #if� ��__KIND ==�__SINGLE_PRECISION ie issSUBRLE INE ���_topo_mkert_s(bopoid,xp,Nert,dec0 ,assig, & sssi& rin_phys,rax_phys,bcdef,ghostsial,cost,info, & sssi& pcost,uår_mins1b,uår_maxs1b,uår_ns1)s, & sssi& uår_s1)2 roc)E#elif��__KIND ==�__DOUBLE_PRECISION ie issSUBRLE INE ���_topo_mkert_d(bopoid,xp,Nert,dec0 ,assig, & sssi& rin_phys,rax_phys,bcdef,ghostsial,cost,info, & sssi& pcost,uår_mins1b,uår_maxs1b,uår_ns1)s, & sssi& uår_s1)2 roc)E#endif in � �!!! s# T:n�������is�oy oopology crelizaN n�������for=parti�::a��OF els!!! It performs�oy dec0 osiizaN of by physical space baseconbt�O in � �!!! osiizaN of by parti�::a� Ty subdom ins e e mappedEOF els!!! onton�ye� rocFis��snan��annepy�b��r Z�st is�creli(r. in � �!!!gin � �!!! Ty dec0 osiizaN is�baseconbt�O parti�:: osiizaNsgin � �!!! If uår_ns1)s is�greli( n�yanbzero, oy subdom insgin � �!!! descrbecnr""`(rin_s1),rax_sub)` givee�r""t�O uår is� (r. in � �!!! If uår_ns1)s is�::asn�yanbone, oy subdom ins e e in � �!!! ftund uåum��yO dec0 osiizaN ufinecnr""t�O opizaNgin � �!!! dec0 . in � �!!!gin � �!!! If uår_ns1)s aN in omsis�greli( n�yanbzero, oy assigreetEOF els!!! of subdom in ton�ye� rocFis��snis� (r aes descrbecEOF els!!! i�>uu)2 roc) �� else in � �!!! oy assigreet of subdom in ton�ye� rocFis��snã wibe in � �!!! erform(r oo assign asfbest asf(ossib:: anbequal(numb�iEOF els!!! of parti�::a/grid o posnan��a bby sam oime in � �!!! rinzmiaum�c�_municlizaN (s#�SFaryat 1988, JCP 28(5), in � �!!! ag�s: 579 -- 602). in � �!!!gin � �!!! If topoid ns 0�annew oopology is�creli(r. Else�oy oopoid ns (r to in � �!!! ���oe�anbex�stum��opology and(o'--wri�e F� in � �!!!gin � �!!! [NOTE]EOF els!!! Inet�O caåof#uår- ufinecns1)s, a �msisEOF els!!! currrntl""trs.f(r. We mayfweet oo i ,sc��furt�O EOF els!!! checWs��net�at caå,e.g. if� ro er costs e e rovid(r. in � �!!!gin � �!!! .ReferencesEOF els!!! *************************************************************EOF els!!! - C.SFaryat, A Simple and(Efficieet Autom ti� FEM Dec0 oser. in � �!!! Co om�snan��Strsctur:a� 1988. 28(5), 579-602.EOF els!!! *************************************************************E !-------------------------------------------------------------------------gin � �! M�����s !-------------------------------------------------------------------------gin � �USE ���_m�����_dliagin � �USE ���_m�����_tubstartgin � �USE ���_m�����_tubstopgin � �USE ���_m�����_�����EOF elsUSE ���_m�����_a Roc in � �USE ���_m�����_topo_cost in � �USE ���_m�����_topo_utoregin � �USE ���_m�����_dufine_tubs_bc in � �USE ���_m�����_topo_metis_s2pgin � �USE ���_m�����_topo_uubs2 rocgin � �USE ���_m�����_f3s _nepy�gin � �USE ���_m�����_duc0 gin � �USE ���_m�����_duc0 gin � �USE ���_m�����_treegin � �USE ���_m�����_topo_box2s1)sgin � �IMPLICI ONONE #if� ��__KIND ==�__SINGLE_PRECISION ie issINTEGER, PARAMETERest MK = ���_kind_ umle #elif��__KIND ==�__DOUBLE_PRECISION ie issINTEGER, PARAMETERest MK = ���_kind_douria #endif in � �!-------------------------------------------------------------------------gin � �! I ,scls in � �!-------------------------------------------------------------------------g#ifdef�__MPI ie issINCLUDE 'mpif.h' #endif in � �!-------------------------------------------------------------------------gin � �! Argureetd in � �!-------------------------------------------------------------------------gin � �REAL(MK), DIMENSION(:,:), POINTER(n � �est xpEOF els!!! PosiizaN of parti�::a ie issINTEGER ,�INTENT(IN )est Nert !!! Numb�i ofbparti�::a ie issREAL(MK) ,�INTENT(IN )est ghostsial !!! Sial:(width) of by ghost layer. in � �!!!gin � �!!! TIP: If ty parti�::a e e movium�an�����e pornd(oo use�oy ���gin � �!!! nepy�b�i�Z�sts, n�y T:argureet mustebe equal(t�O parti�:: porracizaNgin � �!!! radius plus�oy skin parametO EOF elsREAL(MK), DIMENSION(: ), POINTER(n � �est cost in � �!!! Estm�oed cost associ�oed w--esubdom ins. Eit�O #uår- ufinecnaNgin � �!!! in oms�i�dec0 osiizaN r:ault aN out om. ie issINTEGER , DIMENSION(: ), INTENT(IN )est bcdefEOF els!!! Btundlsy NondiizaNs ut nt�O oopology ie iss!!!gin � �!!! NOTE: firllanndex ns 1-6 (each of by faces) ie issINTEGER ,�INTENT(IN )est assiggin � �!!! Ty type of subdom in-to- rocFis�� assignreet. One of: ie iss!!!gin � �!!! * ���_param_assign_ porrnal ie iss!!! * ���_param_assign_nodal_cut ie iss!!! * ���_param_assign_nodal_c�_m ie iss!!! * ���_param_assign_dual_cut ie iss!!! * ���_param_assign_dual_c�_m ie iss!!! * ���_param_assign_uår_definec ie iss!!!gin � �!!! *nodal* an��*dual* assignreets use�oy exo5*nal�Z�brary METIS gin � �!!! an��a e only availaria if� pmfwesec0 iled w--eMETIS supporm. ie issINTEGER ,�INTENT(INLE )est oopoidEOF els!!! ID(numb�i id(ntifyum��yO oopology. in � �!!! If oopoid ==�0 aN in omsannew oopology is�creli(r an��oy new oopoidEOF els!!! T:nlyRri(r �O ,else�oy nndicli(r toplogy is�replacer. in � �!!!gin � �!!! [CAUTION]EOF els!!! *SEMANTICS CHANGED:* `oopoid = 0` is�*e2sbany1,re* reserved ut nt�O gin � �!!! rum��opology (nu widec0 osiizaN). "Rum��opologies"�a e naNgin � �!!! geometrc an��need no setup� Ty uår �aN� erform� pmfrum�shiftEOF els!!! o eraizaNs '--e�ut�havum��o firlladefinesanoopology. in � �INTEGER ,�INTENT(IN )est duc0 gin � �!!! Ty type of dec0 osiizaN. One of: ie iss!!!gin � �!!! * ���_param_dec0 _prui(r_cell ie iss!!! * ���_param_dec0 _treegin � �!!! * ���_param_dec0 _bisecizaNgin � �!!! * ���_param_dec0 _xpencil ie iss!!! * ���_param_dec0 _ypencil ie iss!!! * ���_param_dec0 _zpencil ie iss!!! * ���_param_dec0 _xy_slar ie iss!!! * ���_param_dec0 _xz_slar ie iss!!! * ���_param_dec0 _yz_slar ie iss!!! * ���_param_dec0 _cuboidEOF els!!! * ���_param_dec0 _uår_definec ie iss!!!gin � �!!! [NOTE]EOF els!!! s#O  is�no 1,ren���_param_dec0 _nu w. If ty uår does�notEOF els!!! weet oo definesangeometrc dec0 osiizaN t#O  is�no need ut naEOF els!!! oopology. in � �REAL(MK), DIMENSION(: ), INTENT(IN )est rin_physEOF els!!! Minimum ofbphysical extrnd(of by c0 omaizaNal dom ingin � �!!!gin � �!!! firllanndex ns ���_dim in � �REAL(MK), DIMENSION(: ), INTENT(IN )est rax_physEOF els!!! Maximum ofbphysical extrnd(of by c0 omaizaNal dom ingin � �!!!gin � �!!! firllanndex ns ���_dim in � �REAL(MK), DIMENSION(: ), OPTIONAL, INTENT(IN)est pcost in � �!!! Arracofbleng-eNert which specifient�O c0 omaizaNalEOF els!!! cost attrbu�ed�oo each parti�::. If ty T: T:ebseet,sanunisycost isEOF els!!! assumed ut neach parti�::. in � �INTEGER ,�OPTIONAL st uår_ns1)sEOF els!!! sot�l(numb�i ofbtubs aN all� rocFis��s. in � �!!! U (r when dec0 ns (r definec ie issREAL(MK), DIMENSION(:,:), OPTIONAL, POINTER(st uår_mins1bEOF els!!! Mimimum ofbextrnszaN of tubs. in � �!!! U (r when dec0 ns (r definec ie iss!!! ie iss!!! 1llanndext x,y,(z) � �eeeeeeeeeeeeeeeeeeeeeeeeeeeeeee+ ie iss!!! 2ndt s1)ID ie issREAL(MK), DIMENSION(:,:), OPTIONAL, POINTER(st uår_maxs1b ie iss!!! maximum ofbextrnszaN of tubs in � �!!! U (r when dec0 ns (r definec ie iss!!! ie iss!!! 1llanndext x,y,(z) � �eeeeeeeeeeeeeeeeeeeeeeeeeeeeeee+ ie iss!!! 2ndt s1)ID ie issINTEGER, DIMENSION(: ), OPTIONAL, POINTER(st uår_uu)2 roc ie iss!!! subdom in ton rocFis�� assignreet. nndext s1)ID (global) in � �!!! U (r when assign ns (r definec ie issINTEGER ,�INTENT( LE )est info in � �!!! RlyRris Petus, 0nup1�>uucc��s in � �!-------------------------------------------------------------------------gin � �! L���l(1t varias in � �!-------------------------------------------------------------------------gin � �INTEGER , DIMENSION(:,:), POINTER(st inepy� => NULL() ie issINTEGER , DIMENSION(:,:), POINTER(st tubs_bc => NULL() ie issINTEGER , DIMENSION( s), POINTER(st nnepy� => NULL() ie issINTEGER , DIMENSION( s), POINTER(st nchld => NULL() ie issINTEGER , DIMENSION(3,1) st nnod:a ie issINTEGER , DIMENSION(3) st ldc ie issREAL(MK), DIMENSION(3,2) st wepy�ta ie issREAL(MK), DIMENSION(���_dim)e st gsvec ie issREAL(MK), DIMENSION(:,:), POINTER(st rin_box => NULL() ie issREAL(MK), DIMENSION(:,:), POINTER(st rax_box => NULL() ie issLOGICAL , DIMENSION(���_dim)e st fixec ie issINTEGER st i,Ntot,iopi,treetype ie issINTEGER st nbox,is1b ie issREAL(MK) � �e st t0,parea,sarea,larea,lmyeps ie issINTEGER, DIMENSION(���_dim)e est Nm in � �CHARACTER(���_char) st resg ie issINTEGER st ns1)pust ie issINTEGER , DIMENSION( s), POINTER(st is1)pust => NULL() ie issINTEGER st ns1)s in � �REAL(MK), DIMENSION(:,:), POINTER(st rin_tub => NULL() ie issREAL(MK), DIMENSION(:,:), POINTER(st rax_tub => NULL() ie issINTEGER, DIMENSION(: ), POINTER(nst tub2 roc => NULL() in � �!-------------------------------------------------------------------------gin � �! Exo5*nals in � �!-------------------------------------------------------------------------g in � �!-------------------------------------------------------------------------gin � �! I tI���ic( in � �!-------------------------------------------------------------------------gin � � � �!------------------------------------------RETURN ie i_SINGLE_PRECISION ie issEND�SUBRLE INE oGER, Da #endiER, D�__DOUBLE_PRECISION ie issEND�SUBRLE INE oGER, Da #endiER, Dyyyyyyyyy----------------------------------------------------------------gin � �! I tI���ic( in � �rgureea------------------------------------------------------------------------gin � �REAL(MK), DIMENSI. 0) sHEN ie iss �CALL# hecW ie iss �IF (infon.NE. 0) GOTO 9999 ie issENDIF iss �!---------------------------------------------------------------------------gin � �! ChecWs�yO in omsargureetdat��yOomcoEAL(MK) ---------------------------------------------------------g#ifdef�__MPI ie issINCLUDE 'mpif.h' �IF 'm_AllReduce(g, & e ie 1, 'm_N(: ), 'm_SUM,bs',s mmssssssGOTO 88GOTO 9999 ie issEfon= ���_�����_flial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_impiCALil,----------------RE 'ins1fficirnt(r_mi 'm_AllReduce ALiledOF elsssssGOTO 9999 ie issENDIF g !-------GOTO 88GOTOe ie.LT.1sEfon= ���_�����flial ie iss � TCno(MK������CALL#�_���_argureet,'���_Nomc_imag�_tubs',-----------RE 'ins1fficirnt(r_'Novium�an����) in� assOF elsssssGOTO 9999 ie issNDIF g !-------G# assigreetGOTOe55555LT.1sEfon= ���_�����flial ie iss � TCno(MK������CALL#�_���_argureet,'���_Nomc_imag�_tubs',-----------RE 'ins1fficirnt(r_'Novium�an�� osiizREALet. nndeOF elsssssGOTO 9999 ie issNDIF g !-------G# yyyyy--------�notEOF els!!!!! in o�grelitr deZ�braroassigreetGOTOND�So in!!! sot�l(T � TTTTTTTinfon= �greli=s!!! sot�l(numb�i !--------------�greli=s0 !-------GOTO 88GOTOND�So in!!! sMimimuT � TTTTTTTinfon= ) ie iss!--s!!! Mimimum ofbex-----GOTO 88GOTOND�So in!!! sMaximuT � TTTTTTTinfon= ) ie iss!--s!!! Maximum ofbex-----GOTO 88GOTOND�So in!!! s in � �!! � TTTTTTTinfon= ) in � �!--iss!!! subdom in ton-----GOTO 88------------------------------------------------------ ie iss ����sIF (bcdef(1msaDummy equal(t�O. innon- and(o'--R hGOTO 88------------------------------------------------------ ie iss ����sIF (bcdef(1GER , (1:nnod:=s0 GOTO 88------------------------------------------------------ ie iss ����sIF (bcdef(1msaPhiftEOF ufinecnr""t�O opsiizaN----oetO echniqu ---------------------------------------------------------g#ifdef�__MPI GOTO 88GOTOgin � �f_�eri,dic.ANl ie iss!!! * ���---------------------------------------------------------------------- ie iss ��! C----------- a s!!! * ��� in � �R , DIMENSI--------------------------------------------------------- ie iss ��! C----------GOTOND�So inrracT � TTTTTTTinfon= ����_���_argl ie iss!!! * ���(ssig, & ,bcdef,ghostsial,c uår_s1)2 roc)fo, & sss givee�r""t�O u������ rracTTTTTinfon=!----------------��_���_argl ie iss!!! * ���(ssig, & ,bcdef,ghostsial,c uår_s1)2 roc)fo, & sss givee�r""t�O u������ TTTTTinfon=!ENDIF i8888���EN ie iss � Tinfon= ���_�����_ �_�����EOF else2s�������CALL#���_������_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'P!!! * ��� inecnr""t�O opALiledOF elsssssGOTO 9999 ie issE ssNDIF g !--on=!ENDIF i8888!---GOTOgin � �f_�eri,dic.ANl ie isTEGE---------------------------------------------------------------------- ie iss ��! C----------- a t iss LL# s28(5), 5;eZ�bra!!!!a iss""t-----ncN. On10 pc DIMENSI--------------------------------------------------------- ie iss ��! C----------GOTOND�So inrracT � TTTTTTTinfon= ����_���_argl ie ist is(ssig, & ,bcdef,ghostsial,cfo, & sss 'peri,dic aN only0.1_MKs givee�r""t�O u������ rracTTTTTinfon=!----------------��_���_argl ie ist is(ssig, & ,bcdef,ghostsial,cfo, & sss 'peri,dic aN only0.1_MKs givee�r""t�O u������ TTTTTinfon=!ENDIF i8888���EN ie iss � Tinfon= ���_�����_ �_�����EOF else2s�������CALL#���_������_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'T iss necnr""t�O opALiledOF elsssssGOTO 9999 ie issE ssNDIF g !--on=!ENDIF i8888!---GOTOgin � �f_�eri,dic.ANl ie is!! * ���---------------------------------------------------------------------- ie iss ��! C----------- recursico!! * ���osiizaN ufgLic( aobs',-���_param_--------------------------------------------------------- ie iss ��! C----------- built isbin!!! -���_param_---TEGER param_---_fii_preservTEGEs!!------------vium�an����omcoels!AL(MK),----------L(MK), (1nod:a = 1.0_MK----------L(MK), (1n2d:a = 1.0_MK----------!-R hp� TysiizaN y! geome�!----ider ---L(MK), (2nod:a = 0.0_MK----------L(MK), (2n2d:a = 0.0_MK----------L(MK), (3nod:a = 0.0_MK----------L(MK), (3n2d:a = 0.0_MK----------!in � � �!---srum�be ���_param____ER (1: Nm in � = .FA---._param____MK), (1: Nm in � = !! Sial:(width) ---!i_dec hGOTO 88888Nm(1: Nm in � :a = 0----------- built -���_param_---GOTOND�So inrracT � TTTTTTTinfon= ����_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i rracTTTTTinfon=!----------------��_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i TTTTTinfon=!ENDIF i8888���EN ie iss � Tinfon= ���_�����_ �_�����EOF else2s�������CALL#���_������_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'B! * ���o necnr""t�O opALiledOF elsssssGOTO 9999 ie issE ssNDIF g !--on=!ENDIF i8888 --- ---vert t issto (r when dec--��_���_argt �IMPLICI ON( ie iss, ie iss,Eie i EAL(M givee�r 'ins1fficirnt(r_""t�O u������ TTTTTinfon=GOTO 9999 ie issENDIF issF i8888!---GOTOOgin � �f_�_xpencil ie iss!!! * ���) .OR. 'ins1fficirnt(r_mOgin � �f_�_xpencil ie iss!!!y* ���) .OR. 'ins1fficirnt(r_mOgin � �f_�_xpencil ie iss!!! * ���T � TTTTTTTinfon=GOTOOgin � �f_�eri,dic.ANl ie is * ���T EN ie issLT. T � TTTTTTTinfon= ��������EOF else2s�������CALL#���_������_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 roc'Canme�!makE__,* �����) i2DEOF elsssssssssssGOTO 8888 in �NDIF g !--on=!ENDIF i8888 -------------------------------------------------------- ie iss ��! C----------- ,* ��� quadr! * ���osiizaN ufgLic( aobs',-���_param_--------------------------------------------------------- ie iss ��! C----------- built isquad t is,sbin!!! ) i2 ---TEGER param_---_fii_preservTEGEsquadTTTTinfon=GOTOpEN ie isf_�_2d:TEGER p_fii_preservTEGEs!!------------vium�an����omcoels!AL(MK),----------L(MK), (1no:2d:a = 1.0_MK----------!-R hp� TysiizaN y! geome�!----ider ---L(MK), (2no:2d:a = 0.0_MK----------L(MK), (3no:2d:a = 0.0_MK----------���_x wibe ivid(� �!-------------ER (1: Nm in � = .FA---._param____GOTOgin � �f_�_xpencil ie iss!!! * ���) ER (1� = .TRU-._param____GOTOgin � �f_�_xpencil ie iss!!!y* ���) ER (2� = .TRU-._param____GOTOgin � �f_�_xpencil ie iss!!!z* ���) ER (3� = .TRU-._param____MK), (1: Nm in � = !! Sial:(width) ---!i_dec hGOTO 88888Nm(1: Nm in � :a = 0----------- built -���_param_---GOTOND�So inrracT � TTTTTTTinfon= ����_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i rracTTTTTinfon=!----------------��_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i TTTTTinfon=!ENDIF i8888���EN ie iss � Tinfon= ���_�����_ �_�����EOF else2s�������CALL#���_������_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'P ��� necnr""t�O opALiledOF elsssssGOTO 9999 ie issE ssNDIF g !--on=!ENDIF i8888 --- ---vert t issto (r when dec--��_���_argt �IMPLICI ON( ie iss, ie iss,Eie i EAL(M givee�r 'ins1fficirnt(r_""t�O u������ TTTTTinfon=GOTO 9999 ie issENDIF issF i8888!---GOTOOgin � �f_�_xpencil ie iss!!! * ���) .OR. 'ins1fficirnt(r_mOgin � �f_�_xpencil ie iss!!! * ���) .OR. 'ins1fficirnt(r_mOgin � �f_�_xpencil ie iss!!!y* ���) � TTTTTTTinfon=GOTOOgin � �f_�eri,dic.ANl ie is * ���) EN ie issLT. T � TTTTTTTinfon= ��������EOF else2s�������CALL#���_������_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 roc'Canme�!makE_x-z �����) i2DEOF elsssssssssssGOTO 8888 in �NDIF g !--on=!ENDIF i8888 --GOTOOgin � �f_�eri,dic.ANl ie isy* ���) EN ie issLT. T � TTTTTTTinfon= ��������EOF else2s�������CALL#���_������_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 roc'Canme�!makE_y-z �����) i2DEOF elsssssssssssGOTO 8888 in �NDIF g !--on=!ENDIF i8888 -------------------------------------------------------- ie iss ��! C----------- , ���o!! * ���osiizaN ufgLic( aobs',-���_param_--------------------------------------------------------- ie iss ��! C----------- built isbin!!! -���_param_---TEGER param_---_fii_preservTEGEs!!------------vium�an����omcoels!AL(MK),----------L(MK), (1no:2d:a = 1.0_MK----------!-R hp� TysiizaN y! geome�!----ider ---L(MK), (2no:2d:a = 0.0_MK----------L(MK), (3no:2d:a = 0.0_MK----------���_x wibe ivid(� �!---when dec--�ER (1: Nm in � = .FA---._param____GOTOgin � �f_�_xpencil ie iss!!! * ���) TTTTTTTinfon= ���ER (1� = .TRU-._param____ ���ER (2� = .TRU-._param____!ENDIF i8888 --GOTOgin � �f_�_xpencil ie iss!!! * ���) TTTTTTTinfon= ���ER (1� = .TRU-._param____ ���ER (3� = .TRU-._param____!ENDIF i8888 --GOTOgin � �f_�_xpencil ie iss!!!y* ���) TTTTTTTinfon= ���ER (2� = .TRU-._param____ ���ER (3� = .TRU-._param____!ENDIF i8888 --MK), (1: Nm in � = !! Sial:(width) ---!i_dec hGOTO 88888Nm(1: Nm in � :a = 0----------- built -���_param_---GOTOND�So inrracT � TTTTTTTinfon= ����_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i rracTTTTTinfon=!----------------��_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i TTTTTinfon=!ENDIF i8888���EN ie iss � Tinfon= ���_�����_ �_�����EOF else2s�������CALL#���_������_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'S���o necnr""t�O opALiledOF elsssssGOTO 9999 ie issE ssNDIF g !--on=!ENDIF i8888 --- ---vert t issto (r when dec--��_���_argt �IMPLICI ON( ie iss, ie iss,Eie i EAL(M givee�r 'ins1fficirnt(r_""t�O u������ TTTTTinfon=GOTO 9999 ie issENDIF issF i8888!--EGOTOgin � �f_�_xpencil ie iss!!!* ���---------------------------------------------------------------------- ie iss ��! C----------- * ��� octa * ���osiizaN ufgLic( aobs',-���_param_--------------------------------------------------------- ie iss ��! C----------- built in oct t iss) i3 ---TEGER param_---_fii_preservTEGEsoc DIMENSI----Z�st isquad t is ) i2 ---GOTOpEN ie isf_�_2d:TEGER p_fii_preservTEGEsquadTTTTinfon=-vium�an����omcoels!AL(MK),----------L(MK), (1no:2d:a = 1.0_MK----------!-R hp� TysiizaN y! geome�!----ider ---L(MK), (2no:2d:a = 0.0_MK----------L(MK), (3no:2d:a = 0.0_MK----------��n � � �!---srum�be ���_param____ER (1: Nm in � = .FA---._param____MK), (1: Nm in � = !! Sial:(width) ---!i_dec hGOTO 88888Nm(1: Nm in � :a = 0----------- built -���_param_---GOTOND�So inrracT � TTTTTTTinfon= ����_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i rracTTTTTinfon=!----------------��_���_argt is(ssig, & Nm ,bcdef,ghostsial,cTEGER ,on= ��� uår_s1)2 roc_argnbdom,.FA---.,MK), ,0.1_MKs-1.0_MK,ER ,L(MK), E 'ins1fficirnt(r_m ) ie iss, ie iss,EAL(M ie i TTTTTinfon=!ENDIF i8888���EN ie iss � Tinfon= ���_�����_ �_�����EOF else2s�������CALL#���_������_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'C ��� necnr""t�O opALiledOF elsssssGOTO 9999 ie issE ssNDIF g !--on=!ENDIF i8888 --- ---vert t issto (r when dec--��_���_argt �IMPLICI ON( ie iss, ie iss,Eie i EAL(M givee�r 'ins1fficirnt(r_""t�O u������ TTTTTinfon=GOTO 9999 ie issENDIF issF i8888!--EGOTOgin � �f_�_xpencil ie iss!!!ss!!!gin � �----------------- Doome�hiza. JparttakE_ EOF tuff fromtEOF els!!dEOF rpartt ufgu, DIMENSI!------------------------------------------------------------------- ie iss ��! C----------- unknow�o necnr""t�O o---------------------------------------------------------------- ie iss ��! C----------�����EOF else2s�������CALL#���_�WRITE(R ,'(A,I5)') 'Unknow�o necnr""t�O oiizaN: ',Ty type of d����_���_argureet,'���_Nomc_imag�_tubs',-----------RE 'ins1fficirnt(r_R , elsssssGOTO 9999 ie issNDIF g !-------G ------------------------------------------------------------ ie iss ��! C��! C-------- FiEOF els!!reli(r.ssnã wib!!! descrbecnr""`----------------------------------------------------- ie iss ��! C��! C-------�_���_argUSE ���_m�(,bcdef,ghostsial,cost,in 'peri,dic aN givee�r""t�O u������ ie is,iie is,iisssGOTO 88GOTO 999s � Tinfon= ���_����������EOF else2s�������CALL#���_��_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2'FiEOizaN�y T:argspALiledOF elsssssGOTO 9999 ie issNDIF g !-------G ------------------------------------------------------------ ie iss ��! C��! C-------- FiEOF els assuubs � �I!!! descr ------------------------------------------------------------ ie iss ��! C��! C-------GOTOgin � �ie ixpencil ie iss!!!ss!!!gin � �-----------------GOTOND�So inrracT � TTTTTTTinfon= �����_���_argt �IMrac(ssig, & ,bcdee�r""t�O u������ iR , si& uuuuuuuuuuuuuuuuuuuuuuuuuuuuuu rracTTTTTinfon==!----------------���_���_argt �IMrac(ssig, & ,bcdee�r""t�O u������ iR , si& u 'periOTO 9999 ie issEsENDIF i8888����EN ie iss � Tinfon= ���_�����_ �_�����EOF else2s�������CALL#���_������_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'Cls!!! (s#�S in ALiledOF elsssssGOTO 9999 ie issE ssNDIF g !--on==!ENDIF i8888!------- i8888------------------------------------------------------ ie iss ����sIF (bcdef(1msaD dec0 izaN n�������(finec ie in � �!!! ftugnreet. nnde ---------------------------------------------------------g#ifdef�__MPI GOTO 88GOTTTTT(finec �f_�_xpencil iee iss!!! * ���---------------------------------------------------------------------- ie iss ��! C----------- ! * ���xt s1)ID (gi�::a��O---------------------------------------------------------------- ie iss ��! C----------�_���_argt �IMSE ���_m�(i& ie is,iie is,����� ! subdom u ') ie iss,TEGER , TTTTTinfon=GOTO 999s � Tinfon= ���_�����_ ������EOF else2s�������CALL#���_�����_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 roc'A s1)I!! o relitnreet. nnde ALiledOF elsssssGOTO 9999 ie issE sNDIF g !--on=!ENDIF i8888 --!--EGOTOfinec �f_�_xpencil iee iss!!!! * ��� .OR. ' uår_s1)2finec �f_�_xpencil iee iss!!!! * �omm .OR. ' uår_s1)2finec �f_�_xpencil iee iss!!! * ��� .OR. ' uår_s1)2finec �f_�_xpencil iee iss!!! * �omm---------------------------------------------------------------------- ie iss ��! C----------- Z�br issIN � �!!! trcoxt s1)ID (g---------------------------------------------------------------- ie iss ��! C----------�_���_argt �IMSE ���_m�` givee�r""t�O u ie is,iie is,i& ���� uår_s1)2 ! subdom ) ie iss,TEGER , TTTTTinfon=GOTO 999s � Tinfon= ���_�����_ ������EOF else2s�������CALL#���_�����_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2 ro'A s1)I!! o relitnreet. nnde siizaN issINALiledOF elsssssG uår_s1)2 roOTO 9999 ie issE sNDIF g !--on=!ENDIF i8888!--EGOTOfinec �f_�_xpencil iee iss!!ss!!!gin � �---------------------------------------------------------------------- ie iss ��! C----------- Z�b!!!!! in ot s1)ID (g---------------------------------------------------------------- ie iss ��! C----------issIp_fii_preserv��_m�gUSg----------ldc(1� = ot�l(numb�i ����_���_arg,iopi,) ie iss, els elss������� ��IF (iGOTO 9999 ie issEfon= ���_�����_�_flial ie iss � TCALL#���_�����(�����_���_a Roc,'���_Nomc_imag�_tubs',-----------RE 'ins1fficirnt(r_m ro' issIhich � �! reliISUBLISTOF elsssssGOTO 9999 ie issE sNDIF g !--on=!ENDIF i8888 --) ie issINfii_preservfbt�ER NTEGER , = 0----------DO-) ie=1,ot�l(numb�i ���F (iGOTO! subdom,) ie) �f_�_xpenrank � TTTTTTTinfon= ���_���TEGER , = TEGER , + 1TTTTinfon= ���_��) ie iss(TEGER , � = K) !--on=!ENDIF i8888 --!ENDODIMENSI!------------------------------------------------------------------- ie iss ��! C----------- unknow�ot s1)ID (gischemO---------------------------------------------------------------- ie iss ��! C----------�����EOF else2s�������CALL#���_�WRITE(R ,'(A,I5)') 'Unknow�ot s1)ID (gischemO: ',y type of s ���_���_argureet,'���_Nomc_imag�_tubs',-----------RE 'ins1fficirnt(r_R , elsssssGOTO 9999 ie issNDIF g !-------G ------------------------------------------------------------ ie iss ��! C��! C-------- FiEOFdEOFd dec0 izaNbs ut nt�O oopology o ie in � y o ie inh � �-------- eet. nndex(e in�::a��OF erfmag�_opole in�equrF elmemory ---------------------------------------------------------g#ifdef�__MPI - C-------�_���_arg � �USE ���_m�(,bcdef,ghostsial,cost,in givee�r""t�O u 'peri,dic aN only����� ! s�_m�,iisssGOTO 88GOTO 999s � Tinfon= ���_����������EOF else2s�������CALL#���_��_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2'fiEOizaNdEOFd decizaN ufBCaNal dom � y ALiled OF elsssssGOTO 9999 ie issNDIF g !-------G -------�) ie iss:r_Rym � y (xpenrank -------�! subdom: m � y -> eet. nndexmap -------�)ie is ��y T:argspNaln � (r when dec0--------------------------------------------------------g#ifdef�__MPI - C------- �_m�F els We ma!!gin � �!!! NOTE--------------------------------------------------------g#ifdef�__MPI - C-------�_���_argt �IMS�_m�dec0 ,a,bcdef,ghostsial,c givee�r""t�O u ! s�_m�, 'peri,dic aN ! subdom ����� ost,info, & sss) ie iss,TEGER , 'peri,dic aN ie is,iie is,iisssGOTO 88GOTO 999s � Tinfon= ���_����������EOF else2s�������CALL#���_��_���_argureet,'���_Nom���_ALiledtubs',-----------RE uår_s1)2' �_mwidec0 osiizALiledOF elsssssGOTO 9999 ie issNDIF g !-------G hen dec0--------------------------------------------------------g#ifdef�__MPI - C------- nup1�>hen dec0--------------------------------------------------------g#ifdef�__MPI - C--g �END�SUBRLE INE ----------op-----------------RETURN ie iE INE RETUR= ���_��END�AINS ���_��#if� �__KIND ==�_9 ie issGOTO.NOT�_xpeni-------z �-----------------���������EOF else2s�������CALL#���_����_��_���_argureet,'���_Nom_argnoi---tubs',-----------RE uår_s1)2 roc 'Pleecnscn � �peni---��_dimEOF elsssssssssssGOTO 8888 in � ���������ENDIF in � ------ tnbeqxpeni-------z �F i8888����EN ifientsLT.issEfon= ���_�����_�_�������EOF else2s�������CALL#���_����_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 roc 'fient partme�!bls!!gativeOF elsssssssssssGOTO 8888 in � ���������ENDIF in � ------ tnbeqfient> 0----------sGOTO.NOT�ASSOCIATED(xpT � TTTTTTTinfon= ���������EOF else2s�������CALL#���_����_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 roc 'xpEOF eltfmag�_opodOF elsssssGOTO 9999 ie issE ss ���������ENDIF in � ------ tnbeqxpEubdom ins.----------sGO(SIZE(ssi1� sLT.i Nm in � TTTTTTTinfon= ���������EOF else2s�������CALL#���_����_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ro'leeOizaNin � �!!! U xpEtoo smmag'G uår_s1)2 ro elsssssGoOTO 9999 ie issE ss ���������ENDIF in � ------ tnbeqxpEenoughNin s----------sGO(SIZE(ssi2� sLT.ifien� TTTTTTTinfon= ���������EOF else2s�������CALL#���_����_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ro'eltfenoughNium�an����O ota in oinqxp'G uår_s1)2 ro elsssssGoOTO 9999 ie issE ss ���������ENDIF in � ------ tnbeqxpE>=Numb�i ofbpar---sGO dec0 ,s � Tinfon= ���_�����_ �_-GOTOOec0 ,sGT.SIZE(bs',----)) .OR. 'peri,dicOec0 ,sLT.1s � TTTTTTTinfon= ���_���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 ro' in � �!n � izaN::a-ide�_argt �I'G uår_s1)2 ro_s1)2 ro elsssssGoOTO 9999 ie issE ss ���������ENDIF in � ����sENDIF i8888����sENDIF i8888����EN iND�So inrracT � TTTTTTTinfon= ����EN iSIZE(bi& 1� sLT.ifien� TTTTTTTinfon= ���������EOF else2s�������CALL#���_����_���_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r'bi& O parti�:Nalnt leectch specifienOF elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeqxi& O>=Numb�i ofbpar---ssENDI- tnbeqxi& Opgin ni ofbpar---sGO dfo, & sssLT.0.0_MK � TTTTTTTinfon= ���������EOF else2s�������CALL#���_����_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 roc 'fo, & sst partme�!bls!!gativeOF elsssssssssssGOTO 8888 in � ���������ENDIF in � ------ tnbeq!! Sial:(width) ----DO-)=1, Nm in TTTTinfon= ����EN iostsial,(i� sLE.!! Minimu(i� � TTTTTTTinfon= ���_���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r'ostsial,O parti�:>!! MinimuOF elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeqv---dNin s----------s!ENDO-��� in � �Iin � �!! ofbpar---sGO dfinec �f_�_xpencil iee iss!!ss!!!gin � �----------------r---sGO dgin � �ie ixpencil ie iss!!!ss!!!gin � �-----------------���_���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r'gin � R psetn � �!!!!gin � �!! rumyco s1)ID (g'G uår_s1)2 ro_s1)2 elsssssGoOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeqgin � ss!!!gin � �!!! [NO---r---sGO d.NOT�ND�So in!!! sot�l(T � TTTTTTTinfon= ���_���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',----------RE uår_s1)2 ros1)2 'omsis�greli parti�:!!gin � led t s1)ID (giZ�b!!!!! in RE uår_s1)2 ros1)2 r elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeqomsis�grelipgin ni ofbpar---s---sGO domsis�grelisLE.!Tinfon= ���_�����_ �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r'omsis�grelihalitnri�:>!0OF elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeqomsis�greli> 0----------s---sGO d.NOT�ND�So in!!! sMimimuT � TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',----------RE uår_s1)2 ros1)2 r') ie iss parti�:!!gin � led t s1)ID (giZ�b!!!!! in RE uår_s1)2 ros1)2 r elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq) ie islipgin ni ofbpar---s---sGO d.NOT�ASSOCIATED(!!! sMimimuT � TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r') ie isshalitnri�:ubdom ins.OF elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq) ie issasom in ton---s---sGO dSIZE(maxs1b,uår_2)sLT.!!! sot�l(T� TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r') ie isshalitnri�:hich specint leectc!!! sot�l(' uuuuuuuuuuuuuuuuuu elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq ssthic) ie is----------s---sGO d.NOT�ND�So in!!! sMaximuT � TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',----------RE uår_s1)2 ros1)2 r') ie iss parti�:!!gin � led t s1)ID (giZ�b!!!!! in RE uår_s1)2 ros1)2 r elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq) ie islipgin ni ofbpar---s---sGO d.NOT�ASSOCIATED(!!! sMaximuT � TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r') ie isshalitnri�:ubdom ins.OF elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq) ie issasom in ton---s---sGO dSIZE(maxs1baximu_2)sLT.!!! sot�l(T� TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r') ie isshalitnri�:hich specint leectc!!! sot�l(' uår_s1)2 ros1)2 r elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq ssthic) ie is----------s---sGO d.NOT�ND�So in!!! ssin � �!! � TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',----------RE uår_s1)2 ros1)2 r'sin � �!s parti�:!!gin � led t s1)ID (giZ�b!!!!! in RE uår_s1)2 ros1)2 r elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeqsin � �!spgin ni ofbpar---s---sGO d.NOT�ASSOCIATED(!!! ssin � �!! � TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uuuuuuuuuuuuuuuuuu'sin � �!shalitnri�:ubdom ins.OF elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeqsin � �!sasom in ton---s---sGO dSIZE(maxs1sin � �!!sLT.!!! sot�l(T� TTTTTTTinfon= �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 rr'sin � �!s parti�:nt leectch speci!!! sot�l(' uår_s1)2 ros1)2 rr elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq ssthics subdom in tonnnnnnnnnDO-)=1,!!! sot�l(numb�i ton---s---sGO d(maxs1sin � �!(i!sLT.0).OR. 'ins1fficirnt(r_mmmmmmmmm(maxs1sin � �!(i!sGE�eri,n� �!! � TTTTTTTinfon= �_-���_ �_�����EOF else2s�������CALL#���_�����(��_� _��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 rrrr'inv---dNeet. nndex omaizaN oinqsin � �!'G uår_s1)2 ro_s1)2 ro elsssssGoOTO 9999 ie issE ss ���������ENDIF in � ���� ��sENDI- tnbeqed wet. nndext s1)Iqv---dENDIF in � ����sENDO-��� in � �I is----------ssENDI- do Z�b!!!!! in ot s1)ID (gND ==�s----------sGOTOgin � �f_�_xpencil ie iss!!!ss!!!gin � �--------------------sGOdomsis�grelisLE.!Tinfon= ���_�����_ �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r'no (r w!!!! in oin �!!!!gin � �! necnr""t�O o'G uår_s1)2 ro_s1)2 elsssssGoOTO 9999 ie issE ss ���������ENDIF in � ����sENDI- tnbeq!!! sot�l(numb�i ton---s0--------------------------------------------------------g#ifdnumb�i ton---s0sargureetdat�EOF els!�!!! in o(r w!add upsnã wibwholenumb�i ton---s0sa ingin � �!!!gin � �.numb�i ton---s0saTODO: ONE COULDnDO-MORE TESTS HER-._param____ ���s0--------------------------------------------------------g#ifdnumb�i ton---s,lmye�EOiostsial,(1)-! Minimu(1))*iostsial,(2)-! Minimu(2)9999 ie issE ss GOTOpEN ie �f_�3infon= ���_�����_ �_-���_,lmye�EO,lmye*iostsial,(3)-! Minimu(3)9999 ie issE ss sENDIF i8888��������slmye�EO0.0_MK---------------DO-)=1,!!! sot�l(numb�i ton---s---sllmye�EOimaxs1baximu(1,i)-maxs1b,uår(1,i))* 'peri,dic aN imaxs1baximu(2,i)-maxs1b,uår(2,i)9999 ie issE ss GOTOpEN ie �f_�3infon= ���_�����_ �_-���_---sllmye�EOllmye*imaxs1baximu(3,i)-maxs1b,uår(3,i)9999 ie issE ss sEN DIF i8888������������slmye�EOslmye�+OllmyeENDIF in � ����sENDO--------------sGOdABS(slmye-,lmye)/,lmyesGE�GER, Dinfon= ���_�����_ �_-���_0--------------------------------------------------------g ���_�����_ �_-���_0 Mismatch! ���_�����_ �_-���_0--------------------------------------------------------g ���_�����_ �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----------RE uår_s1)2 ros1)2 r'!a isyn � �!!! ftu!!! in RE elsssssGOTO 9999 ie issE ss ���������ENDIF in � ����sENDI----------ssENDI �����(��_��ND�SUBRLE INE sEN #if� �__KIND ==�__SINGLLE_PRECISION ie issEND�SUBRLE INE osEN #if� �__KINbs',-----------_�__DOUBLLE_PRECISION ie issEND�SUBRLE INE osEN #if� �__KINbs',-----------_yyyyyyyyy���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',USE ���_m�E ���_2d.inc����������������������������������������������������0000644�0001752�0001753�00000011241�11616003524�022006� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_-���_0--------------------------------------------------------g---------------g ���_��� �!-clude file�� inD ==�izaNUBLtwo (r w! geomy T:argsp�st idOizaN ���_��� � wimsnã wibmy T:arg�R , sNUBLthey! ge. The issIs symzaN ywhen dec0 ���_��� �!NPUT LL()p,jp --�!n i. naNal domtwo (r wGoOTcludiza ���_��� ������������������������������ wibeerio i. image when dec0����������� LL()i,jj --�!n i. naNal domcorrespoEOizaNmyel ���_��� ������������������������������ � y (without image )when dec0�� �_PUT N(: ), POINTER(nst tubLL() ie ishen dec0����������� POINTER(st rax_LL() ie ishen dec0 ���_���--------------------------------------------------------g---------------g ���_��� �$Log: bs',USE ���_m�E ���_2d.inc,v $ ���_��� �Revi �!!!1.1.1.1 2007/07/13 10:18:54�_�vos ���_��� �CBL ver �!!! U domPPMN � �!!!hen dec0 ���_��� �Revi �!!!1.2 2006/03/28 21:00:24�_�vos ���_��� �TdomEXITEOF skippn oin dom__VECTOR cecnsnã mag�w vec�_mwz � �!when dec0 ���_��� �Revi �!!!1.1 2006/03/28 19:26:35�_�vos ���_��� �!------ impleag�_ � �!w Tnbe �!! r2d/3d/freespace/eerio i.when dec0 ���_���--------------------------------------------------------g---------------g ���_��� �Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� �!-stitutsthicCingin � �!!!gScienK������CA �!-TH Zg�_rum, Hirschengraben 84 ���_��� �CH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g ���_��mx1�EOMIN() ie is(1,ip),) ie is(1,jp)9999 ie mx2�EOMIN() ie is(2,ip),) ie is(2,jp)99999 ie mn1�EOMAX` givee�(1,ip),)givee�(1,jp)9999 ie mn2�EOMAX` givee�(2,ip),)givee�(2,jp)99999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsarguree! radjacet�O.aces. SHARK:�Tdomfunny logi. iy ALbe r.999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oGO d.NOT�(mx1sLT. givee�(1,ip).OR.mx1sGT. ie is(1,ip)) in o uår_s.NOT�(mx1sLT. givee�(1,jp).OR.mx1sGT. ie is(1,jp)) in o uår_s.NOT�(mx2sLT. givee�(2,ip).OR.mx2sGT. ie is(2,ip)) in o uår_s.NOT�(mx2sLT. givee�(2,jp).OR.mx2sGT. ie is(2,jp))infon= ----------s---------------------------------------------------------gin � �! Che----------s-sargureetdat�EOOF subEOF eltfmamyedyoin domR , �st exclude----------s-sa domtnbe �!subEOtself. The iD ==� onlybmyedlitnri�:done----------s-sane-- eerio i. bs ut niesNUBLoneaNal domcel���)sp�q!! Simcel�.----------s-saOnlybisiizREAconfigura ���o o��yOrisko oub�� g�_rie when dec---s---------------------------------------------------------gin � �! Che----------si �n = .FA---._param____sGO d(pbdrx.OR.pbdry) Eibox�ie jboxT � TTTTTTTinfon= ����EN iii �f_�_jjinfon= ���_�����_ �_-���_0o o�eltfmdd� wibeerio i. imagethic)yself ���_�����_ �_-���_� �n = .TRU-._param____ ���=!----------------������DO kk=1,o��_m�(ii9999 ie issE ss 8GOTO 9�_m�(kk,ii) �f_�_jjinfon= ���_�����_ �_-���_ �_-���_� �n = .TRU-.__SInNCLUDEVECTOR ���_�����_ �_-���_ �_-���_EXITyyyyyyyy�����_ �_-���_ �_-���_EENDIF i8888�����������_EENDO--------------ssENDIF i8888����sENDIF i8888����EN i.NOT�_� �ninfon= ���_�����_ �_----------------------------------------------------------gin � �! numb�i ton---s0sargureeUBL�yOomcoenoughNmemoryfmag�_opod ���_�����_ �_----------------------------------------------------------gin � �! numb�i ton---sEN io��_m�(ii9sGE�i sssOR.o��_m�(jjisGE�i ssinfon= ���_�����_ �_-���_0--------------------------------------------------------g �! numb�i ton---s---s0saUBLelt,Nmyelg�_opol�st updopole ini ssN----ablenumb�i ton---s���_0--------------------------------------------------------g �! numb�i ton---s---sissIp--_fii_preserv��_m�ggrow_pgin rvenumb�i ton---s���_ldc(1� = i ssN+ 100----------s---s���_ldc(2� = ot�l(plu(numb�i ton---s---s�_���_arg,iopi,)ie is, els elss������� ��IF (iiiiiiiiiiEN ie iss � Tinfon= ���_�����_ �_n---s---silial ie iss � TCALL#���_�����(����on---s---s�_���_argoc,'���_Nomc_imag�_tubs',USE ���_m�RE uår_s1)2 ros1)2 rrrrr'elg�_op�!!! U )ie is ALiledOF elsssssGOTO 9999 ie issE sssssssssssNDIF g !--on==========EENDIF i8888�����������_0--------------------------------------------------------g �! numb�i ton---s---s0saSmco dom ssNnumb�i ton---s���_0--------------------------------------------------------g �! numb�i ton---s---si ssN�EOldc(1�ENDIF in � ����sENDI-ENDIF i ���_�����_ �_----------------------------------------------------------gin � �! numb�i ton---s0sa �_m�F els!!reli(r.pset ���_�����_ �_----------------------------------------------------------gin � �! numb�i ton---so��_m�(ii9b�i ton---s=so��_m�(ii9b+ 1TTTTinfon= ���_ 9�_m�(o��_m�(ii9,ii) =_jjnumb�i ton---so��_m�(jjin�i ton---s=so��_m�(jjin+ 1TTTTinfon= ���_ 9�_m�(o��_m�(jji,jjin= iiF i8888����sENDIi ���_��sENDIi y���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',t �IMPLICI ON.f�����������������������������������������������������������0000644�0001752�0001753�00000035126�11616003524�020567� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_ �_----------------------------------------------------------gin � �! in � �! numb�i 0sa ub�::a��OF : bs',t �IMPLICI ON999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsCopyrMK), (c) 2010 CSE Lab (-TH Zurich), MOSAIC G�::p (-TH Zurich), ���_��� �������������������Ce * e! rFluid Dynamics (DTU) ���_���hen dec0 ���_��� The ifile�e iient U domPil llel�Pil�an�� M hpL� �!!! (PPM)when dec0 ���_��� PPMNe if isssoftware: yourum�red , ributsti �st/dexmo if!hen dec0ti fbt�ra domtnrmnaNal domGNU Les�b!!GLic( aoPGER cpL�cense ���_��� a iiGER ,h �!byl domF issSoftware Fs ut p�!!, ei dor ���_��� ver �!!!3aNal domL�cense, dex(at your els���--any lator ���_��� ver �!!when dec0 ���_��� PPMNe id , ributs oin domhopeetdat�s!AL erfbF elsful, ���_��� but WITHOUT ANY WARRANTY; without even domimplaN owarrantyaNa ���_��� MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Se�F el ���_��� GNU GLic( aoPGER cpL�cense fdexmorss ntLilswhen dec0 ���_��� YourshouldOomcoreceivn ot copyaNal domGNU GLic( aoPGER cpL�cense ���_��� aEOF elsGNU Les�b!!GLic( aoPGER cpL�cense along with PPM. IBLelt, ���_��� se�F<http://www.gnu.org/l�censes/>when dec0 ���_��� Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� -TH ZurichyO in omsCH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g __SINGLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',-----PLICI ON_N( ie iss, ie iss,Eie i EAL(M uår_s,bcdee�r""t�O u������ AL(id,level,blevel,child)__DOUBLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',-----PLICI ON_d( ie iss, ie iss,Eie i EAL(M uår_s,bcdee�r""t�O u������ AL(id,level,blevel,child)_���_���!� The i�::a��OF---verts AL(es fromtaNbs' -���_param_�!� (cmyet �!byl`bs',-���`)snã mpsetnhics s�!!! ftuwhichyO in om!� d dec0 aqv---dNi!!! f! necnr""t�O o. IBLel t isslevelyO in om!� OF somaizaN ,iizREAe idoneabyl a�izaN � �Ichildles�yO in om!� t issAL( a iacs s. O dorwis0 izaNbsx naNal doyO in om!� somaizacslevel! geotakEo. IBLt cert! f! �!EieaNa ���_���!� tdomt issdoeF eltfexteEOF oetdat�level,F els!!xt ���_���!� hMK)b!!ex , izaNAL( um�be takEoF oef erft ufgap -------!� O!! rt�ra oorep1�>Lt necnr""t�O oiwith el holes -------!� O!!space.yyyyyyyy999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaModu����999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oUSINbs',modu��_t payO in oUSINbs',modu��_-----b�i ofbparUSINbs',modu��_-----op ofbparUSINbs',modu��_�����CALL#��USINbs',modu��_elg�_yO in oGMPLICIT NONE__SINGLE_PRECISION ie issEND�SUBRLE INE o PPARAMET LL(MKl ie iskSE �iizale__DOUBLE_PRECISION ie issEND�SUBRLE INE o PPARAMET LL(MKl ie iskSE � oub��yyyyyyyy�����_0--------------------------------------------------------g---------------g ���_��� �!-cludeN999 ie ---------------------------------------------------------gin � �! ChecWs�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om A_imag�_s in oyO in om--------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK) POINTER(st rax_,o NT(IN tubLL() ie iss -------!� Low�raco rtinet naNal dombsx n. -------!� -------!� 1beqen � : x,y[,z] + -------!� 2nd:NAL( IDyO in oREAL(MK) POINTER(st rax_,o NT(IN tubLL() ie iss -------!� Upp�raco rtinet naNal dombsx n. -------!� -------!� 1beqen � : x,y[,z] + -------!� 2nd:NAL( IDyO in o ,o NT(IN tubLL()niss -------!� Tot aonumb�raNalbsx nyO in o POINTER(nst tub,o NT(IN tubLL()nie i -------!� Numb�raNalchildrenuubs � �Ibox�yO in o POINTER(nst tub,o NT(IN tub, OPT(nsALLL()blevelyO in om!� T issleveluubs � �Ibox a irep1�> �!bylbs',-���. -------!� Nyedlitnri�:pgin niaUBLleveluilipgin ni�yO in o POINTER(nst ax_,o NT(IN tub, OPT(nsALLL()child -------!� Childrenu(1beqen � )pNaln � bsx na(2ndqen � ). -------!� Nyedlitnri�:pgin niaUBLleveluilipgin ni�yO in o ,o NT(IN tub, OPT(nsALLL()levelyO in om!� SomaizaNs t isslevel fromtwhich bsx na ge ���_���!� to�be takEo. IBL> 0, onlybizaNbsx nawhich geopgicis0ly ���_���!� o ie at�level georep1�> �, r""siblybleeOizaNtl holes cr -------!� tdom necnr""t�O o. IBL< 0, holes geof erN owith els!!xt ���_���!� hMK)b!-level ex , izaNAL(�yO in o POINTER(nst tub,oPO R, OPT(nsALLL()bL(id -------!� Toawhich Nal domorigi!!!gbsx nadoeF � �I ismcorrespoEO? -------!� Onlybmag�_opod aEOFrep1�> �!ofipgin ni�yO in oREAL(MK) POINTER(st rax_,oPO R L() ie is--------!� nup1�>s low�raco rtinet naNal domI ON.yO in oREAL(MK) POINTER(st rax_,oPO R L() ie is--------!� nup1�>s upp�raco rtinet naNal domI ON.yO in o ,o NT(�� �_bLL()nI ON999 ie -!� Numb�raNalI ON.yO in o ,o NT(�� �_bLL() --------!� nup1�>s --btus, 0 uponqsicces�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om L � �!----able��999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK) L()t0yO in o L() elss�,j, , a=�_9 ie i POINTER(st 2) L()ldc_9 ie i POINTER(st x_,oPO R L()I Obox => NULL()_9 ie i POINTER(st x_,oPO R L()box, a=� => NULL()_9 ie im--------------------------------------------------------gin � �! ChecWs�yO in om Ex* �����999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oy�����_0--------------------------------------------------------g---------------g ���_��� �!-------se ���_���--------------------------------------------------------g---------------g ���_��----------b�i-----------PLICI ONRETURN ie iy�����_0--------------------------------------------------------g---------------g ���_��� �rgureeUnput c_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oGOTOpEN iebug sGT.!Tinfon= ���_����-----D ==�_9 ie issGOTO 9999 ie issENDIF issie iss-----G ------------------------------------------------------------ ie iss ��! C��! C-------- Alg�_opolmemoryffrg�R , ------------------------------------------------------------ ie iss ��! C��! C-------issIp----_fii_preserv��_m�gUSg-------ldc(1� -s=soiss ------�_���_arg,iopi,I Obox, els elss������� ��IFEN ie iss � Tinfon= ���_�����_ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',-----PLICI ONRE�_�����(�� uår_s1)2 ' issIhicAL( IDso#ifBOXOF elsssssGOTO 9999 ie issENDIF issie iss----- ���_��I Obox =fii_preservfbt�ER y�����_0--------------------------------------------------------g---------------g ���_��� �rount�EOF numb�raNalI ON aEOFbuilt i�R , ------------------------------------------------------------ ie iss ��! C��! C-------�greli= 0-------EN iND�So inlevelT � TTTTTTTinfon= EN ilevel sGT.!Tinfon= ���_����------------------------------------------------------------ ie iss ��! ���_����------- �rount�bsx naNnx omaizaN olevelyO in o��------------------------------------------------------------ ie iss ��! ���_����------DO-)=1,oiss ------------------EN iblevel(i) �f_�_levelTnfon= ���_�����_ �_n---s---s�greli= �greli+ 1TTTTinfon= ���_��������I Obox(ot�l(T�= iTTTTinfon= ���_����EENDIF i8888��������EENDO-----------!----------------��------------------------------------------------------ ie iss ��! ���_����------- �Traver omt issat�m Simdow�onã wib!omaizaN olevelyO in o��------------------------------------------------------------ ie iss ��! ���_����------issIp----_fii_preserv��_m�gUSg---------------ldc(1� -s=sMIN((-level-2)*(nie i(1)-1in+ nie i(1),1�ENDIF in � �����_���_arg,iopi,box, a=�, els elss������� ��IF (iiiiiiEN ie iss � Tinfon= ���_�����_ �_n---silial ie iss � TCALL#���_�����(����on---s�_���_a Roc,'���_Nomc_imag�_tubs',-----PLICI ONRE�_�����(�� uår_s1)2 ', a=� Nalbsx nonã raver omBOXSTACKRE elsssssGOTO 9999 ie issE ss �����g !--on======sENDIi y !--on======! push root�bsx ���_����------i, a=� = 1TTTTinfon= ���_box, a=�(i, a=�) = 1Ty !--on======! raver omtdomt iss oef EOFbsx nyO in oooooooooDO-WHILE (i, a=� sGT.!Tin ���_�����_ �_n---si = box, a=�(i, a=�) ���_�����_ �_n---si, a=� = i, a=� - 1TTTTinfon= ���_����!fmdd�box if�s!AinaNnxdesirN olevel dexabovol�st ha(numb�i ton---s---s!i_dechildren ------------------EN iiblevel(i)�f_�-level).OR.(nie i(i)�f_�0! � TTTTTTTinfon= �_-���_ �_s�greli= �greli+ 1TTTTinfon= ���_��������I Obox(ot�l(T�= iTTTTinfon= ���_����E----------------������---s!igrow , a=� UBLeeedod ���_�����_ �_---------EN iii, a=�+nie i(i)) sGT.!ldc(1�infon= ���_�����_ �_-���_ �_-���_ldc(1� = ldc(1� + nie i(i9999 ie issE ss 88888issIp----_fii_preserv��_m�ggrow_pgin rvenumb�i ton---s���_________�_���_arg,iopi,box, a=�, els elss������� ��IF (iiiiii �_---------EN ie iss � Tinfon= ���_�����_ �_n---s---s 88888ilial ie iss � TCALL#���_�����(����on---s---s________�_���_argoc,'���_Nomc_imag�_tubs',-----PLICI ONRE 'peri,dic aN onlyyyyy', a=� Nalbsx nonã raver omBOXSTACKRE uår_s1)2 ros1)2 rrrrrrrrrrrrr elsssssGOTO 9999 ie issE sssssssssssssssssssNDIF g !--on==================----- ���_��================----- ���_��================! push n � itslchildrenunã wib! a=�_9 ie iiiiiiiiiiiiiiiiiDO-j=1,oie i(i9999 ie issE ss 88888i, a=� = i, a=� + 1TTTTinfon= ���_������������box, a=�(i, a=�) = child(j,i9999 ie issE ss 8EENDO--------------s====-----F i8888��������EENDO---------------y !--on======! dyelg�_opol! a=�_9 ie iiiiiiiiiissIp----_fii_preservdyelg�_ENDIF in � �����_���_arg,iopi,box, a=�, els elss������� ��IF (iiiiiiEN ie iss � Tinfon= ���_�����_ �_n---silial ie iss � TC�����CALL#���_�����(��_��_���_argureet,'���_Nomdyelg�_tubs',-----PLICI ONRE�_�����( uår_s1)2 ', a=� Nalbsx nonã raver omBOXSTACKRE elsssssGOTO 9999 ie issE ss ----- ���_��====!ENDIF i8888!--E ���_��====---------------------------------------------------------gin � �! Che----------s-sarount�childles�Fbsx nyO in ooooo---------------------------------------------------------gin � �! Che----------sDO-)=1,oiss --------------EN ioie i(i9 sLT.i1infon= ���_�����_ �_n---s�greli= �greli+ 1TTTTinfon= ���_����I Obox(ot�l(T�= iTTTTinfon= ���_sENDIF i8888����sENDODIMENSI!----G ------------------------------------------------------------ ie iss ��! C��! C-------- Alg�_opolmemoryffrg�I ON999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oissIp----_fii_preserv��_m�gUSg-------ldc(1� -s=s Nm in TTTTinfldc(2� = ot�l(numb�i �_���_arg,iopi,,bcdee�r els elss������� ��IFEN ie iss � Tinfon= ���_�����_ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',-----PLICI ONRE�_�����(�� uår_s1)2 ',bcimumfexteEtaNalI ON MIN_SUBOF elsssssGOTO 9999 ie issENDIF issie iss----- numb�i �_���_arg,iopi,,"t�O u� els elss������� ��IFEN ie iss � Tinfon= ���_�����_ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',-----PLICI ONRE�_�����(�� uår_s1)2 ',aximumfexteEtaNalI ON MAX_SUBOF elsssssGOTO 9999 ie issENDIF issie iss----- �� ��IFEN iND�So inbL(id�infon= ���_�����_ldc(1� = ot�l(numb�i �����_���_arg,iopi,boxid,lels elss������� ��IF (iiEN ie iss � Tinfon= ���_�����_ �_nilial ie iss � TCALL#���_�����(����on�_���_a Roc,'���_Nomc_imag�_tubs',-----PLICI ONRE�_�����(�� uår_s1)2 'AL( IDaNalI ON BOXIDOF elsssssssssssGOTO 8888 in � �����g !--on==!ENDIi ���_��sENDIi y���_��0--------------------------------------------------------g#ifdef�__MPI - C------- �_m�FI ON999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oGOTOpEN ie �f_�_2infon= ���_�����_DO-)=1,ot�l(numb�i ton---sj�EOs Obox(i9999 ie issE ss givee�(1,i� = ie iss(1,j9999 ie issE ss givee�(2,i� = ie iss(2,j9999 ie issE ss ie is(1,i� = ie iss(1,j9999 ie issE ss ie is(2,i� = ie iss(2,j9999 ie issE!ENDODIMENSI!-------------_DO-)=1,ot�l(numb�i ton---sj�EOs Obox(i9999 ie issE ss givee�(1,i� = ie iss(1,j9999 ie issE ss givee�(2,i� = ie iss(2,j9999 ie issE ss givee�(3,i� = ie iss(3,j9999 ie issE ss ie is(1,i� = ie iss(1,j9999 ie issE ss ie is(2,i� = ie iss(2,j9999 ie issE ss ie is(3,i� = ie iss(3,j9999 ie issE!ENDODIMENSI!----G ------------------------------------------------------------ ie iss ��! C��! C-------- �_m�FAL( IDsoUBLeeedod ���_��---------------------------------------------------------gin � �! ChecWs�yO in oGOTOND�So inbL(id�infon= ���_�����_DO-)=1,ot�l(numb�i ton---sbL(id(i� = s Obox(i9999 ie issE!ENDODIMENSI!----G------------------------------------------------------------ ie iss ��! C��! C-------- Dyelg�_opolR , ------------------------------------------------------------ ie iss ��! C��! C-------issIp----_fii_preservdyelg�_ENDIF i�_���_arg,iopi,I Obox, els elss������� ��IFEN ie iss � Tinfon= ���_�����_ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_imag�_tubs',-----PLICI ONRE�_�����(�� uår_s1)2 ' issIhicAL( IDso#ifBOXOF elsssssGOTO 9999 ie sENDIi y���_��0--------------------------------------------------------g#ifdef�__MPI - C------- nup1�> ���_���--------------------------------------------------------g---------------g �g �END�SUBRLE INE ----------op-----------PLICI ONRETURN ie iE INE RETUR= ���_��END�AINS ���_��#if� �__KIND ==�_9 ie iss-EN ioAL( sLT.issEfon= ���_�����_�_ilial ie iss � TC�����CALL#���_�����_���_argureet,'���_Nomc_imag�_tubs',-----PLICI ONRE�_��� uår_s1)2 ro'Numb�raNalbsx nO parti�:>=!0OF elsssssGOTO 9999 ie issE s���������ENDIF in �sENDIF i8888���DO-)=1, Nm in TTTTinfon= ��DO-j=1,oiss ---------------EN ioie iss(i,j9 sGT.! ie iss(i,j9infon= ���_�����_ �_-���_�����EOF else2s�������CALL#���_�����(��_��_���_argureet,'���_Nomc_imag�_tubs',-----PLICI ONRE�_� uår_s1)2 ros1)2 r') ieAL( parti�:<= ie iss EOF elsssssssssssGOTO 8888 in � sE s���������ENDIF in �F in �sENDIF i8888��� ��EENDO----------EENDO----------EN iND�So inlevelT � TTTTTTTinfon= -sGO d.NOT�ND�So inblevelT � TTTTTTTinfon= -s��_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',-----PLICI ONRE�_��� uår_s1)2 ro)2 r'blevels parti�:!!in niaUBLleveluil.OF elsssssssssssGOTO 8888 in � sE���������ENDIF in �F in-----F i8888�������GO d.NOT�ND�So inchild) � TTTTTTTinfon= -s��_�����EOF else2s�������CALL#���_�����(���_���_argureet,'���_Nomc_imag�_tubs',-----PLICI ONRE�_��� uår_s1)2 ro)2 r'childs parti�:!!in niaUBLleveluil.OF elsssssssssssGOTO 8888 in � sE���������ENDIF in �F in-----F i8888���sENDI �����(��_�ND�SUBRLE INE sEN #if� �__KIND ==�__SINGLE_PRECISION ie issEND�SUBRLE INE osEN #if� �__KINbs',-----PLICI ON_N__DOUBLE_PRECISION ie issEND�SUBRLE INE osEN #if� �__KINbs',-----PLICI ON_yyyyyyyyy������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',D ==�_ec0 ,sf������������������������������������������������������������0000644�0001752�0001753�00000011526�11616003524�020410� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o---------------------------------------------------------gin � �! in � �! numb�i 0sa ub�::a��OF : bs',D ==�_ec0 ,y���_��0--------------------------------------------------------g#ifdef�__MPI - C------- CopyrMK), (c) 2010 CSE Lab (-TH Zurich), MOSAIC G�::p (-TH Zurich), ���_��� �������������������Ce * e! rFluid Dynamics (DTU) ���_���hen dec0 ���_��� The ifile�e iient U domPil llel�Pil�an�� M hpL� �!!! (PPM)when dec0 ���_��� PPMNe if isssoftware: yourum�red , ributsti �st/dexmo if!hen dec0ti fbt�ra domtnrmnaNal domGNU Les�b!!GLic( aoPGER cpL�cense ���_��� a iiGER ,h �!byl domF issSoftware Fs ut p�!!, ei dor ���_��� ver �!!!3aNal domL�cense, dex(at your els���--any lator ���_��� ver �!!when dec0 ���_��� PPMNe id , ributs oin domhopeetdat�s!AL erfbF elsful, ���_��� but WITHOUT ANY WARRANTY; without even domimplaN owarrantyaNa ���_��� MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Se�F el ���_��� GNU GLic( aoPGER cpL�cense fdexmorss ntLilswhen dec0 ���_��� YourshouldOomcoreceivn ot copyaNal domGNU GLic( aoPGER cpL�cense ���_��� aEOF elsGNU Les�b!!GLic( aoPGER cpL�cense along with PPM. IBLelt, ���_��� se�F<http://www.gnu.org/l�censes/>when dec0 ���_��� Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� -TH ZurichyO in omsCH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g _���_��#if� �__KINbs',D ==�_ec0 ,Oec0 ,,v---dssssssGOTO 88�!� The isub�::a��OFe issIOF oeD ==� a given c0 logy IDafdexitslv---ditywhen dec0!� -------!� [NOTE] -------!� I!Ainarnecnag�dIOF oeeltfu omtde i�::a��OFtoo ofte!, s!AshouldObe ���_���!� typic lly placs oin oeDEBUG codol�st onlybat�critic l placssoin do ���_���!� codoy999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaModu���999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oUSINbs',modu��_t payO in oUSINbs',modu��_-----b�i ofbparUSINbs',modu��_-----op ofbparUSINbs',modu��_�����CALL#��USINbs',modu��_writo ���_��GMPLICIT NONE_999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oG P NT(IN tubLLLLLLLLL()tc0 ,y���_��0!� Tc0 logy IDato�be D ==�od ���_��LOGI�_� ,o NT(�� �_bLLLLLLLLL()v---dENDIF i-!� nup1�>s `TRU-`NUBLthe given m hid islv---dl�st t�ER ,ENDIF i-!� `FA---` o dorwis0�yO in o P NT(�� �_bLLLLLLLLL() --------!� nup1�>s --btus, 0 uponqsicces�y999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaL � �!----able�999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oREAL(e iskSE � oub��) L()t0y999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsa!-------se999 ie ---------------------------------------------------------gin � �! ChecWs�yO in o----------b�i------D ==�_ec0 ,RETURN ie iE INE v---dl= .FA---._999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsargureec_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oGOTOpEN iebug sGT.!Tinfon= ���_����-----D ==�_9 ie issGOTO 9999 ie issENDIF issie iss-----G ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsaV---dity-D ==�_9 ie i�--------------------------------------------------------g---------------g _���_��EN iiec0 , sGE�i1in iiec0 , sLE.!SIZE(bs',----)in i uår_s1)2 ro)2(bs',----iec0 ,)%t%isgin � �- � TTTTTTTinfon= v---dl= .TRU-._param_-----G ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsanup1�> ���_���--------------------------------------------------------g---------------g �g �END�SUBRLE INE ----------op------D ==�_ec0 ,RETURN ie iE INE RETUR= ���_��END�AINS ���_��#if� �__KIND ==�_9 ie iss-�EN i.NOT�_----i-------z �--------------------s�����EOF else2s�������CALL#���_�����(�_���_argureet,'���_Nom'���noi---,-----D ==�_ec0 ,RE�� uår_s1)2 'Pleece Dn � ----i---ifirstEOF elsssssssssssGOTO 8888 in � v---dl= .FA---._OTO 8888 in � ���������ENDIF in �FsENDIF i8888����EN iiec0 ,sGT.SIZE(bs',----)in OR. uår_s1)2 ro)2(ec0 ,sLT.1�infon= ���_�����_ �_-�����EOF else2s�������CALL#���_�����(�_���_argureet,'���_Nomc_imag�_tubs',D ==�_ec0 ,RE� uår_s1)2 ro)2 'ec0 , en � izaN::asidolbs',----RE 'peri,d elsssssGoOTO 9999 ie issE ss ���������ENDIF in �FsENDIF i8888����EN i.NOT�_ASSOCIATED(bs',----iec0 ,)%t�infon= ���_�����_ �_-�����EOF else2s�������CALL#���_�����(�_���_argureet,'���_Nomc_imag�_tubs',D ==�_ec0 ,RE� uår_s1)2 ro)2 'bs',----iec0 ,) 0 * eeltfmbdom ins.OF 'peri,d elsssssGoOTO 9999 ie issE ss ���������ENDIF in �FsENDIF ����(��_��ND�SUBRLE INE sEN #if� �__KIND ==�_E INE sEN #if� �__KINbs',D ==�_ec0 ,y��������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',t �IMdyelg�_sf������������������������������������������������������������0000644�0001752�0001753�00000013026�11616003524�020416� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������E INE ---------------------------------------------------------gin � �! in � �! numb�i 0sa ub�::a��OF : bs',t �IMdyelg�_y���_��0--------------------------------------------------------g#ifdef�__MPI - C------- CopyrMK), (c) 2010 CSE Lab (-TH Zurich), MOSAIC G�::p (-TH Zurich), ���_��� �������������������Ce * e! rFluid Dynamics (DTU) ���_���hen dec0 ���_��� The ifile�e iient U domPil llel�Pil�an�� M hpL� �!!! (PPM)when dec0 ���_��� PPMNe if isssoftware: yourum�red , ributsti �st/dexmo if!hen dec0ti fbt�ra domtnrmnaNal domGNU Les�b!!GLic( aoPGER cpL�cense ���_��� a iiGER ,h �!byl domF issSoftware Fs ut p�!!, ei dor ���_��� ver �!!!3aNal domL�cense, dex(at your els���--any lator ���_��� ver �!!when dec0 ���_��� PPMNe id , ributs oin domhopeetdat�s!AL erfbF elsful, ���_��� but WITHOUT ANY WARRANTY; without even domimplaN owarrantyaNa ���_��� MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Se�F el ���_��� GNU GLic( aoPGER cpL�cense fdexmorss ntLilswhen dec0 ���_��� YourshouldOomcoreceivn ot copyaNal domGNU GLic( aoPGER cpL�cense ���_��� aEOF elsGNU Les�b!!GLic( aoPGER cpL�cense along with PPM. IBLelt, ���_��� se�F<http://www.gnu.org/l�censes/>when dec0 ���_��� Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� -TH ZurichyO in omsCH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g _���_��#if� �__KINbs',t �IMdyelg�_iec0 ssssssGOTO 88�!� The i�::a��OFdyelg�_opos n � memb�rnaNala c0 logy objeci�yO in o---------------------------------------------------------gin � �! ChecWs�yO in omsaModu����999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oUSINbs',modu��_t payO in oUSINbs',modu��_-----b�i ofbparUSINbs',modu��_-----op ofbparUSINbs',modu��_�����CALL#��USINbs',modu��_elg�_y���_��USINbs',modu��_typeginy���_��USINbs',modu��_m h_elg�_yO in oGMPLICIT NONE_O in o---------------------------------------------------------gin � �! ChecWs�yO in omsa!-cludeN999 ie ---------------------------------------------------------gin � �! ChecWs�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om A_imag�_s in oyO in om--------------------------------------------------------gin � �! ChecWs�yO in oTYPE(bs',-,----) P NT(IN �_bLL()----y���_��0!� Tc0 logy , ructureitnri�:dyelg�_opot ���_�� ,o NT(�� �_bLL() --------!� nup1�>s --btus, 0 uponqsicces�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om L � �!----able��999 ie ---------------------------------------------------------gin � �! ChecWs�yO in o POINTER(nst3) L()ldc_9 ie i L() elsyO in oREAL(e iskSE � oub��) L()t0yO in om--------------------------------------------------------gin � �! ChecWs�yO in om Ex* �����999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oy�����_0--------------------------------------------------------g-----------ecWs�yO in o� �!-------se ���_���--------------------------------------------------------g---------------g ���_��----------b�i-----------dyelg�_RETURN ie iE INE ldc = 1TTTTinfissIp_fii_preservdyelg�_E999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsargureec_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oGOTOpEN iebug sGT.!Tinfon= ���_��-----G ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsaDyelg�_opoln � array memb�rn ���_���--------------------------------------------------------g---------------g ���_��-----_arg,iopi,----% givee�s, els elss������� ��IF-----_arg,iopi,----% ie iss, els elss������� ��IF-----_arg,iopi,----% givee�d,lels elss������� ��IF-----_arg,iopi,----% ie isd,lels elss������� ��IF-----_arg,iopi,----% is2proc,lels elss������� ��IF-----_arg,iopi,----%isGER ,t,lels elss������� ��IF-----_arg,iopi,----%bcgin,lels elss������� ��IF-----_arg,iopi,----% is_costs, els elss������� ��IF-----_arg,iopi,----% is_costd,lels elss������� ��IF-----_arg,iopi,----%o��_m� iss, els elss������� ��IF-----_arg,iopi,----%i��_m� iss, els elss������� ��IF-----_arg,iopi,----%I ON_bc,lels elss������� ��IF-----_arg,iopi,----%i��_m�proc,lels elss������� ��IF-----_arg,iopi,----%iecnaseq, els elss������� ��IF-----_arg,iopi,----% givphyss, els elss������� ��IF-----_arg,iopi,----% givphysd,lels elss������� ��IF-----_arg,iopi,----% iephyss, els elss������� ��IF-----_arg,iopi,----% iephysd,lels elss������ ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsaDyelg�_opol elsm heN999 ie ---------------------------------------------------------gin � �! ChecWs�yO in o-----_argm h_elg�__equi,----% h, els elss������� ��IFNULLIFY,----% h��� ��IF----% iem hid = 0-yO in o---------------------------------------------------------gin � �! ChecWs�yO in omsaMarkmtde i c0 logy aF eltft�ER O in o---------------------------------------------------------gin � �! ChecWs�yO in o----%ist�ER l= .FA---._999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaAag�w tde i c0 , ructureitnri�:ressIOF!!xt time999 ie ---------------------------------------------------------gin � �! ChecWs�yO in o'���n!xt_avail-----l= ----%ID y���_��0--------------------------------------------------------g#ifdef�__MPI - C------- nup1�> ���_���--------------------------------------------------------g---------------g �g �END�SUBRLE INE ----------op-----------dyelg�_RETURN ie iE INE RETUR= ���_��sEN #if� �__KINbs',-----dyelg�_E����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',D ==�_m hidsf������������������������������������������������������������0000644�0001752�0001753�00000011570�11616003524�020362� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_��0--------------------------------------------------------g#ifdef�__MPI - C------- ub�::a��OF : bs',D ==�_m hidy���_��0--------------------------------------------------------g#ifdef�__MPI - C------- CopyrMK), (c) 2010 CSE Lab (-TH Zurich), MOSAIC G�::p (-TH Zurich), ���_��� �������������������Ce * e! rFluid Dynamics (DTU) ���_���hen dec0 ���_��� The ifile�e iient U domPil llel�Pil�an�� M hpL� �!!! (PPM)when dec0 ���_��� PPMNe if isssoftware: yourum�red , ributsti �st/dexmo if!hen dec0ti fbt�ra domtnrmnaNal domGNU Les�b!!GLic( aoPGER cpL�cense ���_��� a iiGER ,h �!byl domF issSoftware Fs ut p�!!, ei dor ���_��� ver �!!!3aNal domL�cense, dex(at your els���--any lator ���_��� ver �!!when dec0 ���_��� PPMNe id , ributs oin domhopeetdat�s!AL erfbF elsful, ���_��� but WITHOUT ANY WARRANTY; without even domimplaN owarrantyaNa ���_��� MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Se�F el ���_��� GNU GLic( aoPGER cpL�cense fdexmorss ntLilswhen dec0 ���_��� YourshouldOomcoreceivn ot copyaNal domGNU GLic( aoPGER cpL�cense ���_��� aEOF elsGNU Les�b!!GLic( aoPGER cpL�cense along with PPM. IBLelt, ���_��� se�F<http://www.gnu.org/l�censes/>when dec0 ���_��� Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� -TH ZurichyO in omsCH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g _���_��#if� �__KINbs',D ==�_m hidOec0 ,,m hid,v---dssssssGOTO 88�!� The isub�::a��OFe issIOF oeD ==� a given m h IDafdexitslv---ditywhen dec0!� -------!� [NOTE] -------!� I!Ainarnecnag�dIOF oeeltfu omtde i�::a��OFtoo ofte!, s!AshouldObe ���_���!� typic lly placs oin oeDEBUG codol�st onlybat�critic l placssoin do ���_���!� codoy���_���--------------------------------------------------------g---------------g O in omsaModu���999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oUSINbs',modu��_t payO in oUSINbs',modu��_t pa_m hyO in oUSINbs',modu��_-----b�i ofbparUSINbs',modu��_-----op ofbparUSINbs',modu��_�����CALL#��USINbs',modu��_writo ���_��GMPLICIT NONE_999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oG P NT(IN tubLLLLLLLLL()m hidy���_��0!� M h IDato�be D ==�od�yO in o P NT(IN tubLLLLLLLLL()tc0 ,y���_��0!� Tc0 logy IDa oiwhich elsm hNe id�ER �yO in oLOGI�_� ,o NT(�� �_bLLLLLLLLL()v---dENDIF i-!� nup1�>s `TRU-`NUBLthe given m hid islv---dl�st t�ER ,ENDIF i-!� `FA---` o dorwis0�yO in o P NT(�� �_bLLLLLLLLL() --------!� nup1�>s --btus, 0 uponqsicces�y999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaL � �!----able�999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oREAL(e iskSE � oub��) L()t0yO in oLOGI�_� L()tc0 _o�_E INE TYPE(bs',-,----),oPO R L()tc0 => NULL()_y�����_0--------------------------------------------------------g-----------ecWs�yO in o� �!-------se ���_���--------------------------------------------------------g---------------g ���_��----------b�i------D ==�_m hidRETURN ie iE INE v---dl= .TRU-._999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsargureec_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oGOTOpEN iebug sGT.!Tinfon= ���_����-----D ==�_9 ie issGOTO 9999 ie issENDIF issie iss-----G ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsaV---dity-D ==�_9 ie i�--------------------------------------------------------g---------------g �_����-----bs',D ==�_ec0 ,Oec0 ,,tc0 _o�s������� ��IFEN i.NOT�_tc0 _o�infon= ���_����v---dl= .FA---._OTO 8888NDIF issie iss-----Gie isstc0 => bs',----iec0 ,)%t _���_��EN iim hid sLT.i1i.OR.(m hid sGT�_tc0 % iem hid- � TTTTTTTinfon= v---dl= .FA---._OTO 88-----G ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsanup1�> ���_���--------------------------------------------------------g---------------g �g �END�SUBRLE INE ----------op------D ==�_m hidRETURN ie iE INE RETUR= ���_��END�AINS ���_��#if� �__KIND ==�_9 ie iss-�EN i.NOT�_----i-------z �--------------------s�����EOF else2s�������CALL#���_�����(�_���_argureet,'���_Nom'���noi---,-----D ==�_m hidRE�� uår_s1)2 'Pleece Dn � ----i---ifirstEOF elsssssssssssGOTO 8888 in � v---dl= .FA---._OTO 8888 in � ���������ENDIF in �FsENDIF i8888����-----bs',D ==�_ec0 ,Oec0 ,,tc0 _o�s������� ��IFss-�EN i.NOT�_tc0 _o�infon= ���_����-----s�����EOF else2s�������CALL#���_�����(�_���_argureet,'���_Nomc_imag�_tubs',D ==�_m hidRE�� uår_s1)2 'Tc0 , out NalrangeEOF elsssssssssssGOTO 8888 in � v---dl= .FA---._OTO 8888 in � ���������ENDIF in �FsENDIF ����(��_��ND�SUBRLE INE sEN #if� �__KIND ==�_E INE sEN #if� �__KINbs',D ==�_m hidy����������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',f EO_��_m�_----_3d.inc����������������������������������������������������0000644�0001752�0001753�00000011624�11616003524�022014� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������E INE ---------------------------------------------------------gin � �! ChecWs�yO in omsa!-cludeifile�fdexD ==�izaNUBLtwolI ON arls!!_m�borN aEOFadOizaNyO in omsa domunã wib!!_m�borlR , sNUBLthey arl. The iuses -ymmetrywhen dec0 ���_��� P PUT: L() p,jp -- en ic naNal domtwolI ONGoOTcludiza ���_��� ������������������������������ domperio ic imag n. -------����������� L() i,jj -- en ic naNal domcorrespoEOizaNre#���_����� ������������������������������I ON (without imag n). -------�� �_PUT: POINTER(st xtubLL()n!!_m� -------����������� POINTER(st rax_LL() !_m� ------- ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsa$Log: bs',f EO_��_m�_----_3d.inc,v $yO in omsanuvi �!!!1.1.1.1 2007/07/13 10:18:54-s�vosyO in omsaCBL ver �!!! U domPPMlR �!!!hen dec0 ���_��� Pnuvi �!!!1.2 2006/03/28 21:00:24-s�vosyO in omsaTdomEXIT islskipps oin dom__VECTOR Dnseitnraag�w vectoriz p�!!when dec0 ���_��� Pnuvi �!!!1.1 2006/03/28 19:26:36-s�vosyO in omsa!------mimpleag�_ p�!!w Tests ofdex2d/3d/f isspace/perio icwhen dec0 ���_���----------------------------------------------------- ie iss� �! ChecWs�yO in omsaPil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� a!-stitutst U Compu_ p�!!--mScience ���_��� -TH Zg�_rum, HirsD =ngraben 84yO in omsaCH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g ���_��mx1s=sMIN( ie is(1,ip), ie is(1,jp)) ���_��mx2s=sMIN( ie is(2,ip), ie is(2,jp)) ���_��mx3s=sMIN( ie is(3,ip), ie is(3,jp)) ���_��mn1s=sMAX( givee�(1,ip), givee�(1,jp)) ���_��mn2s=sMAX( givee�(2,ip), givee�(2,jp)) ���_��mn3s=sMAX( givee�(3,ip), givee�(3,jp)) ���_��---------------------------------------------------------gin � �! ChecWs�yO in omsargureefdexadjacen-ifacss. SHARK:aTdomfunny logic isifastsr�yO in o---------------------------------------------------------gin � �! ChecWs�yO in oEN i.NOT�(mx1sLT. givee�(1,ip).OR.mx1sGT� ie is(1,ip)) i �� uår_s.NOT�(mx1sLT. givee�(1,jp).OR.mx1sGT� ie is(1,jp)) i �� uår_s.NOT�(mx2sLT. givee�(2,ip).OR.mx2sGT� ie is(2,ip)) i �� uår_s.NOT�(mx2sLT. givee�(2,jp).OR.mx2sGT� ie is(2,jp)) i �� uår_s.NOT�(mx3sLT. givee�(3,ip).OR.mx3sGT� ie is(3,ip)) i �� uår_s.NOT�(mx3sLT. givee�(3,jp).OR.mx3sGT� ie is(3,jp))infon= ENDIF in �F---------------------------------------------------------gin � �! Che----------s-sargureetdat�the isub isieltfmlre#dyoin dom issIaEOFexclude----------s-sa domtnsts osub itself. The iD ==� onlybnyedlitnri�:done----------s-sane-- perio ic bs ut raNs UBLoneaNal domcells isia gh Simcell.----------s-saOnlybin de iDonfigur p�!!:do we risk oub�� g�_ri n. ------n �F---------------------------------------------------------gin � �! Che----------si �nl= .FA---._OTO 8888 iEN iipbdrx.OR.pbdry.OR.pbdrz) (iAL(�NE.jAL(�infon= ���_�����_ �_-GOTO i �f_�_jjinfon= ���_�����_ �_-���_!:do eltfmdd� domperio ic imag aNalmyself ���_�����_ �_-���_i �nl= .TRU-._param_________E----------------������DO kk=1,o��_m�O i9999 ie issE ss 8GOTO 9�_m�Okk,ii) �f_�_jjinfon= ���_�����_ �_-���_ �_-���_i �nl= .TRU-._#ifbt�Em__VECTOR ���_�����_ �_-���_ �_-���_EXITyyyyyyyy�����_ �_-���_ �_-���_E----F i8888�����������_E--DO---------------sENDIF i8888����sENDIF i8888����EN i.NOT�_i �ninfon= ���_����------------------------------------------------------------ ie iss ��! ���_����------- �rgureeUf we omcoenoughlmemoryfelg�_opot ���_����------------------------------------------------------------ ie iss ��! ���_����------EN io��_m�O i9sGE�i �ze.OR.o��_m�OjjisGE�i �zeinfon= ���_�����_ �_-���_!------------------------------------------------- ie iss ��! ���_����----------- �iBLelt,Nre#�g�_opolnEOFupdopol elsi �ze!----able ���_�����_ �_-���_!------------------------------------------------- ie iss ��! ���_����----------issIp--_fii_preserv��_m�ggrow_pgin rvenumb�i ton---s���_ldc(1� = i �ze!+ 100numb�i ton---s���_ldc(2� = ot�l(plu(numb�i ton---s---s-----_arg,iopi, 9�_m�, els elss������� ��IF (iiiiii �_-EN ie iss � Tinfon= ���_�����_ �_n---s---silial ie iss � TCALL#���_�����(����on---s---s�_���_a Roc,'���_Nomc_imag�_tubs',f EO_��_m�RE�� uår_s1)2 '#�g�_op�!!! U 9�_m�ifails.OF elsssssGOTO 9999 ie issE sssssssssssNDIF g !--on==========E----F i8888�����������_!------------------------------------------------- ie iss ��! ���_����----------- �Smco wib!�ze! ���_�����_ �_-���_!------------------------------------------------- ie iss ��! ���_����----------i!�ze! = ldc(1�---------------sENDI! ���_�� ���_����------------------------------------------------------------ ie iss ��! ���_����------- � �_m�F wib!!_m�bour seg--------------------------------------------------------------------- ie iss ��! ���_����------o��_m�O i9�_����------=-o��_m�O i9�+ 1TTTTinfon= ���_ 9�_m�Oo��_m�O i9,ii) =_jj ���_����------o��_m�Ojjin_����------=-o��_m�Ojjin+ 1TTTTinfon= ���_ 9�_m�Oo��_m�Ojji,jjin= iiF i8888����sENDIi ���_��sENDIi y������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',t �IMget_dnecnpsf���������������������������������������������������������0000644�0001752�0001753�00000016653�11616003524�021132� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------ ie iss ��! iss ��! ���_��0sa ub�::a��OF : bs',t �IMget_dnecnp ���_��---------------------------------------------------------gin � �! ChecWs�yO in omsCopyrMK), (c) 2010 CSE Lab (-TH Zurich), MOSAIC G�::p (-TH Zurich), ���_��� �������������������Ce * e! rFluid Dynamics (DTU) ���_���hen dec0 ���_��� The ifile�e iient U domPil llel�Pil�an�� M hpL� �!!! (PPM)when dec0 ���_��� PPMNe if isssoftware: yourum�red , ributsti �st/dexmo if!hen dec0ti fbt�ra domtnrmnaNal domGNU Les�b!!GLic( aoPGER cpL�cense ���_��� a iiGER ,h �!byl domF issSoftware Fs ut p�!!, ei dor ���_��� ver �!!!3aNal domL�cense, dex(at your els���--any lator ���_��� ver �!!when dec0 ���_��� PPMNe id , ributs oin domhopeetdat�s!AL erfbF elsful, ���_��� but WITHOUT ANY WARRANTY; without even domimplaN owarrantyaNa ���_��� MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Se�F el ���_��� GNU GLic( aoPGER cpL�cense fdexmorss ntLilswhen dec0 ���_��� YourshouldOomcoreceivn ot copyaNal domGNU GLic( aoPGER cpL�cense ���_��� aEOF elsGNU Les�b!!GLic( aoPGER cpL�cense along with PPM. IBLelt, ���_��� se�F<http://www.gnu.org/l�censes/>when dec0 ���_��� Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� -TH ZurichyO in omsCH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g __SINGLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',-----get_dnecnp_sOec0 ,,ot�l, givee�, ie is, is2proc,& ���_�����_ �_-���_ �_-���_________I ON_bc,OTO 99_DOUBLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',-----get_dnecnp_dOec0 ,,ot�l, givee�, ie is, is2proc,& ���_�����_ �_-���_ �_-���_________I ON_bc,OTO 99_Dyyyyy�����_�!� The i�::a��OFrup1�>s wib!ubdomain bs ut raNs aEOFbs ut ryy�����_�!� coEOis����y999 ie ---------------------------------------------------------gin � �! ChecWs�yO in omsaModu���999 ie ---------------------------------------------------------gin � �! ChecWs�yO in oUSINbs',modu��_t payO in oUSINbs',modu��_-----b�i ofbparUSINbs',modu��_-----op ofbparUSINbs',modu��_�����CALL#��USINbs',modu��_D ==�_-dENDIF iUSINbs',modu��_typeginy���_��USINbs',modu��_elg�_yO in oGMPLICIT NONE_O in o---------------------------------------------------------gin � �! ChecWs�yO in omsa!-cludeN999 ie ---------------------------------------------------------gin � �! ChecWs�y__SINGLE_PRECISION ie issEND�SUBRLE INE o PPARAMET L()MKl ie iskSE �single9_DOUBLE_PRECISION ie issEND�SUBRLE INE o PPARAMET L()MKl ie iskSE � oub��9_Dyyyyy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oG P NT(IN tubLL()tc0 ,y���_��0!� Tc0 logy IDyO in oG P NT(�� �_bLL()ot�ly���_��0!� Numb�raNal!ubdomain�yO in oREAL(MK) POINTER(st rax_,oPO R LLL()mgivee�y���_��0!� Rup1�>s wibmgifexteEtaNaln � !ubdomain�yO in o0!� en � 1:id ag� �!!yO in o0!� en � 2:osub IDyO in oREAL(MK) POINTER(st rax_,oPO R LLL()m ie isy���_��0!� Rup1�>s wibmaxfexteEtaNaln � !ubdomain�yO in o0!� en � 1:id ag� �!!yO in o0!� en � 2:osub IDyO in o POINTER(st xtub,oPO R LLLL() is2procyO in o0!� !ubdomain to proces�dexassignag�_yO in o POINTER(st xax_,oPO R LLLL() isN_bcy���_��0!� Rup1�>s wibbs ut ry coEOis���aNaleach !ubdomain analogoulitny���_��0!� bs',-,---- t�ER is���y���_��0!�y���_��0!� - west : 1y���_��0!� - east : 2y���_��0!� - s::ah : 3y���_��0!� - norah : 4y���_��0!� - bottom: 5y���_��0!� - ---LLLL 6y���_��0!�y���_��0!� en � 1:i domin � Nal dom4 dex6ifacssoin 2 aEOF3 DyO in o0!� en � 2:othe globalosub idy���_��0!�y���_��0!� --btes:y���_��0!�y���_��0!� - value: 0othe facsNe i * n#���_�����!� - value: 1 o dorwis0yO in oG P NT(�� �_bLL() --------!� nup1�> --btus, 0 onqsicces�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om L � �!----able�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oREAL(e iskSE � oub��) L()t0yO in oLOGI�_� L()v---dENDIF iTYPE(bs',-,----),oPO R L()tc0 => NULL()_O in oG POINTER(st 2) L()ldayO in om--------------------------------------------------------gin � �! ChecWs�yO in om Ex* ����999 ie ---------------------------------------------------------gin � �! ChecWs�y_O in om--------------------------------------------------------gin � �! ChecWs�yO in om !-------se ���_���--------------------------------------------------------g---------------g ���_��----------b�i-----------get_dnecnpRETURN ie i_O in om--------------------------------------------------------gin � �! ChecWs�yO in om rgureec_imag�_�yO in om--------------------------------------------------------gin � �! ChecWs�yO in oGOTOpEN iebug sGT.!Tinfon= ���_����-----D ==�_9 ie issGOTO 9999 ie issENDIF issie iss-----G ------------------------------------------------------------ --gin � �! ChecWs�yO in om ropya domtc0 logy999 ie ---------------------------------------------------------gin � �! ChecWs�y_O in otc0 => bs',----iec0 ,)%t _���_��lda(1� = pEN in TTTTinflda(2� = ----%ot�l(numb�i Dn � ----,iopi, givee�,lda,ii_preserv��_m�gfiss������� ��IFDn � ----,iopi, ie is,lda,ii_preserv��_m�gfiss������� ��IFUBLO 9999 ie issE don_9 ie iss-silial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',-----get_dnecnpRE��(�� uår_s1)2 'fails.itnraag�_opol givee�,)m ie isOF elsssssGOTO 9999 ie issEgotnr issie issDyyyyy�����_lda(1� = pEN in *2�� ��IFDn � ----,iopi,I ON_bc,lea,ii_preserv��_m�gfiss������� ��IFUBLO 9999 ie issE don_9 ie iss-silial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',-----get_dnecnpRE��(�� uår_s1)2 'fails.itnraag�_opolI ON_bcOF elsssssGOTO 9999 ie issEgotnr issie issDyyyyy�����_lda(1� = ----%ot�l(numb�i Dn � ----,iopi, is2proc,lea,ii_preserv��_m�gfiss������� ��IFUBLO 9999 ie issE don_9 ie iss-silial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',-----get_dnecnpRE��(�� uår_s1)2 'fails.itnraag�_opolI O2procOF elsssssGOTO 9999 ie issEgotnr issie issDyyyyysie issot�l = ----%ot�l(numb�i GOTO----%prec�f_�e iskSE �singleinfon= ���_���� givee�����= ----% givee�s ���_���� ie is����= ----% ie isssie iss------------- givee�����= ----% givee�d ���_���� ie is����= ----% ie isd ���_��E----F i8888I ON_bc ����= ----% isN_bcy���_��I O2proc����= ----% is2procyG ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsanup1�> ���_���--------------------------------------------------------g---------------g �g �END�SUBRLE INE ----------op-----------get_dnecnpRETURN ie iE INE RETUR= ���_��END�AINS ���_��#if� �__KIND ==�_9 ie iss-�EN i.NOT�_----i-------z �--------------------s�����EOF else2s�������CALL#���_�����(�_���_argureet,'���_Nom'���noi---,----------get_dnecnpRE�� uår_s1)2 'Pleece Dn � ----i---ifirstEOF elsssssssssssGOTO 8888 in � ���������ENDIF in �FsENDIF i8888����-----bs',D ==�_ec0 ,Oec0 ,,v---dssssssGOTO 88ss-�EN i.NOT�_v---dinfon= ���_����-----s�����EOF else2s�������CALL#���_�����(�_���_argureet,'���_Nomc_imag�_tubs',-----get_dnecnpRE�� uår_s1)2 'Tc0 logy IDae i v---dEOF elsssssssssssGOTO 8888 in � ���������ENDIF in �FsENDIF ����(��_��ND�SUBRLE INE sEN #if� �__KIND ==�__SINGLE_PRECISION ie issEND�SUBRLE INE osEN #if� �__KINbs',-----get_dnecnp_s__DOUBLE_PRECISION ie issEND�SUBRLE INE osEN #if� �__KINbs',-----get_dnecnp_dyyyyyyyy�������������������������������������������������������������������������������������libbs'-1.2.1/src/----/tnst/�������������������������������������������������������������������������0000755�0001752�0001753�00000000000�11616003524�015704� 5����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/tnst/bs',modu��_mk----.fun����������������������������������������������������0000644�0001752�0001753�00000010162�11616003524�022150� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tnste iite bs',modu��_mk---- y__SIt�Em__MPI INE INCLUDE "mpif.h"yyyyyyyy * ger, reseretor :: iebug = 0- * ger, reseretor :: mk = kSE (1.0dssE!kSE (1.0e0) re#�(mk),reseretor :: pi = 3.1415926535897931_mk re#�(mk),reseretor :: sk�nl= 0._mk * ger,reseretor LL()oin =2 * ger,reseretor LL()pin =2 * ger :: ieecnp,assig,tolexp re#�(mk) :: tol re#�(mk) :: cutoffl= 0.05_mk * ger :: ssss,ecna,rank,nprocy * ger :: tc0 ,y * ger :: np = 100000y * ger :: mpy * ger :: newnp re#�(mk),d ag� �!! xax_,0 * e:: xp re#�(mk),d ag� �!! xtub,0 * e:: rcp re#�(mk),d ag� �!! xax_,0 * e:: wp re#�(mk),d ag� �!! xtub,0 * e:: givphys, iephys,h,p_h re#�(mk),d ag� �!! xtub,0 * e:: leivphys re#�(mk),d ag� �!! xtub,0 * e:: gh Silayer- * ger, d ag� �!! xtub,0 * e:: gh Si!�ze * ger :: s,j,k,sum1,sum2 * ger :: p_i- * ger, d ag� �!! 6) :: bcgin re#�(mk),d ag� �!! xtub,0 * e:: cost- * ger, d ag� �!! xtub,0 * e:: nm * ger :: syedl�ze * gerE��d ag� �!! x),aag�_opable :: syed re#�(mk),�d ag� �!! x),aag�_opable :: randnb * ger :: s-ymm = 0-logical :: l-ymm = .false.,ok re#�(mk) L()t0,t1,t2,t3G ----i--- ENDIF in u ombs',modu��_typeginy���_��n u ombs',modu��_i--- ���_��n ���_��n aag�_opo( givphys(oin ), iephys(oin ),leivphys(oin ),& ���_�����_ �år_s1)2 gh Si!�ze(oin ),gh Silayer(2*oin ),& ���_�����_ �år_s1)2 nm(oin ),h(oin ),p_h(oin ),--bt=sssssGOTO 8888--------- givphys(1:oin )l= 0.0_mk -------- iephys(1:oin )l= 1.0_mk --------leivphys(1:oin )l= iephys- givphys --------gh Si!�ze(1:oin )l= 2 --------gh Silayer(1:2*oin )l= cutoff --------bcgin(1:6� = pEN reservbcgin_perio icGOTO 8888---------nulOUBy(xp,rcp,wp)y__SIt�Em__MPI INE ecnal= pi_ecna_world ���_����Dn � pi_ecna_rank(ecna,rank,sssssGOTO 8888Dn � pi_ecna_!�ze(ecna,nproc,OTO 99_DOsenumb�i trank = 0---------nproc�= 1Tyyyyyyy�����_ �tolexp�= INT(LOG10(EPSILON(1._mk)))+10GOTO 8888Dn � ----i---(oin ,mk,tolexp,0,iebug,OTO ,99 i_O inyyy-i--- E_O infin---z y���_��n u ombs',modu��_fin---z yGOTO 8888Dn � ----fin---z (N ie i_O in o :dyelg�_opo( givphys, iephys,leivphys,gh Si!�ze,nm i_O inyyy-fin---z yG_O insetupyGOTO 8888Dn � randoa_!yed(!�ze=syedl�ze) ���_��n aag�_opo(!yed(!yedl�ze)) ���_��n do i=1,syedl�ze !yed(i)=10+i*i*(rank+1�---------yyydoGOTO 8888Dn � randoa_!yed(put=syed) ���_��n aag�_opo(randnb((1+oin )*np),--bt=sssssGOTO 8888Dn � randoa_numb�r(randnb) ���_��n aag�_opo(xp(oin ,np),rcp(np),wp(pin ,np),--bt=sssssG_O inyyy-setupy���_��n G_O inteardownGOTO 8888---------dyelg�_opo(xp,rcp,wp,--bt=sssssGOTO 8888dyelg�_opo(syed,randnb) _O inyyy-teardownG_O inteSimcub ,y���_�� omsteSimcub , ieecnposis���yENDIF in u ombs',modu��_typeginy���_��n u ombs',modu��_mk---- y���_�� omiss� �! ChecWs�yO in o omscre#te bil�an��sy���_�� omiss� �! ChecWs�yO in o oDn � randoa_numb�r(xp) y���_�� omiss� �! ChecWs�yO in o omsmakomtc0 logy999 ie omiss� �! ChecWs�yO in o oieecnpp_fii_preservdyecnp_cub ,y���_�� omieecnpp_fii_preservdyecnp_xpenci���_�����(assig--_fii_preserv�ssign_ * n#��y�����_ �to0 , = 0-yO in o88Dn � ----mk----Oec0 ,,xp,np,ieecnp,assig, givphys, iephys,bcgin, & ���_����år_s1)2 cutoff,cost,N ie i_O in o :As�b!t_Equ#�(OTO ,0) _O inyyy-testG_O inteSimxp_nulO_cub ,y���_��� bs' trac �anket #93 (https://bs'.OTO.ethz.ch/trac/�anket/93sGOTO 88u ombs',modu��_util_dbgi_O in o * ger L()m hid = -1i_O in odyelg�_opo(xpsGOTO 88xp�=>-nulO()_y�����_nal= 32 *-nproc_y�����_Dn � ----mk----Oec0 ,,)m hidE��(�� uuuuuuuuuuuuuuuuuuxp, 0,uuuuuuuuuuuuuu uuuuuuuuuuuuuuuuuuieecnp,(assig,uuuuuu uuuuuuuuuuuuuuuuuu givphys, iephys,u uuuuuuuuuuuuuuuuuubcgin, gh Si!�ze,uu uuuuuuuuuuuuuuuuuucost, NmGoOTO 99 uuAs�b!t_Equ#�(OTO , 0) _� ������Dn � ----dbg_pr *Oec0 ,,0.0_mk,1,1,sssssG_O inyyy-testG_ yyy-teste iitey��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/tnst/Makofile�����������������������������������������������������������������0000644�0001752�0001753�00000000320�11616003524�017337� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� TESTINC=-I../../../i-cludei-L../../../lib -lbs' sources=$(wildcard *.f) ---gets=$(pat----- %.f,%,$(sources)) n � : $(---gets) $(---gets) : $(sources) $(FC) $(OPTS) $< $(TESTINC) $(LDFLAGS) $(LIBS) -o $@ y����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',f EO_��_m�sf��������������������������������������������������������������0000644�0001752�0001753�00000061765�11616003524�020061� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------ ie iss ��! iss ��! ���_��0sa ub�::a��OF : bs',f EO_��_m� ------------------------------------------------------------ ie iss� �! ChecWs�yO in omsCopyrMK), (c) 2010 CSE Lab (-TH Zurich), MOSAIC G�::p (-TH Zurich), ���_��� �������������������Ce * e! rFluid Dynamics (DTU) ���_���hen dec0 ���_��� The ifile�e iient U domPil llel�Pil�an�� M hpL� �!!! (PPM)when dec0 ���_��� PPMNe if isssoftware: yourum�red , ributsti �st/dexmo if!hen dec0ti fbt�ra domtnrmnaNal domGNU Les�b!!GLic( aoPGER cpL�cense ���_��� a iiGER ,h �!byl domF issSoftware Fs ut p�!!, ei dor ���_��� ver �!!!3aNal domL�cense, dex(at your els���--any lator ���_��� ver �!!when dec0 ���_��� PPMNe id , ributs oin domhopeetdat�s!AL erfbF elsful, ���_��� but WITHOUT ANY WARRANTY; without even domimplaN owarrantyaNa ���_��� MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Se�F el ���_��� GNU GLic( aoPGER cpL�cense fdexmorss ntLilswhen dec0 ���_��� YourshouldOomcoreceivn ot copyaNal domGNU GLic( aoPGER cpL�cense ���_��� aEOF elsGNU Les�b!!GLic( aoPGER cpL�cense along with PPM. IBLelt, ���_��� se�F<http://www.gnu.org/l�censes/>when dec0 ���_��� Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� -TH ZurichyO in omsCH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g __SINGLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',f EO_��_m�_-( givphys, iephys,bcgin, & ���_�år_s1)2 givee�, ie is,ot�l(,o��_m�,i��_m�,i�O 99_DOUBLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',f EO_��_m�_d( givphys, iephys,bcgin, & ���_�år_s1)2 givee�, ie is,ot�l(,o��_m�,i��_m�,i�O 99���_���!� The i�::a��OFf EOF wib!!_m�bournaNalaosub domainwhen dec0!� I!Adoesetdat�by comienizaN domcoordinbtesaNal dohen dec0!� bs utizaNbo Nal domsub domain iusizaNum�N-squ#rohen dec0!� algorithm� MorsoverE�sizc�F wib�::a��OFe iDn � �!befdeohen dec0!� any mappizaNha ibeen perfdemed, *n �*l domsubs (ot�l(99���_���!� mu--fbF search ��y���_��0!�9���_���!� NOTE: Noisub isi issn otsia !!_m�borl U tself.y���_��0!�9���_���!� [NOTE] -------!� ======================================================================9���_���!� Thib!�deieffect U de i�::a��OFisetdat�thom iss�yO in o0!� ` givee�(:)` aEOF` ie is(:)` arssexteEdIOF oei-cludeyO in o0!� gh Simsub domain . The iisieltfssIOFbeyoEOF we i�::a��O.y���_��0!�9���_���!� Thom iss�etdat�arssbuilt coEtain uniqu� g�_ri n. ------�!� The imean�etdat�amsub um�occur at�m Simozc�Fin do ���_���!� !!_m�borlR , aNalaobil�anul-- o dormsub. The inyedl ���_���!� tnri�:taken in oeaccs u!ALhe!:doizaNperio icGOTO 880!� gh Sis.y���_��0!�9���_���!� The i�::a��OFuses cellm iss�eNal domsub ce * l ���_���!� fdexfast search. Thib!�zeaNal domcells isi do ���_���!� exteEt(1:3)aNal doml--geSimsub tdat�exiSis.y���_��0!� Thirefdeo:eUf we omcooneal--gemsub aEOF onsaNa ���_���!� smn � ones, de i�::a��OFL erfperfdem poorlywhen dec0!� (N**2oin domworSimcase). -------!� ======================================================================99_Dyyyyy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaModu��� ���_���--------------------------------------------------------g---------------g ������USINbs',modu��_t payO in oUSINbs',modu��_-----b�i ofbparUSINbs',modu��_-----op ofbparUSINbs',modu��_�����CALL#��USINbs',modu��_elg�_yO in oUSINbs',modu��_Dopy_imag e isssie issUSINbs',modu��_util_ranksie issUSINbs',modu��_!!_m� isssie issGMPLICIT NONE__SINGLE_PRECISION ie issEND�SUBRLE INE o PPARAMET L()MKl ie iskSE �single9_DOUBLE_PRECISION ie issEND�SUBRLE INE o PPARAMET L()MKl ie iskSE � oub��9_Dyyyyy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa!-cludeN999 ie ---------------------------------------------------------gin � �! ChecWs�y_SIt�Em__MPI INE INCLUDE 'mpif.h'9_Dyyyyy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_� in oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK) POINTER(st r) P NT(IN tubLL() givphys ------0!� MinwfexteEtaNal domphysical domainyO in oREAL(MK) POINTER(st r) P NT(IN tubLL() iephys ------0!� MaxwfexteEtaNal domphysical domainyO in o POINTER(st xtub,o NT(IN tubLL()bcgin ------0!� Bs ut ry coEOis���at�ER is���y���_��REAL(MK) POINTER(st rax_,oPO R LL()mgivee�y���_��0!� MinwfexteEtaNal domsub domainy���_��REAL(MK) POINTER(st rax_,oPO R LL()m ie isy���_��0!� MaxwfexteEtaNal domsub domainy���_�� POINTER(st xax_,oPO R LL() !_m� -------!� P *sunã wib`o��_m�O:)` subs U isy���_�� POINTER(st xtub,oPO R LL()n !_m� -------!� `o��_m�O is)` rup1�>s wibtotal numb�r -------!� U !!_m�bourizaNsubs U isy���_�� ,o NT(IN tubLL()ot�l(numb�i 0!� Tctal numb�r U (re#�)msub domain y���_�� ,o NT(�� �_bLL() --------!� nup1�>s --btus, 0 uponqsicces�y---------------------------------------------------------------gin � �! ChecWs�yO in om L � �!----able�oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK) POINTER(st pEN in ) L()b!�ze,leiv isy���_��REAL(MK) POINTER(st rax_,oPO R LL()ctrna=> NULL()_O in oREAL(MK) L()mx1,mx2,mx3_O in oREAL(MK) L()mn1,mn2,mn3y���_�� POINTER(st xtub,oPO R LL() isid => NULL()_O in oG POINTER(st xtub,oPO R LL()lhbx => NULL()_O in oG POINTER(st xtub,oPO R LL()lpdx => NULL()_O in oG POINTER(st xax_,oPO R LL() -LLL=> NULL()_O in oG POINTER(st xax_,oPO R LL()j -LLL=> NULL()_O in oG POINTER(st pEN in ) L() elsNmsNmtot_O in oG POINTER(st 2*pEN in ) L()Ngly���_�� L()ot�l(plu(,nnpy���_�� L()s,j, i,jj,k,kk,ielss�est ���_�� L()sbil�,jbil�,n1,n2,i * ���_�� L()s!�ze, p,jp,cbox,i--b�i ofbpar L()j--b�i,jest,iAL(,jAL( ���_�� L()sm(,jm(,kmx_O in oREAL(MK) L()t0yO in oLOGI�_� L()ssin,pbdrx,pbdry,pbdrzy---------------------------------------------------------------gin � �! ChecWs�yO in om Ex* ����oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa!-------seoy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o----------b�i------f EO_��_m�RETURN ie i_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Aag�_opol emoryffdex!ubdomain ID�y---------------------------------------------------------------gin � �! ChecWs�yO in oissIp_fii_preserv��_m�gfitoy�����_ldc(1� = ot�l(numb�i -----_arg,iopi, isid, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',f EO_��_m�RE�� �� uår_s1)2 'Sub IDso#ifIDOF elsssssssssssGOTO 8888 iNDIF issie iss-----Gie issy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa!-------z�F wibIDyO in o�--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,ot�l(numb�i ) isid(i) =_isie iss---DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Add gh Simdomain ifdex domperio ic systemy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o-----bs',Dopy_imag e iss( givphys, iephys,bcgin, & ���_�år_ givee�, ie is,ot�l(, isid,ot�l(plu(,������� ��IFEN ie iss � ii_preservsicces�inNDIF iss_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Aag�_opol emoryffdex wib!!_m�bournaNal wib!ubdomain�y---------------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�ggrowy�����_ldc(1� = ot�l(plu( numb�i -----_arg,iopi,n9�_m�, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',f EO_��_m�RE�� �� uår_s1)2 'Numb�raNal!!_m�borN NNEIGHOF elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa!-------z�F wibnumb�raNal!!_m�bournanã zeroyO in o�--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,ot�l(plu(numb�i too��_m�O ) = 0----------DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om AEOFaag�_opol domp * sunã wib!!_m�bourn_O in om--------------------------------------------------------gin � �! ChecWs�yO in oldc(1� = 26om gues�iza ���_��ldc(2� = ot�l(plu(numb�i -----_arg,iopi, 9�_m�, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',f EO_��_m�RE�� �� uår_s1)2 'L , aNal!!_m�borN INEIGHOF elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa!-------z�F wibn!_m�borlsub in ic nanã fbt�f Eet ���_���--------------------------------------------------------g---------------g ���_��DO i=1,ot�l(plu(numb�i to�DO j=1,ldc(1�--------------- 9�_m�Oj, � = pEN reservfbt�f Eet ���_��-------DOi---------DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Ial wire�arssles� tdan 2 subs wire�um�bibnol!!_m�borN_O in om--------------------------------------------------------gin � �! ChecWs�yO in oEN iosubs sLT.i2) ���������E_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Aag�_opol domce * ep * posis����y---------------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = pEN in TTTTinfldc(2� = ot�l(plu(numb�i -----_arg,iopi,ctrn, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',f EO_��_m�RE�� �� uår_s1)2 'Sub ce * ep *s CTRSOF elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa �_m�F wibce * ep *s aEOF elsmaxfexteEtaNalnny isy���_��0--------------------------------------------------------gin � �! ChecWs�yO in oGOTOpEN iim �f_�_3infon= ���_����--b!�ze(1:3)l= 0.0_MKnumb�i to�DO i=1,ot�l(plu(numb�i to�����ctrn(1,i) l= 0.5_MK*( givee�(1,iin+ ie is(1,i)�---------------ctrn(2,i) l= 0.5_MK*( givee�(2,iin+ ie is(2,i)�---------------ctrn(3,i) l= 0.5_MK*( givee�(3,iin+ ie is(3,i)�---------------leiv is(1� = ie is(1,i) - givee�(1,iin---------------leiv is(2� = ie is(2,i) - givee�(2,iin---------------leiv is(3� = ie is(3,i) - givee�(3,iin---------------GOTOleiv is(1�sGT.b!�ze(1))-b!�ze(1� = leiv is(1�---------------GOTOleiv is(2�sGT.b!�ze(2))-b!�ze(2� = leiv is(2�---------------GOTOleiv is(3�sGT.b!�ze(3))-b!�ze(3� = leiv is(3�--------------DOi---------------------b!�ze(1:2)l= 0.0_MKnumb�i to�DO i=1,ot�l(plu(numb�i to�����ctrn(1,i) = 0.5_MK*( givee�(1,iin+ ie is(1,i)�---------------ctrn(2,i) = 0.5_MK*( givee�(2,iin+ ie is(2,i)�---------------leiv is(1� = ie is(1,i) - givee�(1,iin---------------leiv is(2� = ie is(2,i) - givee�(2,iin---------------GOTOleiv is(1�sGT.b!�ze(1))-b!�ze(1� = leiv is(1�---------------GOTOleiv is(2�sGT.b!�ze(2))-b!�ze(2� = leiv is(2�--------------DOi-----------Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaDetorm��OFnumb�raNalcells ���_���--------------------------------------------------------g---------------g ���_��DO i=1,pEN in TTTTinfin omsnumb�raNalcells basIOFonot cells-z�F= cutoffn-----------NmO ) = INT(( iephys(i) - givphys(i))/b!�ze(i)�-----------msmakomat least oneaAL( ���_��----GOTONmO ) sLT.i1� NmO ) = 1-----------b!�ze( ) = ( iephys(i) - givphys(i))/REAL(NmO ),MK)i---------DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om NeIOFoneal-y�raNalgh Simcells. Even fdexnon-peroi ic systems asyO in omsao dorwis0F wibn!_m�borlcs u!Ain domtop-leftmcells isiwrong�yO in o---------------------------------------------------------gin � �! ChecWs�yO in oEN ipEN iim �f_�_3infon= ���_����--Ngl(1:3)l= 0 ���_����--Ngl(4:6� = 1-----------Nmtot(1� = NmO1in+ Ngl(1in+ Ngl(4)-----------Nmtot(2� = NmO2in+ Ngl(2in+ Ngl(5)-----------Nmtot(3� = NmO3in+ Ngl(3in+ Ngl(6)i---------------------Ngl(1:2)l= 0 ���_����--Ngl(3:4� = 1-----------Nmtot(1� = NmO1in+ Ngl(1in+ Ngl(3)-----------Nmtot(2� = NmO2in+ Ngl(2in+ Ngl(4)i-----------Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaBuildl domcell isssie iss---------------------------------------------------------gin � �! ChecWs�yO in oEN ipEN iim �f_�_3infon= ���_����--�_���_a Rutil_rank3d,ctrn,ot�l(plu(, givphys, iephys,NmsNgl,lpdxE�� uår_s1)2 lhbxssssssGOTO 88---------------�_���_a Rutil_rank2d,ctrn,ot�l(plu(, givphys, iephys,NmsNgl,lpdxE�� uår_s1)2 lhbxssssssGOTO 88-----Gie issEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_it�l_fails.tubs',f EO_��_m�RE�� �� uår_s1)2 'Fails.ibuildizaN domcellm iss�.OF elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaBuildlcell-cellmen � iss�yO in o0--------------------------------------------------------gin � �! ChecWs�yO in o�_���_a R!!_m� iss_MkN!_m�Idx(.TRU-.sssp,jsp,nsp,������� ��IFEN ie iss � Tinfon= ���_�����_�����EOF else2s�������CALL#���_���_���_a Roc,'���_Nomc_it�l_fails.tubs',f EO_��_m�RE�� uår_s1)2 'Fails.ibuildizaN domcell-cellm iss�.OF elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaSmco wibcurreEtaleadizaNd ag� �!!! U 9�_m�y---------------------------------------------------------------gin � �! ChecWs�yO in ois-z�F= SIZE, 9�_m�,1 i_O in om--------------------------------------------------------gin � �! ChecWs�yO in om SearchizaN dom!!_m�bournausizaN domcell isssie iss---------------------------------------------------------gin � �! ChecWs�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om TWOPOINTER(stSyO in om--------------------------------------------------------gin � �! ChecWs�yO in oEN ipEN iim�f_�2infon= ���_�����_n1 = Nmtot(1�-----------msloop overln � REALmcells (numb�rizaNisi0...n-1�-----------imx = Nmtot(1�-2-----------jmx = Nmtot(2�-2-----------DO j=0,jm(--------------------------------------------------------------------- ie iss ��! ���_����------- �rgureeUf we arssin abbs ut ry cell Nalaoberio ic facs. ���_����------- �The imean�etdat� wire�ouldObomperio ic imag saNal!ub(numb�i to�����- �tdat�we already omcoin domR , aaEOFweinyedanã D ==�_9 ie iss-�����- �fdexduplicbtesaLhe!:addizaN dosomsubs. ���_����------------------------------------------------------------ ie iss ��! ���_����------IF((j�f_�jm().AND.(bcgin(4)�f_�e isreservbcgin_perio ic))fon= ���_�����_ �_n---spbdry = .TRU-. ���_�����_ �_n--------------- �_n---spbdry = .FA---. ���_�����_ �_n-----F i8888��������DO i=0,im(-------------------IF((i�f_�im().AND.(bcgin(2)�f_�e isreservbcgin_perio ic))fon= ���_�����_ �_n---s---spbdrx = .TRU-. ���_�����_ �_n �_n--------------- �_n---s---spbdrx = .FA---. ���_�����_ �_n �_n-----F i8888������������� en � Nal domce * eAL( ���_��------------cbox =_in+ 1n+ n1*j! ���_�����_ �_-���_!sloop overln � box-box * acs����y------------------DO i * =1,onp----------- �_n---s---s!s ntorm��OFbox ic nafdex we i * acs���----------- �_n---s---sibox =_cbox+, 9p(1,i * )+n1* 9p(2,i * )�-----------------------jbox =_cbox+,j9p(1,i * )+n1*j9p(2,i * )�----------------------------------------------------------------------------- ie ----------- �_n---s---s!s Read ic naaEOFcgureeUf box s empty----------------------------------------------------------------------------- ie ----------- �_n---s---si--b�i = lhbx(ibox�-----------------------�est = lhbx(ibox+1�-1TTTTinfon= ���_________EN ieest sLT.ii--b�i) CYCL------------ �_n---s---s------------------------------------------------------ ie ----------- �_n---s---s!s Wi wen wibbsx tself8u om-ymmetry aEOFav , ----------- �_n---s---s!s addizaN do bil�an�� tself8 oeis�eNwn isssie iss---- �_n---s---s------------------------------------------------------ ie ----------- �_n---s---sEN iebsx �f_�_jboxinfon= ���_����-----sssssssssssssDO ibil�=i--b�is�est ���_��������������������������ipp_flpdx(ibil��-----------------------��������ii = isid(ip)y_SIt�Em__SXF90 !CDIR NODEPTyyyyyyy�����_ �����-----sssssssssssssDO jbil�=(ibil�+1�s�est ���_������������������������������jpp_flpdx(jbil��-----------------------������������jj = isid(jp)y_S-cludei"----/bs',f EO_��_m�e iss_2d.S-c"-----------------------��������---DOi------------------��������---DOi------------------����------------------------------------------------------ ie ----------- �_n---s---s!s Fdex wibo dormboxes cgureecerfpil�an��sy���_�� o----------����------------------------------------------------------ ie ----------- �_n---s---s--------------- �_n---s---s---s!sgetmp * sunã first aEOFlast bil�an�� ----------- �_n---s---s---sj--b�i = lhbx(jbox�--------------------------sjest = lhbx(jbox+1�-1TTTTinfon= ���_________---s!sskipp we i * eUf o dormbox s empty---------------------------EN ijest sLT.ij--b�i) CYCL------------ �_n---s---s---s!sloop overln � pil�an��s !�dei we icell ���_����-----sssssssssssssDO ibil�=i--b�is�est ���_��������������������������ipp_flpdx(ibil��-----------------------��������ii = isid(ip)y_SIt�Em__SXF90 !CDIR NODEPTyyyyyyy�����_ �����-----sssssssssssssDO jbil�=j--b�i,jest ���_������������������������������jpp_flpdx(jbil��-----------------------������������jj = isid(jp)y_S-cludei"----/bs',f EO_��_m�e iss_2d.S-c"-----------------------��������---DOi------------------��������---DOi------------------����--------����! ebsx �f_�_jbox ���_�����_ �_n �_n---DO ! i * ���_�� �_n �_n---DO ! i �� �_n �_n---DO ! ji_O in om--------------------------------------------------------gin � �! ChecWs�yO in om THREEPOINTER(stSyO in om--------------------------------------------------------gin � �! ChecWs�yO in o---------------n1 = Nmtot(1�-----------n2 = Nmtot(1�*Nmtot(2�-----------msloop overln � REALmcells (numb�rizaNisi0....n-1�-----------imx = Nmtot(1�-2-----------jmx = Nmtot(2�-2-----------kmx = Nmtot(3�-2-----------DO k=0,km(--------------------------------------------------------------------- ie iss ��! ���_����------- �rgureeUf we arssin abbs ut ry cell Nalaoberio ic facs. ���_����------- �The imean�etdat� wire�ouldObomperio ic imag saNal!ub(numb�i to�����- �tdat�we already omcoin domR , aaEOFweinyedanã D ==�_9 ie iss-�����- �fdexduplicbtesaLhe!:addizaN dosomsubs. ���_����------------------------------------------------------------ ie iss ��! ���_����------IF((k�f_�km().AND.(bcgin(6)�f_�e isreservbcgin_perio ic))fon= ���_�����_ �_n---spbdrz = .TRU-. ���_�����_ �_n--------------- �_n---spbdrz = .FA---. ���_�����_ �_n-----F i8888��������DO j=0,jm(-------------------IF((j�f_�jm().AND.(bcgin(4)�f_�e isreservbcgin_perio ic))fon= ���_�����_ �_n---s---spbdry = .TRU-. ���_�����_ �_n �_n--------------- �_n---s---spbdry = .FA---. ���_�����_ �_n �_n-----F i8888������������DO i=0,im(-----------------------IF((i�f_�im().AND.(bcgin(2)�f_�---- uår_s1)2 ---s---sp isreservbcgin_perio ic))fon= ���_�����_ �_n---s---s---spbdrx = .TRU-. ���_�����_ �_n �_n �_n--------------- �_n---s---s---spbdrx = .FA---. ���_�����_ �_n �_n �_n-----F i8888����������������� en � Nal domce * eAL( ���_��----------------cbox =_in+ 1n+ n1*j!+ n2*�_9 ie iss-�������������� loop overln � box-box * acs����y----------------------DO i * =1,onp----------- �_n---s---s����� ntorm��OFbox ic nafdex we i * acs���----------- �_n---s---sssssibox =_cbox+, 9p(1,i * )+n1* 9p(2,i * )+- uår_s1)2 ---s---ssssssssn2* 9p(3,i * )�---------------------------jbox =_cbox+,j9p(1,i * )+n1*j9p(2,i * )+- uår_s1)2 ---s---ssssssssn2*j9p(3,i * )�-------------------------------------------------------------------------------------------- �_n---s---s����� Read ic naaEOFcgureeUf box s empty-------------------------------------------------------------------------------------------- �_n---s---s����i--b�i = lhbx(ibox�-----------------------����iest = lhbx(ibox+1�-1TTTTinfon= ���_____________EN ieest sLT.ii--b�i) CYCL------------ �_n---s---s--------------------------------------------------------------------- �_n---s---s����!s Wi wen wibbsx tself8u om-ymmetry aEOFav , ----------- �_n---s---s����!s addizaN do bil�an�� tself8 oeis�eNwn isssie iss---- �_n---s---s--------------------------------------------------------------------- �_n---s---s����EN iebsx �f_�_jboxinfon= ���_����-----sssssssssssssssssDO ibil�=i--b�is�est ���_������������������������������ipp_flpdx(ibil��-----------------------������������ii = isid(ip)y_SIt�Em__SXF90 !CDIR NODEPTyyyyyyy�����_ �����-----sssssssssssssssssDO jbil�=(ibil�+1�s�est ���_����������������������������������jpp_flpdx(jbil��-----------------------����������������jj = isid(jp)y_S-cludei"----/bs',f EO_��_m�e iss_3d.S-c"-----------------------������������---DOi------------------������������---DOi------------------��������----------------------------------------------------------------- �_n---s---s����!s Fdex wibo dormboxes cgureecerfpil�an��sy���_�� o----------��������----------------------------------------------------------------- �_n---s---s����--------------- �_n---s---s---s����!sgetmp * sunã first aEOFlast bil�an�� ----------- �_n---s---s---sssssj--b�i = lhbx(jbox�--------------------------sssssjest = lhbx(jbox+1�-1TTTTinfon= ���_________---s����!sskipp we i * eUf o dormbox s empty-------------------------------EN ijest sLT.ij--b�i) CYCL------------ �_n---s---s---s����!sloop overln � pil�an��s !�dei we icell ���_����-----sssssssssssssssssDO ibil�=i--b�is�est ���_������������������������������ipp_flpdx(ibil��-----------------------������������ii = isid(ip)y_SIt�Em__SXF90 !CDIR NODEPTyyyyyyy�����_ �����-----sssssssssssssssssDO jbil�=j--b�i,jest ���_����������������������������������jpp_flpdx(jbil��-----------------------����������������jj = isid(jp)y_S-cludei"----/bs',f EO_��_m�e iss_3d.S-c"-----------------------������������---DOi------------------������������---DOi------------------��������--------����! ebsx �f_�_jbox ���_�����_ �_n �_n����---DO�_n �_n����! i * ���_�� �_n �_n����---DO�_n �_n��������! i ���_�� �_n �_n---DO ����! j �� �_n �_n---DO ����! �_9 ie i--------���� ����! pEN in T_O in om--------------------------------------------------------gin � �! ChecWs�yO in om F iss elsmemoryfagainy���_��---------------------------------------------------------gin � �! ChecWs�yO in oissIp_fii_preservdyelg�_yO in o-----_arg,iopi,ctrn, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',f EO_��_m�RE�� �� uår_s1)2 'Sub ce * ep *s CTRSOF elsssssssssssGOTO 8888 iNDIF issie iss----- numb�i -----_arg,iopi,lpdxE els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',f EO_��_m�RE�� �� uår_s1)2 'cell issmp * suLPDXOF elsssssssssssGOTO 8888 iNDIF issie iss----- numb�i -----_arg,iopi,lhbxs els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',f EO_��_m�RE�� �� uår_s1)2 'cell issmhead suLHBXOF elsssssssssssGOTO 8888 iNDIF issie iss----- numb�i -----_arg,iopi,ssp, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',f EO_��_m�RE�� �� uår_s1)2 'cell-cellmen* acsa�!!!en � INPOF elsssssssssssGOTO 8888 iNDIF issie iss----- numb�i -----_arg,iopi,jsp, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',f EO_��_m�RE�� �� uår_s1)2 'cell-cellmen* acs�!!!en � JNPOF elsssssssssssGOTO 8888 iNDIF issie iss----- nu����(issIp_fii_preservdyelg�_yO in o-----_arg,iopi, isid, els elss������� ��IFEN ie iss � ii_preservsicces�infon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',f EO_��_m�RE�� �� uår_s1)2 'Sub IDso#ifIDOF elsssssssssssGOTO 8888 iNDIF issie iss----- T_O in om--------------------------------------------------------gin � �! ChecWs�yO in om nup1�>sy�����_�--------------------------------------------------------gin � �! ChecWs�yO is CONTINUEyO in o----------op------f EO_��_m�RETURN ie iO in oRETURN__SINGLE_PRECISION ie issEND�SUBRLE INE o---o#if� �__KINbs',f EO_��_m�_-9_DOUBLE_PRECISION ie issEND�SUBRLE INE o---o#if� �__KINbs',f EO_��_m�_dTyyyyyyy�����������libbs'-1.2.1/src/----/bs',----_metis_s2psf����������������������������������������������������������0000644�0001752�0001753�00000111415�11616003524�020721� 0����������������������������������������������������������������������������������������������������u---- �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������O in om--------------------------------------------------------gin � �! ChecWs�yO in om ub�::a��OF : bs',----_metis_s2p_O in om--------------------------------------------------------gin � �! ChecWs�yO in om CopyrMK), (c) 2010 CSE Lab (-TH Zurich), MOSAIC G�::p (-TH Zurich), ���_��� �������������������Ce * e! rFluid Dynamics (DTU) ���_���hen dec0 ���_��� The ifile�e iient U domPil llel�Pil�an�� M hpL� �!!! (PPM)when dec0 ���_��� PPMNe if isssoftware: yourum�red , ributsti �st/dexmo if!hen dec0ti fbt�ra domtnrmnaNal domGNU Les�b!!GLic( aoPGER cpL�cense ���_��� a iiGER ,h �!byl domF issSoftware Fs ut p�!!, ei dor ���_��� ver �!!!3aNal domL�cense, dex(at your els���--any lator ���_��� ver �!!when dec0 ���_��� PPMNe id , ributs oin domhopeetdat�s!AL erfbF elsful, ���_��� but WITHOUT ANY WARRANTY; without even domimplaN owarrantyaNa ���_��� MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Se�F el ���_��� GNU GLic( aoPGER cpL�cense fdexmorss ntLilswhen dec0 ���_��� YourshouldOomcoreceivn ot copyaNal domGNU GLic( aoPGER cpL�cense ���_��� aEOF elsGNU Les�b!!GLic( aoPGER cpL�cense along with PPM. IBLelt, ���_��� se�F<http://www.gnu.org/l�censes/>when dec0 ���_��� Pil llel�Pil�an�� M hpL� �!!! (PPM) ���_��� -TH ZurichyO in om CH-8092 Zurich, Switzerl�st ���_���--------------------------------------------------------g---------------g __SINGLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',----_metis_s2p_-( givee�, ie is,o��_m�,i��_m�,E o uår_s1)2 ---cost,ot�l(,assig,t�l2proc,OsGER ,t,ot�lR ,t,i�O 99_DOUBLE_PRECISION ie issEND�SUBRLE INE o#if� �__KINbs',----_metis_s2p_d( givee�, ie is,o��_m�,i��_m�,E o uår_s1)2 ---cost,ot�l(,assig,t�l2proc,OsGER ,t,ot�lR ,t,i�O 99_Dyyyyy�����_�!� The i�::a��OF�ssignsl wib!ubdomain�unã wibproces�o l ���_���!� usizaN domMETIS grid pil�as���izaNl� �!!!.y���_��0!�9���_���!� [NOTE] -------!� Uses bs',myepnafdexre#� comienisonsain ort�ra --------!� dec�deiUBLtwoep *s am�F wibsame.�rguresN doso--------!� dec� �!!nausizaN domi��_m� iss.y���_��0!�9���_���!� Thomcoric( numb�rizaNisicurreEtly do�OFusizaNu full9���_���!� search. The iisii��fficieEtaaEOFshouldOmaybF bo--------!� replacN owith somexmorssn��verln gorithm.y���_��0!�9���_���!� [NOTE] -------!� CurreEtly,Fweimakomno8u omNallink (graph edge(99���_���!� weMK), a iwellma iecnaunicbt�!!!weMK),s (numb�raNa ���_���!� gh Simpil�an��s/m hep *s tdat�nyedanã bF sent ���_���!� fdexeach edgecut). ThireNe id�ER isely room fde ���_���!� improveag�_ hireNnã getmeven bettor loa�!bal�scing�yO in o---------------------------------------------------------gin � �! ChecWs�yO in omsaModu��� ���_���--------------------------------------------------------g---------------g ������USINbs',modu��_t payO in oUSINbs',modu��_-----b�i ofbparUSINbs',modu��_-----op ofbparUSINbs',modu��_�����CALL#��USINbs',modu��_elg�_yO in oUSINbs',modu��_writeyO in oGMPLICIT NONE__SINGLE_PRECISION ie issEND�SUBRLE INE o PPARAMET L()MKl ie iskSE �single9_DOUBLE_PRECISION ie issEND�SUBRLE INE o PPARAMET L()MKl ie iskSE � oub��9_Dyyyyy�����_�--------------------------------------------------------gin � ----------g ������msa!-cludeN999 ie ---------------------------------------------------------gin � �! ChecWs�y�����_�--------------------------------------------------------gin � ----------g ������msaA_imag�_� in oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK) POINTER(st rax_,o NT(IN tubLL() givee�y���_��0!� MinwfexteEtaNaln � !ubdomain�y------REAL(MK) POINTER(st rax_,o NT(IN tubLL() ie isy���_��0!� MaxwfexteEtaNaln � !ubdomain�y------REAL(MK) POINTER(st rtub,o NT(IN tubLL()cost -------!� Coss�eNaln � !ubdomain� (i.e.�sumeNalpil�an��/m henode)costsii� -------!� tdat�!ubdomain. Used fdexweMK),izaN dom�ssignag�_. INE o POINTER(st xtub,o NT(IN tubLL()n !_m� -------!� Twibnumb�raNal!!_m�bournaNalaosubdomainy���_�� POINTER(st xax_,o NT(IN tubLL() !_m� -------!� P * sunã wisib!!_m�bourn_O in o POINTER(st xtub,oPO R LL() is2proc -------!� Full issmNalproces�o affilibt�!!!Nal!ubdomain y���_�� POINTER(st xtub,oPO R LL()OsGER ,t -------!� L , aNal!ubdomain� �ssignedanã domR � �!proces�o l ���_�� ,o NT(IN tubLL()ot�l(numb�i 0!� Tctal numb�r U !ubdomain y���_�� ,o NT(IN tubLL()�ssigy���_��0!� METIS �ssignag�_ type.�OnomNa:y���_��0!�9���_���!� *fii_preserv�ssign_nodal_cut9���_���!� *fii_preserv�ssign_nodal_ccna9���_���!� *fii_preserv�ssign_dual_cut9���_���!� *fii_preserv�ssign_dual_ccna9���_�� ,o NT(�� �_bLL()nsGER ,t -------!� Twibnumb�raNal!ubdomain� �ssigned9���_�� ,o NT(�� �_bLL() --------!� nup1�>s --btus, 0 uponqsicces�y---------------------------------------------------------------gin � �! ChecWs�yO in om L � �!----able�oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o POINTER(st xtub,oPO R L()elm�_� i=> NULL()_O in oG POINTER(st xtub,oPO R L()nient i=> NULL()_O in oG POINTER(st xtub,oPO R L()nxadjt i=> NULL()_O in oG POINTER(st xtub,oPO R L()nadjncyi=> NULL()_O in oG POINTER(st xtub,oPO R L()vwgt ii=> NULL()_O in oG POINTER(st xtub,oPO R L()adjwgt => NULL()_O in oG POINTER(st xtub,oPO R L()vs-z�Ft => NULL()_O in oG POINTER(st xtub,oPO R L()votet ii=> NULL()_O in oG POINTER(st xax_,oPO R L()coric(no8=> NULL()_O in oREAL(MK) POINTER(st xaxax_,oPO R L()coric(ii=> NULL()_O in oREAL(e iskSE �single) POINTER(st r),oPO R L()tpwgt=> NULL()_O in oG POINTER(st 3) L() el_O in oG POINTER(st 1) L() ivote_O in oG POINTER(st 5) L() etis_els��� y���_�� L() elss� is,p *s,etypey���_�� L()nnodes,numtype,niens,edgecuty���_�� L()j,k,iy���_�� L()j is,jj,idg�_,nvert,wgflag,volmagyO in o-HARAC R(e ischar) L() esg_O in oREAL(MK) L()t0,lmyepn_O in oREAL(e iskSE � oub��) L() gisp, isp, ean�p ofbparLOGI�_� L() a-ymmy---------------------------------------------------------------gin � �! ChecWs�yO in om Ex* ����oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa!-------seoy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o----------b�i----------_metis_s2pRETURN ie i_SINGLE_PRECISION ie issEND�SUBRLE INE olmyepnl ie ismyepn-9_DOUBLE_PRECISION ie issEND�SUBRLE INE olmyepnl ie ismyepndTyyyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om E����iUBLMETIS l� �!!!---ppontisieltfavailabley---------------------------------------------------------------gin � �! ChecWs�y_SInt�Em__METISy------ilial ie iss � TC�����CALL#���_���_a Roc,'���_Nomc_inometis,---------_metis_s2pRE o uår_s'PPMNwa iecnpils.iwithout Metis---pponOF elsssssssssssGOTO 88nsGER ,tl= 0 ���_��NDIF isO in oy_DOseyy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_�y�����_�--------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_�����_���D ==�_9 ie issEN ie is s � TinNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaAag�_opol dom is2proc arrayy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = ot�l(numb�i -----_arg,iopi, is2proc, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(��WRITE ( esg,'(A,I10,A)') 'aag�_opizaN',ot�l(,'m is2procs fails.'��_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsargureeUf we only omcooneaproces�o , we arssdo�Oy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o N ipEN nproc �f_�_1infon= ���_����-�--------------------------------------------------------gin � �! Chec ���_����-�saAag�_opol domOsGER ,t arrayy�����_��-�--------------------------------------------------------gin � �! Chec ���_����-issIp--_fii_preserv��_m�gf-- ���_��_��ldc(1� = ot�l(numb�i i -----_arg,iopi,st�lR ,t, els elss������� ��IF IFEN ie is s � Tinfon= ���_����-- --ilial ie iss � TCALL#���_�����(�� ��WRITE ( esg,'(A,I10,A)') 'aag�_opizaN',ot�l(,'mOsGER ,t fails.'��_�����(�� ���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 esg, elsssssssssssGOTO 8888 i iNDIF issie iss _n-----F i8888����--------------------------------------------------------gin � �! Chec ���_����-�saAssignln � !ubdomain� nã wibproces�o aaEOFrup1�>F i8888����--------------------------------------------------------gin � �! Chec ���_����-nsGER ,tl= ot�l(numb�i i DO it�l=1,ot�l(numb�i ) --isGER ,tO is) =_i isy���_�������� is2procO is) =_bs',ranksie iss ��---DOi---------NDIF issie iss----- T_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Numb�raNalp *s perlsub aEOFeleag�_ type_O in om--------------------------------------------------------gin � �! ChecWs�yO in op *s = 8yO in oetype--_f3 ��� METIS type-hexahedrayO in o N ipEN iim �f_�_2infon= ���_�����_p *s = 4 ���_�����_etype--_f4 ��� METIS type-quadrilatorals ���_��-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaroric(i!ubdomain array�y---------------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = pEN in TTTTinfldc(2� = p *sTTTTinfldc(3� = ot�l(numb�i -----_arg,iopi,coric(, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 '!ubdomain coric(iR ,tlCORNEROF elsssssssssssGOTO 8888 iNDIF issie iss-----Gie issldc(1� = p *sTTTTinfldc(2� = ot�l(numb�i -----_arg,iopi,coric(no, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 '!ubdomain coric(inumb�rslCORNERNOOF elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsa!-------z�Fcoric(inumb�rsy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oDO it�l=1,ot�l(numb�i ) DO j=1,p *sTTTTinfffffffffcoric(noOj, is) =_0 ���_����-----DOi---------DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om �_m�Fsub coric(sain METIS numb�rizaNort�ry�����_�--------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iim �f_�_2infon= ���_�����_DO it�l=1,ot�l(numb�i ) --ffcoric((1,1, is) =_ givee�(1,i is)numb�i ) --ffcoric((2,1, is) =_ givee�(2,i is)numb�i ) --ffnumb�i ) --ffcoric((1,2, is) =_ givee�(1,i is)numb�i ) --ffcoric((2,2, is) =_ ie is(2,i is)numb�i ) --fnumb�i ) --ffcoric((1,3, is) =_ ie is(1,i is)numb�i ) --ffcoric((2,3, is) =_ ie is(2,i is)numb�i ) --numb�i ) --ffcoric((1,4, is) =_ ie is(1,i is)numb�i ) --ffcoric((2,4, is) =_ givee�(2,i is)numb�i ) ---DOi---------------------DO it�l=1,ot�l(numb�i ) --ffcoric((1,1, is) =_ givee�(1,i is)numb�i ) --ffcoric((2,1, is) =_ givee�(2,i is)numb�i ) --ffcoric((3,1, is) =_ ie is(3,i is)numb�i ) numb�i ) --ffcoric((1,2, is) =_ givee�(1,i is)numb�i ) --ffcoric((2,2, is) =_ ie is(2,i is)numb�i ) --ffcoric((3,2, is) =_ ie is(3,i is)numb�i )numb�i ) --ffcoric((1,3, is) =_ ie is(1,i is)numb�i ) --ffcoric((2,3, is) =_ ie is(2,i is)numb�i ) --ffcoric((3,3, is) =_ ie is(3,i is)numb�i numb�i ) --ffcoric((1,4, is) =_ ie is(1,i is)numb�i ) --ffcoric((2,4, is) =_ givee�(2,i is)numb�i ) --ffcoric((3,4, is) =_ ie is(3,i is)numb�i numb�i ) --ffcoric((1,5, is) =_ givee�(1,i is)numb�i ) --ffcoric((2,5, is) =_ givee�(2,i is)numb�i ) --ffcoric((3,5, is) =_ givee�(3,i is)numb�i numb�i ) --ffcoric((1,6, is) =_ givee�(1,i is)numb�i ) --ffcoric((2,6, is) =_ ie is(2,i is)numb�i ) --ffcoric((3,6, is) =_ givee�(3,i is)numb�inumb�i ) --ffcoric((1,7, is) =_ ie is(1,i is)numb�i ) --ffcoric((2,7, is) =_ ie is(2,i is)numb�i ) --ffcoric((3,7, is) =_ givee�(3,i is)numb�numb�i ) --ffcoric((1,8, is) =_ ie is(1,i is)numb�i ) --ffcoric((2,8, is) =_ givee�(2,i is)numb�i ) --ffcoric((3,8, is) =_ givee�(3,i is)numb�i ) ---DOi-----------Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaNumb�racoric(sawith samomp *ain space omcizaNsamomnumb�ry�����_�--------------------------------------------------------gin � �! ChecWs�yO in ocoric(noO1,1� = 1-------coric(noO2,1� = 2-------coric(noO3,1� = 3-------coric(noO4,1� = 4 ���_��nnodes = 4 ���_�� N ipEN iim �f_�_2infon= ���_�����DO it�l=2,ot�l(numb�i ) --DO j=1,p *sTTTTinfffffffff idg�_ =_0 ----------- �_n-�--------------------------------------------------------gin � �!----------- �_n-� rgureea � p *s Naln � !!_m�borN_O in o---- �_n-�--------------------------------------------------------gin � �!----------- �_n-DO k=1,o��_m�O is)numb�i ) --ffffffj is =_i��_m�Ok,i is)numb�i ) --ff) --DO jj=1,p *sTTTTinfffffffff - �_n-�--------------------------------------------------------giTTTTinfffffffff - �_n-� Ialp *s c c�de, s�_m�Fp *anumb�ry�����_ffffffff - �_n-�--------------------------------------------------------giTTTTinfffffffff - �_n-IF((ABS(coric((1,j, is)-coric((1,jj,j is))sLT.ioo uår_s1)2 ---s--lmyepn*( ie is(1,i is)- givee�(1,i is))).AND.o uår_s1)2 ---s--(ABS(coric((2,j, is)-coric((2,jj,j is))sLT.i uår_s1)2 ---s--lmyepn*( ie is(2,i is)- givee�(2,i is)))infon= ���_����-----sssssssssss N icoric(noOjj,j is) sGT. Tinidg�_ =_coric(noOjj,j is) ���_����-----ssssssss-----F i8888������������---DOi------------------DOi---------------�--------------------------------------------------------gin � �!----------- �_n-� Ialidg�_i� �!p *awa ifs ut() h�ri*anumb�r, DOsey---------- �_n-� creaselcs u!�raNald , ct nodes aEOFgetmnewanumb�ry�����_ffffffff �--------------------------------------------------------gin � �!----------- �_n-EN iedg�_ sGT. Tinfon= ���_���������������coric(noOj, is) =_edg�_i------------------------------ �_n---s-nnodes = nnodes + 1TTTTinfon= ���______coric(noOj, is) =_nnodesi--------------------F i8888������---DOi------------DOi--------------------coric(noO5,1� = 5----------coric(noO6,1� = 6----------coric(noO7,1� = 7----------coric(noO8,1� = 8----------nnodes = 8----------DO it�l=2,ot�l(numb�i ) --DO j=1,p *sTTTTinfffffffff idg�_ =_0----------- �_n-�--------------------------------------------------------gin � �!----------- �_n-� rgureea � p *s Naln � !!_m�borN_O in o---- �_n-�--------------------------------------------------------gin � �!----------- �_n-DO k=1,o��_m�O is)numb�i j is =_i��_m�Ok,i is)numb�i ) --ff) --DO jj=1,p *sTTTTinfffffffff - �_n-�--------------------------------------------------------giTTTTinfffffffff - �_n-� Ialp *s c c�de, s�_m�Fp *anumb�ry�����_ffffffff - �_n-�--------------------------------------------------------giTTTTinfffffffff - �_n-IF((ABS(coric((1,j, is)-coric((1,jj,j is))sLT.ioo uår_s1)2 ---s--lmyepn*( ie is(1,i is)- givee�(1,i is))).AND.o uår_s1)2 ---s--(ABS(coric((2,j, is)-coric((2,jj,j is))sLT.ioo uår_s1)2 ---s--lmyepn*( ie is(2,i is)- givee�(2,i is))).AND.o uår_s1)2 ---s--(ABS(coric((3,j, is)-coric((3,jj,j is))sLT.ioo uår_s1)2 ---s--lmyepn*( ie is(3,i is)- givee�(3,i is)))infon= ���_����-----sssssssssss N icoric(noOjj,j is) sGT. Tinidg�_ =_coric(noOjj,j is) ���_����-----ssssssss-----F i8888������������---DOi------------------DOi---------------�--------------------------------------------------------gin � �!----------------� Ialidg�_i� �!p *awa ifs ut() h�ri*anumb�r, DOsey---------- �_n-� creaselcs u!�raNald , ct nodes aEOFgetmnewanumb�ry�����_ffffffff �--------------------------------------------------------gin � �!----------- �_n-EN iedg�_ sGT. Tinfon= ���_���������������coric(noOj, is) =_edg�_i------------------------------ �_n---s-nnodes = nnodes + 1TTTTinfon= ���______coric(noOj, is) =_nnodesi--------------------F i8888������---DOi------------DOi-----------Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaSmnity�D ==�_9 ie i�--------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_���� o N iMAXVALicoric(no) s � nnodes .OR. MINVALicoric(no) s � 1infon= ���_����------ilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_inode_numb�r,ubs',----_metis_s2pRE uår_s1)2 -'Nodes wireNmissIOForlcs u!edanwiceOF elsssssssssssGOTO 8888 iiiiiNDIF issie iss _n------F i8888-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaDeaag�_opolcoric(iR ,ty�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preservdyelg�_yO in o-----_arg,iopi,coric(, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooo uår_s1)2 '!ubdomain coric(iR ,tlCORNEROF elsssssssssssGOTO 88-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsargureeUf we nyedaa-ymmetric pil�as���s dexnoty�����_�--------------------------------------------------------gin � �! ChecWs�yO in o gispl iMINVALiii_prroc_spyed(0:pEN nproc-1)�------- ispl iMAXVALiii_prroc_spyed(0:pEN nproc-1)�------- ean�p = 1.0_e iskSE � oub��/REAL(e isnproc,e iskSE � oub��)------- ean�p = (ABS( isp- gisp))/ ean�p ofbpar a-ymm = .FA---. ���_��� if� wire�e imom�F wan 5 perce *ld ffirence, doeis �� ��IFEN i ean�p sGT. T.05_e iskSE � oub��)r a-ymm = .TRU-. yO in o N ipEN iebug sGT. Tinfon= ���_���� oWRITE( esg,'(A,F7.4)') 'SloweSimproces�o : ', gisp��_�����(���_���_a Rwrite(bs',ranktubs',----_metis_s2pRE esg,sssssGOTO 8888 iWRITE( esg,'(A,F7.4)') 'FasteSimproces�o : ', isp��_�����(���_���_a Rwrite(bs',ranktubs',----_metis_s2pRE esg,sssssGOTO 8888 iWRITE( esg,'(A,F7.4)') 'Proces�o aspyed imbal�sce: ', ean�p ofbpar�(���_���_a Rwrite(bs',ranktubs',----_metis_s2pRE esg,sssssGOTO 8888 i N i a-ymminfon= ���_����-----�_���_a Rwrite(bs',ranktubs',----_metis_s2pRE uår_s1)2 'DoizaNu-ymmetric �ssignag�_',sssssGOTO 8888 i--------------- �_�_���_a Rwrite(bs',ranktubs',----_metis_s2pRE uår_s1)2 'DoizaN-ymmetric �ssignag�_',sssssGOTO 8888 i-----F i8888-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaNumb�raNalvertic nain domgraph_9 ie i�--------------------------------------------------------gin � �! ChecWs�yO in o N i�ssig �f_�_ii_preserv�ssign_nodal_cut .OR. oo uår_s�ssig �f_�_ii_preserv�ssign_nodal_comminfon= ���_����--nvert =_nnodesi---------------------nvert =_nt�l(numb�i -----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaNumb�raNaldesired graph pil�as���sy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oniens--_fii_pnprocGy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaAag�_opolMETIS m het pa arrayy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = ot�l(*p *sTTTTinf-----_arg,iopi,elm�_�, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS m het pa array---MNTSOF elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��ldc(1� = overtTTTTinf-----_arg,iopi,nien, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS node)pil�as���lvecto aNODEPARTOF elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��-----_arg,iopi,vwg, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS vertex weMK), vecto aVWGTOF elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��ldc(1� = 1 ���_��-----_arg,iopi,adjwg, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS vertex weMK), vecto aADJWGTOF elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��-----_arg,iopi,vs-z�, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS vertex weMK), vecto aVSIZEOF elsssssssssssGOTO 8888 iNDIF issie iss----- ��� ���NULLIFY,adjwg) !Fweimakomno8u omNallink weMK),s ��� ���NULLIFY,vs-z�) !Fweimakomno8u omNalecnaunicbt�!!!weMK),s ���_��ldc(1� = overt+1 ���_��-----_arg,iopi,nxadj, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS graph structure array-NXADJOF elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��ldc(1� = 6*overtTTTTinf N ipEN iim �f_�_2inldc(1� = 4*overtTTTTinf-----_arg,iopi,nadjncy, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS graph adjace cy array-NADJNCYOF elsssssssssssGOTO 8888 iNDIF issie iss----- ���_�� N i a-ymminfon= ���_����-ldc(1� = oiens ���_����------_arg,iopi,tpwg, els elss������� ��IF IFEN ie is s � Tinfon= ���_����-- --ilial ie iss � TCALL#���_�����(�� ���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE oooooooo uår_s1)2 'METIS pil�as���lweMK),s TPWGTOF elsssssssssssGOTO 8888 i8 iNDIF issie iss i-----F i8888-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaF erfMETIS m het pa structurey�����_�--------------------------------------------------------gin � �! ChecWs�y_SIt�Em__VECTORy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaFor lozaNvecto alength() ic(iRoop is overlt�l(numb�i �--------------------------------------------------------gin � �! ChecWs�yO in oDO j=1,p *sTTTTinfffffDO it�l=1,ot�l(numb�i ) --ffelm�_�(O is-1)*p *s+j) =_coric(noOj,i is)numb�i ) ---DOi---------DOi#DOsey------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFor memoryf, ride() ic(iRoop is overlp *sTTTTinf�--------------------------------------------------------gin � �! ChecWs�yO in oDO it�l=1,ot�l(numb�i ) DO j=1,p *sTTTTinfffffffffelm�_�(O is-1)*p *s+j) =_coric(noOj,i is)numb�i ) ---DOi---------DOi#Dyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om �_m�Fpil�as���lweMK),s fdexMETIS if nyedet ���_���--------------------------------------------------------g---------------g ���_�� N i a-ymminfon= ���_����-DO i=1,oiens ���_����----tpwg(i) =_REAL(e isrroc_spyed(i-1),e iskSE �single)sie iss i---DO F i8888-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaConvert m henã graph usizaNMETISy------�--------------------------------------------------------gin � �! ChecWs�yO in omsu omFrotran numb�rizaN(--b�iizaNfrom 1�-------numtype = 1 ���_�� N i�ssig �f_�_ii_preserv�ssign_nodal_cut .OR. oo uår_s�ssig �f_�_ii_preserv�ssign_nodal_comminfon= ���_����-�_���METIS_M hToNodal(ot�l(,nnodes,elm�_�,etype,numtype,nxadj,oo uår_s1)nadjncy) ----------wgflag = 2 !FweMK),s ��lvertic naonly /iecnput.FweMK),s ��ly ���_����-DO i=1,overtTTTTinfffffffvwg(i) =_0-------------DOi---------DO i=1,ot�l(numb�i ) --DO j=1,p *sTTTTinfffffffff !iecnputbt�!!!weMK),s ���_��infffffffvwg(coric(noOj,i)) =_vwg(coric(noOj,i)) +� (cost(i)sGOTO 8888 i8 ---DOi------------DOi---------- N i�ssig �f_�_ii_preserv�ssign_dual_cut .OR. oo uår_sr_s�ssig �f_�_ii_preserv�ssign_dual_ccnainfon= ���_����-�_���METIS_M hToDual(ot�l(,nnodes,elm�_�,etype,numtype,nxadj,oo uår_s1)nadjncy)----------wgflag = 2 !FweMK),s ��lvertic naonly /iecnput.FweMK),s ��ly ���_����-DO i=1,ot�l(numb�i ) --!iecnputbt�!!!weMK),s ���_��inffffvwg(i) =_ (cost(i)sGOTO 8888 ---DOi--------------------ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_im_imag�_tubs',----_metis_s2pRE uår_s1)'UnknNwn METIS �ssignag�_ scheme.�BailizaNout.OF elsssssssssssGOTO 8888 NDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaPil�as���lgraph *ooniens-iens-usizaNMETIS aEOF elsminim#���_����msaedgecut objectivOy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o N i�ssig �f_�_ii_preserv�ssign_nodal_cut .OR. oo uår_s�ssig �f_�_ii_preserv�ssign_dual_cutinfon= ���_����- N iniens-.L� 8infon= ���_����-- -�--------------------------------------------------------gin � �! Cnumb�i ) --!i UseorecursivOln gorithm sizcsti rroduc nabettor pil�as���sy�����_��-- -�--------------------------------------------------------gin � �! Cnumb�i ) -- etis_els��� (1� = 1omsu omu or-set valuesi------------ etis_els��� (2� = 3�� sor!edaheavy-edge matchizai------------ etis_els��� (3� = 1omsreg���lgrowizaNpreproces�izai------------ etis_els��� (4� = 1omsbs ut ryfr�ER eag�_ postproces�izai------------ etis_els��� (5) =_0omsno iebuggizai------------ N i a-ymminfon= ���_����-----�-�_���METIS_WPil�GraphRecursivO(nvert,nxadj,nadjncy,vwg,adjwg, uår_s1)2 wgflag,numtype,niens,tpwg, etis_els��� ,edgecut,niensGOTO 8888 i8 --------------- �_n-�_���METIS_Pil�GraphRecursivO(nvert,nxadj,nadjncy,vwg,adjwg, uår_s1)2 wgflag,numtype,niens, etis_els��� ,edgecut,niensGOTO 8888 i8 -----F i8888���--------------- ��--------------------------------------------------------gin � �! Cnumb�i ) --!i Useomulti��velln gorithm sizcsti e ifastery�����_��-- -�--------------------------------------------------------gin � �! Cnumb�i ) -- etis_els��� (1� = 1omsu omu or-set valuesi------------ etis_els��� (2� = 3�� sor!edaheavy-edge matchizai------------ etis_els��� (3� = 1omsi-------z�Fwith recursivOlbisecs�!!i------------ etis_els��� (4� = 3�� minim-z�Fco icctivityaNa !ubdomain y���_��------ etis_els��� (5) =_0omsno iebuggizai------------ N i a-ymminfon= ���_����-----�-�_���METIS_WPil�GraphKway(nvert,nxadj,nadjncy,vwg,adjwg, oo uår_s1)2 wgflag,numtype,niens,tpwg, etis_els��� ,edgecut,niensGOTO 8888 i8 --------------- �_n-�_���METIS_Pil�GraphKway(nvert,nxadj,nadjncy,vwg,adjwg, oo uår_s1)2 wgflag,numtype,niens, etis_els��� ,edgecut,niensGOTO 8888 i8 -----F i8888���-----Gy�����_ ���--------------------------------------------------------gin � �! Chec ���_����-�saOutput diagnosticsy�����_ ���--------------------------------------------------------gin � �! Chec ���_����-�segdecut isl wibnumb�raNalm heedge( tdat�hanabeen cut byl do ���_����-�spil�as���. ---------- N ipEN iebug sGT. Tinfon= ���_���� o iWRITE( esg,'(A,I6)') 'METIS rup1�>edaedgecut = ',edgecuty���_��- �_n-�_���_a Rwrite(bs',ranktubs',----_metis_s2pRE esg,sssssGOTO 8888 -----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaPil�as���lgraph *ooniens-iens-usizaNMETIS aEOF elsminim#���_����msaecnaunicbt�!!!volmag objectivOy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o---- N i�ssig �f_�_ii_preserv�ssign_nodal_comm .OR. oo uår_sr_s�ssig �f_�_ii_preserv�ssign_dual_ccnainfon= ���_����-�--------------------------------------------------------gin � �! Chec ���_����-�saFor we iobjectivONMETIS only omsl wibmulti��velln gorithm ���_����-�--------------------------------------------------------gin � �! Chec ���_����- etis_els��� (1� = 1omsu omu or-set valuesi--------- etis_els��� (2� = 3�� sor!edaheavy-edge matchizai--------- etis_els��� (3� = 1omsi-------z�Fwith recursivOlbisecs�!!i--------- etis_els��� (4� = 3�� minim-z�Fco icctivityaNa !ubdomain y���_��--- etis_els��� (5) =_0omsno iebuggizai--------- N i a-ymminfon= ���_����----�_���METIS_WPil�GraphVKway(nvert,nxadj,nadjncy,vwg,vs-z�, oo uår_sr_s wgflag,numtype,niens,tpwg, etis_els��� ,volmag,niensGOTO 8888 --------------- ��_���METIS_Pil�GraphVKway(nvert,nxadj,nadjncy,vwg,vs-z�, oo uår_sr_s wgflag,numtype,niens, etis_els��� ,volmag,niensGOTO 8888 -----Gy�����_ ���--------------------------------------------------------gin � �! Chec ���_����-�saOutput diagnosticsy�����_ ���--------------------------------------------------------gin � �! Chec ���_����-�segdecut isl wibnumb�raNalm heedge( tdat�hanabeen cut byl do ���_����-�spil�as���. ---------- N ipEN iebug sGT. Tinfon= ���_���� o iWRITE( esg,'(A,I6)') 'METIS rup1�>edaecnaunicbt�!!!volmag = ',volmagyO in o---- ��_���_a Rwrite(bs',ranktubs',----_metis_s2pRE esg,sssssGOTO 8888 -----G 8888 --------------ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_im_imag�_tubs',----_metis_s2pRE uår_s1)'UnknNwn METIS �ssignag�_ scheme.�BailizaNout.OF elsssssssssssGOTO 8888 NDIF issie iss-----Gy�����_�-----------------------------------------------------------gin � �! Chec ���_��msaF EOFsubs2proc assignag�_ basIOFo�lgraph decomposis�!!i------�--------------------------------------------------------gin � �! ChecWs�yO in o N i�ssig �f_�_ii_preserv�ssign_nodal_cut .OR. oo uår_s�ssig �f_�_ii_preserv�ssign_nodal_comminfon= ���_����-! a vertex isla m henode: takoma majority)votetNaln � coric(saNa ���_����-! a is to ietnrm��OFis-iroces�o affilibt�!! ���_����-ldc(1� = oiens ���_����------_arg,iopi,vote, els elss������� ��IF IFEN ie is s � Tinfon= ���_����-- --ilial ie iss � TCALL#���_�����(�� ���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE oooooooo uår_s1)2 'majority)votetcs u! VOTEOF elsssssssssssGOTO 8888 i88 NDIF issie iss 8 -----F i8888���DO i=1,ot�l(numb�i ) --vote(1:oiens) =_0 ���_����----DO j=1,p *sTTTTinfffffffff !i wibproces�o a we inode)wa i�ssignedanã TTTTinfffffffff jj = oien(coric(noOj,i)) ���_��infffffffvote(jj) =_vote(jj) + 1TTTTinfon= ��---DOi------------! majority)votetNaln � coric(saNaa we isisy���_�������� ivotel iMAXLOC,vote) ���_��inffffsis2procO ) =_ ivote(1)-1��� MPI ranks --brt at�0-------------DOi---------- N i�ssig �f_�_ii_preserv�ssign_dual_cut .OR. oo uår_sr_s�ssig �f_�_ii_preserv�ssign_dual_ccnainfon= ���_����-! a graph vertex isla sisy���_�����DO i=1,ot�l(numb�i ) --sis2procO ) =_oien(i)-1����� MPI ranks --brt at�0-------------DOi--------------------ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_im_imag�_tubs',----_metis_s2pRE uår_s1)'UnknNwn METIS �ssignag�_ scheme.�BailizaNout.OF elsssssssssssGOTO 8888 NDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaDeaag�_opolMETIS work memoryy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preservdyelg�_yO in o N i a-ymminfon= ���_����------_arg,iopi,tpwg, els elss������� ��IF IFEN ie is s � Tinfon= ���_����-- --ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE oooooooo uår_s1)2 'METIS graph adjace cy array-TPWGTOF elsssssssssssGOTO 8888 -----F i8888-----G_����------_arg,iopi,nadjncy, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS graph adjace cy array-NADJNCYOF elsssssssssssGOTO 88-----G_����------_arg,iopi,nxadj, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS graph structure array-NXADJOF elsssssssssssGOTO 88----- ���_��-----_arg,iopi,vs-z�, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS graph structure array-VSIZEOF elsssssssssssGOTO 88----- ���_��-----_arg,iopi,adjwg, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS graph structure array-ADJWGTOF elsssssssssssGOTO 88----- ���_��-----_arg,iopi,vwg, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS vertex weMK), vecto aVWGTOF elsssssssssssGOTO 88-----G_����------_arg,iopi,nien, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS node)pil�as���lvecto aNODEPARTOF elsssssssssssGOTO 88-----G_����------_arg,iopi,elm�_�, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 'METIS m het pa array---MNTSOF elsssssssssssGOTO 88-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaDeaag�_opolcoric(inumb�rsy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preservdyelg�_yO in o-----_arg,iopi,coric(no, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_idyelg�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 '!ubdomain coric(inumb�rslCORNERNOOF elsssssssssssGOTO 88-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCou *anumb�raNa !ub i�ssignedanã R � �!proces�o y�����_�--------------------------------------------------------gin � �! ChecWs�yO in onsGER ,tl= 0 ���_��DO it�l=1,ot�l(numb�i ) EN isis2procO is) �f_�_ii_prank)-nsGER ,tl= ot�lR ,tl+ 1TTTTinf---DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Aag�_opol domOsGER ,t arrayy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = ot�lR ,ty�����_-----_arg,iopi,st�lR ,t, els elss������� ��IFEN ie is s � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(��WRITE ( esg,'(A,I10,A)') 'aag�_opizaN',ot�lR ,t,'mOsGER ,t fails.'��_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_metis_s2pRE ooooooooooo uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaF erf issmNalR � �!t�l(numb�i �--------------------------------------------------------gin � �! ChecWs�yO in onsGER ,tl= 0 ���_��DO it�l=1,ot�l(numb�i ) EN isis2procO is) �f_�_ii_prank)-fon= ���_����-----�nsGER ,tl= ot�lR ,tl+ 1TTTTinf�_����--it�lR ,t(ot�lR ,t) =_i isy���_������-----F i8888---DOi#Dyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om Rup1�>F i8888---------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(-------------_metis_s2pRETURN ie i�����_RETUR= ���_��CONTAINSy------SUBROUTINE�D ==�_9 ie iss- N in!ub i.L� Tinfon= ���_����-- --ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_metis_s2pRE uår_s1))))))'n!ub imu,tlbe > 0OF elsssssssssssGOTO 8888 i88NDIF 8888GOTO 8888 -----F i8888 o N i�ssig � � ii_preserv�ssign_nodal_cut .AND.o uår_s1))�ssig � � ii_preserv�ssign_nodal_comm .AND.o uår_s1)2�ssig � � ii_preserv�ssign_dual_cut .AND.o uår_s1)2�ssig � � ii_preserv�ssign_dual_comminfon= ���_����-- --ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_metis_s2pRE uår_s1))))))'Invalid �ssignag�_ type fdexMETIS passIOOF elsssssssssssGOTO 8888 i88NDIF 8888GOTO 8888 -----F i8888 oDO it�l=1,ot�l(numb�i ) --f N in��_m�O is) sLT.iTinfon= ���_�������������ilial ie iss � TC�����CALL#���_����������_���_a Roc,'���_Nomc_im_imag�_tubs',----_metis_s2pRE uår_s1))))))))))'n��_m�imu,tlbe >=_0ofdexn � !ubsOF elsssssssssssGOTO 8888 iiiii88NDIF 8888GOTO 8888 888 -----F i8888 o --f N icost(i is) sLT.iTinfon= ���_�������������ilial ie iss � TC�����CALL#���_����������_���_a Roc,'���_Nomc_im_imag�_tubs',----_metis_s2pRE uår_s1))))))))))'costsimu,tlbe >=_0ofdexn � !ubsOF elsssssssssssGOTO 8888 iiiii88NDIF 8888GOTO 8888 888 -----F i8888 o---DOi-8888�����ONTINUEy�����_----SUBROUTINE�D ==�__SINGLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_metis_s2p_-9_DOUBLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_metis_s2p_dTyyyyyyy���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_copy.f���������������������������������������������������������������0000644�0001752�0001753�00000033604�11616003524�017771� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o---------------------------------------------------------gin � �! ChecWs�yO in om ubrout��OF :ALL#���_��������� bs',----_copyy---------------------------------------------------------------gin � �! ChecWs�yO in om CopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in om CH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy------SUBROUTINE�bs',----_copy( *opo,out*opo,sssssGOTO 88!!! Twe irout��OFcopiesl wibmemb�rastructuresNfrom onea*opologyGOTO 88!!! objectanã anotwiroone. Twibprevious c u!� *s Nalout*opo w erGOTO 88!!! bssdestroyed. Twe ialso aag�_oposlout*opo.GOTO 88!!!GOTO 88!!! [WARNe i]GOTO 88!!! Twe irout��OFe inotanestedyy---------------------------------------------------------------gin � �! ChecWs�yO in om Modulosly---------------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_elg�_yO in oUSE�bs',modulo_typedefyO in oUSE�bs',modulo_t---_elg�_yO in o MPLICIT NONEy---------------------------------------------------------------gin � �! ChecWs�yO in om Includesi---------------------------------------------------------------gin � �! ChecWs�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om A_imag�_s in oyO in om--------------------------------------------------------gin � �! ChecWs�yO in oTYPE��_Not_t---) ,_ ENT(IN ) :: *opoGOTO 88!!! Input *opologyGOTO 88TYPE��_Not_t---) ,_ ENT( OUT) :: out*opoGOTO 88!!! Output *opology. Wi � contain domsamomt pa as *opo upon rup1�>.GOTO 88 EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�>s --btus,_0oupon succes�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om L � �!variablosly---------------------------------------------------------------gin � �! ChecWs�yO in oREAL(e iskSE � oub��)r :: t0GOTO 88 EGER :: ot�l(,nt�lR ,t,max��_m�,prec,i,j, elsGOTO 88LOGICAL :: validGOTO 88 EGER, DIMENBRLE(1� :: ldcyO in om--------------------------------------------------------gin � �! ChecWs�yO in om Extornalsly---------------------------------------------------------------gin � �! ChecWs�yO in oy---------------------------------------------------------------gin � �! ChecWs�yO in om In------seoy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',----_copyRETURN ie iy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_����-----D ==�_9 ie issEN ie is s � TinNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaDetnrm��OFs-z� Nal *opoGOTO 88!--------------------------------------------------------gin � �! ChecWs�yO in on!ub i =_i�*opo%ot�l(numb�i nsGER ,tl= i�*opo%ot�lR ,ty�����_max��_m�l= SIZE( *opo%i��_m�t�l(,1�-------prec i =_i�*opo%prec i_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Aag�_opolresult *opologyGOTO 88�--------------------------------------------------------gin � �! ChecWs�yO in o-----bs',----_,iopi,out*opo%ID,ot�l(,nt�lR ,t,max��_m�,prec,i������ ��IFEN ie is s � ii_preservsucces�infon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_copyRE��(�� uår_s1)2 'result *opology OUTTOPOOF elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCopy doms� �arbmemb�rsy---------------------------------------------------------------gin � �! ChecWs�yO in oout*opo%IDOTO 8888 i=_i�*opo%IDyO in oout*opo%prec i =_i�*opo%precyO in oout*opo%n!ub i =_i�*opo%ot�l(numb�i out*opo%n!ubR ,tl =_i�*opo%ot�lR ,ty�����_out*opo%n��_m�proc =_i�*opo%o��_m�procy�����_out*opo%isels�m-z�d =_i�*opo%isels�m-z�dy�����_out*opo%ncommseql =_i�*opo%ocommseqy�����_out*opo% iem hid =_i�*opo% iem hidyO in oy---------------------------------------------------------------gin � �! ChecWs�yO in om Copy dombs ut ryfcondas���sy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,2*pEN iim ���_����-_out*opo%bcdefO ) =_i�*opo%bcdefO )sie iss---DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Copy domdomainy---------------------------------------------------------------gin � �! ChecWs�yO in o N iprec �f_�_ii_pkSE �single)nfon= ���_���� o N ipEN iim �f_�_2infon= ���_���������_out*opo% in_phys (1� = i�*opo% in_phys (1� ���_���������_out*opo% in_phys (2� = i�*opo% in_phys (2� ���_���������_out*opo% iephys (1� = i�*opo% iephys (1� ���_���������_out*opo% iephys (2� = i�*opo% iephys (2� ���_������--------------- �_nout*opo% in_phys (1� = i�*opo% in_phys (1� ���_���������_out*opo% in_phys (2� = i�*opo% in_phys (2� ���_���������_out*opo% in_phys (3� = i�*opo% in_phys (3� ���_���������_out*opo% iephys (1� = i�*opo% iephys (1� ���_���������_out*opo% iephys (2� = i�*opo% iephys (2� ���_���������_out*opo% iephys (3� = i�*opo% iephys (3� ���_������-----G 8888 --------------o N ipEN iim �f_�_2infon= ���_���������_out*opo% in_physd(1� = i�*opo% in_physd(1� ���_���������_out*opo% in_physd(2� = i�*opo% in_physd(2� ���_���������_out*opo% iephysd(1� = i�*opo% iephysd(1� ���_���������_out*opo% iephysd(2� = i�*opo% iephysd(2� ���_������--------------- �_nout*opo% in_physd(1� = i�*opo% in_physd(1� ���_���������_out*opo% in_physd(2� = i�*opo% in_physd(2� ���_���������_out*opo% in_physd(3� = i�*opo% in_physd(3� ���_���������_out*opo% iephysd(1� = i�*opo% iephysd(1� ���_���������_out*opo% iephysd(2� = i�*opo% iephysd(2� ���_���������_out*opo% iephysd(3� = i�*opo% iephysd(3� ���_������-----G 8888 -----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCopy domsubdomain y���_��---------------------------------------------------------gin � �! ChecWs�yO in o N iprec �f_�_ii_pkSE �single)nfon= ���_���� o N ipEN iim �f_�_2infon= ���_���������_DO i=1,ot�l(numb�i ) --�����_out*opo% in_t�l((1,i� = i�*opo% in_t�l((1,i�numb�i ) --�����_out*opo% in_t�l((2,i� = i�*opo% in_t�l((2,i�numb�i ) --�����_out*opo% ie is((1,i� = i�*opo% ie is((1,i�numb�i ) --�����_out*opo% ie is((2,i� = i�*opo% ie is((2,i�numb�i ) --��---DOi------------------------- �_nDO i=1,ot�l(numb�i ) --�����_out*opo% in_t�l((1,i� = i�*opo% in_t�l((1,i�numb�i ) --�����_out*opo% in_t�l((2,i� = i�*opo% in_t�l((2,i�numb�i ) --�����_out*opo% in_t�l((3,i� = i�*opo% in_t�l((3,i�numb�i ) --�����_out*opo% ie is((1,i� = i�*opo% ie is((1,i�numb�i ) --�����_out*opo% ie is((2,i� = i�*opo% ie is((2,i�numb�i ) --�����_out*opo% ie is((3,i� = i�*opo% ie is((3,i�numb�i ) --��---DOi---------------G 8888 --------------o N ipEN iim �f_�_2infon= ���_���������_DO i=1,ot�l(numb�i ) --�����_out*opo% in_t�ld(1,i� = i�*opo% in_t�ld(1,i�numb�i ) --�����_out*opo% in_t�ld(2,i� = i�*opo% in_t�ld(2,i�numb�i ) --�����_out*opo% ie isd(1,i� = i�*opo% ie isd(1,i�numb�i ) --�����_out*opo% ie isd(2,i� = i�*opo% ie isd(2,i�numb�i ) --��---DOi------------------------- �_nDO i=1,ot�l(numb�i ) --�����_out*opo% in_t�ld(1,i� = i�*opo% in_t�ld(1,i�numb�i ) --�����_out*opo% in_t�ld(2,i� = i�*opo% in_t�ld(2,i�numb�i ) --�����_out*opo% in_t�ld(3,i� = i�*opo% in_t�ld(3,i�numb�i ) --�����_out*opo% ie isd(1,i� = i�*opo% ie isd(1,i�numb�i ) --�����_out*opo% ie isd(2,i� = i�*opo% ie isd(2,i�numb�i ) --�����_out*opo% ie isd(3,i� = i�*opo% ie isd(3,i�numb�i ) --��---DOi---------------G 8888 -----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCopy domsub costsy���_��---------------------------------------------------------gin � �! ChecWs�yO in o N iprec �f_�_ii_pkSE �single)nfon= ���_���� oDO i=1,ot�l(numb�i ) --��out*opo%t�l_costsO ) =_i�*opo%t�l_costsO )i-------------DOi--------------------oDO i=1,ot�l(numb�i ) --��out*opo%t�l_costdO ) =_i�*opo%t�l_costdO )i-------------DOi-----------Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCopy domsub to proc assignag�_y�����_�--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,ot�l(numb�i ) out*opo%t�l2procO ) =_i�*opo%t�l2procO )sie iss---DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Copy dom issmNalR � �!t�l(numb�i �--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,ot�lR ,ty�����_ ) out*opo%it�lR ,t( ) =_i�*opo%it�lR ,t( )sie iss---DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Copy dom!ub ibs ut ryfcondas���sy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iim �f_�_2infon= ���_������DO i=1,ot�lR ,ty�����_ ) ) out*opo%t�ls_bc(1,i� = i�*opo%t�ls_bc(1,i�y�����_ ) ) out*opo%t�ls_bc(2,i� = i�*opo%t�ls_bc(2,i�numb�i ) --��out*opo%t�ls_bc(3,i� = i�*opo%t�ls_bc(3,i�numb�i ) --��out*opo%t�ls_bc(4,i� = i�*opo%t�ls_bc(4, )i-------------DOi--------------------oDO i=1,ot�lR ,ty�����_ ) ) out*opo%t�ls_bc(1,i� = i�*opo%t�ls_bc(1,i�y�����_ ) ) out*opo%t�ls_bc(2,i� = i�*opo%t�ls_bc(2,i�numb�i ) --��out*opo%t�ls_bc(3,i� = i�*opo%t�ls_bc(3,i�numb�i ) --��out*opo%t�ls_bc(4,i� = i�*opo%t�ls_bc(4, )i------------��out*opo%t�ls_bc(5,i� = i�*opo%t�ls_bc(5, )i------------��out*opo%t�ls_bc(6,i� = i�*opo%t�ls_bc(6, )i-------------DOi-----------Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCopy domsub ��_m�bo(inumb�rsy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,ot�lR ,ty�����_ ) out*opo%n��_m�t�l(( ) =_i�*opo%n��_m�t�l(( )sie iss---DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Copy dom!ub ��_m�bo(iR ,tsy�����_�--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,ot�lR ,ty�����_ ) DO j=1,max��_m�i------------��out*opo%i��_m�t�l(Oj,i) =_i�*opo%i��_m�t�l(Oj,i)i-------------DOi---------DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Copy dom issmNal��_m�bo(izaNproces�o s. Twe ie inotaaag�_opod byyO in om *opoimag�_!_O in om--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = i�*opo%o��_m�procy�����_-----_arg,iopi,out*opo%i��_m�proc, els elss������� ��IFEN ie is s � ii_preservsucces�infon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_copyRE��(�� uår_s1)2 ' issmNal��_m�bo(izaNproc OUTTOPO%INEIGHPROCOF elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��DO i=1,i�*opo%o��_m�procy�����_--��out*opo%i��_m�procO ) =_i�*opo%i��_m�procO )i---------DOi_O in oEN ie *opo%isels�m-z�dinfon= ���_����--issIp--_fii_preserv��_m�gf-- ���_���_��ldc(1� = i�*opo%ocommseqy�����_���_-----_arg,iopi,out*opo%icommseq, els elss������� ��IF IFFEN ie is s � ii_preservsucces�infon= ���_����--��--ilial ie iss � TCALL#���_�����(���(���_���_a Roc,'���_Nomc_imag�_tubs',----_copyRE��(�� u uår_s1)2 'ecnaunicbt�!!!sequence OUTTOPO%ICOMMSEQOF elsssssssssssGOTO 8888 iiiiiNDIF issie iss 8 -----F i8888 o DO i=1,i�*opo%ocommseqy�����_���_--��out*opo%icommseqO ) =_i�*opo%icommseqO )i-------------DOi-----------Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCopy domm het�ER as���sy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o N ii�*opo% iem hid sGT. Tinfon= ���_���� o_��OCATE,out*opo%m hii�*opo% iem hid),STAT=������� ��IF IFFEN ie is s � Tinfon= ���_����������ilial ie iss � TCALL#���_�����(���(���_���_a Roc,'���_Nomc_imag�_tubs',----_copyRE��(�� u uår_s1)2 'm het�ER as���s OUTTOPO%MESHOF elsssssssssssGOTO 8888 iiiiiNDIF issie iss 8 -----F i8888 o DO i=1,i�*opo% iem hidyO in o���_--��out*opo%m hii� = i�*opo% hii�i-------------DOi-----------G------y�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaSetlout*opo to ieER et ���_���--------------------------------------------------------g---------------g ���_��out*opo%itieER et = .TRUE.yy---------------------------------------------------------------gin � �! ChecWs�yO in om Rup1�>-y�����_�--------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(-------------_copyRETURN ie i�����_RETUR= ���_��CONTAINSy------SUBROUTINE�D ==�_9 ie iss- N i.NOT ii_pi-------z�dinfon= ���_����------ilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_i�_Nonoi---tubs',----_copyRE��(��oo uår_s1)2 'Please cn � ii_pi--- first!OF elsssssssssssGOTO 8888 iiiiiNDIF 8888GOTO 8888 8-----G-8888������ONTINUEy�����_----SUBROUTINE�D ==�_�����_----SUBROUTINE�bs',----_copyy����������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_subs2proc.f����������������������������������������������������������0000644�0001752�0001753�00000055310�11616003524�020737� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_�--------------------------------------------------------gin � �! ChecWs�yO in omsaSubrout��OF :ALL#���_��������bs',----_subs2procy---------------------------------------------------------------gin � �! ChecWs�yO in om CopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in om CH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy_SINGLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_subs2proc_sicost,o��_m�,i��_m�,ot�l(,t�l2procE uår_s1)))))))))))))))))))))))))))))st�lR ,t,nt�lR ,t,sssssG_DOUBLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_subs2proc_dicost,o��_m�,i��_m�,ot�l(,t�l2procE uår_s1)))))))))))))))))))))))))))))st�lR ,t,nt�lR ,t,sssssG_Dyyyyy-------!! Twe irout��OFassigns domsubdomain to wibproces�o sy-------!! usizaN wibcosti�ssignedanã eachmsubdomain. Iti�ssignsy-------!! domdomains recursivOly, byl�ssignizaNdomains �EOF eliry-------!! physi� �!��_m�bou s. At domDyyxn � proces�o s w erGOTO 88!!! knNw who�hanawdat.GOTO 88!!!GOTO 88!!! NOTE: Do we nyeda weatruncbt�!!!h�EOliza?y---------------------------------------------------------------gin � �! ChecWs�yO in om Modulosly---------------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_elg�_yO in oUSE�bs',modulo_writeyO in o MPLICIT NONEy_SINGLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE �singleG_DOUBLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE � oub��G_Dyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om Includesi---------------------------------------------------------------gin � �! ChecWs�y_SIieEON MPI INE o CLUDE 'mpif.h'G_Dyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om A_imag�_s in oyO in om--------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK), DIMENBRLE(:) ,_ ENT(IN ) :: costy-------!! TwomDstimopod costi�ssociopod with domsubdomain y���_�� EGER , DIMENBRLE(: ),_ ENT(IN ) :: n��_m�i-------!! Twomnumb�raNa ��_m�bou stNalnmsubdomainy���_�� EGER , DIMENBRLE(:,:),_ ENT(IN ) :: i��_m�i-------!! P *�rslto wise ��_m�bou sy���_�� EGER , DIMENBRLE(: ),_PO ER :: t�l2proci-------!! Fuerf issmNaliroces�o affilibt�!!aNa !ubdomain y���_�� EGER , DIMENBRLE(: ),_PO ER :: it�lR ,ty�����_-!! LissmNalsubdomain �ssignedanã dom � �!proces�o y���_�� EGER ,_ ENT(IN ) :: nt�l(numb�i �!! Tot �!�umb�raNa !ubdomain y���_�� EGER ,_ ENT( OUT) :: nt�lR ,ty�����_-!! Twomnumb�raNa subdomain �ssignedy���_�� EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�> --btus,_0oon succes�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om L � �!variablosly---------------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK):: costsum,tot �cost,t0GOTO 88 EGER , DIMENBRLE(:),_PO ER :: l ,tl => NULL()GOTO 88LOGICAL , DIMENBRLE(:),_PO ER :: not_�ssigneda=> NULL()GOTO 88LOGICAL , DIMENBRLE(:),_PO ER :: not_l ,teda => NULL()GOTO 88 EGER , DIMENBRLE(pEN iim) :: ldcyO in o EGER :: s,j, s,jj,k, elsGOTO 88 EGER :: s--bt,is-z�,rankGOTO 88 EGER :: nR ,t,sR ,ty�����_ EGER :: s-ub,j-ub,n�ssignedy���_��CHARAC ER(pEN char) :: esgy�����_ EGER :: �ssignedtorankGOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in om Extornalsly---------------------------------------------------------------gin � �! ChecWs�yO in oy---------------------------------------------------------------gin � �! ChecWs�yO in om In------seoy�����_�--------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',----_subs2procRETURN ie iy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_����-----D ==�_9 ie issEN ie is s � TinNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaMakomsure we omcoenoum�imemoryofor domsub2proc y�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = ot�lsyO in o-----_arg,iopi,t�l2procE els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(��WRITE ( esg,'(A,I10,A)') 'aag�_opizaN',ot�ls,'msub2procs fails.'��_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_subs2procRE uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsargureeUBLwe only omve oneaproces�o ,Lwe are doney---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN nproc �f_�_1infon= ���_����-�--------------------------------------------------------gin � �! Chec ���_����-�saAag�_opol domOsGER ,t arrayy�����_��-�--------------------------------------------------------gin � �! Chec ���_����-issIp--_fii_preserv��_m�gf-- ���_���_�ldc(1� = ot�lsyO in o o-----_arg,iopi,st�lR ,t, els elss������� ��IF IFEN ie is s � Tinfon= ���_����-- --ilial ie iss � TCALL#���_�����(�� ��WRITE ( esg,'(A,I10,A)') 'aag�_opizaN',ot�ls,'mOsGER ,t fails.'��_�����(�� ���_���_a Roc,'���_Nomc_imag�_tubs',----_subs2procRE uår_s1)2 esg, elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----F i8888����--------------------------------------------------------gin � �! Chec ���_����-�saAssignxn � !ubdomain to wibproces�o �EOFrup1�>F i8888����--------------------------------------------------------gin � �! Chec ���_����-nsGER ,tl= ot�lsyO in o oDO it�l=1,ot�l(numb�i ) --it�lR ,t( sis) =_i isy���_������--sis2procO sis) =_ii_pranksie iss 8 ---DOi---------NDIF issie iss-----oy---------------------------------------------------------------gin � �! ChecWs�yO in om ayyxn ��_opolsomeimemoryofor domR ,tsmNalR gi� �s �EOFi-------z�FyO in om dom to rue, since noneaNaa wea!ubdomain omve been �ssignedayet.GOTO 88! dom issmnot_�ssignedaindi_opoliaa wea!ubdomain�hanabeen �ssignedy���_��m *o abproces�o �EOF dom iss: not_l ,tedaholds domsubdomain thaty���_��m omve been pu,hed onto wib(-eree(R ,t(:))aNa !ub ito be �ssigneda-FyO in om we nyeda wisb(-ereesince oneanewa!ubdomain�w erfomve sevoral yO in om ��_m�bou st�EOF domway !ub i�re �ssignedanã procs requiresl wisb(-ereey�����_�--------------------------------------------------------gin � �! ChecWs�yO in o-----_arg,iopi,not_�ssignedE els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(��WRITE ( esg,'(A,I10,A)') uår_s'aag�_opizaN � �!array-(1� Na !-z�F',ot�ls,'mfails.'��_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_subs2procRE uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_-----_arg,iopi,not_l ,teda E els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(��WRITE ( esg,'(A,I10,A)') uår_s'aag�_opizaN � �!array-(2� Na !-z�F',ot�ls,'mfails.'��_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_subs2procRE uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_---------------------------------------------------------gin � �! ChecWs�yO in om In------ze domR ,tsmto ruey�����_---------------------------------------------------------gin � �! ChecWs�yO in onot_�ssigneda= .TRUE. yO in onot_l ,teda = .TRUE.y�����_---------------------------------------------------------gin � �! ChecWs�yO in om A ��_opolsomeimemoryofor dom(-eree(R ,t(:))y�����_�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- yO in ois-z� l iMAXVALin��_m�)y�����_ldc(1� = is-z�y�����_-----_arg,iopi,R ,t, els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(��WRITE ( esg,'(A,I10,A)') uår_s'aag�_opizaN � �!array-(3� Na !-z�F',is-z�,'mfails.'��_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_subs2procRE uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_---------------------------------------------------------gin � �! ChecWs�yO in om Compupol domtot � costi�EOF domavoragibcostiper!proces�o y�����_�--------------------------------------------------------gin � �! ChecWs�yO in otot �costp--_f0.0_MKyO in oDO i=1,ot�l(numb�i )tot �costp=)tot �costp+ cost(i)sie iss---DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Pu,hF domfirsta!ubdomain�onto wib(-ereey�����_�--------------------------------------------------------gin � �! ChecWs�yO in oi!ub = 1TTTTinfnl ,tl = 1TTTTinfil ,tl = 0GOTO 88y�����_l ,t(oR ,t) = i isy���_��TTTTinfn�ssigneda = 0G_O in om--------------------------------------------------------gin � �! ChecWs�yO in om loop overa weaproces�o sy---------------------------------------------------------------gin � �! ChecWs�yO in om TODO:l wisbpil�aNaa wearout��OFnyeds rewriteyO in oDO rank=0,pEN nproc-1TTTTinf�_��--------------------------------------------------------gin � �! Chec ���_����-�sain------ze domcostpNaa weacurrg�_ proces�o �EOFruset wib(-ere ���_����-�sanã p * to wibnexta!ubpNaa weaprevious (-ere ���_����-�--------------------------------------------------------gin � �! Chec ���_����-costsum = 0.0_MKyO in o oi!ub = R ,t( R ,t+1� ���_�����R ,t(1) = i isy���_�����not_l ,teda = .TRUE.y�����_���not_l ,tedO sis) =_.FALSE.y�����_���il ,tl = 0GOTO 88 nfnl ,tl = 1TGOTO 88 nf�ssignedtorank = 0GOTO 88 nf�--------------------------------------------------------gin � �! Chec ���_����-�sakeepaincludizaNsubdomain until domcostpexcyeds domavoragibcost ���_����-�sabut makomsure you get at least onea!ub �EOFleave at least onea!ub ���_����-�sanã wearemainizaNprocs ���_����-�sandomfacto a0.5 helps (plittizaN wibload morssequ �!amongsta weaprocs ���_����-�saAssignxn so at least onea!ubdomain�nã eachmproces�o y�����_ nf�--------------------------------------------------------gin � �! Chec ���_����-�PRINT *,_ii_prank,'s2p)tot �cost',rank,tot �cost*REAL(e isproc_spyed(rank),MK� ���_�����yO in o oDO WHILE ((�ssignedtorank�f_�0).OR. uår_s1)2 -(n�ssigned+1�f_�ot�l(-ipEN nproc-rank-1).OR. uår_s1)2 -(n�ssignedsLT.ot�l(-ipEN nproc-rank-1).AND.o uår_scostsum+0.5_MK*cost(i is).L� tot �cost*REAL(e isproc_spyed(rank),MK�))sGOTO 8888 i 8 m PRINT *,_ii_prank, 's2p)1',(�ssignedtorank�f_�0) m PRINT *,_ii_prank, 's2p)2',n�ssigned+1�f_�ot�l(-ipEN nproc-rank-1) m PRINT *,_ii_prank, 's2p)3',n�ssignedsLT.ot�l(-ipEN nproc-rank-1) m PRINT *,_ii_prank, 's2p)4',costsum+0.5_MK*cost(i is).L� tot �cost*REAL(e isproc_spyed(rank),MK� m PRINT *,_ii_prank,'s2p)i is',rank,s-ub,cost(i is) m PRINT *,_ii_prank,'s2p)i��_m�',rank,s-ub,i��_m�(:,i is) �--------------------------------------------------------gin � �! C � Pop dom issmayyxnssignx wibnexta!ubdomain�nã weaproces�o : ranksie iss 8 �--------------------------------------------------------gin � �! C il ,tl = iR ,tl+ 1TTTTinf�_����i!ub = R ,t( R ,t) costsum = costsum + cost(i is) sis2procO sis) = ranksie iss 8 not_�ssignedO sis) =_.FALSE.y �--------------------------------------------------------gin � �! C � Incremg�_ tdomcouu!�rafdextwomnumb�raNa �ssignedat�l(numb�i ) --�--------------------------------------------------------gin � �! C n�ssigneda = n�ssigneda+ 1TTTTinf�_�����ssignedtorank = �ssignedtorank + 1TGOTO 88 nf �--------------------------------------------------------gin � �! C � Reaag�_opol domR ,tlnã holdxtwomnumb�raNa ��_m�bou stNal domsubGOTO 88 nf �--------------------------------------------------------gin � �! C N inR ,tl+ n��_m�O is)sGT.is-z�infon= ���_�����������issIp--_fii_preserv��_m�ggrowspruserve ���_�����������is-z� l inR ,tl+ n��_m�O is) ���_�����������ldc(1� = is-z�y�����__________-----_arg,iopi,R ,t, els elss������� ��IF N ie iss � Tinfon= ���_����--���������ilial ie iss � TCALL#���_�����(���(�������WRITE ( esg,'(A,I10,A)') uår_s1)2 -'aag�_opizaN � �!array-(3� Na !-z�F',is-z�,'mfails.'��_�����(��_________-----_argoc,'���_Nomc_imag�_tubs',----_subs2procRE uår_s1)2 ---s------------ esg, elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----F i8888 o -------Gy�����_______�--------------------------------------------------------gin � �! C � includex wibne_m�bou stNali!ub in dom issmNal!ubdomain to � considery�����_______�--------------------------------------------------------gin � �! C DO i=1,o��_m�O is) ���_�����������j-ub = i��_m�O ,i is) ___�--------------------------------------------------------gin � �! ___� -D ==�liaai��_m�O ,i is) e ialready in dom iss ___�--------------------------------------------------------gin � �! ___ N inot_�ssignedOj is)sAND.not_l ,tedOj is)infon= ���_����--��������nl ,tl = nR ,tl+ 1TTTTinf�_����������l ,t(oR ,t) = jsubGOTO 88 nf ������not_l ,tedOj is) =_.FALSE.y�����_���������-----oy------������---DOi_O in o ___�--------------------------------------------------------gin � �! �! � Ial dorOFe inoanewaeleag�_s evailablo,�i can mean twã wizas: � 1� ei wirowe are done (omve �ssignedan � !ubs) dex � 2) we omcostranded onmayFe layyxnyyxnyeda o get a fmc_y_O in o ___�--------------------------------------------------------gin � �! �! N ieR ,t+1sGT.oR ,t) fon= ���_����--������--------------------------------------------------------gin � �! ___� -Fiyyxna!ubdomain�ndat�hananotayetabeen �ssignedy���_�� ___� -We do�ndat�by loopizaNoveran � dom!ub inyyxD ==�izaNiaa weyy���_�� ___� -omve been �ssigned ���_����--������--------------------------------------------------------gin � �! _SIieEON VECTOR ���_����--������--------------------------------------------------------gin � �! ___� -Twomvecto avers���le ia !-mple do�loop:x wibnoti�ssignedawith ___� - domhige,tlid�w erfwin ���_����--������--------------------------------------------------------gin � �! ___i-ub = 0 ___DO i=1,ot�l(,1TTTTinf�_���������� N inot_�ssignedOi)infon= ���_����--��������___i-ub = i ���_����--��������-----F i8888 o --f��---DOi#els�y�����__________�--------------------------------------------------------gin � �! ___� -Twoms� �arbvers���l(-ensN wibloop at�n!ub ito obtain do ___� -smcosolut�!!aasN wibvecto avers���. BothFrup1�>_i-ub = 0 ___� ifan � !ubs omve been �ssigneda- which cannotibe �nd w erGOTO 88 ___� beatreopod a ia bug ! ���_����--������--------------------------------------------------------gin � �! ___i-ub = ot�l(numb�i ) --���DO WHILE (.NOT not_�ssignedO sis)) ���_����--��������i-ub = i-ub - 1TTTTinf�_���������� N ie-ubsLT.1� EXITF i8888 o --f��---DOi#eyyyyy------��--������--------------------------------------------------------gin � �! ___� ifai!ub is zeroan � !ubs omve been �ssigneda�nd we exit do ___� -loop ___�--------------------------------------------------------gin � �! ___ N ie-ubsLT.1� fon= ���_����--��������EXITF i8888 o --f��--------------- �_n ___ N ipEN iebug sGT. Tinfon= ���_�����������������WRITE( esg,'(A,I6)') uår_s1)2 ---s---'fs utmayFe layy. Chosena!ub �sanewalayy:F',isubGOTO 88 nf ������ __-----_argwrite(ii_prank,'bs',----_subs2procRE esg,sssssGOTO 8888 i 8 -----F i8888 o --f��-----oyy------��--������--------------------------------------------------------gin � �! ___� orowe diOFruachmayFe layyxnyyxpu,hF domnewalayy�onto wib(-erey------��--������--------------------------------------------------------gin � �! ___nl ,tl = nR ,tl+ 1TTTTinf�_�������l ,t(oR ,t) =_i isy���_������-------oy------���---DOi---------DOi_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Assignxlasta!ub to wiblastaproces�o y�����_�--------------------------------------------------------gin � �! ChecWs�yO in oDO it�l=1,ot�l(numb�i ) N inot_�ssignedOi is)infon= ���_����--��sis2procO sis) = pEN nproc - 1TTTTinf�_����not_�ssignedO sis) =_.FALSE.y_������-------o ��yO in o---DOi------�--------------------------------------------------------gin � �! ChecWs�yO in omsaDebuggiza:-D ==�lndat�n � !ubdomain omve been �ssigned ���_��---------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebugsGT.Tinfon= ���_�����i = 0 DO it�l=1,ot�l(numb�i ) -- N inot_�ssignedOi is)infon= ���_����--�����i = il+ 1oy------������-----F i8888 o---DOi_O in o �--------------------------------------------------------gin � �! Chec ���_����-�saIBLwe fs utmayy, writemayFoc,'�- essagibayy�bail�out ! ���_����-�--------------------------------------------------------gin � �! Chec ���_����- N ies � Tinfon= ���_����--��ilial ie iss � TC�����CALL#���_����WRITE ( esg,'(A,I10,A)') 'missey:F',i,'msubNdomains'��_�����(��__-----_argoc,'���_Nomc_it�l(_maptubs',----_subs2procRE uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 i8 NDIF issie iss 8 -----F_O in o �--------------------------------------------------------gin � �! Chec ���_����-�saDolsomei--bt ,tics (only root) �--------------------------------------------------------gin � �! Chec ���_����- N iii_prank�f_�0)nfon= ���_����--��DO rank=0,pEN nproc-1TTTTinf�_�������costsum = 0.0_MKyO in o o��--��DO it�l=1,ot�l(numb�i ) --_����- N isis2procO sis)�f_�rank)nfon= ���_�����������������costsum = costsum + cost(i is) iss 8 -----F iss 8 ---DOi---------------WRITE( esg,'(A,I5,A,E12.4)') 'costpfdexproces�o : ',rank, uår_s1)))))))))))))))))))))))))))))))))'mOs ',costsumy�����__________-----_argwrite(ii_prank,'bs',----_subs2procRE esg,sssssoy------������---DOi iss 8 -----F �--------------------------------------------------------gin � �! Chec ���_����-�saEyy�ofaDebuggiza:-D ==�lndat�n � !ubdomain omve been �ssigned ���_�� �--------------------------------------------------------gin � �! Chec ���_��-----oyy---------------------------------------------------------------gin � �! ChecWs�yO in om A ��_opol dom � �! issmNal!ubdomain �ssignedanã dom � �!proces�o y---------------------------------------------------------------gin � �! ChecWs�yO in oldc(1� = ot�lsyO in oissIp--_fii_preserv��_m�gf-- ���_��-----_arg,iopi,st�lR ,t, els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(��WRITE ( esg,'(A,I10,A)') 'OsGER ,t with iim ',ot�ls,'mfails.'��_�����(���_���_a Roc,'���_Nomc_imag�_tubs',----_subs2procRE uår_s1)2 ---s--- esg, elsssssssssssGOTO 8888 iNDIF issie iss-----Gy�����_---------------------------------------------------------gin � �! ChecWs�yO in om Storssam � �! issmNal!ubdomain �ssignedanã dom � �!proces�o y---------------------------------------------------------------gin � �! ChecWs�yO in onsGER ,tl= 0 DO i=1,ot�l(numb�i ) N isis2procO )�f_�ii_prank)nfon= ���_��������n!ubR ,tl =�n!ubR ,tl+ 1TTTTinf�_����i!ubl ,t(o!ubl ,t) =_iy_������-------oyO in o---DOi------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFree domm moryoagainy---------------------------------------------------------------gin � �! ChecWs�yO in oissIp_fii_preservdeelg�_yO in o-----_arg,iopi,R ,t, els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_ideelg�_tubs',----_subs2procRE uår_s1)2 'deaag�_op�!!aNa R ,t fails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��-----_arg,iopi,not_�ssignedE els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_ideelg�_tubs',----_subs2procRE uår_s1)2 'deaag�_op�!!aNa not_�ssignedafails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- ���_��-----_arg,iopi,not_l ,tedE els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_ideelg�_tubs',----_subs2procRE uår_s1)2 'deaag�_op�!!aNa not_l ,tedafails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRup1�>-y�����_�--------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(-------------_subs2procRETURN ie i�����_RETUR= ���_��CONTAINSy------SUBROUTINE�D ==�_9 ie iss- N in!ub i.L� Tinfon= ���_����-- --ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_subs2procRE uår_s1)2 'n!ub imustibe > 0OF elsssssssssssGOTO 8888 iiiNDIF 8888GOTO 8888 -----F DO it�l=1,ot�l(numb�i ) --_ N in��_m�O is) sLT. Tinfon= ���_�������������ilial ie iss � TC�����CALL#���_����������_���_a Roc,'���_Nomc_im_imag�_tubs',----_subs2procRE uår_s1)2 'n��_m�imustibe >= 0pfdexn � !ubsOF elsssssssssssGOTO 8888 iiiiiiiNDIF 8888GOTO 8888 888 -----F ---DOi-8888�����ONTINUEy�����_----SUBROUTINE�D ==�__SINGLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_subs2proc_sG_DOUBLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_subs2proc_di#eyyyyy������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_get.f����������������������������������������������������������������0000644�0001752�0001753�00000014447�11616003524�017602� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�--*- f90 -*---------------------------------------------gin � �! ChecWs�yONE o�saSubrout��OF :ALL#���_�������� ��bs',----_geti------�--------------------------------------------------------gin � �! ChecWs�yO in omsCopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in omsCH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy------SUBROUTINE�bs',----_get(----id,----ssssssGOTO 88-!! Twe irout��OFrup1�> ia p *�ranã dom----logyGOTO 88-!! p *�d at�by ----id.GOTO 88!!! GOTO 88!!! [TIP]GOTO 88-!! Twomu or should nevorxnyeda o manun �y moyyyy dom----logyostrucp1�e.GOTO 88!!! Ial de irout��OFe inyededE don�i mostaprobab�y mean that ei wiro do ���_��!!! l� �!!!-e imissizaNa fmap1�e dextwomclisnt codeie inotaweerfdesigned!GOTO 88!!!GOTO 88!!! [WARNe i]GOTO 88-!! Ina weacurrg�_ -mpleag�_op�!!ayou can orious�y break wizas ifayouGOTO 88-!! *change* domm mb�rsaNaa wearup1�>eda o--logyo�s only a p *�rai(numb�i �!! rup1�>ed, ra wiro dan a copyaNaa wea *�rnal t pa.yy------- TODO saf�raimpleag�_op�!!i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaIncludesi---------------------------------------------------------------gin � �! ChecWs�y------�--------------------------------------------------------gin � �! ChecWs�yO in omsaModulosy------�--------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_D ==�_idyO in oUSE�bs',modulo_typedeaGOTO 88 MPLICIT NONEyy---------------------------------------------------------------gin � �! ChecWs�yO in om A_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o EGER ,_ ENT(IN ) :: ----idGOTO 88-!! To--logyoIDGOTO 88TYPE��_Not,----),_PO ER :: ----GOTO 88-!! Rup1�> i dom----logyop *�d at�by `----id`yO in o EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�> --btus,_0oon succes�yO in om--------------------------------------------------------gin � �! ChecWs�yO in om L � �!variablosyO in om--------------------------------------------------------gin � �! ChecWs�yO in oREAL(e iskSE � oub��) :: -0 LOGICAL :: validGOTO 88TYPE��_Not,----),_PO ER :: ss,---- => NULL()GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in om Extornalsy---------------------------------------------------------------gin � �! ChecWs�yy---------------------------------------------------------------gin � �! ChecWs�yO in om In------sey---------------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',----_getRETURN ie iy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_����-----D ==�_9 ie issEN ie is s � TinNDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaCopy dom----logyGOTO 88---------------------------------------------------------gin � �! ChecWs�yO in omss,---- => bs',----(----id)%tGy�����_---- => bs',----(----id)%tGy!�����_----%IDp=)to--idG!�����_----%itieER et = is,----%itieER etG!�����_----%mis,physs = is,----%mis,physsG!�����_----%max,physs = is,----%max,physsG!�����_----%mis,physd = is,----%mis,physdG!�����_----%max,physd = is,----%max,physdG!�����_----%bcieEOOOOOOO= is,----%bcieEG!�����_----%n!ub iOOOOOO= is,----%ot�l(n!�����_----%mis,!ub iOOO= is,----%mis,t�l(n!�����_----%max,!ub iOOO= is,----%max,!ub n!�����_----%mis,!ubdiOOO= is,----%mis,t�ldG!�����_----%max,!ubdiOOO= is,----%max,!ubdG!�����_----%!ub_costsOOO= is,----%!ub_costsG!�����_----%!ub_costdOOO= is,----%!ub_costdG!�����_----%!ub2proc OOO= is,----%!ub2proci!�����_----%n!ubR ,tl = is,----%ot�l iss !�����_----%itubR ,tl = is,----%it�l iss !�����_----%t�l(_bc OOO= is,----%!ub(_bci!�����_----%n��_m�!ub iO= is,----%o��_m�!ub !�����_----%i��_m�!ub iO= is,----%i��_m�!ub !�����_----%o��_m�prociO= is,----%o��_m�proci!�����_----%i��_m�prociO= is,----%i��_m�proci!�����_----%isels�m-z�d = is,----%itels�m-z�d !�����_----%ocommseql = is,----%ocommseqy!�����_----%icommseql = is,----%icommseqy!�����_----% iem hid O= is,----%max,m hidy!�����_----% h iOOOOOO= is,----% h m TODO:lD ==�liaa de iworks i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRup1�>y�����_�--------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(-------------_getRETURN ie i�����_RETUR= ���_��CONTAINSy------SUBROUTINE�D ==�_9 ie iss-- N i.NOT ii_pi-------z�dinfon= ���_����------ilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_i�_Nonoi---tubs',----_getREoo uår_s1)2 'Please cn � ii_pi--- first!OF elsssssssssssGOTO 8888 iiiiiNDIF 8888GOTO 8888 8-----G-��_�������_���_a RD ==�_to--id(----id,validssssssGOTO 8888 i N i.NOT validinfon= ���_����------ilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_im_imag�_tubs',----_getREoo uår_s1)2 'To--logyoIDie iinvalid!OF elsssssssssssGOTO 8888 iiiiiNDIF 8888GOTO 8888 8-----G-8888������ONTINUEy�����_----SUBROUTINE�D ==�_�����_----SUBROUTINE�bs',----_geti�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_mkgeom.f�������������������������������������������������������������0000644�0001752�0001753�00000072723�11616003524�020303� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_�--------------------------------------------------------gin � �! ChecWs�yO in omsaSubrout��OF :ALL#���_�������� ��bs',----_mkgeomi------�--------------------------------------------------------gin � �! ChecWs�yO in omsCopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in omsCH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy_SINGLLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_mkgeom_s(----id,decomp,�ssig,mis,physE uår_s1)2 max,phys,bcieE,ghosts-z�,cost,ssss,u or_mis-ub, uår_s1)2 u or_max-ub,u or_ot�ls,u or_!ub2procsG_DOUBLLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_mkgeom_d(----id,decomp,�ssig,mis,physE uår_s1)2 max,phys,bcieE,ghosts-z�,cost,ssss,u or_mis-ub, uår_s1)2 u or_max-ub,u or_ot�ls,u or_!ub2procsG_Dyyyyy-------!! Twe irout��OFi i dom----logyocreop���lrout��OFfdexpurely GOTO 88!!! geometry-based decomposip���sE i.e.iwithout pil�aclss �nd w thoutGOTO 88!!! hes.GOTO 88!!!GOTO 88!!! [NOTE]GOTO 88-!! Ina weau or_ieER et case, weau orimusti!ubmitpex ,tingGOTO 88-!! !ubdomain �yyxn � Naa`mis,t�l`,a`max,!ub`,a`cost` �yyx`u or_ot�ls`GOTO 88!!! ustibe provided.aSub i�re don�mapped onto proces�o s �EOy-------!!i dom----logyoisb(-orsd.Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaModulosy------�--------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_----_cost ���_��USE�bs',modulo_----_(-orsyO in oUSE�bs',modulo_teER e_!ub(_bci���_��USE�bs',modulo_----_(ubs2proci���_��USE�bs',modulo_----_metis_s2pi���_��USE�bs',modulo_fSE ���_m�i------USE�bs',modulo_-reei------USE�bs',modulo_elg�_yO in oUSE�bs',modulo_----_box2t�l(numb�i MPLICIT NONEy_SINGLLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE �singleG_DOUBLLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE � oub��G_Dyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om Includesi---------------------------------------------------------------gin � �! ChecWs�y------�--------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o EGER ,_ ENT(INOUT) :: ----idGOTO 88-!! IDmnumb�raidentyyyizaN wib----logy.GOTO 88!!! Ial ---idISIO0oon input a newa----logyoisbcreopod aEOF elsnewa----idGOTO 88-!! e irup1�>edadorO, elsol domOndi_opoda o-logyoisbreplaced.GOTO 88!!!GOTO 88!!! [CAUTION]GOTO 88-!! *SEMANTICS�CHANGED:* `----idl= 0`oisb*noti�nymors* ruservedafdextwomGOTO 88-!! rizaN ---logyo(nuerfdecomposip���). "RizaN ---logies"i�re n!!i------�!! geometr c nyyxnyedano setup. Twomu or can perfdemie i rizaNshiftGOTO 88!!! operop���siwithout omcizaN -mfirstateER e a ----logy.GOTO 88 EGER ,_ ENT(IN ) :: decompy-------!! Twe validfdecomposip��� type i�re:GOTO 88!!!GOTO 88!!! *fii_preservdecomp_bisecp�!!i------�!! *fii_preservdecomp_xpencili------�!! *fii_preservdecomp_ypencili------�!! *fii_preservdecomp_zpencili------�!! *fii_preservdecomp_xy_slabi------�!! *fii_preservdecomp_xz_slabi------�!! *fii_preservdecomp_yz_slabi------�!! *fii_preservdecomp_cub-idGOTO 88-!! *fii_preservdecomp_u or_ieER etGOTO 88 EGER ,_ ENT(IN ) :: �ssigy-------!! Twe typemNal!ubdomain-to-proces�o �ssignag�_. OneaNa:GOTO 88!!!GOTO 88!!! *ffii_preserv�ssign_ *�rnalGOTO 88!!! *ffii_preserv�ssign_nodal_cutGOTO 88!!! *ffii_preserv�ssign_nodal_commGOTO 88!!! *ffii_preserv�ssign_dual_cutGOTO 88!!! *ffii_preserv�ssign_dual_commGOTO 88!!! *ffii_preserv�ssign_u or_ieER etGOTO 88!!!GOTO 88!!! [NOTE]GOTO 88-!! Twiblattorou o i domextornal l� �!!!-METIS �EOFis onlyGOTO 88-!! availabloliaae i wasbcompils.Nwith METIS support.GOTO 88REAL(MK), DIMENBRLE(: ),_ ENT(IN ) :: mis,physGOTO 88-!! MinimummNalphysi� �mextoyy�ofatdomcompupop���al tomain�( oub��)GOTO 88!!!GOTO 88!!! firstaOndex islppN iimGOTO 88REAL(MK), DIMENBRLE(: ),_ ENT(IN ) :: max,physGOTO 88-!! MaximummNalphysi� �mextoyy�ofatdomcompupop���al tomain�( oub��)GOTO 88!!!GOTO 88!!! firstaOndex islppN iimGOTO 88 EGER , DIMENBRLE(: ),_ ENT(IN ) :: bcieEGOTO 88!!! Bs ut !!-condip���sifdextwom----logyGOTO 88-!!GOTO 88!!! firstaOndex isl1-6 (uachmofatdomfaces)GOTO 88REAL(MK) ,_ ENT(IN ) :: ghosts-z�GOTO 88-!! Twib!-z�F(width)mofatdomghostblayer.GOTO 88REAL(MK), DIMENBRLE(: ),_PO ER :: cost ���_��-!! E,timopodacosti�s�ociopodawith !ubdomain . Ei wirou or-ieER et !!i------�!! input dexdecomposip��� rusult on�output. TwomcostpNaana!ubdomainGOTO 88-!! e igiven byoits volmag.GOTO 88REAL(MK), DIMENBRLE(:,:), OPTIONAL,_PO ER :: u or_mis-ubGOTO 88-!! MimimummNalextoys�!!aNa t�l(.GOTO 88!!! Used iaadecomp e iu or ieER et.GOTO 88!!!GOTO 88!!! 1staOndex: x,y,(z) +GOTO 88!!! 2yy:Ft�lIDGOTO 88REAL(MK), DIMENBRLE(:,:), OPTIONAL,_PO ER :: u or_max-ubGOTO 88-!! MaximummNalextoys�!!aNa t�l(.GOTO 88!!! Used iaadecomp e iu or ieER et.GOTO 88!!!GOTO 88!!! 1staOndex: x,y,(z) +GOTO 88!!! 2yy:Ft�lIDGOTO 88 EGER ,_OPTIONAL :: u or_ot�l(numb�i -!! Tot � numb�raNa !ub ionxn � proces�o s.GOTO 88!!! Used wdon�decomp e iu or ieER et.GOTO 88 EGER, DIMENBRLE(: ),_ OPTIONAL,_PO ER :: u or_!ub2prociOTO 88!!! Subdomain�nã proces�o �ssignag�_.GOTO 88!!! Used iaa�ssignag�_ e iu or ieER et.GOTO 88!!!GOTO 88!!! Ondex: t�lID (global)GOTO 88 EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�>s --btus,_0oupon succes�.y�����_---------------------------------------------------------gin � �! ChecWs�yO in om L � �!variablosyO in om--------------------------------------------------------gin � �! ChecWs�yO in o EGER :: i,-reetype,nbox,isubGOTO 88 EGER :: ioptGOTO 88 EGER, DIMENBRLE(:,:), PO ER :: ss�_m�i => NULL()GOTO 88 EGER, DIMENBRLE(:,:), PO ER :: t�l(_bc => NULL()GOTO 88 EGER, DIMENBRLE(1 ) :: NmdummyE elGOTO 88 EGER, DIMENBRLE(3,1) :: nnodosyO in o EGER, DIMENBRLE(: ),_PO ER :: ns�_m�i => NULL()GOTO 88 EGER, DIMENBRLE(: ),_PO ER :: nchldOOO=> NULL()GOTO 88REAL(MK) :: t0,resea,sesea,lesea,lmyepsGOTO 88REAL(MK), DIMENBRLE(ppN iim) :: gsvecGOTO 88REAL(MK), DIMENBRLE(1,1) :: xpdummyGOTO 88LOGICAL , DIMENBRLE(ppN iim) :: fixetGOTO 88REAL(MK), DIMENBRLE(3,2) :: w�_m�tsGOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: mis,boxOO=> NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: max,boxOO=> NULL()GOTO 88CHARAC ER(LEN=_a RD ar) :: esgGOTO 88 EGER :: ot�l iss, ot�lsyO in o EGER , DIMENBRLE( :),_PO ER :: ssGER ,tl=> NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: mis,t�lOO=> NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: max,t�lOO=> NULL()GOTO 88 EGER, DIMENBRLE(: ),_PO ER :: t�l2proc => NULL()GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in om Extornalsy---------------------------------------------------------------gin � �! ChecWs�yy---------------------------------------------------------------gin � �! ChecWs�yO in om In------sey---------------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',----_mkgeomRETURN ie i_SINGLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepssG_DOUBLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepsdG_Dyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_����-----D ==�_9 ie issEN ie is s � TinNDIF issie iss-----Gy!ie issEN i----_id �f_� Tinfon= m ilial ie iss � TCwarniza m �_���_a Roc,'���_Nomc_im_imag�_t 'bs',----_mkgeomRE & m år_s1'----_id wasbruset fdexnon-nuerfdecomposip���OF elssssss N ie im ----_id = -1im -----G-��_��! Ial deiu or ieER et�n!ub itdon�usol dosey------EN iND�SENT(u or_ot�l()infon= ���_����--n!ub i= u or_ot�l(numb�i ---------------n!ub i= 0 -----G-��_��EN iND�SENT(u or_mis-ub)infon= ���_����--mis,t�lO=> u or_mis-ubGOTO 88-----G-��_��EN iND�SENT(u or_max-ub)infon= ���_����--max,t�lO=> u or_max-ubGOTO 88-----G-��_��EN iND�SENT(u or_!ub2procsinfon= ���_����--t�l2proc => u or_!ub2prociOTO 88-----G-��_��!--------------------------------------------------------gin � �! ChecWs�yO in o�saDummyea_imag�_s fdexnon-ex ,ting pil�aclss �nd hesG-��_��!--------------------------------------------------------gin � �! ChecWs�yO in oxpdummy(1,1) = 0.0_MKyO in oNmdummy(1) = 0 nnodos(1:3,1) = 0G_O in om--------------------------------------------------------gin � �! ChecWs�yO in om Recursive bisecp�!!i------�--------------------------------------------------------gin � �! ChecWs�yO in oEN idecomp�f_�ii_preservdecomp_bisecp�!!infon= ���_����-! buildaa bin !!--reei----------reetype---------_fii_preserv-ree_bin ���_����-! no pil�aclss �nd no h ���_����-w�_m�ts(1,1:2) = 0.0_MKyO in o ow�_m�ts(2,1:2) = 0.0_MKyO in o o! geometry�hanau--- w�_m�tyO in o ow�_m�ts(3,1:2) = 1.0_MKyO in o o! n � direcp�!!s can beacutyO in o ofixet(1:ppN iim) =_.FALSE.y_������--gsvec(1:ppN iim) =_ghosts-z�GOTO 88��-! builda-reei---------�_���_a R-ree(xpdummy,0,NmdummyEmis,physEmax,phys,-reetype, uår_s1)2pEN nproc,.FALSE.,gsvec,0.1_MK,-1.0_MK,fixet,w�_m�ts,mis,boxE uår_s1)2max,box,nbox,nchldssssssGOTO 8888 N ie iss � Tinfon= ���_����--���ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'Bisecp�!!xdecomposip��� fails.'F elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----FOTO 88��-! converta-ree�nã t�l(numb�i )�_���_a R----_box2t�l((mis,boxEmax,box,nchldsnbox,mis,t�lE uår_s1)2max,t�lEot�ls,sssssGOTO 8888 N ie is s � TinNDIF iss_O in om--------------------------------------------------------gin � �! ChecWs�yO in om PencilsG-��_��!--------------------------------------------------------gin � �! ChecWs�yO in o---- N iidecomp �f_� ii_preservdecomp_xpencil) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_ypencil) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_zpencilsinfon= ���_����-EN idecomp�f_�ii_preservdecomp_zpencilsAND.ppN iimsLT.3infon= ���_����-- --ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'Cannotimakomz pencil iin 2D!OF elsssssssssssGOTO 8888 iiiiNDIF issie iss 8 -----FOTO 88��-!--------------------------------------------------gin � �! ChecWs�yO in on om pencil quadrisecp�!!xusizaN wibgenoral _a R-reeFOTO 88��-!--------------------------------------------------gin � �! ChecWs�yO in on om buildaa quada-ree, bin !!-in 2d ���_�� -reetype---------_fii_preserv-ree_quad ���_����-EN ippN iim �f_� 2) -reetype-_fii_preserv-ree_bin ���_����-! no pil�aclss �nd no h ���_����-w�_m�ts(1,1:2) = 0.0_MKyO in o ow�_m�ts(2,1:2) = 0.0_MKyO in o o! geometry�hanau--- w�_m�tyO in o ow�_m�ts(3,1:2) = 1.0_MKyO in o o! fix weapropor iirecp�!!yO in o ofixet(1:ppN iim) =_.FALSE.y_������--EN idecomp �f_� ii_preservdecomp_xpencil) fixet(1) =_.TRUE.y_������--EN idecomp �f_� ii_preservdecomp_ypencil) fixet(2) =_.TRUE.y_������--EN idecomp �f_� ii_preservdecomp_zpencil) fixet(3) =_.TRUE.y_������--gsvec(1:ppN iim) =_ghosts-z�GOTO 88��-! builda-reei---------�_���_a R-ree(xpdummy,0,NmdummyEmis,physEmax,phys,-reetype, uår_s1)2pEN nproc,.FALSE.,gsvec,0.1_MK,-1.0_MK,fixet,w�_m�ts,mis,boxE uår_s1)2max,box,nbox,nchldssssssGOTO 8888 N ie iss � Tinfon= ���_����--���ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'Pencilxdecomposip��� fails.'F elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----FOTO 88��-! converta-ree�nã t�l(numb�i )�_���_a R----_box2t�l((mis,boxEmax,box,nchldsnbox,mis,t�lE uår_s1)2max,t�lEot�ls,sssssGOTO 8888 N ie is s � TinNDIF iss_O in om-------------------------------------------------------------------------yO in om SlabsG-��_��!--------------------------------------------------------gin � �! ChecWs�yO in o---- N iidecomp �f_� ii_preservdecomp_xy_slab) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_xz_slab) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_yz_slab)infon= ���_����-EN idecomp�f_�ii_preservdecomp_xz_slabsAND.ppN iimsLT.3infon= ���_����-- --ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'Cannotimakomx-z slab iin 2D!OF elsssssssssssGOTO 8888 iiiiNDIF issie iss 8 -----FOTO 88��-EN idecomp�f_�ii_preservdecomp_yz_slabsAND.ppN iimsLT.3infon= ���_����-- --ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'Cannotimakomy-z slab iin 2D!OF elsssssssssssGOTO 8888 iiiiNDIF issie iss 8 -----FOTO 88��-!--------------------------------------------------gin � �! ChecWs�yO in on om slab bisecp�!!xusizaN wibgenoral _a R-reeFOTO 88��-!--------------------------------------------------gin � �! ChecWs�yO in on om buildaa bin !!--reei----------reetype---------_fii_preserv-ree_bin ���_����-! no pil�aclss �nd no h ���_����-w�_m�ts(1,1:2) = 0.0_MKyO in o ow�_m�ts(2,1:2) = 0.0_MKyO in o o! geometry�hanau--- w�_m�tyO in o ow�_m�ts(3,1:2) = 1.0_MKyO in o o! fix weapropor iirecp�!!(numb�i )fixet(1:ppN iim) =_.FALSE.y_������--EN idecomp �f_� ii_preservdecomp_xy_slab) fon= ���_����-- --fixet(1) =_.TRUE.y_������--- --fixet(2) =_.TRUE.y_������-------FOTO 88��-EN idecomp �f_� ii_preservdecomp_xz_slab) fon= ���_����-- --fixet(1) =_.TRUE.y_������--- --fixet(3) =_.TRUE.y_������-------FOTO 88��-EN idecomp �f_� ii_preservdecomp_yz_slab) fon= ���_����-- --fixet(2) =_.TRUE.y_������--- --fixet(3) =_.TRUE.y_������-------FOTO 88��-gsvec(1:ppN iim) =_ghosts-z�GOTO 88��-! builda-reei---------�_���_a R-ree(xpdummy,0,NmdummyEmis,physEmax,phys,-reetype, uår_s1)2pEN nproc,.FALSE.,gsvec,0.1_MK,-1.0_MK,fixet,w�_m�ts,mis,boxE uår_s1)2max,box,nbox,nchldssssssGOTO 8888 N ie iss � Tinfon= ���_����--���ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'Slabxdecomposip��� fails.'F elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----FOTO 88��-! converta-ree�nã t�l(numb�i )�_���_a R----_box2t�l((mis,boxEmax,box,nchldsnbox,mis,t�lE uår_s1)2max,t�lEot�ls,sssssGOTO 8888 N ie is s � TinNDIF iss_O in om-------------------------------------------------------------------------yO in om Cub-idsG-��_��!--------------------------------------------------------gin � �! ChecWs�yO in o---- N idecomp �f_� ii_preservdecomp_cub-idinfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on om cub-id octasecp�!!xusizaN wibgenoral _a R-reeFOTO 88��-!--------------------------------------------------gin � �! ChecWs�yO in on om buildaan octa-ree�in 3d ���_�� -reetype---------_fii_preserv-ree_octyO in o o! nndaa quada-ree-in 2d ���_�� EN ippN iim �f_� 2) -reetype-_fii_preserv-ree_quad ���_����-! no pil�aclss �nd no h ���_����-w�_m�ts(1,1:2) = 0.0_MKyO in o ow�_m�ts(2,1:2) = 0.0_MKyO in o o! geometry�hanau--- w�_m�tyO in o ow�_m�ts(3,1:2) = 1.0_MKyO in o o! n � direcp�!!s can beacutyO in o ofixet(1:ppN iim) =_.FALSE.y_������--gsvec(1:ppN iim) =_ghosts-z�GOTO 88��-! builda-reei---------�_���_a R-ree(xpdummy,0,NmdummyEmis,physEmax,phys,-reetype, uår_s1)2pEN nproc,.FALSE.,gsvec,0.1_MK,-1.0_MK,fixet,w�_m�ts,mis,boxE uår_s1)2max,box,nbox,nchldssssssGOTO 8888 N ie iss � Tinfon= ���_����--���ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'Cub-id decomposip��� fails.'F elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----FOTO 88��-! converta-ree�nã t�l(numb�i )�_���_a R----_box2t�l((mis,boxEmax,box,nchldsnbox,mis,t�lE uår_s1)2max,t�lEot�ls,sssssGOTO 8888 N ie is s � TinNDIF iss_O in om-------------------------------------------------------------------------yO in om U or provides decomposip���:aDolnothingGOTO 88--------------------------------------------------------------------------yO in o---- N idecomp �f_� ii_preservdecomp_u or_ieER etinfon= ���_����-!Dolnothing. Justitakom wib(-uff froml deiu or aEOF rustitwibguy.Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaUnknow!xdecomposip��� typeGOTO 88--------------------------------------------------------------------------yO in o---- ���_����-ilial ie iss � TC�����CALL#���_�WRITE( esg,'(A,I5)') 'Unknow!xdecomposip��� type: ',decompy------����_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2mesg, elsssssssssssGOTO 8888 NDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF elsne_m�borsaNaa wea!ubdomain y�����_�--------------------------------------------------------gin � �! ChecWs�yO in o�_���_a RfSE ���_m�(mis,physEmax,phys,bcieE, uår_s1)))))))))))))))mis,t�lEmax,t�lEot�ls,ns�_m�,is�_m�,is����� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'FiEOizaNne_m�borsafails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF elscostpNaauachm!ubdomainGOTO 88---------------------------------------------------------gin � �! ChecWs�yO in o N idecomp � � ii_preservdecomp_u or_ieER etinfon= ���_����-)�_���_a R----_cost(xpdummy,0,mis,t�lEmax,t�lEot�ls,nsodosE uår_s1)2 cost,sssssGOTO 8888 i N ie iss � Tinfon= ���_����--���ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'CompupizaNcostsOfails.'F elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----FOTO 88----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaAssigna wea!ubdomain �nã proces�o sy---------------------------------------------------------------gin � �! ChecWs�yO in o N (�ssig �f_� ii_preserv�ssign_ *�rnalinfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on om *�rnal �ssignag�_ rout��O ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o�_���_a R----_(ubs2proc(cost,ns�_m�,is�_m�,ot�ls,!ub2proc, uår_s1))st�lR ,t,ot�l iss,sssssGOTO 8888 N ie iss � Tinfon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'AssignizaNsub ito proces�o s fails.'F elsssssssssssGOTO 8888 i 8NDIF issie iss 8 -----FOTO 88---- N i�ssig �f_� ii_preserv�ssign_nodal_cut .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_nodal_comm .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_dual_cut .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_dual_comminfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on om usolMETIS l� �!!!-to do �ssignag�_ ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o�_���_a R----_metis_s2p(mis,t�lEmax,t�lEos�_m�,is�_m�,cost,nt�ls, uår_s1)2�ssig,!ub2proc,st�lR ,t,ot�l iss,sssssGOTO 8888 N ie iss � Tinfon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'AssignizaNsub ito proces�o s usizaNMETIS fails.'F elssssss uår_s1)2 sssssGOTO 8888 i 8NDIF issie iss 8 -----FOTO 88---- N i�ssig �f_� ii_preserv�ssign_u or_ieER etinfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on om usor ieER et��ssignag�_ ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on oissIp_fii_preserv��_m�gf-- ���_�� oldc(1� = ot�lsyO in o����_���_a R,iopi,st�lR ,t, els elss������� ��IF 8 N ie is s � Tinfon= ���_����--���ilial ie iss � TCALL#���_�����(������_���_a Roc,'���_Nomc_ielg�_tubs',----_mkgeomRE uår_s1)2)2 ' issmNal � �!sub iISUBLIST'F elsssssssssssGOTO 8888 i 8 NDIF issie iss 8 -----FOTO 88��-ssGER ,tl=fii_preservundeER etGOTO 88 onsGER ,tl= 0 DO it�l=1,ot�l(numb�i ) --_ N isis2procO sis) sf_� ii_prank)nfon= ���_��������88 onsGER ,tl= n!ubR ,tl+ 1TTTTinf�_����88��-ssGER ,t(o!ubl ,t) =_i-ubGOTO 88 iss 8 -----FOTO 88��----DOi---------- ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on om unknow!x�ssignag�_ schemO ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on oilial ie iss � TC�����CALL#���_�WRITE( esg,'(A,I5)') 'Unknow!x�ssignag�_ schemO: ',�ssigy------ ���_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2mesg, elsssssssssssGOTO 8888 NDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOFaEOFteER e weabs ut !!-condip���siona wea!ubsiona wea � �yO in omsaproces�o ( wearout��OFw erfaag�_opea wearuquris.im mory)GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in oNULLIFY(t�l(_bc)GOTO 88C_���_a RteER e_!ub(_bc(mis,physEmax,phys,bcieE,mis,t�lEmax,t�lE uår_s1)))))))))))))))))))ot�ls,!ub(_bc,is����� ��IFEN ie iss � Tinfon= ���_����-ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkpil�RE uår_s1)2'fiEOizaNaEOFteER izaN wibBCaNaa wea!ubs fails. 'F elssssss uår_s1)2sssssGOTO 8888 NDIF issie iss-----Gy�����_�--------------------------------------------------------gin � �! ChecWs�yO in omsaS-orsi dom----logyoi *�rnallyGOTO 88---------------------------------------------------------gin � �! ChecWs�yO in o�_���_a R----_(-ors(----id,mis,physEmax,phys,mis,t�lEmax,t�lE!ub(_bc, uår_s1)))))))))))))))!ub2proc,ot�ls,bcieE,ghosts-z�,st�lR ,t,ot�l iss, uår_s1)))))))))))))))ns�_m�,is�_m�,is����� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_i!ub_fails.,'bs',----_mkgeomRE uår_s1)2 'S-orizaN ---logyofails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaDump�outid ,gnosticifilssi---------------------------------------------------------------gin � �! ChecWs�y------� N ipEN iebug sGT. Tinfon= ���_��m WRITE( esg,'(A,I4.4)') 'pil�REii_prank ���_��m OPEN(10,FILE= esgsGOTO 88!GOTO 88!O 88DO j=1,ot�l iss OTO 88!O 88��--i =_i-ubR ,t(jsGOTO 88!GOTO 88!O 88O 88!Ox-y planGOTO 88!O 88O 88WRITE(10,'(2e12.4)') mis,t�l(1,i),mis,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') max,t�l(1,i),mis,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') max,t�l(1,i),max,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') mis,t�l(1,i),max,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') mis,t�l(1,i),mis,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'( 88a )')GOTO 88!GOTO 88!O 88O 88!Oy-z planGOTO 88!O 88O 88EN ippN iim �GT. 2infon= ���_��m O 88O 88WRITE(10,'(2e12.4)') mis,t�l(2,i),mis,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'(2e12.4)') max,t�l(2,i),mis,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'(2e12.4)') max,t�l(2,i),max,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'(2e12.4)') mis,t�l(2,i),max,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'(2e12.4)') mis,t�l(2,i),mis,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'( 88a )')GOTO 88!O 88O 88-----G-��_��! �----DOi------!GOTO 88!O 88CLOSE(10)GOTO 88!----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRup1�>y�����_�--------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(-------------_mkgeomRETURN ie i�����_RETUR= ���_��CONTAINSy------SUBROUTINE�D ==�_9 ie iss- N i.NOT ii_pi-------z�dinfon= ���_����-----ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_ipEN noi---tubs',----_mkgeomRE uår_s1)2 'Please cn � ii_pi--- first!OF elsssssssssssGOTO 8888 iiiiNDIF 8888GOTO 8888 -----FOTO 88��-EN(ghosts-z� sLT. 0.0_MKinfon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'ghosts-z� ustibe >= 0.0OF elssssss N ie iTO 8888 iiiiNDIF 8888GOTO 8888 -----FOTO 88��-DO i=1,ppN iimiTO 8888 iiiiEN(max,phys(i).LE.mis,phys(i))nfon= ���_��������88 ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'max,phys ustibe > mis,physOF elssssss N ie iTO 8888 iiiiiiiNDIF 8888GOTO 8888 88 -----FOTO 88��----DOi------ s- N i�ssig �f_� ii_preserv�ssign_u or_ieER etinfon= ���_����- o N idecomp � � ii_preservdecomp_u or_ieER etinfon= ���_����-)��88 ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'decomp type-isb(etito u or_ieER et fdextwisb�ssignag�_', uår_s1)))))))) elssssss N ie iTO 8888 iiiiiiiNDIF 8888GOTO 8888 88 -----FOTO 88��- o N(u or_ot�l( .LE. Tinfon= ���_����--���8 ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'nã t�l( ieER et�in u or_ieER et �ssignag�_', uår_s1)))))))) elssssss N ie iTO 8888 iiiiiiiNDIF 8888GOTO 8888 88 -----FOTO 88��- o N i.NOT ASSOCIATEDisis2proc))nfon= ���_��������88 ilial ie iss � TC�����CALL#���_���������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 't�l2proc ustibe aag�_opet fdexusor ieER et��ssignag�_', uår_s1))))))))) elssssss N ie iTO 8888 iiiiiiiiNDIF 8888GOTO 8888 88 -----FOTO 88��- oDO i=1,u or_ot�l(numb�i O 88��- o N iisis2procO )sLT.0).OR.isis2procO )sGE.pEN nproc))nfon= ���_��������88 8 ilial ie iss � TC�����CALL#���_������������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'invalidaproces�o specifiet�in sis2proc', uår_s1)))))))))))) elssssss N ie iTO 8888 iiiiiiiiiiiNDIF 8888GOTO 8888 88 88 -----FOTO 88��- o---DOi------ s------FOTO 88��-EN idecomp �f_� ii_preservdecomp_u or_ieER etinfon= ���_����- o N ii.NOT ASSOCIATEDimis,t�l)).OR.i.NOT ASSOCIATEDimax,t�l)))nfon= ���_��������88 ilial ie iss � TC�����CALL#���_���������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'mis,t�l/max,t�lO ustibe aag�_opet fdexusor ieE.xdecomp', uår_s1))))))))) elssssss N ie iTO 8888 iiiiiiiiNDIF 8888GOTO 8888 88 -----FOTO 88��- o N(u or_ot�l( .LE. Tinfon= ���_����--���8 ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'nã t�l( ieER et�in u or_ieER et decomposip���OF uår_s1)))))))) elssssss N ie iTO 8888 iiiiiiiNDIF 8888GOTO 8888 88 -----FOTO 88��- o!--------------------------------------------------gin � �! ChecWs�yO in on o om rgureetdat� deiu or-ieER et t�l( add upito deiwholeyO in on o om compupop���al tomain.yO in on o om ONE�COULDoDO MORE TESTS HERE.y_������--- -!--------------------------------------------------gin � �! ChecWs�yO in on o oreseal i(max,phys(1)-mis,phys(1))*(max,phys(2)-mis,phys(2))FOTO 88��- o N(ppN iim�f_�3infon= ���_����-- -- oreseal iresea*(max,phys(3)-mis,phys(3))FOTO 88��- o-----FOTO 88��- oseseal i0.0_MKyO in o o oDO i=1,u or_ot�l(numb�i O 88��- leseal i(max,t�l(1,i)-mis,t�l(1,i))*(max,t�l(2,i)-mis,t�l(2,i) iTO 8888 iiiiiii N(ppN iim�f_�3infon= ���_����-- -- o- leseal ileseal*i(max,t�l(3,i)-mis,t�l(3,i) iTO 8888 iiiiiii------FOTO 88��- o oseseal iseseal+ileseaFOTO 88��- o---DOi------ s-iii N(ABS(sesea-resea)/reseasGE.lmyepsinfon= ���_����-- -- o!--------------------------------------------------gin � �! Chec ���_����-- -- o! Mismatch! ���_����-- -- o!--------------------------------------------------gin � �! Chec ���_����-- -- oilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkgeomRE uår_s1)2 'faultya!ubdomain �ieER etOF elsssssssssssGOTO 8888 iiiiiiNDIF 8888GOTO 8888 88 -----Fi------ s------FOTO 88��-�--------------------------------------------------------gin � �! ChecFOTO 88��-� rgureebcieEGOTO 88��-�--------------------------------------------------------gin � �! ChecFOTO 88��-� [TODO]!!!GOTO 88��-� ustiD ==�lfdexcompop�bilityaNaabs ut !!-condip���sGOTO 88��-� aEOFbs ut !!-condp���siarray ustiomcoone morsGOTO 88��-� iimoys�!!, �s its possibloltdat�you dont wantitoGOTO 88��-� omco wea!ameabs ut !!-condip���sionaeve!!-sidsGOTO 88��-� Naa wea!ubdomainGOTO 88��-� W erfbomaccs upet fdex�s soonxnsm wib(-ructureaNaGOTO 88��-� tdomfielda-ype-isbbettorodeER etGOTO 88 o�--------------------------------------------------------gin � �! ChecFO8888�����ONTINUEy�����_----SUBROUTINE�D ==�__SINGLLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_mkgeom_sG_DOUBLLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_mkgeom_dG_Dyyyyy���������������������������������������������libbs'-1.2.1/src/----/bs',----_D ==�.f��������������������������������������������������������������0000644�0001752�0001753�00000027160�11616003524�020074� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� 88 o�--------------------------------------------------------gin � �! Chec-s�yO in omsaSubrout��OF :ALL#���_�������� ��bs',----_D ==�_9 ie i�--------------------------------------------------------gin � �! Chec-s�yO in omsCopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in omsCH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy_SINGLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_D ==�_s(----id,xp,Npil�,----_okRN ie i_DOUBLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_D ==�_d(----id,xp,Npil�,----_okRN ie i_Dyyyyy-------!! rgures iaa� � iil�aclss �reaNn domcurrentito--logy.GOTO 88!!! (ona wea � �aproces�o )GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in om Includesi---------------------------------------------------------------gin � �! ChecWs�y------�--------------------------------------------------------gin � �! ChecWs�yO in omsaModulosy------�--------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_D ==�_idGOTO 88 MPLICIT NONEy_SINGLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE �singleG_DOUBLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE � oub��G_Dyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om A_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK), DIMENBRLE(:,:), ENT(IN ) :: xpy-------!! Pil�acls g�_op���sGOTO 88 EGER ,_ ENT(IN ) :: Npil�y-------!! Numb�raNa iil�aclss ona wislproces�o y------LOGICAL ,_ ENT( OUT) :: ----_oky-------!! I i dom----logyoc��s , g�_ ���_�� EGER ,_ ENT(IN ) :: ----idGOTO 88-!! Tdom----logyoto beac ==�etGOTO 88 EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�>s --btus,_0oupon succes�yy---------------------------------------------------------------gin � �! ChecWs�yO in om L � �!variablosyO in om--------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK) :: t0GOTO 88 EGER :: ipil�,idom,j,is!!yO in oLOGICAL :: valid INE o EGER, DIMENBRLE(:),_PO ER :: bcieE => NULL()GOTO 88TYPE��_Not,----) ,_PO ER :: ----OO=> NULL()GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in om Extornalsy---------------------------------------------------------------gin � �! ChecWs�yy---------------------------------------------------------------gin � �! ChecWs�yO in om In------sey---------------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',----_c ==�RETURN ie i�����_----_ok =_.TRUE.yy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_����-----D ==�_9 ie issEN ie is s � TinNDIF issie iss-----Gy---------------------------------------------------------------gin � �! ChecWs�yO in om Set ----idGOTO 88---------------------------------------------------------gin � �! ChecWs�yO in o----O=> bs',----(----id)%_ ���_��bcieE => ----%bcieEGy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea � iil�aclssy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iim �f_� 2) fon= ���_����--DO iiil�=1,Npil�y--------------is!!l= 0 ���--DO j=1,----%ot�l iss OTO 88------------idoml= ----%i-ubR ,t(jsG_SINGLLE_PRECISION ie issEND�SUBRLE INE oooooooooooooo N ixp(1,ipil�)sGE.----%mis,t�ls(1,idom)sAND. uår_s1)2 oxp(1,ipil�)sLE.----%max,t�ls(1,idom)sAND. uår_s1)2 oxp(2,ipil�)sGE.----%mis,t�ls(2,idom)sAND. uår_s1)2 oxp(2,ipil�)sLE.----%max,t�ls(2,idom))nfon= ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 - InF elsnon-periodic case, aag�w iil�aclss tdat�are ���_��������88 8 - exactly ONaan uppor EX ERNAL bs ut !!. ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 IF(ixp(1,ipil�)sLT.----%max,t�ls(1,idom) .OR. uår_s1)2 (----%!ub(_bc(2,idom)sf_�1)2 sAND. uår_s1)2 bcieE(2)� � ii_preservbcieE_periodic)) sAND. uår_s1)2 (xp(2,ipil�)sLT.----%max,t�ls(2,idom) .OR. uår_s1)2 (----%!ub(_bc(4,idom)sf_�1)2 sAND. uår_s1)2 bcieE(4)� � ii_preservbcieE_periodic)))nfon= _DOUBLLE_PRECISION ie issEND�SUBRLE INE o������88 8 IF ixp(1,ipil�)sGE.----%mis,t�ld(1,idom)sAND. uår_s1)2 oxp(1,ipil�)sLE.----%max,t�ld(1,idom)sAND. uår_s1)2 oxp(2,ipil�)sGE.----%mis,t�ld(2,idom)sAND. uår_s1)2 oxp(2,ipil�)sLE.----%max,t�ld(2,idom))nfon= ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 - InF elsnon-periodic case, aag�w iil�aclss tdat�are ���_��������88 8 - exactly ONaan uppor EX ERNAL bs ut !!. ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 IF(ixp(1,ipil�)sLT.----%max,t�ld(1,idom) .OR. uår_s1)2 (----%!ub(_bc(2,idom)sf_�1)2 sAND. uår_s1)2 bcieE(2)� � ii_preservbcieE_periodic)) sAND. uår_s1)2 (xp(2,ipil�)sLT.----%max,t�ld(2,idom) .OR. uår_s1)2 (----%!ub(_bc(4,idom)sf_�1)2 sAND. uår_s1)2 bcieE(4)� � ii_preservbcieE_periodic)))nfon= _Dyyyyy----------------------! iil�aclsNe iinoone of my t�l(numb�i O 88��- is!!l= 1TTTTinf�_����88��------EXITTTTTinf�_����88��--------FOTO 88��- o88��--------FOTO 88��- o88---DOi------ s-iiissEN ies!!l�f_� Tinfon= ------------------! fs ut a iil�aclsNtdat�violato i dom----logy ----------------------_ok =_.FALSE.y_������-----------! no need�nã tearch any fur wiry_������-----------NDIF issie iss 8 �--------FOTO 88��- ---DOi---------- N ipEN iim �f_� 3infon= ���_����--DO iiil�=1,Npil�y--------------is!!l= 0 ���--DO j=1,----%ot�l iss OTO 88------------idoml= ----%i-ubR ,t(jsG_SINGLLE_PRECISION ie issEND�SUBRLE INE oooooooooooooo N ixp(1,ipil�)sGE.----%mis,t�ls(1,idom)sAND. uår_s1)2 oxp(1,ipil�)sLE.----%max,t�ls(1,idom)sAND. uår_s1)2 oxp(2,ipil�)sGE.----%mis,t�ls(2,idom)sAND. uår_s1)2 oxp(2,ipil�)sLE.----%max,t�ls(2,idom)sAND. uår_s1)2 oxp(3,ipil�)sGE.----%mis,t�ls(3,idom)sAND. uår_s1)2 oxp(3,ipil�)sLE.----%max,t�ls(3,idom))nfon= ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 - InF elsnon-periodic case, aag�w iil�aclss tdat�are ���_��������88 8 - exactly ONaan uppor EX ERNAL bs ut !!. ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 IF(ixp(1,ipil�)sLT.----%max,t�ls(1,idom) .OR. uår_s1)2 (----%!ub(_bc(2,idom)sf_�1)2 sAND. uår_s1)2 bcieE(2)� � ii_preservbcieE_periodic)) sAND. uår_s1)2 (xp(2,ipil�)sLT.----%max,t�ls(2,idom) .OR. uår_s1)2 (----%!ub(_bc(4,idom)sf_�1)2 sAND. uår_s1)2 bcieE(4)� � ii_preservbcieE_periodic)) sAND. uår_s1)2 (xp(3,ipil�)sLT.----%max,t�ls(3,idom) .OR. uår_s1)2 (----%!ub(_bc(6,idom)sf_�1)2 sAND. uår_s1)2 bcieE(6)� � ii_preservbcieE_periodic)) )nfon= _DOUBLLE_PRECISION ie issEND�SUBRLE INE o������88 8 IF ixp(1,ipil�)sGE.----%mis,t�ld(1,idom)sAND. uår_s1)2 oxp(1,ipil�)sLE.----%max,t�ld(1,idom)sAND. uår_s1)2 oxp(2,ipil�)sGE.----%mis,t�ld(2,idom)sAND. uår_s1)2 oxp(2,ipil�)sLE.----%max,t�ld(2,idom)sAND. uår_s1)2 oxp(3,ipil�)sGE.----%mis,t�ld(3,idom)sAND. uår_s1)2 oxp(3,ipil�)sLE.----%max,t�ld(3,idom))nfon= ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 - InF elsnon-periodic case, aag�w iil�aclss tdat�are ���_��������88 8 - exactly ONaan uppor EX ERNAL bs ut !!. ���_��������88 8 ---------------------------------------------------------gin ���_��������88 8 IF(ixp(1,ipil�)sLT.----%max,t�ld(1,idom) .OR. uår_s1)2 (----%!ub(_bc(2,idom)sf_�1)2 sAND. uår_s1)2 bcieE(2)� � ii_preservbcieE_periodic)) sAND. uår_s1)2 (xp(2,ipil�)sLT.----%max,t�ld(2,idom) .OR. uår_s1)2 (----%!ub(_bc(4,idom)sf_�1)2 sAND. uår_s1)2 bcieE(4)� � ii_preservbcieE_periodic)) sAND. uår_s1)2 (xp(3,ipil�)sLT.----%max,t�ld(3,idom) .OR. uår_s1)2 (----%!ub(_bc(6,idom)sf_�1)2 sAND. uår_s1)2 bcieE(6)� � ii_preservbcieE_periodic)) )nfon= _Dyyyyy----------------------! iil�aclsNe iinoone of my t�l(numb�i O 88��- is!!l= 1TTTTinf�_����88��------EXITTTTTinf�_����88��--------FOTO 88��- o88��--------FOTO 88��- o88---DOi------ s-iiissEN ies!!l�f_� Tinfon= ------------------! fs ut a iil�aclsNtdat�violato i dom----logy ----------------------_ok =_.FALSE.y_������-----------! no need�nã tearch any fur wiry_������-----------NDIF issie iss 8 �--------FOTO 88��- ---DOi------------Fy---------------------------------------------------------------gin � �! ChecWs�yO in om Rup1�>y�����_�--------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(-------------_c ==�RETURN ie i�����_RETUR= ���_��CONTAINSy------SUBROUTINE�D ==�_9 ie iss- N i.NOT ii_pi-------z�dinfon= ���_����-----oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_ipEN noi---tubs',----_c ==�RE_������ uår_s1)2 'Please cn � ii_pi--- first!OF elsssssssssssGOTO 8888 iiiiiNDIF 8888GOTO 8888 8-----FOTO 88��- N iNpil� sLT. 0infon= ���_����-----oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_im_imag�_tubs',----_c ==�RE_�������� uår_s1)2 'Npil� ustibe >= 0OF elsssssssssssGOTO 8888 iiiiiNDIF 8888GOTO 8888 8-----FOTO 88��- �_���_a RD ==�_----id(----id,valid,sssssGOTO 8888 i N i.NOT validinfon= ���_����-----oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_im_imag�_tubs',----_c ==�RE_ uår_s1)2 '----id invalid', uår_s1))))))))) elssssss N ie iTO 8888 iiiiiiNDIF 8888GOTO 8888 8-----FO8888������ONTINUEy�����_----SUBROUTINE�D ==�__SINGLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_D ==�_sG_DOUBLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_D ==�_dG_Dyyyyy����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',teER e_!ub(_bc.f����������������������������������������������������������0000644�0001752�0001753�00000021051�11616003524�020701� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�--------------------------------------------------------gin � �! Chec-s�yO in omsaSubrout��OF :ALL#���_�������� bs',teER e_!ub(_bcy---------------------------------------------------------------gin � �! ChecWs�yO in om CopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in omsCH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy_SINGLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�teER e_!ub(bc_s(mis,physEmax,phys,bcieE, uår_s1))))))mis,t�lEmax,t�lEot�ls,!ub(_bc,is����_DOUBLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�teER e_!ub(bc_d(mis,physEmax,phys,bcieE, uår_s1))))))mis,t�lEmax,t�lEot�ls,!ub(_bc,is����_Dyyyyy-------!! Twe irout��OFteER es weabs ut !!-condip���siofl do ���_��!!! !ubsionan � iroces�o s. TwusNsub itdat�omc ���_��!!! facss �t� deiphysi� �!bs ut !!-are marks.iwith +1 �EOy-------!! *�rnal facss with deivalue 0. Twe iis��rm s���Ne y-------!! obtained bylcomporizaN wibcoordinato iNaa wea!ubvs withy-------!! deivalue iNaa`mis,phys` �EOF`max,phys`.GOTO 88!!!y-------!! [WARNe i]y-------!! Ifl deiu or creopet wea!ubs wibcomporis!!lNaafloatsain dompresg�_ ���_��-!! rout��OFmMK), fail (rs ut off oc,'�s) �EOF elscomporis!!lshould b ���_��!!! replacsd byla `ABS(value--brget) < epsiloz`scomporis!!.y---------------------------------------------------------------gin � �! ChecWs�yO in omsaModulos y---------------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_aag�_CALL#�� MPLICIT NONEy_SINGLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE �singleG_DOUBLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE � oub��G_Dyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in omsaIncludesi---------------------------------------------------------------gin � �! ChecWs�y_SIieE __MPI INE o CLUDE 'mpif.h'G_Dyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_s in oy---------------------------------------------------------------gin � �! ChecWs�yO in oREAL(MK), DIMENBRLE(:) ,_ ENT(IN ) :: mis,phys ���_��!!! Min. ex g�_iNaa weaphysi� �!domainGOTO 88REAL(MK), DIMENBRLE(:) ,_ ENT(IN ) :: max,phys ���_��!!! Max. ex g�_iNaa weaphysi� �!domainGOTO 88 EGER , DIMENBRLE(: ),_ ENT(IN ) :: bcieEGOTO 88!!! Bs ut !!-condip���FteER ip���GOTO 88REAL(MK), DIMENBRLE(:,:), ENT(IN ) :: mis,t�l ���_��!!! Min. ex g�_iNaa weat�lOdomainGOTO 88REAL(MK), DIMENBRLE(:,:), ENT(IN ) :: max,t�l ���_��!!! Max. ex g�_iNaa weat�lOdomainGOTO 88 EGER ,_ ENT(IN ) :: ot�l(numb�i -!! Tdom--t �!numb�raNa (reol)at�lOdomainsGOTO 88 EGER , DIMENBRLE(:,:), PO ER :: !ub(_bcy-------!! Bs ut !!-teER p���FNaauachm!ubGOTO 88 EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�>s --btus,_0oupon succes�y---------------------------------------------------------------gin � �! ChecWs�yO in omsaL � �!variablosoy---------------------------------------------------------------gin � �! ChecWs�yO in o EGER , DIMENBRLE(pEN iim) :: ldcGOTO 88 EGER :: is elsGOTO 88REAL(MK) :: t0GOTO 88REAL(MK) :: lmyepsy---------------------------------------------------------------gin � �! ChecWs�yO in omsaExtornalsoy---------------------------------------------------------------gin � �! ChecWs�yO in oy---------------------------------------------------------------gin � �! ChecWs�yO in omsaIn------seoy---------------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',teER e_!ub(_bcRETURN ie i_SINGLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepssG_DOUBLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepsdG_Dyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om Aag�_opeam moryofor !ubdomain bcaflagsy---------------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = 2*ppN iimiTO 888ldc(2� = MAX(ot�ls,1)GOTO 88C_���_a R,iopi,!ub(_bc, els elss������� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TCALL#���_�����(���_���_a Roc,'���_Nomc_ielg�_tubs',teER e_!ub(_bcRE��(�� uår_s1)2 'aag�_op���FNaa!ub(_bcofails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaLoop overa weaglob �!sub i�EOFcomporel doiroy�����_� bcoordinato iwith deiphysi� �!bs ut !!i------�--------------------------------------------------------gin � �! ChecWs�yO in oDO i=1,ot�l(numb�i O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-� comporel do westibs ut !!i------O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-EN iABS(mis,t�l(1,i)-mis,phys(1)) sLT. lmyeps*(max,t�l(1,i)-mis,t�l(1,i))infon= GOTO 8888 i a!ub(_bc(1,i)l= 1TTTTinf�_�---- ���_����-i a!ub(_bc(1,i)l= 0 ----- numb�i O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-� comporel do eastibs ut !!i------O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-EN iABS(max,t�l(1,i)-max,phys(1)) sLT. lmyeps*(max,t�l(1,i)-mis,t�l(1,i))infon= ���_����-i a!ub(_bc(2,i)l= 1TTTTinf�_�---- ���_����-i a!ub(_bc(2,i)l= 0 ----- numb�i O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-� comporel do south bs ut !!i------O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-EN iABS(mis,t�l(2,i)-mis,phys(2)) sLT. lmyeps*(max,t�l(2,i)-mis,t�l(2,i) infon= ���_����-i a!ub(_bc(3,i)l= 1TTTTinf�_�---- ���_����-i a!ub(_bc(3,i)l= 0 ----- numb�i O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-� comporel do north bs ut !!i------O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-EN iABS(max,t�l(2,i)-max,phys(2)) sLT. lmyeps*(max,t�l(2,i)-mis,t�l(2,i) infon= ���_����-i a!ub(_bc(4,i)l= 1TTTTinf�_�---- ���_����-i a!ub(_bc(4,i)l= 0 ----- numb�i O 8�--------------------------------------------------------gin � �! ChecFOTO 88��-� in dree iimoys�!!(numb�i O 8�--------------------------------------------------------gin � �! ChecFOTO 88��- N ipEN iim�f_�3infon= ���_����-- -!--------------------------------------------------gin � �! ChecWs�yO in on o om comporel do bottom bs ut !!i------O 8- -!--------------------------------------------------gin � �! ChecWs�yO in on o oEN iABS(mis,t�l(3,i)-mis,phys(3)) sLT. lmyeps*(max,t�l(3,i)-mis,t�l(3,i) infon= ---------------!ub(_bc(5,i)l= 1TTTTinf�_��_�---- ���_����-i a---!ub(_bc(5,i)l= 0 ���----- numb�i O 8- -!--------------------------------------------------gin � �! ChecWs�yO in on o om comporel do top bs ut !!i------O 8- -!--------------------------------------------------gin � �! ChecWs�yO in on o oEN iABS(max,t�l(3,i)-max,phys(3)) sLT. lmyeps*(max,t�l(3,i)-mis,t�l(3,i) infon= ---------------!ub(_bc(6,i)l= 1TTTTinf�_��_�---- ���_����-i a---!ub(_bc(6,i)l= 0 ���----- ���----- ---DOii------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRup1�>oy---------------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(---------teER e_!ub(_bcRETURN ie i�����_RETUR= _SINGLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�teER e_!ub(bc_sG_DOUBLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�teER e_!ub(bc_dG_Dyyyyy���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_mktree.f�������������������������������������������������������������0000644�0001752�0001753�00000060015�11616003524�020302� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������------�--------------------------------------------------------gin � �! ChecWs�yO in omsaSubrout��OF :ALL#���_�������� ��bs',----_mktreei------�--------------------------------------------------------gin � �! ChecWs�yO in omsCopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in omsCH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy_SINGLLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_mktree_s(----id,m hid,xp,Npil�,�ssig,mis,physE uår_smax,phys,bcieE,cost,misboxs-z�,pruneboxes,w�_m�ts,fixedE_������ uår_smaxvarianceEmaxboxcost,i(-en,ut sa,Nm,(-orsm h,tree-ypeRN ieE uår_spcost,u or_mist�lEu or_maxt�lEu or_ot�ls,u or_sis2proc)G_DOUBLLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_mktree_d(----id,m hid,xp,Npil�,�ssig,mis,physE uår_smax,phys,bcieE,cost,misboxs-z�,pruneboxes,w�_m�ts,fixedE_������ uår_smaxvarianceEmaxboxcost,i(-en,ut sa,Nm,(-orsm h,tree-ypeRN ieE uår_spcost,u or_mist�lEu or_maxt�lEu or_ot�ls,u or_sis2proc)G_Dyyyyy-------!! Twe irout��OFcreopesaa ----logyobaseda��lbs',-ree.y-------!! Tweiu or can directly specifyl do a_imag�_sofor bs',-ree, ra wiry_�����-!! dan choosingifromaa (etiNa iredeER et `ii_preservdecomp_*`.GOTO 88!!! Please seeldocmag�_op���FNaa`bs',-ree`ofor descripp���FNaa do ���_��!!! a_imag�_s.GOTO 88!!!y-------!! [WARNe i]y-------!! Twe iisofor advancediu orsionly.y---------------------------------------------------------------gin � �! ChecWs�yO in omsaIncludesi---------------------------------------------------------------gin � �! ChecWs�y------�--------------------------------------------------------gin � �! ChecWs�yO in omsaModulosy------�--------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t pa_m hyO in oUSE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_aag�_CALL#��USE�bs',modulo_m h_aag�_CALL#��USE�bs',modulo_----_DostTTTTinfUSE�bs',modulo_----_(-orsCALL#��USE�bs',modulo_m h_(-orsCALL#��USE�bs',modulo_m h_os,t�lsyO in oUSE�bs',modulo_teER e_!ub(_bcy------USE�bs',modulo_----_(ub(2procy------USE�bs',modulo_----_metis_(2py------USE�bs',modulo_fSE �n�_m�y------USE�bs',modulo_-reei------USE�bs',modulo_----_box2t�lsyO in o MPLICIT NONEy_SINGLLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE �singleG_DOUBLLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE � oub��G_Dyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o EGER ,_ ENT(INOUT) :: ----idGOTO 88-!! ID!numb�raidg�_ifyizaN wibto--logy.GOTO 88!!! Ifl ---id SIO0a��linput a new ----logyoisocreopet �EOF elsnew ----idGOTO 88-!! e irup1�>et wire, elsel do SE i_opet ---logyoisoreplacsd.GOTO 88!!!y-------!! [CAUTION]y-------!! *SEMANTICS CHANGED:* ` ---id S 0`oiso*not anymors* resgrvet fdextweoy�����_�!! rizaN ---logyo(nuerfdecomposip���). "RizaN ---logies"-are n��GOTO 88�!! geome ric �EOFneed�nã tup1p. Tweiu or can per��rmie i rizaN hif_ ���_��-!! operop���siwithout omcizaN - first�teER eaa ----logy.GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: xpy-------!! Pil�acls posip���s. Ialpresg�_,Odomainfdecomposip��� w erfboGOTO 88�!! guided byliil�aclsNg�_op���sGOTO 88 EGER ,_ ENT(IN ) :: Npil�y-------!! Numb�raNa iil�aclss. Set -- some hizaNsLE.0 iaa wire-are n�y-------!! iil�aclss.GOTO 88 EGER ,_ ENT(IN ) :: �ssigy-------!! Twei-ype-Naa!ubdomain-to-proces�o �ssignag�_. One of:GOTO 88!!!y-------!! * ii_preserv�ssign_ *�rnaly-------!! * ii_preserv�ssign_nodal_cuty-------!! * ii_preserv�ssign_nodal_commy-------!! * ii_preserv�ssign_dual_cuty-------!! * ii_preserv�ssign_dual_commy-------!! * ii_preserv�ssign_u or_ieER etGOTO 88!!!y-------!! [NOTE]y-------!! Tweilattorou os wibextornal l� �!!!-METIS �EOFisionly ���_��!!! availablo iaae i was compils.Nwith METIS support.GOTO 88REAL(MK), DIMENBRLE(: ),_ ENT(IN ) :: mis,phys ���_��!!! MinimumaNa ihysi� �!ex g�daNaa weacompupop���al tomain ( oub��)GOTO 88!!!y-------!! first�SE ex islppN iimiTO 888REAL(MK), DIMENBRLE(: ),_ ENT(IN ) :: max,phys ���_��!!! MaximumaNa ihysi� �!ex g�daNaa weacompupop���al tomain ( oub��)GOTO 88!!!y-------!! first�SE ex islppN iimiTO 888 EGER , DIMENBRLE(: ),_ ENT(IN ) :: bcieEGOTO 88!!! Bs ut !!-condip���s fdextweo----logy ------!!!y-------!! first�SE ex isl1-6 (uachmNaa weafacss)iTO 888REAL(MK), DIMENBRLE(: ),_PO ER :: DostTTTTinf-!! Estimopet Dost �ssociopet with !ubdomains. Ei wirou or-ieER et ��GOTO 88�!! input or decomposip��� resulta��loutput. TweiDost Naaaa!ubdomainGOTO 88-!! e igiven bylits volmag.GOTO 88REAL(MK), DIMENBRLE(: ),_OPTIONAL,_ ENT(IN) :: pDostTTTTinf-!! Array Naalength Npil� whichm!pecifiesa weacompupop���alTTTTinf-!! Dost �t ributsda-- uachmiil�acls. Ifl de iisoabsg�_,Oa unityaDost e y-------!! �ssmagt fdexuachmiil�acls.GOTO 88REAL(MK), DIMENBRLE(:,:), OPTIONAL,_PO ER :: u or_mist�l ���_��!!! MimimumaNa ex g�s���FNaa!ub(. OPTIONAL reseretorou oOFiEGOTO 88!!! decomp isousor ieER et.GOTO 88!!!y-------!! 1st�SE ex: x,y,(z) +y-------!! 2nd: !ubIDGOTO 88REAL(MK), DIMENBRLE(:,:), OPTIONAL,_PO ER :: u or_maxt�ly-------!! maximumaNa ex g�s���FNaa!ub(. y-------!! U oOFiE decomp isousor ieER et.GOTO 88!!!y-------!! 1st�SE ex: x,y,(z) +y-------!! 2nd: !ubIDGOTO 88 EGER ,_OPTIONAL :: u or_ot�l(numb�i -!! T-t �!numb�raNa !ubsionan � iroces�o s.y-------!! U oOFwhen decomp isousor ieER et INE o EGER, DIMENBRLE(: ),_ OPTIONAL,_PO ER :: u or_sis2procy-------!! Subdomain -- proces�o �ssignag�_. y-------!! U oOFiE �ssignag�_ isousor ieER et.GOTO 88!!!y-------!! SE ex: !ubID (glob �)iTO 888REAL(MK) ,_ ENT(IN ) :: misboxs-z�y-------!! Tweimis s-z�mNaa weaboxesy------LOGICAL ,_ ENT(IN ) :: pruneboxesy-------!! Whe wiro-- keep emptyaboxes or not?GOTO 88REAL(MK), DIMENBRLE(3,2),_ ENT(IN ) :: w�_m�tsy-------!! W�_m�tsofor bil�aclss, m h poi�_so�EOFgeome ry. `w�_m�ts(:,1)`GOTO 88!!! deER es weabsxaDosts (wwire--- reER e),_`w�_m�ts(:,2)` deER esGOTO 88!!! wwire--- cut a bsx.y------LOGICAL , DIMENBRLE(: ),_ ENT(IN ) :: fixedGOTO 88!!! Flags -- prevent cutsain certainfdirect���s. (seelbs',-ree)iTO 888REAL(MK) ,_ ENT(IN ) :: maxvariance ���_��!!! Maximumaaag�woOFvariancemNaaDosts between t�l(numb�i REAL(MK) ,_ ENT(IN ) :: maxboxcost ���_��!!! MaximumaDost Naaaabsx. Subdivis��� w erfcontinue (UBLLpossiblo)y-------!! SfaDost Naaanyabox isolbrger dan de . Set -- <= 0 -!! oid ,abloltdisocriterion.GOTO 88 EGER ,_ ENT(INOUT) :: m hid ���_��!!! M h idg�_ifier (usor numb�riza)ofor default m h (a �ieER et byy-------!! Nm)aNn dom----logy. Ifl<0,ae i w erfcreope a numb�rai *�rnally ���_��!!! aEOFrup1�>�i wire-onaexit.GOTO 88 EGER , DIMENBRLE(:,:), PO ER :: i(-artTTTTinf-!! S-art SE i_es (i,j[,k]) (first�SE ex)aNa !ub m h i-ub (secondy-------!! SE ex)ain glob �!m h.GOTO 88 EGER , DIMENBRLE(:,:), PO ER :: nt payO in o-!! Numb�raNa grid poi�_soin x,y[,z] (first�SE ex)aNa !ub m h i-ubyO in o-!! (second�SE ex).aIncludes deipoi�_soONa weat�lObs ut !iss.GOTO 88 EGER , DIMENBRLE(: ),_ ENT(IN ) :: NmyO in o-!! Numb�raNa m h poi�_so(not cells)ain uachmdirect���mNaa weaglob �TTTTinf-!! Dompupop���al tomain (includizaNpoi�_soONaits bs ut !iss)y------LOGICAL ,_ ENT(IN ) :: (-orsm hGOTO 88!!! Ifl`TRUE` (-orsa weam h teER ip���ai *�rnally. Ifl`FALSE`, -!! weam h sgrvesionly �s a guide fdextweodecomposip��� �EOFisinot -!! (-orsd �s a e i Dompupe!m h.GOTO 88 EGER ,_ ENT(IN ) :: tree-ype -!! One of:GOTO 88!!!y-------!! *ii_preservtree_binGOTO 88-!! *ii_preservtree_quadGOTO 88-!! *ii_preservtree_oct (3Dionly)GOTO 88 EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�>s --btus,_0oupon succes�.yy---------------------------------------------------------------gin � �! ChecWs�yO in om L � �!variablosyO in om--------------------------------------------------------gin � �! ChecWs�yO in o EGER :: issboxs elss�!ubGOTO 88 EGER, DIMENBRLE(2 ) :: ldcGOTO 88 EGER, DIMENBRLE(:,:), PO ER :: ss�_m�OO=> NULL()GOTO 88 EGER, DIMENBRLE(:,:), PO ER :: !ub(_bco=> NULL()GOTO 88 EGER, DIMENBRLE(: ),_PO ER :: ns�_m�OO=> NULL()GOTO 88 EGER, DIMENBRLE(: ),_PO ER :: nchld OO=> NULL()GOTO 88REAL(MK) :: t0,lmyepsy------REAL(MK), DIMENBRLE(pEN iim) :: gsvecy------REAL(MK), DIMENBRLE(:,:), PO ER :: mis,box => NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: max,box => NULL()GOTO 88CHARAC ER(LEN=_a RD ar) :: m gy------LOGICAL :: omc_bil�aclss,omc_m hGOTO 88 EGER :: ot�l iss, ot�l(numb�i EGER , DIMENBRLE( :), PO ER :: i-ubR ,t => NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: mis,t�lOO=> NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: max,t�lOO=> NULL()GOTO 88 EGER, DIMENBRLE(: ),_PO ER :: !ub2procO=> NULL()GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in om Extornalsy---------------------------------------------------------------gin � �! ChecWs�yy---------------------------------------------------------------gin � �! ChecWs�yO in om In------sey---------------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',----_mktreeRETURN ie i_SINGLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepssG_DOUBLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepsdG_Dyyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_����-----D ==�_9 ie issEN ie is s � TinNDIF issie iss-----Gy!ie issEN i ---id �f_� Tinfon= m ilial ie iss � TCwarniza m �_���_a Roc,'���_Nomc_im_imag�_t 'bs',----_mktreeRE & m år_s1'----id was resgt fdexnon-nuerfdecomposip���'F elssssss N ie im ---id S -1im -----FOTO 88! Ifl deiu or ieER et n!ubs winiu o wosey------EN iND�SENT(u or_ot�l( infon= ----------n!ubs = u or_ot�l(numb�i ---- ���_����-in!ubs = 0 -----FOTO 88EN iND�SENT(u or_mist�l infon= ----------mis,t�lO=> u or_mist�l ���_��-----FOTO 88EN iND�SENT(u or_maxt�l infon= ----------max,t�lO=> u or_maxt�ly-----------FOTO 88EN iND�SENT(u or_sis2proc)infon= ----------!ub2procO=> u or_sis2procy-----------FOTO 88!--------------------------------------------------------gin � �! ChecWs�yO in om rgureeUBLwe omcoiil�aclss �EOFm hGOTO 88!--------------------------------------------------------gin � �! ChecWs�yO in oomc_bil�aclss =_.FALSE.y_�����omc_m h_�����=_.FALSE.y_����� N iNpil� sGT. Tinomc_bil�aclss =_.TRUE.y_����� N iSIZE(Nm,1) sGE. pEN iim) fon= ---------- N ipEN iim �GT. 2) fon= ���_����------ N i(Nm(1)�GT.1)sAND.(Nm(2)�GT.1)sAND.(Nm(3)�GT.1)) uår_s1)))))))omc_m h_=_.TRUE.y_�����-------- ���_����-i a-- N i(Nm(1)�GT.1)sAND.(Nm(2)�GT.1)))omc_m h_=_.TRUE.y_�����---------FOTO 88----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaCn � dom-ree rout��Oi------�--------------------------------------------------------gin � �! ChecWs�yO in ogsvec(1:pEN iim) = misboxs-z�y------- build -reei------EN iND�SENT(pDost)infon= ----------�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)))pEN nproc,pruneboxes,gsvec,maxvarianceEmaxboxcost,fixedE_� uår_s1)))w�_m�ts,mis,box,max,boxssboxsnchldRN ieEpDost)numb�i ---- ���_����-i�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)))pEN nproc,pruneboxes,gsvec,maxvarianceEmaxboxcost,fixedE_� uår_s1)))w�_m�ts,mis,box,max,boxssboxsnchldRN ie)y-----------FOTO 88EN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2 'Genoral -ree decomposip��� fails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- ------- convel� -ree -- s�l(numb�i �_���_a R----_box2t�ls(mis,box,max,boxsschldRsboxsmis,t�lE �� uår_smax,t�lEot�ls,������� ��IFEN ie is s � TinNDIF issi------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF elsne_m�bor iNaa wea!ubdomainsGOTO 88---------------------------------------------------------gin � �! ChecWs�yO in o-----_a RfSE �n�_m�(mis,physEmax,phys,bcieE, uår_s1)))))))))))))))mis,t�lEmax,t�lEot�ls,ns�_m�,is�_m�,is����� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2 'FiEOizaNne_m�bor ifails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaAag�_opeam h tata -- av-id oc,'�si------�--------------------------------------------------------gin � �! ChecWs�yO in oissIp--_fii_preserv��_m�gf-- ���_��ldc(1� = ppN iimiTO 888ldc(2� = 0yO in o-----_a R,iopi,i(-en, els elss������� ��IFEN ie is s � Tinfon= ���_����-ilial ie iss � TCALL#���_�����(��_���_a Roc,'���_Nomc_ielg�_tubs',----_mktreeRE uår_s1)2'm h s-art SE i_es ISTART'F elsssssssssssGOTO 8888 NDIF issie iss----- -----------_a R,iopi,ut sa, els elss������� ��IFEN ie is s � Tinfon= ���_����-ilial ie iss � TCALL#���_�����(��_���_a Roc,'���_Nomc_ielg�_tubs',----_mktreeRE uår_s1)2'm h s-z�s NDATA'F elsssssssssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaDeER eam hesion wea!ubsy---------------------------------------------------------------gin � �! ChecWs�yO in o N iomc_m hinfon= ----------�_���_a Rm h_os,t�ls(Nm,mis,physEmax,phys,mis,t�lEmax,t�lEot�ls, uår_s1)))))))))))))))_����-i(-en,ut sa,sssssGOTO 8888 i N ie iss � Tinfon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2 1)2'DeER izaNm hesifails.'F elsssssssssssGOTO 8888 i88 NDIF issie iss iss----- ie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF elsDost Naauachm!ubdomainGOTO 88---------------------------------------------------------gin � �! ChecWs�yO in oEN iND�SENT(pDost)infon= ----------�_���_a R----_Dost(xp,Npil�,mis,t�lEmax,t�lEot�ls,nt sa, uår_s1)2 cost,i ieEpDost)numb�i ---- ���_����-i�_���_a R----_Dost(xp,Npil�,mis,t�lEmax,t�lEot�ls,nt sa, uår_s1)2 cost,i ie)y-----------FOTO 88EN ie iss � Tinfon= ���_����-ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2'CompupizaNDosts fails.'F elsssssssssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaAssigna wea!ubdomains -- proces�o sy---------------------------------------------------------------gin � �! ChecWs�yO in o N (�ssig �f_� ii_preserv�ssign_ *�rnalinfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� intornal �ssignag�_ rout��Oi------��-!--------------------------------------------------gin � �! ChecWs�yO in on o�_���_a R----_(ub(2proc(cost,ns�_m�,is�_m�,ot�ls,!ub2proc, uår_s1))i-ubR ,t,ot�l iss,sssssGOTO 8888 N ie iss � Tinfon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2 1'AssignizaN ubs - proces�o sifails.'F elsssssssssssGOTO 8888 i88NDIF issie iss is----- ie iss---- N i�ssig �f_� ii_preserv�ssign_nodal_cut .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_nodal_comm .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_dual_cut .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_dual_comminfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� u o METIS l� �!!!- oido �ssignag�_i------��-!--------------------------------------------------gin � �! ChecWs�yO in on o�_���_a R----_metis_(2p(mis,t�lEmax,t�lEos�_m�,is�_m�,cost,nt�ls, uår_s1)2�ssig,!ub2proc,i-ubR ,t,ot�l iss,sssssGOTO 8888 N ie iss � Tinfon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2 1'AssignizaN ubs - proces�o siusingiMETIS fails.'F elsssssssssssGOTO 8888 i88NDIF issie iss is----- ie iss---- N i�ssig �f_� ii_preserv�ssign_u or_ieER etinfon= ���_����-!--------------------------------------------------gin � �! ChecWs�-s�yO in on o� u or ieER et �ssignag�_i------��-!--------------------------------------------------gin � �! ChecWs�-s�yO in on oissIp_fii_preserv��_m�gf-- ���_�� ��ldc(1� = ot�l(numb�i O 8-----_a R,iopi,i(�l iss, els elss������� ��IF IFEN ie is s � Tinfon= ���_����---��ilial ie iss � TCALL#���_�����(������_���_a Roc,'���_Nomc_ielg�_tubs',----_mktreeRE uår_s1)2 1)2'R ,t Naal � �! ubs ISUBLIST'F elsssssssssssGOTO 8888 i88 NDIF issie iss is-----FOTO 88��-i-ubR ,t =fii_preservundeER et INE o ot�l issl= 0 DO it�l=1,ot�l(numb�i O 8F IFEN i!ub2proc,i(�l) �f_� ii_prankinfon= -----------------ot�l issl= ot�l issl+ 1TTTTinf�_����88��-i-ubR ,t(ot�l iss� = �!ubGOTO 88 iss is-----FOTO 88��----DOi---------- ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� unknown �ssignag�_ schemOi------��-!--------------------------------------------------gin � �! ChecWs�yO in on oilial ie iss � TC�����CALL#���_�WRITE(m g,'(A,I5)') 'Unknown �ssignag�_ schemO: ',�ssigy------ ���_���_a Roc,'���_Nomc_im_imag�_tubs',----_mktreeRE uår_s1)2m g, elsssssssssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF�EOFteER ea weabs ut !!-condip���sion wea!ubsion weal � �yO in omsaproces�o ( wearout��OFw erfaag�_opea wearequris.im mory)GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in oNULLIFY,!ub(_bc)GOTO 88C_���_a RteER e_!ub(_bc(mis,physEmax,phys,bcieE,mis,t�lEmax,t�lE uår_s1)))))))))))))))_���ot�ls,!ub(_bc,is����))_���EN ie iss � Tinfon= ���_����-ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2'fiEOizaN�EOFteER izaN wibBCiNaa wea!ubsifails. 'F elsssssssssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaS-orsa wea----logyoi *�rnally ���_��!--------------------------------------------------------gin � �! ChecWs�yO in o�_���_a R----_(-ors(----id,mis,physEmax,phys,mis,t�lEmax,t�lE!ub(_bc, uår_s1)))))))))))))))!ub2proc,ot�ls,bcieE,misboxs-z�,i-ubR ,t,ot�l iss, uår_s1)))))))))))))))ns�_m�,is�_m�,is����� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2 'S-orizaN ---logyofails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------EN i!-orsm h sAND. omc_m hinfon= numb�i O 8-!--------------------------------------------------------gin � �! Chenumb�i O 8-!saS-orsanew m h i *�rnally ���_��O 8-!--------------------------------------------------------gin � �! Chenumb�i O 8-�_���_a Rm h_(-ors(----id,m hid,ut sa,s(-en,Nm,sssssGOTO 8888 i N ie iss � Tinfon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mktreeRE uår_s1)2 1)2 'S-orizaNm h teER ip���afails.'F elsssssssssssGOTO 8888 i88 NDIF issie iss iss----- ie iss----- 8888 i88 ! (-orsm hGi------�--------------------------------------------------------gin � �! ChecWs�yO in omsaDumploutid ,gnosticifilssi---------------------------------------------------------------gin � �! ChecWs�y------� N ipEN iebug sGT. Tinfon= ���_��m WRITE(m g,'(A,I4.4)') 'pil�',ii_prank ���_��m OPEN(10,FILE=m gsGOTO 88!GOTO 88!O 88DO j=1,ot�l issGOTO 88!O 88��-oi = �!ubR ,t(jsGOTO 88!GOTO 88!O 88O 88!Ox-y planGOTO 88!O 88O 88WRITE(10,'(2e12.4)') mis,t�l(1,i),mis,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') max,t�l(1,i),mis,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') max,t�l(1,i),max,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') mis,t�l(1,i),max,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'(2e12.4)') mis,t�l(1,i),mis,t�l(2,i)GOTO 88!O 88O 88WRITE(10,'( 88a )')GOTO 88!GOTO 88!O 88O 88!Oy-z planGOTO 88!O 88O 88 N ipEN iim �GT. 2) fon= ���_��m WRITE(10,'(2e12.4)') mis,t�l(2,i),mis,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'(2e12.4)') max,t�l(2,i),mis,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'(2e12.4)') max,t�l(2,i),max,t�l(3,i) ���_��m WRITE(10,'(2e12.4)') mis,t�l(2,i),max,t�l(3,i) ���_��m WRITE(10,'(2e12.4)') mis,t�l(2,i),mis,t�l(3,i)GOTO 88!O 88O 88O 88WRITE(10,'( 88a )')GOTO 88!O 88O 88----- ------- �----DOi------!GOTO 88!O 88CLOSE(10)GOTO 88!----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRup1�>i------�--------------------------------------------------------gin � �! ChecWs�yO isOCONTINUEy�����_-----t�l(-------------_mktreeRETURN ie i�����_RETUR= �����_-ONTAINS �����_SUBROUTINE�D ==�_9 ie iss8 N i.NOT� ii_pin------zetinfon= ���_����-----ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_ipEN noin--,'bs',----_mktreeRE uår_s1)2 1)2'Please cn � ii_pin-- first!'F elsssssssssssGOTO 8888 i88 NDIF 8888sie iss is-----FOTO 88��-IF(misboxs-z� sLT. 0.0_MK) fon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_im_imag�_tubs',----_mktreeRE uår_s1)2 1)'misboxs-z� mustibe >= 0.0'F elssssss N ie iTO 8888 i88 NDIF 8888sie iss is-----FOTO 88��-DO i=1,ppN iimiTO 888 88��-IF(max,phys(i)sLE.mis,phys(i infon= ---------------ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mktreeRE uår_s1)2 1) 1)'max,phys mustibe > mis,phys'F elssssss N ie iTO 8888 i88 88 NDIF 8888sie iss is is-----FOTO 88��----DOi------ s8 N i�ssig �f_� ii_preserv�ssign_u or_ieER etinfon= ���_����-��-IF(u or_ot�l(NsLE. Tinfon= ���_����---��--ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mktreeRE uår_s1)2 1) 1)'n- s�l( ieER et in u or_ieER et �ssignag�_', uår_s1)))))))) elssssss N ie iTO 8888 i88 88 NDIF 8888sie iss is is-----FOTO 88��- s8 N i.NOT�ASSOCIATEDi!ub2proc infon= ----------------ilial ie iss � TC�����CALL#���_���������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mktreeRE uår_s1)2 1) 1) '!ub2procOmustibe aag�_opet fdexu or ieER et �ssignag�_', uår_s1))))))))) elssssss N ie iTO 8888 i88 88 NDIF 8888sie iss is is-----FOTO 88��- s8DO i=1,u or_ot�l(numb�i O 88��- s8 N ii!ub2proc,i)sLT.0).OR.i!ub2proc,i)sGE.pEN nproc infon= -------------------ilial ie iss � TC�����CALL#���_������������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mktreeRE uår_s1)2 1) 1) 1) 'inv---daproces�o !pecifiet in !ub2proc', uår_s1)))))))))))) elssssss N ie iTO 8888 i88 88 8 NDIF 8888sie iss is iss is-----FOTO 88��- s8---DOi------ s8-----FO8888�����ONTINUEy�����_----SUBROUTINE�D ==�__SINGLLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_mktree_sG_DOUBLLE_PRECISION ie issEND�SUBRLE INE o----SUBROUTINE�bs',----_mktree_dG_Dyyyyy�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_mkfield.f������������������������������������������������������������0000644�0001752�0001753�00000117507�11616003524�020437� 0����������������������������������������������������������������������������������������������������u--br �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�--------------------------------------------------------gin � �! ChecWs�yO in omsaSubrout��OF :ALL#���_�������� ��bs',----_mkfieldi------�--------------------------------------------------------gin � �! ChecWs�yO in omsCopyrMK), (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in om Ceu!�rafdexFluid Dynamics (DTUsGOTO 88!GOTO 88!GOTO 88! Twe ifils islpil�aNaa weaPiln �elaPil�acls M h L� �!!!-(PPM).GOTO 88!GOTO 88! PPMNe ifree software: you can red , ributsti and/or moyyyyy-------ti undera weatnrmsaNaa weaGNU LessIr Genoral P�lR c L�censeoy�����_� �s p�lR ,hed byl do Free Software Fs ut s���, ei wiroy�����_� vers���l3aNaa weaL�cense, dex(at your els���) any latoroy�����_� vers���.GOTO 88!GOTO 88! PPMNe id , ributsdain domhope tdat�i w erfbomu oful,GOTO 88! but WITHOUT ANY WARRANTY;iwithout even domimplis.iwarrantyaNaGOTO 88! MERCHANTABILITY dexFITNESS FOR A PARTICULAR PURPO--. Seel do ���_��!aGNU Genoral P�lR c L�censeofor morssdetails.GOTO 88!GOTO 88! You should omcoreceivedaa copyaNaa weaGNU Genoral P�lR c L�censey�����_� �EOF elsGNU LessIr Genoral P�lR c L�censeoalozaNwith PPM. Ialnot,GOTO 88! seel<http://www.gnu.org/l�censes/>.GOTO 88!GOTO 88! Piln �elaPil�acls M h L� �!!!-(PPM)GOTO 88! ETH ZurichyO in omsCH-8092 Zurich, Switzerl�EOy---------------------------------------------------------------gin � �! ChecWs�yy_SINGLLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_mkfield_s(----id,m hid,xp,Npil�,decomp,�ssig,INE o uår_s1))))))))))mis,physEmax,phys,bcieE,MK)osts-z�,cost, uår_s1))))))))))Nm,ssss,ndom,pcost,u or_mist�lEu or_maxt�lE uår_s1))))))))))u or_ot�ls,u or_sis2proc)G_DOUBLLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE�bs',----_mkfield_d(----id,m hid,xp,Npil�,decomp,�ssig,INE o uår_s1))))))))))mis,physEmax,phys,bcieE,MK)osts-z�,cost, uår_s1))))))))))Nm,ssss,ndom,pcost,u or_mist�lEu or_maxt�lE uår_s1))))))))))u or_ot�ls,u or_sis2proc)G_Dyyyyy-------!! Twe irout��OFisa wea----logyocreop��� rout��OFfor m hes.GOTO 88!!! Inl deiu or_ieER et case, deiu or mustip�ssGOTO 88!!! ex , izaN ubdomains �EOFn � Naa`u or_mist�l`,a`u or_maxt�l`, -!! `cost`,a`u or_ot�ls`Omustibe provided. Tweis�lObs ut !iss -!! musti---gnNwith m h pl�Ees.GOTO 88!!! Fo � � N wirodecomposip���s,oiil�aclss can bomu odGOTO 88-!! to guide wim. Fo tdis,a`Npil�` mustibe > 0. Fo GOTO 88-!! Npil� <= 0,xtweodecomposip��� islpurely m h-based.GOTO 88!!! Sub i�rsa wen mappet �� - proces�o siandy-------!! both dei----logyo�EOF elsm h teER ip���ais (-orsd.GOTO 88!!!y-------!! [NOTE]y-------!! Inl deicase Naau or-ieER et t�ls, a lot e y-------!! curreu!ly trusted. Wlsmayiwant -- includOFfur wiry_�����-!! D ==�sain dat�case, e.g. iaaeroperNDosts �rsaprovided, -!! itata �EOFntata �ctuallysmake sense, deiex g�tsaNaGOTO 88!!! � � sub i�rsai *�gor multiplss Naa weam h spaciza, etc...yy---------------------------------------------------------------gin � �! ChecWs�yO in om Modulosy------�--------------------------------------------------------gin � �! ChecWs�yO in oUSE�bs',modulo_t payO in oUSE�bs',modulo_t pa_m hyO in oUSE�bs',modulo_-ypeieEGOTO 88USE�bs',modulo_t�l(-artTTTTinfUSE�bs',modulo_t�l(-opTTTTinfUSE�bs',modulo_�����CALL#��USE�bs',modulo_aag�_CALL#��USE�bs',modulo_----_DostTTTTinfUSE�bs',modulo_----_(-orsCALL#��USE�bs',modulo_teER e_!ub(_bcy------USE�bs',modulo_m h_os,t�lsyO in oUSE�bs',modulo_m h_aag�_CALL#��USE�bs',modulo_m h_(-orsCALL#��USE�bs',modulo_----_(ub(2procy------USE�bs',modulo_----_metis_(2py------USE�bs',modulo_fSE �n�_m�y------USE�bs',modulo_decompy------USE�bs',modulo_-reei------USE�bs',modulo_----_box2t�lsyO in o MPLICIT NONEy_SINGLLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE �singleG_DOUBLLE_PRECISION ie issEND�SUBRLE INE o EGER, PARAMETER :: MKl ie iskSE � oub��G_Dyyyyy---------------------------------------------------------------gin � �! ChecWs�yO in omsaIncludesi---------------------------------------------------------------gin � �! ChecWs�y------�--------------------------------------------------------gin � �! ChecWs�yO in omsaA_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o EGER ,_ ENT(INOUT) :: ----idGOTO 88-!! ID!numb�raidg�_ifyizaN wibto--logy. +y-------!! Ifl ---id SIO0a��linput a new ----logyoisocreopet �EOF elsnew ----idGOTO 88-!! e irup1�>et wire, elsel do SE i_opet ---logyoisoreplacsd.GOTO 88!!!y-------!! [CAUTION]y-------!! *SEMANTICS CHANGED:* ` ---id S 0`oiso*not anymors* resgrvet fdextweoy�����_�!! rizaN ---logyo(nuerfdecomposip���). "RizaN ---logies"-are n��GOTO 88�!! geome ric �EOFneed�nã tup1p. Tweiu or can per��rmie i rizaN hif_ ���_��-!! operop���siwithout omcizaN - first�teER eaa ----logy.GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: xpy-------!! Pil�acls posip���s. Ialpresg�_,Odomainfdecomposip��� w erfboGOTO 88�!! guided byliil�aclsNg�_op���sGOTO 88 EGER ,_ ENT(IN ) :: Npil�y-------!! Numb�raNa iil�aclss. <=0 iaanã xp e igiven to guide wifdecomposip���GOTO 88 EGER ,_ ENT(IN ) :: decompy-------!! Tweiv---dadecomposip��� -ype i�rs:GOTO 88!!!y-------!! * ii_preservdecomp_bisect���y-------!! * ii_preservdecomp_xpencily-------!! * ii_preservdecomp_ypencily-------!! * ii_preservdecomp_zpencily-------!! * ii_preservdecomp_xy_slaby-------!! * ii_preservdecomp_xz_slaby-------!! * ii_preservdecomp_yz_slaby-------!! * ii_preservdecomp_cil�esia�y-------!! * ii_preservdecomp_cub-idGOTO 88-!! * ii_preservdecomp_u or_ieER etGOTO 88 EGER ,_ ENT(IN ) :: �ssigy-------!! Twei-ype-Naa!ubdomain-to-proces�o �ssignag�_. One of:GOTO 88!!!y-------!! * ii_preserv�ssign_ *�rnaly-------!! * ii_preserv�ssign_nodal_cuty-------!! * ii_preserv�ssign_nodal_commy-------!! * ii_preserv�ssign_dual_cuty-------!! * ii_preserv�ssign_dual_commy-------!! * ii_preserv�ssign_u or_ieER etGOTO 88!!!y-------!! [NOTE]y-------!! Tweilattorou os wibextornal l� �!!!-METIS �EOFisionly ���_��!!! availablo iaae i was compils.Nwith METIS support.GOTO 88REAL(MK), DIMENBRLE(: ),_ ENT(IN ) :: mis,phys ���_��!!! MinimumaNa ihysi� �!ex g�daNaa weacompupop���al tomain ( oub��)GOTO 88!!!y-------!! First�SE ex islppN iimiTO 888REAL(MK), DIMENBRLE(: ),_ ENT(IN ) :: max,phys ���_��!!! MaximumaNa ihysi� �!ex g�daNaa weacompupop���al tomain ( oub��)GOTO 88!!!y-------!! First�SE ex islppN iimiTO 888 EGER , DIMENBRLE(: ),_ ENT(IN ) :: bcieEGOTO 88!!! Bs ut !!-condip���s fdextweo----logy ------!!!y-------!! First�SE ex isl1-6 (uachmNaa weafacss)iTO 888 EGER, DIMENBRLE(: ),_ ENT(IN ) :: MK)osts-z�GOTO 88!!! S-z� (width)mNaa weag)ostilayer.GOTO 88REAL(MK), DIMENBRLE(: ),_PO ER :: DostTTTTinf-!! Estimopet Dost �ssociopet with !ubdomains. Ei wirou or-ieER et ��GOTO 88�!! input or decomposip��� resulta��loutput. TweiDost Naaaa!ubdomainGOTO 88-!! e igiven bylits volmag.GOTO 88 EGER ,_ ENT(INOUT) :: m hid ���_��!!! M h idg�_ifier (usor numb�riza)ofor default m h (a �ieER et byy-------!! Nm)aNn dom----logy. Ifl<0,ae i w erfcreope a numb�rai *�rnally ���_��!!! aEOFrup1�>�i wire-onaexit.GOTO 88 EGER , DIMENBRLE(: ),_ ENT(IN ) :: NmyO in o-!! Numb�raNa *m h poi�_s*o(not cells)ain uachmdirect���mNaa weaglob �TTTTinf-!! Dompupop���al tomain (includizaNpoi�_soONaits bs ut !iss)y------ EGER ,_ ENT( OUT) :: ssssGOTO 88!!! Rup1�>s --btus,_0oupon succes�.yOTO 88 EGER , OPTIONAL ,_ ENT(IN ) :: ndomyO in o-!! Numb�raNa ubdomains requested. Ialnotigiven, deinumb�r ���_��-!! oa !ubsiw erfbomequal -o deinumb�riNa iroces�o s. Twe iisoonly ���_��!!! relevent for decomp_cil�esia� aEOFpencilsiwithout iil�aclss.GOTO 88REAL(MK), DIMENBRLE(: ),_OPTIONAL,_ ENT(IN) :: pDostTTTTinf-!! Array Naalength Npil� whichm!pecifiesa weacompupop���alTTTTinf-!! Dost �t ributsda-- uachmiil�acls. Ifl de iisoabsg�_,Oa unityaDost e y-------!! �ssmagt fdexuachmiil�acls.GOTO 88REAL(MK), DIMENBRLE(:,:), OPTIONAL,_PO ER :: u or_mist�l ���_��!!! MimimumaNa ex g�s���FNaa!ub(. ���_��!!! U oOFiE decomp isousor ieER et.GOTO 88!!!y-------!! 1st�SE ex: x,y,(z) +y-------!! 2nd: !ubIDGOTO 88REAL(MK), DIMENBRLE(:,:), OPTIONAL,_PO ER :: u or_maxt�ly-------!! MaximumaNa ex g�s���FNaa!ub(. y-------!! U oOFiE decomp isousor ieER et.GOTO 88!!!y-------!! 1st�SE ex: x,y,(z) +y-------!! 2nd: !ubIDGOTO 88 EGER ,_OPTIONAL :: u or_ot�l(numb�i -!! T-t �!numb�raNa !ubsionan � iroces�o s.y-------!! reseretorou oOFwhen decomp isousor ieER et INE o EGER, DIMENBRLE(: ),_ OPTIONAL,_PO ER :: u or_sis2procy-------!! Subdomain -- proces�o �ssignag�_. SE ex: !ubID (glob �)iTO 888-!! reseretorou oOFiE �ssignag�_ isousor ieER et.Gyy---------------------------------------------------------------gin � �! ChecWs�yO in om L � �!variablosyO in om--------------------------------------------------------gin � �! ChecWs�yO in o EGER :: is elsstree-ypeRsboxyO in o EGER :: it�lEmisboxyO in o EGER, DIMENBRLE(1) :: ldcGOTO 88 EGER, DIMENBRLE(:,:), PO ER :: ss�_m�OO=> NULL()GOTO 88 EGER, DIMENBRLE(:,:), PO ER :: !ub(_bco=> NULL()GOTO 88 EGER, DIMENBRLE(: ),_PO ER :: ns�_m�OO=> NULL()GOTO 88 EGER, DIMENBRLE(: ),_PO ER :: nchld OO=> NULL()GOTO 88 EGER, DIMENBRLE(:,:), PO ER :: ss-art O=> NULL()GOTO 88 EGER, DIMENBRLE(:,:), PO ER :: ntata OO=> NULL()GOTO 88REAL(MK) :: t0,resea,sesea,lesea,lmyeps,maxvarGOTO 88REAL(MK), DIMENBRLE(ppN iim) :: gsvec,m hdxyO in oLOGICAL , DIMENBRLE(ppN iim) :: fixedGOTO 88REAL(MK), DIMENBRLE(3,2) :: w�_m�tsy------REAL(MK), DIMENBRLE(:,:), PO ER :: mis,box => NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: max,box => NULL()GOTO 88CHARAC ER(LEN=_a RD ar) :: m gy------ EGER :: ot�l issGOTO 88 EGER , DIMENBRLE( :), PO ER :: i-ubR ,t => NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: mis,t�lOO=> NULL()GOTO 88REAL(MK), DIMENBRLE(:,:), PO ER :: max,t�lOO=> NULL()GOTO 88 EGER :: ot�lsGOTO 88 EGER, DIMENBRLE(: ),_PO ER :: sub2procO=> NULL()GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in om Extornalsy---------------------------------------------------------------gin � �! ChecWs�yy---------------------------------------------------------------gin � �! ChecWs�yO in om In------sey---------------------------------------------------------------gin � �! ChecWs�yO in o-----t�l(-en('bs',----_mkfieldRETURN ie i_SINGLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepssG_DOUBLLE_PRECISION ie issEND�SUBRLE INE olmyepsl ie ismyepsdG_DyyyyyO in om dolnoticare about tweiv-riancemfor m hes.aS-op �s soonans you omcyO in om enough !ubdomains.yO in omaxvarl iHUGE(maxvar)yy---------------------------------------------------------------gin � �! ChecWs�yO in om rgureea_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N ipEN iebug sGT. Tinfon= ���_����-----D ==�_9 ie issEN ie is s � TinNDIF issie iss-----GyO in om Ifl deiu or ieER et n!ubs winiu o wosey------EN iND�SENT(u or_ot�l( infon= ----------n!ubs = u or_ot�l(numb�i ---- ���_����-in!ubs = 0 -----FOTO 88EN iND�SENT(u or_mist�l infon= ----------mis,t�lO=> u or_mist�l ���_��-----FOTO 88EN iND�SENT(u or_maxt�l infon= ----------max,t�lO=> u or_maxt�ly-----------FOTO 88EN iND�SENT(u or_sis2proc)infon= ----------!ub2procO=> u or_sis2procy-----------FOTO 88!--------------------------------------------------------gin � �! ChecWs�yO in om rompupe!grid spacizaFOTO 88!--------------------------------------------------------gin � �! ChecWs�yO in om hdx(1� = (max,phys(1)-mis,phys(1))/REAL(Nm(1)-1,MK)yO in om hdx(2� = (max,phys(2)-mis,phys(2))/REAL(Nm(2)-1,MK)yO in o N ipEN iim �GT. 2) fon= ���_����--m hdx(3� = (max,phys(3)-mis,phys(3))/REAL(Nm(3)-1,MK)yO in o----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaCnl�esia� (m h-only)Odomainfdecomposip���y---------------------------------------------------------------gin � �! ChecWs�yO in o N idecomp �f_� ii_preservdecomp_cil�esia�) fon= ---------- N iND�SENT(ndom infon= --------------C_���_a Rtecomp_cil�esia�(Nm,mis,physEmax,phys, uår_s1)))))))ii_preservdecomp_cub-id,mis,t�lEmax,t�lEot�ls,ssss,ndom iTO 8888 i8---- ���_����-i a--C_���_a Rtecomp_cil�esia�(Nm,mis,physEmax,phys, uår_s1)))))))ii_preservdecomp_cub-id,mis,t�lEmax,t�lEot�ls,ssss iTO 8888 i8-----FOTO 88��- N ie iss � Tinfon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 1)2 'Cnl�esia� decomposip��� fails.'F elsssssssssssGOTO 8888 iiiiiNDIF issie iss iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRecursive bisect���.aCnn bomiil�acls-guidedi------�--------------------------------------------------------gin � �! ChecWs�yO in o---- N idecomp�f_�ii_preservdecomp_bisect���infon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� recursive bisect���iusingi weagenoral bs',-reei------��-!--------------------------------------------------gin � �! ChecWs�yO in on o� build a bin!!!- reei------��-tree-ype 8888 iiiii=fii_preservtree_binGOTO 88 �� N iNpil� sGT. Tinfon= ���_����--��-w�_m�ts(1,1:2� = 0.5_MKon o� iil�aclss omco50%-w�_m�t ���_����--��-w�_m�ts(2,1:2� = 0.5_MK ���_����----- ���_����-i a-w�_m�ts(1,1:2� = 0.0_MKon o� only m h hns w�_m�t ���_����--��-w�_m�ts(2,1:2� = 1.0_MK ���_����------FOTO 88��-! geome ry hns no w�_m�t ���_����-w�_m�ts(3,1:2� iiii=f0.0_MK ���_����-! � � direct���s can bomcuty---------fixed(1:pEN iim) = .FALSE.y_����� ogsvec(1) =8REAL(MK)osts-z�(1),MK)*m hdx(1�y_����� ogsvec(2) =8REAL(MK)osts-z�(2),MK)*m hdx(2��� ��IF IFEN ipEN iim �GT. 2) fon= ���_����-- ogsvec(3) =8REAL(MK)osts-z�(3),MK)*m hdx(3) ���_����------FOTO 88��-misboxi=fii_pnprocy------ -- N iND�SENT(ndom inmisboxi=fMAX(ii_pnproc,ndom iTO 8888 i- build -reei------ -- N iND�SENT(pDost)infon= ---------- -i�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)2 1)2misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1)2 1)2mis,box,max,boxssboxsnchldRN ieEpDost)numb�i �----- ���_����-i a-�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)2 1)2misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1)2 1)2mis,box,max,boxssboxsnchldRN ie) ���_����------FOTO 88��- N ie iss � Tinfon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 1)2'Bisect���idecomposip��� fails.'F elsssssssssssGOTO 8888 iiiiNDIF issie iss is-----FOTO 88��-- convel� -ree -- s�l(numb�i o�_���_a R----_box2t�ls(mis,box,max,boxsschldRsboxsmis,t�lE �� uår_s _smax,t�lEot�ls,������� ��IF ssEN ie is s � TinNDIF issi------�--------------------------------------------------------gin � �! ChecWs�yO in omsaPencilsi------�--------------------------------------------------------gin � �! ChecWs�yO in o---- N iidecomp �f_� ii_preservdecomp_xpencil) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_ypencil) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_zpencil)infon= --------- N idecomp�f_�ii_preservdecomp_zpencilsAND.pEN iimsLT.3infon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE uår_s1)2 1)2'Cnnnotimake zFpencilsiinf2D!'F elsssssssssssGOTO 8888 i88 NDIF issie iss is-----FOTO 88��- N iNpil� sLT. 1infon= ���_����--��-�--------------------------------------------------------gin � �! ���_����--��-� No iil�aclss: cil�esia� pencilfdecomposip���y------��--��-�--------------------------------------------------------gin � �! ���_����--��- N iND�SENT(ndom infon= -------------- --C_���_a Rtecomp_cil�esia�(Nm,mis,physEmax,phys, uår_s1))))))))))decomp,mis,t�lEmax,t�lEot�ls,ssss,ndom iTO 8888 i8 i8---- ���_����-i a-- --C_���_a Rtecomp_cil�esia�(Nm,mis,physEmax,phys, uår_s1))))))))))decomp,mis,t�lEmax,t�lEot�ls,ssss iTO 8888 i8 i8-----FOTO 88��- s8 N ie iss � Tinfon= ���_����--��-o --ilial ie iss � TC�����CALL#���_����������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1))))))))))'Cnl�esia� pencilfdecomposip��� fails.'F elsssssssssssGOTO 8888 iiiii iiNDIF issie iss iss i8-----FOTO 88��----- ���_����-i a-�--------------------------------------------------------gin � �! ���_����--��-� With iil�aclss: pencilfquadrisect���iusingibs',-reei------��-i a-�--------------------------------------------------------gin � �! ���_����--��-� build a quad -ree, bin!!!-inf2d ���_����--��-tree-ype 8888 iiiii=fii_preservtree_quadFOTO 88��- s8 N ipEN iim �f_� 2) tree-ype =fii_preservtree_binGOTO 88 �� s8 N iNpil� sGT. Tinfon= ���_����--��-----w�_m�ts(1,1:2� = 0.5_MKon o� iil�aclss omco50%-w�_m�t ���_����--��-----w�_m�ts(2,1:2� = 0.5_MK ���_����--------- ���_����-i a-- --w�_m�ts(1,1:2� = 0.0_MKon o� only m h hns w�_m�t ���_����--��-----w�_m�ts(2,1:2� = 1.0_MK ���_����----------FOTO 88��- s8 ! geome ry hns no w�_m�t ���_����-----w�_m�ts(3,1:2� iiii=f0.0_MK ���_����- s8 ! fixi weaeroperNdirect��� ���_����- s8 fixed(1:pEN iim) = .FALSE.y_����� ooooo N idecomp �f_� ii_preservdecomp_xpencil) fixed(1)_=_.TRUE.y_�����----ooo N idecomp �f_� ii_preservdecomp_ypencil) fixed(2)_=_.TRUE.y_�����----ooo N idecomp �f_� ii_preservdecomp_zpencil) fixed(3)_=_.TRUE.y_�����----ooogsvec(1) =8REAL(MK)osts-z�(1),MK)*m hdx(1�y_����� o-ooogsvec(2) =8REAL(MK)osts-z�(2),MK)*m hdx(2��� ��IF IF-ooo N ipEN iim �GT. 2) fon= ���_����-- o-ooogsvec(3) =8REAL(MK)osts-z�(3),MK)*m hdx(3) ���_����----------FOTO 88��- s8 misboxi=fii_pnprocy------ ---ooo N iND�SENT(ndom inmisboxi=fMAX(ii_pnproc,ndom iTO 8888 iiiii- build -reei------ ---ooo N iND�SENT(pDost)infon= ---------- -iiiii�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1))))))))))misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1))))))))))mis,box,max,boxssboxsnchldRN ieEpDost)numb�i �--------- ���_����-i a-- --C_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1))))))))))misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1))))))))))mis,box,max,boxssboxsnchldRN ie iTO 8888 i8 i8-----FOTO 88��- s8 N ie iss � Tinfon= ���_����--��-o --ilial ie iss � TC�����CALL#���_����������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1))))))))))'Pencilfdecomposip��� fails.'F elsssssssssssGOTO 8888 iiiii iiNDIF issie iss iss i8-----FOTO 88��------ convel� -ree -- s�l(numb�i o�����_���_a R----_box2t�ls(mis,box,max,boxsschldRsboxsmis,t�lE � uår_s1)2 1)2max,t�lEot�ls,ssss iTO 8888 i8 i8EN ie is s � TinNDIF issie iss ss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaSlabsy---------------------------------------------------------------gin � �! ChecWs�yO in o---- N iidecomp �f_� ii_preservdecomp_xy_slab) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_xz_slab) .OR. uår_s1)2 idecomp �f_� ii_preservdecomp_yz_slab)infon= --------- N idecomp�f_�ii_preservdecomp_xz_slabsAND.pEN iimsLT.3infon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE uår_s1)2 1)2'Cnnnotimake x-z slabsiinf2D!'F elsssssssssssGOTO 8888 i88 NDIF issie iss is-----FOTO 88��- N idecomp�f_�ii_preservdecomp_yz_slabsAND.pEN iimsLT.3infon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE uår_s1)2 1)2'Cnnnotimake y-z slabsiinf2D!'F elsssssssssssGOTO 8888 i88 NDIF issie iss is-----FOTO 88��-!--------------------------------------------------gin � �! ChecWs�yO in on o� slab bisect���iusingi weagenoral bs',-reei------��-!--------------------------------------------------gin � �! ChecWs�yO in on o� build a bin!!!- reei------��-tree-ype 8888 iii=fii_preservtree_binGOTO 88 �� N iNpil� sGT. Tinfon= ���_����--��-w�_m�ts(1,1:2� = 0.5_MKon o� iil�aclss omco50%-w�_m�t ���_����--��-w�_m�ts(2,1:2� = 0.5_MK ���_����----- ���_����-i a-w�_m�ts(1,1:2� = 0.0_MKon o� only m h hns w�_m�t ���_����--��-w�_m�ts(2,1:2� = 1.0_MK ���_����------FOTO 88��-! geome ry hns no w�_m�t ���_����-w�_m�ts(3,1:2� iiii=f0.0_MK ���_����-! fixi weaeroperNdirect���(numb�i ofixed(1:pEN iim) = .FALSE.y_����� o N idecomp �f_� ii_preservdecomp_xy_slab) fon= ���_����--��-fixed(1)_=_.TRUE.y_�����----ooofixed(2)_=_.TRUE.y_�����--------FOTO 88��- N idecomp �f_� ii_preservdecomp_xz_slab) fon= ���_����--��-fixed(1)_=_.TRUE.y_�����----ooofixed(3)_=_.TRUE.y_�����--------FOTO 88��- N idecomp �f_� ii_preservdecomp_yz_slab) fon= ���_����--��-fixed(2)_=_.TRUE.y_�����----ooofixed(3)_=_.TRUE.y_�����--------FOTO 88��-gsvec(1) =8REAL(MK)osts-z�(1),MK)*m hdx(1�y_����� ogsvec(2) =8REAL(MK)osts-z�(2),MK)*m hdx(2��� ��IF IFEN ipEN iim �GT. 2) fon= ���_����-- ogsvec(3) =8REAL(MK)osts-z�(3),MK)*m hdx(3) ���_����------FOTO 88��-misboxi=fii_pnprocy------ -- N iND�SENT(ndom inmisboxi=fMAX(ii_pnproc,ndom iTO 8888 i- build -reei------ -- N iND�SENT(pDost)infon= ---------- -i�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)2 1)2misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1)2 1)2mis,box,max,boxssboxsnchldRN ieEpDost)numb�i �----- ���_����-i a-�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)2 1)2misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1)2 1)2mis,box,max,boxssboxsnchldRN ie) ���_����------FOTO 88��- N ie iss � Tinfon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 1)2'Slabidecomposip��� fails.'F elsssssssssssGOTO 8888 iiiiNDIF issie iss is-----FOTO 88��-- convel� -ree -- s�l(numb�i o�_���_a R----_box2t�ls(mis,box,max,boxsschldRsboxsmis,t�lE �� uår_s _smax,t�lEot�ls,������� ��IF ssEN ie is s � TinNDIF iss 88��----------------------------------------------------gin � �! ChecWs�hecWs�yO in omsaCub-idsy---------------------------------------------------------------gin � �! ChecWs�yO in o---- N idecomp �f_� ii_preservdecomp_cub-idinfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� cub-id octasect���iusingi weagenoral bs',-reei------��-!--------------------------------------------------gin � �! ChecWs�yO in on o� build an oct -ree inf3dFOTO 88��-tree-ype 8888 iii=fii_preservtree_octyO in on o� �EOFn quad -ree-inf2d ���_����- N ipEN iim �f_� 2) tree-ype =fii_preservtree_quadFOTO 88��- N iNpil� sGT. Tinfon= ���_����--��-w�_m�ts(1,1:2� = 0.5_MKon o� iil�aclss omco50%-w�_m�t ���_����--��-w�_m�ts(2,1:2� = 0.5_MK ���_����----- ���_����-i a-w�_m�ts(1,1:2� = 0.0_MKon o� only m h hns w�_m�t ���_����--��-w�_m�ts(2,1:2� = 1.0_MK ���_����------FO in on o� geome ry hns no w�_m�t ���_����-w�_m�ts(3,1:2� iiii=f0.0_MK ���_����-! � � direct���s can bomcuty---------fixed(1:pEN iim) = .FALSE.y_����� ogsvec(1) =8REAL(MK)osts-z�(1),MK)*m hdx(1�y_����� ogsvec(2) =8REAL(MK)osts-z�(2),MK)*m hdx(2��� � 88��- N ipEN iim �GT. 2) fon= ���_����-- ogsvec(3) =8REAL(MK)osts-z�(3),MK)*m hdx(3) ���_����------FOTO 88��-misboxi=fii_pnprocy------ -- N iND�SENT(ndom inmisboxi=fMAX(ii_pnproc,ndom iTO 8888 i- build -reei------ -- N iND�SENT(pDost)infon= ---------- -i�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)28��-misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1)2 1)2mis,box,max,boxssboxsnchldRN ieEpDost)numb�i �----- ���_����-i a-�_���_a R-ree(xp,Npil�,Nm,mis,physEmax,phys,tree-ypeR uår_s1)2 1)2misbox,.FALSE.,gsvec,maxvar,-1.0_MK,fixedEw�_m�ts, uår_s1)2 1)2mis,box,max,boxssboxsnchldRN ie) ���_����------FOTO 88��- N ie iss � Tinfon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 1)2'Cub-ididecomposip��� fails.'F elsssssssssssGOTO 8888 iiiiNDIF issie iss is-----FOTO 88��-- convel� -ree -- s�l(numb�i o�_���_a R----_box2t�ls(mis,box,max,boxsschldRsboxsmis,t�lE �� uår_s _smax,t�lEot�ls,������� ��IF ssEN ie is s � TinNDIF isss 88��----------------------------------------------------gin � �! ChecWs�hecWs�yO in omsaU or providesidecomposip���: DolnothizaFOTO 88!--------------------------------------------------------gin � �! ChecWs�yO in o---- N idecomp �f_� ii_preservdecomp_u or_ieER etinfon= ���_����-�! NOPss 88��----------------------------------------------------gin � �! ChecWs�hecWs�yO in omsaUnknown decomposip��� -ypeFOTO 88!--------------------------------------------------------gin � �! ChecWs�yO in o---- ���_����-ilial ie iss � TC�����CALL#���_�WRITE(m g,'(A,I5)') 'Unknown decomposip��� -ype: ',decompy------����_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE uår_s1)2m g, elsssssssssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF elsne_m�bo siNaa wea!ubdomainsi------�--------------------------------------------------------gin � �! ChecWs�yO in o�_���_a RfSE �n�_m�(mis,physEmax,phys,bcieE, uår_s1)))))))))))))))mis,t�lEmax,t�lEot�ls,ns�_m�,is�_m�,is����� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 'FiEOizaNne_m�bo sifails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaDeER eam hesion wea!ubsi------�--------------------------------------------------------gin � �! ChecWs�yO in o�_���_a Rm h_os,t�ls(Nm,mis,physEmax,phys,mis,t�lEmax,t�lEot�ls, uår_s1)))))))))))))))_�s(-en,ut sa,ss����))_���EN ie iss � Tinfon= ���_����-ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2'DeER izaNm hesifails.'F elsssssssssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF elsDost Naauachm!ubdomainGOTO 88---------------------------------------------------------gin � �! ChecWs�yO in o N idecomp � � ii_preservdecomp_u or_ieER etinfon= ���_����-� N iND�SENT(pDost)infon= ---------- -ii�_���_a R----_Dost(xp,Npil�,mis,t�lEmax,t�lEot�ls,nt sa,cost, uår_s1)))))))))))))))_�_����-iliaEpDost)numb�i �------ ���_����-i a--C_���_a R----_Dost(xp,Npil�,mis,t�lEmax,t�lEot�ls,nt sa,cost,ssss iTO 8888 i8-----FOTO 88��- N ie iss � Tinfon= ���_����--��-ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 1)2'rompupizaNDosts fails.'F elsssssssssssGOTO 8888 iiiiNDIF issie iss iss----- ie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaAssigna wea!ubdomains -- proces�o sy---------------------------------------------------------------gin � �! ChecWs�yO in o N i�ssig �f_� ii_preserv�ssign_i *�rnalinfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� i *�rnal �ssignag�_ rout��O ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on oC_���_a R----_(ub(2proc(cost,ns�_m�,is�_m�,ot�ls,sis2proc, uår_s1))i-ubR ,t,ot�l iss,������� ��IF ssEN ie iss � Tinfon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1))))'AssignizaN ubs -- proces�o s fails.'F elsssssssssssGOTO 8888 iiiNDIF issie iss is-----FOTO 88---- N i�ssig �f_� ii_preserv�ssign_nodal_cut .OR. uår_s1)))�ssig �f_� ii_preserv�ssign_nodal_comm .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_dual_cut .OR. uår_s1)2 �ssig �f_� ii_preserv�ssign_dual_comminfon= ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� u o METIS l� �!!!--- do �ssignag�_ ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on oC_���_a R----_metis_(2p(mis,t�lEmax,t�lEos�_m�,is�_m�,cost,nt�ls, uår_s1))�ssig,sis2proc,i-ubR ,t,ot�l iss,������� ��IF ssEN ie iss � Tinfon= ���_����--��ilial ie iss � TC�����CALL#���_�����_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1))))'AssignizaN ubs -- proces�o s usingiMETIS fails.'F elssssss uår_s1)2 1)sssssGOTO 8888 iiiNDIF issie iss is-----FOTO 8---- N i�ssig �f_� ii_preserv�ssign_u or_ieER etinfon= ���_����----------------------------------------------------------gin � �! ChyO in on o� u or ieER et �ssignag�_ ���_����----------------------------------------------------------gin � �! ChyO in on o els =fii_preservaag�_RfS_ ���_����-ldc(1)_=_ot�l(numb�i O 8�_���_a Raag�_(i-ubR ,t,ldcs elss������� ��IF ssEN ie is s � Tinfon= ���_����--��-ilial ie iss � TCf sal ���_����--��-�_���_a Roc,'���_Nomc_imag�_,'bs',----_mkfieldRE uår_s1))))))'R ,t Naal � �! ubs ISUBLIST'F elsssssssssssGOTO 8888 iiiii iiNDIF issie iss is-----FOTO 88��-�_���_a Raag�_(sis2proc,ldcs elss������� ��IF ssEN ie is s � Tinfon= ���_����--��-ilial ie iss � TCf sal ���_����--��-�_���_a Roc,'���_Nomc_imag�_,'bs',----_mkfieldRE uår_s1))))))'t�lO-- proces�o �ssignag�_ R ,t SUB2PROC'F elsssssssssssGOTO 8888 iiiiNDIF issie iss is-----FOTO 88��-i-ubR ,t =fii_preservundeER et INE o ot�l iss = 0 s8DO it�l=1,nt�ls GOTO 8888 iiiiEN isub2proc,it�l �f_� ii_prankinfon= ���_����--��-o --ot�l iss = ot�l iss + 1 ���_����--��-o --i-ubR ,t(ot�l iss)_=_it�ly------ iss is-----FOTO 88��----DOi--------- ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on o� unknown �ssignag�_ schemO ���_����-!--------------------------------------------------gin � �! ChecWs�yO in on oilial ie iss � TC�����CALL#���_�WRITE(m g,'(A,I5)') 'Unknown �ssignag�_ schemO: ',�ssigy------ ���_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE uår_s1)2m g, elsssssssssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaFiEOF�EOFteER ea weabs ut !!-condip���s on wea!ubs on weal � �yO in omsaproces�o ( wearout��OFw erfaag�_ope wearequris.imemory)GOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in oNULLIFY(!ub(_bc)GOTO 88C_���_a RteER e_!ub(_bc(mis,physEmax,phys,bcieE,mis,t�lEmax,t�lE uår_s1)))))))))))))))_�_�ot�ls,sis(_bc,ss����))_���EN ie iss � Tinfon= ���_����-ilial ie iss � TC�����CALL#���_��_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2'fiEOizaN�EOFteER ingi weaBCiNaa wea!ubs fails. 'F elssssss uår_s1)2 sssssGOTO 8888 NDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaS-orsxtweo----logy ------!--------------------------------------------------------gin � �! ChecWs�yO in oC_���_a R----_(-ors(----id,mis,physEmax,phys,mis,t�lEmax,t�lEsis(_bc, uår_s1)))))))))))))))sis2proc,ot�ls,bcieE,0._MK,i-ubR ,t,ot�l iss, uå uår_s1)))))))))))))))ns�_m�,is�_m�,is����� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 'S-orizaN ---logyofails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaS-orsxnew m h i *�rnally ���_��!--------------------------------------------------------gin � �! ChecWs�yO in o�_���_a Rm h_(-ors(----id,m hid,ut sa,s(-en,Nm,ssss��� ��IFEN ie iss � Tinfon= ���_����--ilial ie iss � TC�����CALL#���_���_���_a Roc,'���_Nomc_isis_fails.,'bs',----_mkfieldRE uår_s1)2 'S-orizaNm h teER ip���afails.'F elsssssssssssGOTO 8888 iNDIF issie iss----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaDumploutid ,gnosticifilssy---------------------------------------------------------------gin � �! ChecWs�y!� ��IFEN i_a Rtebug sGT. Tinfon= m WRITE(m g,'(A,I4.4)') 'pil�',ii_prank m OPEN(10,FILE=m g) m DO ul=1,nt�l issGm i_=_it�lR ,t(ul) mGm ! x-y pl�EGm WRITE(10,'(2e12.4)') mis,t�l(1,i),mis,t�l(2,i)Gm WRITE(10,'(2e12.4)') max,t�l(1,i),mis,t�l(2,i)Gm WRITE(10,'(2e12.4)') max,t�l(1,i),max,t�l(2,i)Gm WRITE(10,'(2e12.4)') mis,t�l(1,i),max,t�l(2,i)Gm WRITE(10,'(2e12.4)') mis,t�l(1,i),mis,t�l(2,i)Gm WRITE(10,'( a )') mGm ! y-z pl�EGm N ipEN iim �GT. 2) fon= m WRITE(10,'(2e12.4)') mis,t�l(2,i),mis,t�l(3,i)Gm WRITE(10,'(2e12.4)') max,t�l(2,i),mis,t�l(3,i)Gm WRITE(10,'(2e12.4)') max,t�l(2,i),max,t�l(3,i)Gm WRITE(10,'(2e12.4)') mis,t�l(2,i),max,t�l(3,i)Gm WRITE(10,'(2e12.4)') mis,t�l(2,i),mis,t�l(3,i)Gm WRITE(10,'( a )') m ----- ! ---DOi! CLOSE(10) m ----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRep1�>i------�--------------------------------------------------------gin � �! ChecWs�yO in o els =fii_preservdeaag�_CALL#���_���_a Raag�_(is�_m�,ldcs elss������� ��IF�_���_a Raag�_(ns�_m�,ldcs elss������� ��IFIFidecomp� � ii_preservdecomp_cnl�esia� sAND. uår_decomp� � ii_preservdecomp_u or_ieER etinfon= ���_����-�_���_a Raag�_(mis,box,ldcs elss������� ��IF ss�_���_a Raag�_(max,boxsldcs elss������� ��IF ss�_���_a Raag�_(schldRldcs elss������� ��IF--- --FOTO 88EN ie iss � Tinfon= ���_����--ilial ie iss � TCf sal ���_����--�_���_a Roc,'���_Nomc_ideaag�_,'bs',----_mkfieldRE uår_s1)2 'deaag�_ap���afails.'F elsssssssssssGOTO 88----- i- is CONTINUE�� ��IF�_���s�l(-op('bs',----_mkfieldRETURN ie i� ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie issEN i.NOT� ii_pin------zetinfon= ���_����-��--ilial ie iss � TC�����CALL#���_������_���_a Roc,'���_Nomc_iii_pnoin--,'bs',----_mkfieldRE uår_s1)2 1)2'Please cn � ii_pin-- first!'F elsssssssssssGOTO 8888 i88 NDIF 8888sie iss is-----FOTO 88��-DO i=1,pEN iimGOTO 8888 i88IFimax,phys(i).LE.mis,phys(i)infon= ---------- -iiiilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'max,phys mustibe > mis,phys'F elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��-i88IFiNm(i) sLT. 2) fon= ���_����-- o-oilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'Nm mustibe > 1-inf� � dimg�s���s'F elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��-i88IFiMK)osts-z�(i) sLT. Tinfon= ���_����--��-o ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'MK)osts-z� mustibe >= 0'F elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��----DOi------i88IF iNpil� sGT. T sAND. ASSOCIATED(xp)infon= ---------- -IFiSIZE(xp,2) sLT. Npil�infon= ���_����--��-o ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'notienough iil�aclss contaR et infxp', uår_s1)))))))) elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��-i88IFiSIZE(xp,1) sLT. pEN iim) fon= ���_����--��-o ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'leaOizaNdimg�s���iNaaxp too sm� �', uår_s1)))))))) elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��-i88IF iND�SENT(pDost)infon= ---------- -iiiiIFiSIZE(pDost,1) sLT. Npil�infon= ���_����--��-o �-o ilial ie iss � TC�����CALL#���_������������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))))))'pDost doeslnoticontaR NDosts fo � � iil�aclss', uår_s1)))))))))))) elssssss)sssssGOTO 8888 iii88 i88 NDIF 8888sie iss is iss is-----FOTO 88��-i88-----FOTO 88��------FOTO 88��- N i�ssig �f_� ii_preserv�ssign_u or_ieER etinfon= ���_����- o N idecomp � � ii_preservdecomp_u or_ieER etinfon= ���_����-������ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'decomp -ype is tupO-- u or_ieER et fdextwisoassignag�_', uår_s1)))))))) elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��-i88IFiu or_ot�l( .LE. Tinfon= ���_����--��-o ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'n- s�l( ieER et in u or_ieER et assignag�_', uår_s1)))))))) elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��-i88IF i.NOT�ASSOCIATED(u or_sis2proc)infon= -----------��-o ilial ie iss � TC�����CALL#���_���������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1)))))))))'sis2proc mustibe aag�_opet fdexu or ieER et �ssignag�_', uår_s1))))))))) elssssss)sssssGOTO 8888 iii88 iNDIF 8888sie iss is is-----FOTO 88��-i88DO i=1,u or_ot�l(numb�i O 88��-i88IF i(u or_sis2proc(i).LT Ti.OR.(u or_sis2proc(i).GE. uår_s1))))))))))ii_pnproc)infon= -----------��-o -o ilial ie iss � TC�����CALL#���_������������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))) ))'Mnv---daproces�o !pecifiet in sis2proc', uår_s1)))))))))))) elssssss)sssssGOTO 8888 iii88 i88 NDIF 8888sie iss is iss is-----FOTO 88��-i88---DOi------i88-----FOTO 88��- N idecomp �f_� ii_preservdecomp_u or_ieER etinfon= ���_����- o Niu or_ot�l( .LE. Tinfon= ���_����--��-o ilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1))))))))'n- s�l( ieER et in u or_ieER et decomposip���', uår_s1)))))))) elssssss)sssssGOTO 8888 iii88 NDIF 8888sie iss is is-----FOTO 88��-i88IF ii.NOT�ASSOCIATED(u or_mist�l i.OR. uår_s1)))))i.NOT�ASSOCIATED(u or_maxt�l iinfon= -----------��-o ilial ie iss � TC�����CALL#���_���������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE å uår_s1)))))))))'mis,t�l/max,t�lOmustibe aag�_opet fdexu or ieE. decomp', uår_s1))))))))) elssssss)sssssGOTO 8888 iii88 iNDIF 8888sie iss is is-----FOTO 88��-i88!--------------------------------------------------gin � �! ChecWs�yO in on o om rgureethatl deiu or-ieER et s�l( add up -o deiwholeyO in on o om compupop���al tomain.yO in on o om ONE COULD8DO MORE TESTS HERE.y_�����----oo!--------------------------------------------------gin � �! ChecWs�yO in on o oresea = (max,phys(1)-mis,phys(1))*(max,phys(2)-mis,phys(2)) ���_����- o NipEN iim�f_�3infon= ���_����--��- oresea = resea*(max,phys(3)-mis,phys(3))sie iss is is-----FOTO 88��-i88sesea = 0.0_MK ���_����- s8DO i=1,u or_ot�l(numb�i O 88��-i8lesea = (u or_maxt�l(1,i)-u or_mist�l(1,i))* å uår_s1))))))))) ))(u or_maxt�l(2,i)-u or_mist�l(2,i)sGOTO 8888 iii88 NipEN iim�f_�3infon= ���_����--��- o-i8lesea = lesea *)(u or_maxt�l(3,i)-u or_mist�l(3,i)sGOTO 8888 iii88 --- --FOTO 88 88��-i88sesea = sesea + leseaFOTO 88��-i88---DOi------i8888 NiABS(sesea-resea)/resea.GE.lmyepsinfon= ���_����--��- o!--------------------------------------------------gin � �! Chec ���_����--��- o! Mism�tch! ���_����--��- o!--------------------------------------------------gin � �! Chec ���_����--��- oilial ie iss � TC�����CALL#���_��������_���_a Roc,'���_Nomc_im_imag�_tubs',----_mkfieldRE uå uår_s1)))))))))'faultya!ubdomains ieER et'F elsssssssssssGOTO 8888 iiiii NDIF 8888sie iss is is-----FOTO 88��------FO8888�����ONTINUE�FOTO 88��-�--------------------------------------------------------gin � �! ChecFOTO 88��-� rgureebcieEFOTO 88��-�--------------------------------------------------------gin � �! ChecFOTO 88��-� [TODO]!!!y------��-� mustiD ==� fdexcompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomcoo eamorey------��-� dimg�s���,ans its possibleethatlyou dont wanpO--y------��-� omco wea!ameabs ut !!-condip���s on eve!!-sidey------��-� Naa wea!ubdomainy------��-� W erfbe accs upet fdex�s soonans wea!tructuroofy------��-� weafield -ype is bettor ieER et INE o��-�--------------------------------------------------------gin � �! ChecFOTO 88--- SUBROUTINE-D ==�__SINGLLE_PRECISION ie issEND�SUBRLE INE o--- SUBROUTINE-bs',----_mkfield_sG_DOUBLLE_PRECISION ie issEND�SUBRLE INE o--- SUBROUTINE-bs',----_mkfield_dG_Dyyyyy�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_Dost.f���������������������������������������������������������������0000644�0001752�0001753�00000050414�11616003524�017765� 0����������������������������������������������������������������������������������������������������u(-en �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� o��-�--------------------------------------------------------gin � �! Chec-s�yO in omsaSubrout��OF : bs',----_Dost o��-�--------------------------------------------------------gin � �! Chec-s�yO in omsCopyr_m�t (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in omsaaaaaaaaaaaaaaaaaaaCe *�r fdexFluid Dynamics (DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrantyaofGOTO 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_Dost_s(xp,Np,mis,t�lEmax,t�lEot�ls,nnodes,cost, uå uår_s1)))))))))iliaEpDost)n_DOUBLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_Dost_d(xp,Np,mis,t�lEmax,t�lEot�ls,nnodes,cost, uå uår_s1)))))))))iliaEpDost)n_DyyyyyO in om!m Twisorout��OFcalculetesF elsDompupop���al Dost NayO in om!m uachm!ubdomain baset on ei wer weaeil�aclss (iaa were are any)GOTO 88m!m or weam h points. Tweaeer-eil�aclsNDosts are summed up iaaprese *.GOTO 88m!m Iflnot, �-unityaDost isoassumet fdexuachmeil�acls.GOTO 88m!mGOTO 88m!m [NOTE]GOTO 88m!m Ifl`Np < 0`,aDost isoDompupet baset on eil�aclss. IfGOTO 88m!m `SIZE(nnodes,2) >= ot�ls`,aDost baset on m h pointsGOTO 88m!m isoDompupet �EOFnddet -o deieil�aclsNDost. IflNne_ wer eil�aclssGOTO 88m!m nor m h are given,sDost Naaam!ubdomain isoequal -o its volume. o��-�--------------------------------------------------------gin � �! Chec-s�yO in oms Modulss o��-�--------------------------------------------------------gin � �! Chec-s�yO in oUSE-bs',moduls_t sayO in oUSE-bs',moduls_s�l(-il�yO in oUSE-bs',moduls_s�l(-opyO in oUSE-bs',moduls_�����CALL#��USE-bs',moduls_aag�_CALL#��USE-bs',moduls_writeyO in oIMPLICIT NONE__SINGLE_PRECISION ie issEND�SUBRLE INE oINTEGER, PARAMETER :: MKl ie iskSE �singlen_DOUBLE_PRECISION ie issEND�SUBRLE INE oINTEGER, PARAMETER :: MKl ie iskSE �do�lRen_DyyyyyO in om--------------------------------------------------------gin � �! Chec-s�yO in oms Includssy---------------------------------------------------------------gin � �! ChecWs�y_SIieEON MPI INE oINCLUDE 'mpif.h'n_DyyyyyO in om--------------------------------------------------------gin � �! Chec-s�yO in oms A_imag�_s in oyO in om--------------------------------------------------------gin � �! Chec-s�yO in oREAL(MK), DIMENBRLE(:,:), INTENT(INn o) :: xpGOTO 88m!m Pes�acls posip���syO in oREAL(MK), DIMENBRLE(:,:), INTENT(INn o) :: mis,t�lGOTO 88m!m Min. extg�_ Naa wea!ubdomainsi------REAL(MK), DIMENBRLE(:,:), INTENT(INn o) :: max,t�lGOTO 88m!m Max. extg�_ Naa wea!ubdomainsi------REAL(MK), DIMENBRLE(: o), POINTER------ :: Dost o��-�!m Aggregope Dost fdexuachm!ubdomainy------REAL(MK), DIMENBRLE(: o), OPTRLEAL, INTENT(IN) :: pDost o��-�!m Per-eil�aclsNDosts. OPTRLEAL. IflNnotaprese *, �-cost Naa1aeer o��-�!m eil�aclsNisoassumet. INE oINTEGER , DIMENBRLE(:,:), INTENT(INn o) :: nnodes o��-�!m Number Naam h nodes in uachmdirect��� (first index) on eachyO in om!m t�lO(second index). IflNp i( .LE. T,xtwisoisotaken ooDompupeo weGOTO 88m!!NDost. IflSIZE(nnodes,2).LT ot�ls,snEOF elre are no iil�aclss, Dost o��-�!m isoDompupet �s geome r c volume. o��-INTEGER , INTENT(INn o) :: Np o��-�!m Number Naaeil�aclss. SupO-- .LE. T iaam h-baset Dosts are desiret. INE oINTEGER , INTENT(INn o) :: ot�l(numb�i m!m Total number Naa!ubdomainsi------INTEGER , INTENT( OUT) :: ilianumb�i m!m Rep1�>s (-itus, 0 upon sicces�yO in om--------------------------------------------------------gin � �! Chec-s�yO in oms L � �!variablss o��-�--------------------------------------------------------gin � �! Chec-s�yO in oREAL(MK) :: t0y_SIieEON MPI INE oREAL(MK), DIMENBRLE(:), POINTER---:: Dostsum =>oNULL()n_DyyyyyO in oINTEGER, DIMENBRLE(pEN iim) :: ldu,Nc INE oREAL(MK),DIMENBRLE(pEN iim) :: les,t�lGOTO 88INTEGER :: i,ipil�,jGOTO 88INTEGER :: ielssnR ,t1snR ,t2,idomyO in oINTEGER, DIMENBRLE(:), POINTER--- :: iR ,t1 =>oNULL()nO in oINTEGER, DIMENBRLE(:), POINTER--- :: iR ,t2 =>oNULL()nO in oINTEGER, DIMENBRLE(:), POINTER--- :: iR ,t3 =>oNULL()nO in oCHARACTER(LEN=pEN char) :: m gyO in om--------------------------------------------------------gin � �! Chec-s�yO in oms Ex*�rnals o��-�--------------------------------------------------------gin � �! Chec-s�yO in oyO in om--------------------------------------------------------gin � �! Chec-s�yO in oms In------se yO in om--------------------------------------------------------gin � �! Chec-s�yO in o�_���s�l(-il�('bs',----_DostRETURN ie iyO in om--------------------------------------------------------gin � �! Chec-s�yO in oms rgureem_imag�_sy---------------------------------------------------------------gin � �! ChecWs�yO in o N i_a Rtebug sGT. Tinfon= �_���D ==�_9 ie issEN ie is s � TinNDIF iss 88��------ i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaAag�_ope memory fdextwsNDostsi------�--------------------------------------------------------gin � �! ChecWs�yO in o els =fii_preservaag�_RfS_ ���_��ldu(1)_=_ot�l(numb�i �_���_a Raag�_(cost,ldu, elss������� ��IFIF ie is s � Tinfon= ���_����--ilial ie iss � TCf sal ���_����--�_���_a Roc,'���_Nomc_iaag�_,'bs',----_DostRE��-- uår_s1)2 'Dosts perNt�lOCOST'F elsssssssssssGOTO 8888 iNDIF iss 88��------ i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaAnd in------zeO-- zeroi------�--------------------------------------------------------gin � �! ChecWs�yO in ocost = 0.0_MK i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaDe-ermR ea weatotal Dost Naauachm!ub ei wer baset on eil�aclss ��CALL#��msabaset on m h pointsGOTO 88m--------------------------------------------------------gin � �! ChecWs�yO in oIF iNp sGT. Tinfon= ���_����-- N i_a Rtebug sGT. Tinfon= ����--�_���_a Rwrite(ii_prank,'bs',----_DostRE��-å uår_s1)))))))'rompupizaNDosts baset on eil�aclss',ssss iTO 8888 i8-----FOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- msaAag�_ope memory fdextwsNeil�aclsNR ,tsFOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- els =fii_preservaag�_RfS_ ���_����-�ldu(1)_=_Np ���_����--�_���_a Raag�_(iR ,t1sldu, elss������� ��IF��-- N ie is s � Tinfon= ���_����--��--ilial ie iss � TCf sal ���_����--��--�_���_a Roc,'���_Nomc_iaag�_,'bs',----_DostRE��-- uår_s1)2 ))))'eil�aclsNR ,ta1aILIST1'F elsssssssssssGOTO 8888 iiiiiNDIF issie iss iss----- ie iss��--�_���_a Raag�_(iR ,t2sldu, elss������� ��IF��-- N ie is s � Tinfon= ���_����--��--ilial ie iss � TCf sal ���_����--��--�_���_a Roc,'���_Nomc_iaag�_,'bs',----_DostRE��-- uår_s1)2 ))))'eil�aclsNR ,ta2aILIST2'F elsssssssssssGOTO 8888 iiiiiNDIF issie iss iss----- FOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- msaIn------zeO-wsNeil�aclsNR ,tFOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- DO ieil�=1,Np ���_����--��--iR ,t1(ipil�in= ieil�sie iss iss---DOi------i888nR ,t1 =_Np FOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- msaLoop ove � � !ubdomainsi------��- m--------------------------------------------------------gin � �! CheFOTO 88��- DO idom=ot�ls,1,-1 ���_����--��-onR ,t2 = 0 s88��- DO i=1snR ,t1 ���_����--��-o -- ieil�n= iR ,t1(isGOTO 8888 iii88 i88m--------------------------------------------------------gin �GOTO 8888 iii88 i88m Ifl-wsNeil�aclsNisoinsidextwsNDurrg�_ subdomain, �ssign itGOTO 8888 iii88 i88m--------------------------------------------------------gin �GOTO 8888 iii88 i88 N ipEN iim �GT. 2) fon= ���_����-- o-ooo8 i88 N ixp(1,ipil�i.GE.mis,t�l(1,idom sAND. å uår_s1)))))))))))))))xp(1,ipil�i.LT.max,t�l(1,idom sAND. å uår_s1)))))))))))))))xp(2,ipil�i.GE.mis,t�l(2,idom sAND. å uår_s1)))))))))))))))xp(2,ipil�i.LT.max,t�l(2,idom sAND. å uår_s1)))))))))))))))xp(3,ipil�i.GE.mis,t�l(3,idom sAND. å uår_s1)))))))))))))))xp(3,ipil�i.LT.max,t�l(3,idom ) fon= ���_����-- o-ooo8 i888888m----------------------------------------------------- ���_����-- o-ooo8 i888888m--�ost baset on eil�aclssGOTO 88��-- o-ooo8 i888888m----------------------------------------------------- ���_����-- o-ooo8 i888888IF iND�SENT(pDost)infon= ---------- -iiiiiiiiiiiiiiiiiiDost(idom n= Dost(idom n+ pDost(ipil�i ---------- -iiiiiiiiiiiiii---- ���_����-i a--iiiiiiiiiiiiiiiiDost(idom n= Dost(idom n+ 1.0_MK ���_����-- -iiiiiiiiiiiiii-----FOTO 88��-----iiiiiiiii---- ���_����-i a--iiiiiiiiiiim------------------------------------------------------ ���_����-i a--iiiiiiiiiiim iaanot, �ddlit weal ,t Naaeil�aclsN-- searchyO in o��-i a--iiiiiiiiiiim------------------------------------------------------ ���_����-i a--iiiiiiiiiiinR ,t2 =inR ,t2 + 1 ���_����--��-o ----------iR ,t2(nR ,t2in= ieil�sie iss issssssssssssss-----FOTO 88��-----iiiii---- ���_����-i a--iiiiiiii N ixp(1,ipil�i.GE.mis,t�l(1,idom sAND. å uår_s1)))))))))))))))xp(1,ipil�i.LT.max,t�l(1,idom sAND. å uår_s1)))))))))))))))xp(2,ipil�i.GE.mis,t�l(2,idom sAND. å uår_s1)))))))))))))))xp(2,ipil�i.LT.max,t�l(2,idom ) fon= ���_����-- o-ooo8 i888888m----------------------------------------------------- ���_����-- o-ooo8 i888888m--�ost baset on eil�aclssGOTO 88��-- o-ooo8 i888888m----------------------------------------------------- ���_����-- o-ooo8 i888888IF iND�SENT(pDost)infon= ---------- -iiiiiiiiiiiiiiiiiiDost(idom n= Dost(idom n+ pDost(ipil�i ---------- -iiiiiiiiiiiiii---- ���_����-i a--iiiiiiiiiiiiiiiiDost(idom n= Dost(idom n+ 1.0_MK ���_����-- -iiiiiiiiiiiiii-----FOTO 88��-----iiiiiiiii---- ���_����-i a--iiiiiiiiiiim------------------------------------------------------ ���_����-i a--iiiiiiiiiiim iaanot, �ddlit weal ,t Naaeil�aclsN-- searchyO in o��-i a--iiiiiiiiiiim------------------------------------------------------ ���_����-i a--iiiiiiiiiiinR ,t2 =inR ,t2 + 1 ���_����--��-o ----------iR ,t2(nR ,t2in= ieil�sie iss issssssssssssss-----FOTO 88��-----iiiii-----FOTO 88��-----i---DOiiim loop ove eil�aclssGFOTO 88��-----im--------------------------------------------------------gin � �! FOTO 88��-----im sCopy weal ,ts (well, only iaanR ,t2 changet - decreasedi ---------- -iim--------------------------------------------------------gin � �! FOTO 88��-----iIF inR ,t2s � nR ,t1infon= ���_����--��-o --oR ,t1 =_nR ,t2 ���_����--��-o --iR ,t3 =>oiR ,t1 ���_����--��-o --iR ,t1 =>oiR ,t2 ���_����--��-o --iR ,t2 =>oiR ,t3FOTO 88��-----i---IF GFOTO 88��-----im--------------------------------------------------------gin � �! FOTO 88��-----im sExit iaa weal ,t isoempty ---------- -iim--------------------------------------------------------gin � �! FOTO 88��-----iIF inR ,t1�f_�0) EXITsie iss iss---DO---im loop ove !ubdomainsi------��- FOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- msargureethatlwe didNnotamiss a eil�aclsFOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- IF inR ,t2 sGT. Tinfon= ����--ilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_iiil�_un�ss,'bs',----_DostRE��------ uår_s1)2 ))))'Bewese:lDompupet Dosts are wrong!'F elsssssssssssGOTO 8888 i----- FOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- msaDeaag�_ope weamemory fdextwsNR ,tsFOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- els =fii_preservdeaag�_CALL#�������_���_a Raag�_(iR ,t2sldu, elss������� ��IF��-- N ie is s � Tinfon= ���_����--��--ilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_ideaag�_,'bs',----_DostRE��-- uår_s1)2 ))))'eil�aclsNR ,ta2aILIST2'F elsssssssssssGOTO 8888 i----- ie iss��--�_���_a Raag�_(iR ,t1sldu, elss������� ��IF��-- N ie is s � Tinfon= ���_����--��--ilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_ideaag�_,'bs',----_DostRE��-- uår_s1)2 ))))'eil�aclsNR ,ta1aILIST1'F elsssssssssssGOTO 8888 i----- FOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- msaDo an AllReduce Naa weaDosts asoo eaproces�o only hns ITSFOTO 88��- msaeilaclss, bup _���_il�aclss contribupe!-o deiDost ( weGOTO 88��- msaeil�aclss are not yetamapped!)FOTO 88��- m--------------------------------------------------------gin � �! CheF_SIieEON MPI INE o��- m--------------------------------------------------------gin � �! CheFOTO 88��- msaSkipxtwisoiflwe only hncoo eat�lE becau o thatlmeans -hatFOTO 88��- msaei wer wersNisoonly o eaproces�o , o we hncoa rizaFOTO 88��- msa ---logy. In wealattor case weaAllReduce would leaO!-o wrongFOTO 88��- msaresults.GOTO 88��- m--------------------------------------------------------gin � �! CheFOTO 88��- IF int�l( .GT. 1infon= ���_����--��- els =fii_preservaag�_RfS_ ���_����-� ��ldu(1)_=_ot�l(numb�i �_���_a Raag�_(costsumsldu, elss������� ��IF��-- -- N ie is s � Tinfon= ���_����--��-- --ilial ie iss � TCf sal ���_����--��-- --�_���_a Roc,'���_Nomc_iaag�_,'bs',----_DostRE��-- uår_s1)2 ))))))'sim NaaDosts Naaa � iroces�o s COSTSUM'F elsssssssssssGOTO 8888 iiiii iiNDIF issie iss isssss-----FOTO 88��-----Dostsum = 0.0_MK _SINGLE_PRECISION ie issEND�SUBRLE INE o��-- --�_���MPI_AllReduce(cost,costsumsot�ls,MPI_REAL,MPI_SUME��-- uår_s1)2 ))pEN comm,ssss��_DOUBLE_PRECISION ie issEND�SUBRLE INE o��-- --�_���MPI_AllReduce(cost,costsumsot�ls,MPI_ie issEND�SUBRLE, uår_s1)))))MPI_SUMEpEN comm,ssss��_DyyyyyO in oooooooom--------------------------------------------------------gin � �! yO in oooooooom sCopy t sa ba=�_9 ie issooooom--------------------------------------------------------gin � �! yO in oooooooocost = costsum yO in oooooooom--------------------------------------------------------gin � �! yO in oooooooom sDeaag�_ope weatempor !!-costsum arrayyO in oooooooom--------------------------------------------------------gin � �! yO in oooooooo els =fii_preservdeaag�_CALL#������ �_���_a Raag�_(costsumsldu, elss������� ��IF��-- -- N ie is s � Tinfon= ���_����--��-- --ilial ie iss � TC�����CALL#���_����������_���_a Roc,'���_Nomc_ideaag�_,'bs',----_DostRE�� uår_s1)2 ))))))'sim NaaDosts Dosts COSTSUM'F elsssssssssssGOTO 8888 iiii-----FOTO 88��-------F_DyyyyyO in o----- FOTO 88 N iSIZE(nnodes,2) .GE. ot�lsinfon= ���_����-�!--------------------------------------------------------gin � �! -heFOTO 88��- msarost baset on m h pointsGOTO 88��-�!--------------------------------------------------------gin � �! -heFOTO 88��- N i_a Rtebug sGT. Tinfon= ����--�_���_a Rwrite(ii_prank,'bs',----_DostRE��-å uår_s1)))))))'rompupizaNDosts baset on m h points',ssss iTO 8888 i8-----FOTO 88��- N ipEN iim �f_� 3infon= ���_����--��- DO i=1snt�l(numb�i O 88��-i88 Nc(1)_=_onodes(1,i)numb�i O 88��-i88 Nc(2)_=_onodes(2,i)numb�i O 88��-i88 Nc(3)_=_onodes(3,i)numb�i O 88��-i88 Dost(i n= Dost(i n+ (REAL(Nc(1),MK)*REAL(Nc(2),MK)*��-å uår_s1)))))))))))REAL(Nc(3),MK))numb�i O 88��-i---DOi------i888---- ���_����-i a--DO i=1snt�l(numb�i O 88��-i88 Nc(1)_=_onodes(1,i)numb�i O 88��-i88 Nc(2)_=_onodes(2,i)numb�i O 88��-i88 Dost(i n= Dost(i n+ (REAL(Nc(1),MK)*REAL(Nc(2),MK))numb�i O 88��-i---DOi------i888-----FOTO 88---- N iNp sLT. 1infon= ���_����--!--------------------------------------------------------gin � �! -heFOTO 88��- msarost baset on geome ryoiflwe hncono iil�aclsssnEOFno m hGOTO 88��-�!--------------------------------------------------------gin � �! -heFOTO 88��- N i_a Rtebug sGT. Tinfon= ����--�_���_a Rwrite(ii_prank,'bs',----_DostRE��-å uår_s1)))))))'rompupizaNDosts baset on geome ry',ssss iTO 8888 i8-----FOTO 88��- N ipEN iim �f_� 3infon= ���_����--��- DO i=1snt�l(numb�i O 88��-i88 les,t�l(1)_=_max,t�l(1,i)-mis,t�l(1,i)numb�i O 88��-i88 les,t�l(2)_=_max,t�l(2,i)-mis,t�l(2,i)numb�i O 88��-i88 les,t�l(3)_=_max,t�l(3,i)-mis,t�l(3,i)numb�i O 88��-i88 Dost(i n= les,t�l(1)*les,t�l(2)*les,t�l(3)numb�i O 88��-i---DOi------i888---- ���_����-i a--DO i=1snt�l(numb�i O 88��-i88 les,t�l(1)_=_max,t�l(1,i)-mis,t�l(1,i)numb�i O 88��-i88 les,t�l(2)_=_max,t�l(2,i)-mis,t�l(2,i)numb�i O 88��-i88 Dost(i n= les,t�l(1)*les,t�l(2)numb�i O 88��-i---DOi------i888-----FOTO 88----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaSome diagnosticsy---------------------------------------------------------------gin � �! ChecWs�yO in o N i_a Rtebug sGT. 1infon= ���_����--�_���_a Rwrite(ii_prank,'bs',----_DostRE�� uår_s1)2 1)2'-----------------------------gin � �! ChecWs�',ssss iTO 8888 i8DO i=1snt�l(numb�i O 88��-iWRITE(m g,'(I4,A,F15.3)') i,'m!ub Dost: ',Dost(i ����--�_���_a Rwrite(ii_prank,'bs',----_DostRE��å uår_s1))))))))))m g,ssss iTO 8888 i8---DOi------i888�_���_a Rwrite(ii_prank,'bs',----_DostRE�� uår_s1)2 1)2'-----------------------------gin � �! ChecWs�',ssss iTO 888----- i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaRep1�> yO in om--------------------------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-op('bs',----_DostRETURN ie i� ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF int�l( .LE. Tinfon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å uår_s1)))))))'nt�l( mustibe > 0'F elsssssssssssGOTO 8888 iiiiiNDIF 8888sie iss is -----FOTO 88��- N iSIZE(mis,t�lE2) sLT. nt�l( .OR. SIZE(max,t�lE2) sLT. nt�l(infon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å uår_s1)))))))'notienough t�l( !pecifiet in mis,t�lE_max,t�l'F elsssssssssssGOTO 8888 iiiiiNDIF 8888sie iss is -----FOTO 88��- N iSIZE(mis,t�lE1i.LT.pEN iim�OR.SIZE(max,t�lE1i.LT.pEN iiminfon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å uår_s1)))))))'leaOizaNdimg�s���iin mis,t�lE_max,t�l wrong'F elsssssssssssGOTO 8888 iiiiiNDIF 8888sie iss is -----FOTO 88��- DO i=1snt�l(numb�i O 88��-iDO j=1,pEN iimGOTO 8888 i8888��- N imax,t�l(j,i) sLT. mis,t�l(j,i)infon= ---------- -iiiiiiiiiiilial ie iss � TC�����CALL#���_���������������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å uår_s1)))))))1)))))))'max,t�lOmustialwaysibe >= mis,t�l'F elsssssssssssGOTO 8888 iiiii iiiiiiiNDIF 8888sie iss is -----FOTO 88��-----i---DOiTO 8888 i8---DOi------i888IF iNp sGT. Tinfon= ���_����--i888IF iSIZE(xp,2) sLT. Npinfon= ---------- -iiiiiiilial ie iss � TC�����CALL#���_�����������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å uår_s1)))))))1)))'notienough iil�aclss contaR et infxp', elsssssssssssGOTO 8888 iiiii iiiNDIF 8888sie iss is -----FOTO 88��-----iIF iSIZE(xp,1) sLT. pEN iim) fon= ���_����--��-o iiiilial ie iss � TC�����CALL#���_�����������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å uår_s1)))))))1)))'leaOizaNdimg�s���iNaaxp ist�fficig�_', elsssssssssssGOTO 8888 iiiii iiiNDIF 8888sie iss is -----FOTO 88��-------FOTO 88��- N iND�SENT(pDost)infon= ---------- -iiIF iSIZE(pDost,1) sLT. Np) fon= ���_����--��-o iiiilial ie iss � TC�����CALL#���_�����������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å uår_s1)))))))1)))'pDost mustibe Naaat least length Np', elsssssssssssGOTO 8888 iiiii iiiNDIF 8888sie iss is -----FOTO 88��-------FO8888���� CONTINUE�� ��IF--- SUBROUTINE-D ==�__SINGLE_PRECISION ie issEND�SUBRLE INE o--- SUBROUTINE-bs',----_Dost_s�_DOUBLE_PRECISION ie issEND�SUBRLE INE o--- SUBROUTINE-bs',----_Dost_dG_Dyyyyy����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libbs'-1.2.1/src/----/bs',----_(-ors.f��������������������������������������������������������������0000644�0001752�0001753�00000043610�11616003524�020151� 0����������������������������������������������������������������������������������������������������u(-en �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�--------------------------------------------------------gin � �! Chec-s�yO in omsaSubrout��OF : �_a R----_(-orsi------�--------------------------------------------------------gin � �! ChecWs�yO in omsCopyr_m�t (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), yO in omsaaaaaaaaaaaaaaaaaaaCe *�r fdexFluid Dynamics (DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrantyaofGOTO 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår_s1)))))))1)))))))))))))))t�l(_bc,sis2procsot�ls,bcieE,K)osts-z�, uår_s1)))))))))))))))))))))))it�lR ,t,nt�l iss,ns�_m�,is�_m�,isss��_DOUBLE_PRECISION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_d(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår_s1)))))))1)))))))))))))))t�l(_bc,sis2procsot�ls,bcieE,K)osts-z�, uår_s1)))))))))))))))))))))))it�lR ,t,nt�l iss,ns�_m�,is�_m�,isss��_DyyyyyO in om!m Twisorout��OF(-orssaa � relevanpOisssrmap���aaboutyO in om!m elsnewa ---logy (creopet bya_a Rtecomp rout��Os) iny------m!m aa ---logy !tructur. Ifl-wsNgivena ---logy ID pointsO--y------m!m an exissizaN ---logy,lit isoreplaced,aelse UBLICISIO0, �-newyO in om!m ---logy !tructurNisoaag�_opet �EOFnppDyyet into-bs',----. TweyO in om!m newaICIisorep1�>et fdextweiu or.GOTO 88m!mGOTO 88m!m [NOTE]GOTO 88m!m Twisorout��OFdeag�_opesF elsarray:)t�l(_bc pisset -o i*.GOTO 88m!m Tweachoice NaaplacizaNit wersNisosomewhatlarbit�!!!, bupGOTO 88m!m sincemewha,������MpnR , 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-sTABE,K)osts-mkyyy �NE oSUBROU---E,K)osts-mkBROUTI- whym----dom newnaresulsoreI- -�--.-----------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-opUSE-bs',moduls_s�l(-il�yO in oUSE-bs',moduls_s�l(-opyO in oUSE-bs',moduls_�����CALL#��USE-bs',moduls_aag�_CALL#��USE-bs',moduls_writeyO in oIMPLICIT NONE__SINGLE_PRECISION ie issEND�SUBRLE INE oINTEGER, PARAMETER :: MKl ie---l_inevet_--iR ,t1(ipMETER :: MKl ie iskSE �singlen_DOUBLE_PRECosts- iskSE �singEND�SUBRLE INE---------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-op.h'n_DyyyyyO in om--------------------------------------------------------gin � �! Chec-s�yO in oms A_imag�_s in oyO in om---------- oINTEGER, PARAMETER :: MKl ie iskSE �do�lRen_DyyyyyO in om--------------------------------------------------------gin � �! Chec-s�yO in oms Includssy---------------------------------------------------------------gin � �! ChecWs�y_SIieEON MPI INE oINCLUDs�l(-op:,:), INTENT(INn o) :: xpGOTO 88m!m Pes�acls posip���syO in oREAL(MK), DIMENBRLE(:,:), INTENT(INn o) :: mis,t�lGOTO 88m!m MaclsNOTO 88m!m Max. extg�_)))) oSUBROU---ainsi------REAL(MK)----gi. *, �-cost Naa1aeer o��-�!m eil�aclsN��-�!m Aggregope Dost)))) oSUBROU---amainy------REAL(MK----gi. *, �-cost Naa1aeer o��-�!m eil�,t�lGOTO 88m!m Max. extg�_ Naa wea!ubdomainsi------REAL(MK), DIMENBRLE(: o), POINTER------ :: Dost o��-�!m Aggregope Dost fdexuachm!ubdomainy------REAL(MK), DIMENBRLE(: o) in om!m t�lO(second indexpDost o��-�!m P 88m ETexuachm!ubdBfy------��-� weafchoiT.pENogysssGOISION ie LE(: o) in om!m t�lO(second�!m o��-�!m Aggregope Twisorouexuachm!ubdAnumb�i O -------nppDGOISI LE(: o) in om!m t�lO(second�!m o��-�!m Aggregope wa ---loexuachm!ubdLiiiiiii---nphNE l��.GOTO moyyISION ieLE(: o) in om!m t�lO(second�!m o��-�!m Aggregope ustiD ==� fd!ubdBfy------��-� weafon points. Tweaeer-eiboxE(: o), POINTER------------------��-�!m Aggregope � releva ==� fd!ubdS1,NpREAL(MK � relayee LE(: o) in om!mmmmmmmmmmmmmmmmmm!m Rep1�>s (-itus, 0 upon sicces�yO in om------------afon _PRECISI LE(: o) in om!mmmmmmmmmmmmmmmmmm!m Rep1�>s (-itus, 0 u--loexuachm!ubdN------------afon 88 i88 NyISION ieLE(: o) in om!mmmmmmmmmmmmmmmmmm!m Rep1�>s �! Che uår_on sicces�yO oaag�_opelogy DompurNaN ---.GOTO 88m!m [NOTE]GOTO 88m�OFd8m!m Ton sicces�ypeloEet frn oooooooo els m!m [NOT ETH tweiu uår_on sicc------------------------------gin � �! Chec-s�yO in oms L � �!vriablss. o��-�-------n eachyO in om!m t�lO(second aclsN��-�!m Aggregope t bya_exuachm!ubdN--------- bya_bie i-----------LE(: o) in om!m t�lO(second index��-�!m Aggregope w bya_exuachm!ubdNbya_bie i-----------acizaNit wersNisosomew1es,2).LT: 1...t bya_ ( bya_bie,2).LT-------TEGER, DIMENBRLE(pEN iim)+rsNisosomew2aclss, D: 1..ag�_tu(TO 8---whsENaresuupetnppDGget-----m!ya_bie --------------------------------------------------gin � �! ChecWs�yO in o N i_a Rtebug sGT. :: t0y_SIieEON MPI INE oREAL(MK), DIMENBRLE(:), POINTER---:: Dostsum =>oNULL()n_DyyyyyO in om!m t�lO(second3TEGERTEGERc,GERlon sicc------------------------:: iR ,j,k,kkomc_idelevanioroutelenon sicc------------------------:: iRDosRtecomtg�ofy--gy (cDosgy (creopDoson siccTYPEiiiiitCostsdexpDost Che uågin � �! Chec-s� in oINTEGER, DIMENBRLE(pE :-----------------------------------------------gin � �! ChecWs�yO in o N i_a Rtebug sGT. ----------------------------------------gin � �! Chec-s�yO in oms In------se yO in om--------------------------------------------------------gin � �! Chec-s�yO in o�_���s�l(-il�('bs',----_DostRETURN ie iyO in om----------------------------------------------s�yO in o�_���s�l(-il�('bs',- in oms rgureem_imag�_sy!truc-----------------------------------------------------------gin � �! ChecWs�yO in o N i_a Rtebug sGT. Tinfon= �_���D ==�_9 ie issEN ie is s � TinNDIF iss 88��------ i------�--------------------------------------------------------gin � �! ChecWs�yO in omsaAag�_ope memory fdextwsNDostsi------�--------------------------------------------------------gin � �! ChecWs�yO in o els --------------Dosimumom---------m!ya_biurINGLE_PREl ), DIMENBRLE(: o)-------------------------------------------------------gin � �! ChecWs�yO in o eDosRteco-----------iilial ie i--iR ,t1(ipil�jTO 88teco(wa ---lo(lmyepsinfon= in j----DosRteco)eDosRteco---jextwsNDostDO------�--------------------------------------------------------gin � �! ChecWs�yO in o els (Re)a 88��- els =fii_preser8m!m [NOTE]GOTO 88 ie iyO in om----------------------------------------------s�yO in o�_���s�l(-il�('bs',- in o_imag�_sy_���_a uår_sO in om (creopeDosRtecomMKE��-- uår_s1)2 'Dostslial ie is-------perNt�lOCOST'F elsssssssssssGOTO 8888 iNDIF iss 88��------ i------�--------------------!truc--t�l iss,ns�_m�,is�'CPM. I----a 88��- els =fii_prO oaag�_ ChecWs�yO in omsaAnd in------zeO-- zeroi------�-eroi-- uågin --------a uår_)%t------�--------------------------------------------------------gin � �! ChecWs�yO in o els !trucxtg�_))))m�OFdDost)))) oSUBROU------------------------------------------------------gin � �! ChecWs�yO - oINTEGER, PARAMETER :: MKl ie iskSE �do---_(-orsi------�--------------------------------------------------------gin � �! Ch----- Numcin wkSE �do---_(-orsi------�--------------------------------------------------------gin � �!iilk_���������������_��� uå%tg�_))))s(k-----(1,i)-u k)������_��� uå%tost))))s(k-----(u or_mak)extwsNDostDO-��_��� uå% � relevas--- � releva #>et -----�--------------------------------------------------------gin � �! ChecWs�yO in o els ------ Numcin wkSE �do---_(-orsi------�--------------------------------------------------------gin � �!iilk_���������������_��� uå%tg�_))))d(k-----(1,i)-u k)������_��� uå%tost))))d(k-----(u or_mak)extwsNDostDO-��_��� uå% � relevad--- � releva #>----- in � �!iilial ie iss � TC����� uå%Twisorou------Twisorou---extwsNDostDO------�--------------------------------------------------------gin � �! ChecWs�yO in o els -----�-----c_imiz--logyiablss flagRLE(: o)-------------------------------------------------------gin � �! ChecWs�yO in o e uå%isHOUTmevad---.FALSE.-----------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-opStrucx----m-------------------NTABILIT88 i88 N8m!m [NOLE(: o)-------------------------------------------------------gin � �! ChecWs�yO in o e uå%ag�_tus � TCf ----------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-opStrucx----y------REAL(MK), DIMENBRLE(: o) ==�_9 ie issEN ie is s � TinNDIF iss 88��------ i------�------------------------------im(2)_(1,idom sAND. åompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiom----wo iND�SENT(s sAND. åompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiilial ie iss ))pEN comm,ssss��_DOUBLE_PRECISION ie issEND�S uå%tg�_e is8��-i --i888IF 8��-i---DOi------i uå%tg�_e is82�-i --i888IF 8----------------- uå%toste is8��-i --ies,t�l(2)nu------------- uå%toste is82�-i --ies,t�l(-----#>et -----�------i uå%tg�_e id8��-i --i888IF 8��-i---DOi------i uå%tg�_e id82�-i --i888IF 8----------------- uå%toste id8��-i --ies,t�l(2)nu------------- uå%toste id82�-i --ies,t�l(-----#>issooooom-----ostDO-��_���x,t�l(2,i)-misompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiom----hGOTOiND�SENT(s sAND. åompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiilial ie iss ))pEN comm,ssss��_DOUBLE_PRECISION ie issEND�S uå%tg�_e is8��-i --i888IF 8��-i---DOi------i uå%tg�_e is82�-i --i888IF 8----------------- uå%tg�_e is83�-i --i888IF 8nt�l(numb�i O 88� uå%toste is8��-i --ies,t�l(2)nu------------- uå%toste is82�-i --ies,t�l(----------------- uå%toste is83�-i --ies,t�l(3----#>et -----�------i uå%tg�_e id8��-i --i888IF 8��-i---DOi------i uå%tg�_e id82�-i --i888IF 8----------------- uå%tg�_e id83�-i --i888IF 8nt�l(numb�i O 88� uå%toste id8��-i --ies,t�l(2)nu------------- uå%toste id82�-i --ies,t�l(----------------- uå%toste id83�-i --ies,t�l(3----#>issooooom-----ostDO-��_���xisoempty -------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-opStrucx----y---rr-eiboy------��-� weafchoiO moy8m!m [NOLE(: o)-------------------------------------------------------gin � �! ChecWs�yO in o eiilial 2*�������������_��� uå%ustiD------ustiD---extwsNDostDO-��_���ty -------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-opZuriMAX----m (creopm�OFd1n � nee o��-�avr_-a 88��-logyfailuryyyyyO in -----at yetamappeTO 80oms r. SamLes orag�_tuaDost isoassuno----afuce would --a 8------------------------------------------gin � �! Chec-s�yO in oUSE-bs',moduls_t sayO iy (cDos---MAX(-------) sayO iy (creopDos---MAX(----reope-) ------�--------------------------------------------------------gin � �! ChecWs�yO in o els !trucx----in oooy88��-O msargL(MK), nphNE l��.GOTO IT88 i88 in o els yetamappe wa ---lo(1:----reop)-----�--------------------------------------------------------gin � �! ChecWs�yO in o e��å reopmeome ryoiflwe hncono ii dummy 88 O 88��- N i_a Rt---afuc-a 8s � TC����� uå%88tecoe is8�)--ilial ie isin of ���zeroi------�-eroi--iilial ie i--iR ,t1(ipil�jTO 88teco(wa ---lo(lmyepsinfon= uå%88tecoe is8-----jextwsNDostDO--------�--------------------------------------------------------gin � �! ChecWs�yO in o els !trucxm!ya_bieO ---afoy88��-O msargL(MK), nphNE l��.GOTO IT88 i88 in o els yetamappe wa ---lo(1:----reop) ------m!ya_biurINaucx----a-----��. in o els -hG) sLTcg�se8teco(1:----reop,)-----�--------------------------------------------------------gin � �! ChecWs�yO in o eiilial ie i--iR ,t1(ipil�#���_�� uå%88tecoe is8--------------- uå%i8tecoe is8j�-i --e8teco(j�-a ---lo(lmyepsinfon= ostDO-��_���xisDO-------�--------------------------------------------------------gin � �! ChecWs�yO in o els K i-!trucxit BC-----�--------------------------------------------------------gin � �! ChecWs�yO in o e��å smeome ryoiflwe hncono i dummy 88 Oies88��- N i_a Rt---afuc-a 8s � TC���� uå%Twim ET(2)�)--ilial ie isin of ���zeroi--��� uå%Twim ET(2)�)--ilial ie isin of ���zeroi--��� uå%Twim ET(3)�)--ilial ie isin of ���zeroi--��� uå%Twim ET(4)�)--ilial ie isin of ���zeroi--���---------im(2)__max,t�l(2,i)-mis,t� uå%Twim ET(5)�)--ilial ie isin of ���zeroi--���,t� uå%Twim ET(6)�)--ilial ie isin of ���zeroi--���icsy--------------in o eiilial ie iss � TC���� uå%Twim ET(2)-----Twim ET(2)--zeroi--��� uå%Twim ET(2)-----Twim ET(2)--zeroi--��� uå%Twim ET(3)-----Twim ET(3)--zeroi--��� uå%Twim ET(4)-----Twim ET(4)--zeroi--���---------im(2)__max,t�l(2,i)-mis,t� uå%Twim ET(5)-----Twim ET(5---------------- uå%Twim ET(6)-----Twim ET(6-------------icsy-----------DO------�--------------------------------------------------------gin � �! ChecWs�yO in o els Ainfonw dn oooooooo elsl �MpnR , 88m ETHWHY?-----�--------------------------------------------------------gin � �! ChecWs�yO h L� ��-- --ilial ie iss � TC�� h L� ����������_���_a 88m ET,ERc,mc_ideaag�_!i--���----�� uår_s1)2 h L� �!!!-sssssssssssGOTO 8888 iN h L� �!!!-8 iiii-----FOTO 88��-------F_DyyyyyO in o!truc--ttttt&N h L� ----------BCafchoiT.pENogyl yetamappefailed ChecWs�yO in oms h L� �!!!----zeO-- z!------icsy-------�--------------------------------------------------------gin � �! ChecWs�yO in o els !trucxm-------------------NhNE l��.GO in o els -he 88 i88 NyISION ieLE(: o)U------------------------------------------------------gin � �! ChecWs�yO ------- uå% reopm=, 0 u--loe in o e��å reopmeome ryoiflwe hncono uå%is ---lo(1)--ilial ie isin of ���zeroi------�-eroi--iilial ie i--iR ,t1(ipil� uå%is ---lo(-i --es ---lo(-iextwsNDostDO---------�--------------------------------------------------------gin � �! ChecWs�yO in o els ----------a i-!trucx----m!ya_bie -REAL(moyyISION ieLE(: o)-------------------------------------------------------gin � �! ChecWs�yO in o e uå%am!ya_yISI----- in o eeleva---Teva( uå%i8tecoorout-) sayO i-eroi--iilk_�� uå%8e i--iR ,t1(ipil� i =� uå%is ---lo(k)������_����#���_��88teco(wECISION ie issENiyISI--- uå%Twisorou--8teco(j�---------------gin!88�� newaIsGT. yselooooom---------�----�yISI-Dostslial----uår_s1)))))))1)))'pDost msin-------------------oi--iilkk_�� uå%88tecoorouexuachmmmmmmmmmmmmmmmmm---- uå%i8tecoorou(k-uå(2)_=�yISI) msin---iim loop ove eil�ac������_����������-----gin!88��----a readyNTAB--iR ,t1(ipil� -------�----�sin-(2)_=r_s1)2 ))))))'sim NaaDossssss uå%am!ya_yISI--- uå%am!ya_yISI-Oiiim loop ove eil�aclssG---- uå%am!ya_yISI------elevabaset on eil�aclssGOTO 88��-- o-o ----ly askes or Genoels =fon eil�aclssGOTO 88��-- o-eleva---eleva-Oiiim loop ove eil�aclssGFOTGERc(1)--iileva ==� fdaclssGOTO 88��-- o-ee is s � Tinfon= ���_grow_preserva ==� fdaclssGOTO 88��-- o-���������_���_a uå%i8tecooroutERc,mc_ideaag�_==� fdaclssGOTO 88��-- o-stRE�� uår_s1)2 ))))))'sim NaaDosTO 88��-- o-es Naaa � iroces�o s COSTSUM'F elsssssssTO 88��-- o-���������- i------�--------------------!truc--pOisssrmap���aaboutyO in om!m elsne'TO 8 bya_bie,reopmPPM_Ws�IGHO 88is -----FOTO 88��-----i---------p sGT. Tinfon= ���_����--i888IF iSIZEEEEEEEEEuce(cost,costsumsot�ls,,,,,,,,,,,,,,-i a--iiiiiiiiiiim iaanot, ����a--iiiiiiiiiiim iaanot, !�_����yISI-------giiiiiiiim!ya_bie ))))))'sim NaaDossssss uå%i8tecoorou( uå%am!ya_yISI------rouexuachmmmmmmmmmmmmm����a--iiiiiiiiiiim ����a--iiiiiiiiii������_������������_ in o e uå%is of ���---.TRUE.-----------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-op('bs',----_DostRETURN ie i� ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF int�l( .LE. Tinfon= ���_����--��-oilial ie !truc-----------nfon= _�������_���_a Roc,'���_Nomc_im_imag�_tubs',----_DostRE��å a uår_meome r_bs',-a uår_me----',----lial ie)oc,'���_Nomc_im_imag�_���iin mis,t�lE_max,t�l wrong'F elsssssssssssGOTO 8888 iiiiiNDIF 8888sie iss is!truc--t�l iss,ns�_m�,is�����' uår_m,t�lE2) s----a i-<=-',----lial ie)N iiminfon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_a uår_s1)))))))'nt�l( mustibe > 0'F elsssssssssssGOTO 8888 iiiiiNDIF 8888sie iss is -----FOTO 88��- N iSIZE(!truc--tt2) sLT. nt�l( .OR. SIZE(max,t�lE2) sT. nt�l(infon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_ reopmeome )))))))'nt�l( mustibe > 0'F elsssssssssssGOTO 8888 iiiiiNDIF 8888sie iss is -----FOTO 88��- N iSIZE(!truc--tt2) sLT. nt�l( .OR. SIZE(mreopm,t�lE2) sT. nt�l(infon= ���_����--��-oilial ie iss � TC�����CALL#���_�������_���_ s uår_s1reop) ))))'nt�l( mustibe > 0'F elsssssssssssGOTO 8888 iiiiiNDIF 8888sie iss is -----FOTO 88��- N iSIZE(!truc--tt2) sLT. nt�l( .OR. SIt in om------------af----m----rgL(agyl one8��- N imax,t�l(j,i) sLT. mis,t�l(j,i)infon= ---------- -iiiiiiiiiiilial ie iss � TC�����CALL#���_���������������_���_a Roc,'���Nomc_im_imag�_tuEs',----_DostRE��å uår_s1)))))))1)))))))'max,t�lOmustialwaysibe >= mis,t�l'F elsssssssssssGOTO 8888 iiiii iiiiiiiNDIF 8888sie !truc--tt2) sLT. nt�l( .OR. S( .OR. SI,----_Dm,t�lE2) <1i.LT.pEN iiminfon= ���_����--��-oilialLT. mis,t�l(j,i)infon= ---------------- -iiiiiiilial ie iss � TC�����CALL#���_����������iilial ie iss � TC�����CALL��NTwisorou----eome )))))))'nt�l( mustibe mustibe Naaat least length Np', elsssssssssssGOTO 8888 iiiii iiiNDIF 8888sie iss is!truc--tt2) sLT. nt�l( .OR. S( .O'foy----DOi----anumb� o��-�anyyyISION ie ==�__SINGLE_PRECISION ie issEND�SUBRLE INE o--- SUBROUTINE-bs',----_Dost_s�_��_�LE_PRECISION ie issEND�SUBRLE INE o--- SUBROUTINE-bs',----_Dost_dG_Dyyyyy������������������������������������z�, ������������������������������������������������������������������z�, ��������������������������������������������������������������������������������������������������������������������������������3�00000043610�116R :: MKl ie---l_---lnv_2x2���������������������������������������������������������������������������������������05013u(-en �inc���21360���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------������tRE*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (cR :: MKl ie---l_---lnv_2x2----------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår_---------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o Dof �� typyyyyyO in om--------------------------------------------------------gin � �! Chec-s� of ��Dost_dG_Dyyyyy����� 1s� of ��Dos���������������� 2r_------MODULTER :: MKl ie---l_---lnv_2x2--------!e!it �E MKl iyyISvida,�����aced,ael--------!e!FITNE----gin inevesNpREA2x21i.m MION��--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces-------gaced,ae(s)�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER ::---l_---lnv_2x2-------------MODULTEPROCEDURTER ::---l_---lnv_2x2_s-------------MODULTEPROCEDURTER ::---l_---lnv_2x2_�zeroi--���icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomih'n_DygL(MK) WIce�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array musta Roc,'��s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg"---l/R ::---l_---lnv_2x2.f" #in ofDos�����s� of ��Dos�����os�����������������#ih'n_Dyg"---l/R ::---l_---lnv_2x2.f" #in ofDos�����si--���icstMODULTER :: MKl ie---l_---lnv_2x2-������INE o�--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl ie---l_----���������������������������������������������������������������������������������������������05265u(-en �inc���20333���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------�- elsomp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (c (cR :: MKl ie---l_--------------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår_---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Dof �� typyyyyyO in om--------------------------------------------------------gin � �! Chec-s� of ��Dost_dG_Dyyyyy����� 1s� of ��Dos���������������� 2r_------MODULTER :: MKl ie---l_------------!e!it �E MKl iyyISvida,�����---liail----O aced,ael��--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces-------gcePREleopm----O aced,ael�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER ::---l_----3�zeroi--���,t�MODULTEPROCEDURTER ::---l_----3�_s-------------MODULTEPROCEDURTER ::---l_----3�_�zeroi--���icstost FACT rray mustost FACTER ::---l_----2�zeroi--���,t�MODULTEPROCEDURTER ::---l_----2�_s-------------MODULTEPROCEDURTER ::---l_----2�_�zeroi--���icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomih'n_DygL(MK) WIce�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array musta Roc,'��s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg"---l/R ::---l_----3�.f" #ih'n_Dyg"---l/R ::---l_----2d.f" #in ofDos�����s� of ��Dos�����os�����������������#ih'n_Dyg"---l/R ::---l_----3�.f" #ih'n_Dyg"---l/R ::---l_----2d.f" #in ofDos�����si--���icstMODULTER :: MKl ie---l_-----������INE o�------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl iein o_loadbal������������������������������������������������������������������������������������������05171u(-en �incardon727���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------�- elsomp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (c R :: MKl iein o_loadbal----------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårSUBRO_------MODULTER :: MKl iein o_loadbal--------!e!it �E MKl iyholds-in oous��.GOTO 88load balancO aced,ael��--��- wersNisosomewhatlarbit�!!!, bupGe declPPMANTABIL �E MKl ish PPM. I----bTOiN,GOtly a-----��bit�!!!, buGOTO 88aaplaupGeyNaucxmanagpesF eM hly GOTO 88l------��--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUSE-bs'�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustduls_aag�_CALL#��US, ONLY:y----------------rray mustPRIVATEE ----------------�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomTimO 88m load iabli�_����--�_��elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustioe�_�mrout��� COttpPMAof � Tweyser8m!m [NOarray must in o---------------)E ----loadbal isorep�����----.0_----------------rray must!���u8mGOTttphowxmanOTOim decrepl����-wn omeasuPMAN(N-zeroi--���---------------------- ----loadbal icn--------------! runnO --mTttpNomcOim - avgOim )array must in o---------------)E ----loadbal run--mT---.0_----------------rray must!�old luNpREAL(MKSaa funct wkSE �doust in o---------------)E ----loadbal old_s���= 0040_----------------si--���icstMODULTER :: MKl iein o_loadbal-����INE o�--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl iein o_�i3h���������������������������������������������������������������������������������������������06546u(-en �incardon31����������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------_��elsomp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (c (cER :: MKl iein o_�i3h----------------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår_------MODULTER :: MKl iein o_�i3h--------!e!it �E MKl iyholds-in oonee o�GOTO 88(re)m hO aced,ael��--��- wersNisosomewhatlarbit�!!!, bupGe declPPMANTABIL �E MKl ish PPM. I----bTOiN,GOtly a-----��bit�!!!, buGOTO 88aaplaupGeyNaucxmanagpesF eM hly GOTO 88l------��--��- elUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å u�--��- elUop.h'n_DyyyyyO inelUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å u�--��- elduls_aag�_CALL#��US,ONLY:---------------,----------------rray mus!PRIVATEE ---------------,----------------rray musEND�SUBRLE INE------elUoOim E------el in o����(040D0))E :�--��- elUopm---------88 i88 ly e foe 888peskernelyyyyO inel Chec-s�yO in oms Incli.LTAofkernely�= 4:�--��- elUopkernel-TevayyyyO inel Chec-s�y�lO(second4)E ----�i3h_kernelyeva-yyyO inelDATA ----�i3h_kernelyeva-/1,2,2,3/:�--��- elUopF eM r-eiw!ya_tsE------el in o---------------R----�lO(second inindexpDost wx1_sgin � �! Chec-s�st in o---------------)----�lO(second inindexpDost wx1_dgin � �! Chec-s�st in o---------------R----�lO(second inindexpDost wx2_sgin � �! Chec-s�st in o---------------)----�lO(second inindexpDost wx2_dgin � �! Chec-s�st in o---------------R----�lO(second inindexpDost wx3_sgin � �! Chec-s�st in o---------------)----�lO(second inindexpDost wx3_dgin � �! C�--��- elUopF eM r-eiBROUTsE------el in o---------------R--�lO(second ininindexpDost tuc_2dsgin � �! Chec-s�st in o---------------)--�lO(second ininindexpDost tuc_2ddgin � �! Chec-s�st in o---------------R-�lO(second inininindexpDost tuc_3dsgin � �! Chec-s�st in o---------------)-�lO(second inininindexpDost tuc_3ddgin � �! C�--��- elUopF eM r-eip--------leopyyyyO inel Chec-s t�lO(second indexpDost TEGEeop--_Dmin � �! Chec-s�st Chec-s t�lO(second aclsNpDost TEGz�, mustibn � �! C��--��- elUopfOR A��USE-bs',mel Chec-s�y�lO(second5gope wmasfyyyO inelDATA wmasf-/1,2,3,4,5/ -si--���icstMODULTER :: MKl iein o_�i3h--si--���-����INE o�-----------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl ie���--�������������������������������������������������������������������������������������������������04620u(-en �incardon�in���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------��- elUmp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (c (cER :: MKl iesION ie issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårSUBRO issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o Dof �� typyyyyyO in om--------------------------------------------------------gin � �! Chec-s� of ��Dost_dG_Dyyyyy����� 1s� of ��Dos���������������� 2r_------MODULTER :: MKl iesION ie issEND-!e!it �E MKl iyyISvida,�---liail-ced,ael��--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces----sION ie issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTEsION ie issENDels --MODULTEPROCEDURTEsION ie_s-------------MODULTEPROCEDURTEsION ie_�zeroi--���icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomih'n_DygL(MK) WIce �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array musta Roc,'���s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg"---l/���--����" #in ofDos�����s� of ��Dos�����os�����������������#ih'n_Dyg"---l/���--����" #in ofDos�����si--���icstMODULTER :: MKl iesION ie ----------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl iemap Tinte---l�����������������������������������������������������������������������������������������13536u(-en �inc5��2120n���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------�- elsomp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (c R :: MKl iemap Tinte---l issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o Dof �� typyyyyyO in om--------------------------------------------------------gin � �! Chec-s� of ��Dost_dG_Dyyyyy����� 1s� of ��Dos���������������� 2s� of ��Dos-------------------------3s� of ��DosLOGICAL------------------4s� of ��Dost_dG_Dyyyyy�����_COMPLEX 5s� of ��Dos����������������_COMPLEX 6r_------MODULTER :: MKl iemap Tinte---l issEND-!e!it �E MKl iyyISvida,� ousip--------map-O ---liail88m helper issEND-!e!-ced,ael 88m Pesir work-�MpnRs. �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomWork-leopyyyyO inelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost c-s�y�lO(secondndexpDost TEGpEeop-da,�in � �! Chec-s�sttost c-s�y�lO(secondndexpDost TEGpEeop-act�in � �! Chec-s�sttost c-s�y�lO(secondndexpDost TEGpEeop-exc�in � �! Chec-s�sttost c-s�y�lO(secondndexpDost TEGsrEeop1sttin � �! Chec-s�sttost c-s�y�lO(secondndexpDost TEGsrEeop2sttin � �! Chec-s�sttost c-s------------------------TEGnEeop1,nEeop2,nEeop3,nEeop4Chec-s�sttost c-s-,�lO(secondndexpDost TEGiEeop1stttin � �! Chec-s�sttost c-s-,�lO(secondndexpDost TEGiEeop2stttin � �! Chec-s�sttost c-s-,�lO(secondndexpDost TEGiEeop3stttin � �! Chec-s�sttost c-s-,�lO(secondndexpDost TEGiEeop4stttin � �! CChec-s�sttPRIVATEE -Eeop-da,,pEeop-act,pEeop-exc,srEeop1,srEeop2Chec-s�sttPRIVATEE nEeop1,nEeop2,nEeop3,nEeop4Chec-s�sttPRIvATEE iEeop1,iEeop2,iEeop3,iEeop4�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces----R :: ap Tinteeq 88m ME issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER :: ap Tinteeq 88m ME issENDels --MODULTEPROCEDURTER :: ap Tinteeq 88m ME_�zeroi--���,t�MODULTEPROCEDURTER :: ap Tinteeq 88m ME_yyyyO inelsicstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces----R :: ap Tintesend issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER :: ap Tintet bcelzeroi--���,t�MODULTEPROCEDURTER :: ap Tintet bcelzeroi--���icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces----PeseR :: ap Tintegep--_D issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER :: ap Tintegep--_D issENDels,t�MODULTEPROCEDURTER :: ap Tintegep--_D_s-------------MODULTEPROCEDURTER :: ap Tintegep--_D_�zeroi--���icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces----R :: ap Tinteload issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER :: ap Tinteload issENDels---MODULTEPROCEDURTER :: ap Tinteload issENDelsicstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces----R :: ap TinteeO _shift issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER :: ap TinteeO _shift issENDels---MODULTEPROCEDURTER :: ap TinteeO _shift_s-------------MODULTEPROCEDURTER :: ap TinteeO _shift_d issENDelsicstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces----R :: ap Tintez�, issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER :: ap Tintez�, issENDels---MODULTEPROCEDURTER :: ap Tintez�, issENDelsicstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomih'n_DygL(MK) WIce �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array musta Roc,'��s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg" ap/R :: ap Tinteeq 88m ME��" #in ofDos�����s� of ��Dos�����os�����������������#ih'n_Dyg" ap/R :: ap Tinteeq 88m ME��" #in ofDos�����s�ih'n_Dyg" ap/R :: ap Tintet bcel��" s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg" ap/R :: ap Tintegep--_D��" #in ofDos������ of ��Dos�����os�����������������#ih'n_Dyg" ap/R :: ap Tintegep--_D��" #in ofDos������#ih'n_Dyg" ap/R :: ap Tinteload��" s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg" ap/R :: ap TinteeO _shift��" #in ofDos�����s� of ��Dos�����os�����������������#ih'n_Dyg" ap/R :: ap TinteeO _shift��" #in ofDos�����s�ih'n_Dyg" ap/R :: ap Tintez�, ��" sENDelsicstMODULTER :: MKl iemap Tinte---l ������INE o�-----------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl ie---l_eigen_3sym���������������������������������������������������������������������������������������050���(-en �incardo14in���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------�- elsomp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (cR :: MKl ie---l_eigen_3sym issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Dof �� typyyyyyO in om--------------------------------------------------------gin � �! Chec-s� of ��Dost_dG_Dyyyyy����� 1s� of ��Dos���������������� 2r_------MODULTER :: MKl ie---l_eigen_3sym issEND-!e!it �E MKl iyyISvida,�����aced,ael FITN issEND-!e!----gin Eigen luNl 88m Eigen ectie -REAsymmem MI 3x31i.m MION��--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces-------gaced,ae(s)�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER ::---l_eigen_3sym issEND------MODULTEPROCEDURTER ::---l_eigen_3sym_s-------------MODULTEPROCEDURTER ::---l_eigen_3sym_�zeroi--���icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomih'n_DygL(MK) WIce�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array musta Roc,'��s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg"---l/R ::---l_eigen_3sym��" #in ofDos�����s� of ��Dos�����os�����������������#ih'n_Dyg"---l/R ::---l_eigen_3sym��" #in ofDos�����si--���icstMODULTER :: MKl ie---l_eigen_3sym ������INE o�-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl iem---_ of ���������������������������������������������������������������������������������������������05114u(-en �inc5��20604���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------�- elsomp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (c (R :: MKl iem---_ of �� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Dof �� typyyyyyO in om--------------------------------------------------------gin � �! Chec-s� of ��Dost_dG_Dyyyyy����� 1s� of ��Dos���������������� 2s_------MODULTER :: MKl iem---_ of �� issEND-!e!it �E MKl iyconl Pn,�����I8mGOface----`R :: ---_ of ��` issEND-!e issEND-!e!hatlarbit�!!!, bupGe ���iinm [NOy 88mingu!s��sA Ptwe L� ---Nl 88m BROUTsE------, bu(����in oolivO oL�cg�s ---Nl)GenovM h BROUTset byRTIal P�lR c L� busam�s ---.-----Nl 8enoraf ��din om000F eM r-eiTYPES, win easE------, buBROUTse8enoaapl-yISvidadinMpnRs. ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces---- --- c eaUT Agaced,ae issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER :: ---_ of �� issEND------MODULTEPROCEDURTER :: ---_ of �� issEND---icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomIh'n_DygL(MK) WIce�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array musta Roc,'��s�ih'n_Dyg" ---/R :: ---_ of ����" ssENDelsicstMODULTER :: MKl iem---_ of �� ��INE o�-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116R :: MKl ie---l_---lnv_3x3���������������������������������������������������������������������������������������05013u(-en �inc���21362���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------�- elsomp*- f90 E*- ��IFRETUR= ���_��CONTAINS ���_��SUBROUTINE-D ==�_9 ie iss- IF �����topUSE-bs-_Dost_msCopyr_m�t (cR :: MKl ie---l_---lnv_3x3 issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Dof �� typyyyyyO in om--------------------------------------------------------gin � �! Chec-s� of ��Dost_dG_Dyyyyy����� 1s� of ��Dos���������������� 2r_------MODULTER :: MKl ie---l_---lnv_3x3 issEND-!e!it �E MKl iyyISvida,�����aced,ael--------!e!FITNE----gin inevesNpREA3x31i.m MION��--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomDof �� i8mGOfaces-------gaced,ae(s)�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustost FACTER ::---l_---lnv_3x3 issEND------MODULTEPROCEDURTER ::---l_---lnv_3x3_s issEND------MODULTEPROCEDURTER ::---l_---lnv_3x3_�zeroi--���icstost FACT �--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomih'n_DygL(MK) WIce�--��- elsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array musta Roc,'��s� of ��Dos�����ost_dG_Dyyyyy������#ih'n_Dyg"---l/R ::---l_---lnv_3x3��" #in ofDos�����s� of ��Dos�����os�����������������#ih'n_Dyg"---l/R ::---l_---lnv_3x3��" #in ofDos�����si--���icstMODULTER :: MKl ie---l_---lnv_3x3 ������INE o�--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/-----------------------------------------------------------------------------���0755�����������������������00000u(-en �inc5��15037� 5----------------------------------------------------------------------------------------------------�������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_2dl����������������������������������������������������������������������������������������������37316u(-en �inc5��17727���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEEEER ::---oc_2dl issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(-o(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_2dl_s(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http2Dt,Gal-Te----inMpnRs #elifOos�����==�os�����������������oSUBROSUBReGOINE ---oc_2dl_d(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http2Dt,Gal-------inMpnRs #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_2dl_sc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http2Dt----lex-Te----inMpnRs #elifOos�����==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_2dl_dc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http2Dt----lex-------inMpnRs #elifOos�����==�osost c-s�oSUBROSUBReGOINE ---oc_2dl_i(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http2Dti8mGg�acnMpnRs #elifOos�����==�osLONGost�oSUBROSUBReGOINE ---oc_2dl_li(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http2Dt64bSS i8mGg�acnMpnRs #elifOos�����==�osLOGICAL�oSUBROSUBReGOINE ---oc_2dl_l(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http2Dtlogical-nMpnRs #ent�� � �! C!! (poi8mGOs) bas��.t wabsol Soflow�acn8m upp�acin ox bs dilR c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.h'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h USE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Argu 888yyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second indexpDost TEGa��US #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second indexpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second indexpDost TEGa��US #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second indexpDost TEGa��US #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second indexpDost TEGa��US #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second indexpDost TEGa��US #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second indexpDost TEGa��US #ent�� � �! C!! Poi8mGO----nMpnR whsENse y---b88(re)---ocANTd.�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdl issEND-!e!Low�acin ox limi8yyyyO inost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdu issEND-!e!Upp�acin ox limi8y (>Edl(1:2)).�oSUBROost c-s-------------------ost NT(INd--- TEGiHOU issEND-!e!---ocANit w�_Ce. OnNpRE: issEND-!e issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::---oc_fit_pres�ave issEND-!e!*s_aagyyya::---oc_grow issEND-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second indexpDost TEGwork #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second indexpDost TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second indexpDost TEGwork #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second indexpDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second indexpDost TEGwork #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second indexpDost TEGwork #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second indexpDost TEGwork #ent�� � �! ost c-s�y�lO(second2) TEGEdS,ldb,ldc,ldd,ldl_new,ldu_new�oSUBROost c-s---------------TEGi,j�oSUBROLOGICAL---------------TEGEeo<,l---oc,lre---oc�oSUBRO in o---------------)E t0 c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Initialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(CALL sION ---('R ::---oc_2dl',t0,mustn issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_2dl',iHOU,ldl,2,must,ldu Chec-s�sttoF omusti.NE. 0) GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Poi8m----Rrop�acwork-nMpnRyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_2ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_2dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROwork-=>Owork_2dsc #elifOos�����==�os����������������_COMPLEX�oSUBROwork-=>Owork_2ddc #elifOos�����==�osost c-s�oSUBROwork-=>Owork_2di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_2dli #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_2dl #ent�� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.ldb(1).NE.Edu(1)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L�cgldl_new(1) = Edl(1)�oSUBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(1) = Eda(1)�oSUBRO�l( L�cgldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).NE.Edl(2).OR.ldb(2).NE.Edu(2)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L�cgldl_new(2) = Edl(2)�oSUBRO�l( L�cgldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(2) = Eda(2)�oSUBRO�l( L�cgldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)��oSUBRO�l( L�ldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_fit) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.ldb(1).NE.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(1) = Edl(1)�oSUBRO�l( L�cggldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).NE.Edl(2).OR.ldb(2).NE.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(2) = Edl(2)�oSUBRO�l( L�cggldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)��oSUBRO�l( L�ldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow_pres�ave) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.ldb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).GT.Edl(2).OR.ldb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L�cggldu_new(2) = MAX(ldb(2),Edu(2)) �oSUBRO�l( L�cggldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)��oSUBRO�l( L�ldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.ldb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).GT.Edl(2).OR.ldb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L�cggldu_new(2) = MAX(ldb(2),Edu(2)) �oSUBRO�l( L�cggldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)��oSUBRO�l( L�ldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::de---oc) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l((((DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�cgoF omusti.NE. 0) THE��oSUBRO�l( L�cggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_2dl',DDD& issEN&sENDDDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_2dl',DDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDD'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1):ldu_new(1),ldl_new(2):ldu_new(2)),STAT=mustn � �! oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#f�USlzeroi--���,t�DCALL R ::error(R ::err:n--oc,'R ::---oc_2dl',DDD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF oleo<) THE��oSUBRO�l(ldc(1) = MAX(ldl_new(1),lda(1))�oSUBRO�l(ldc(2) = MAX(ldl_new(2),lda(2)) �oSUBRO�l(ldd(1) = MINoldu_new(1),ldb(1))�oSUBRO�l(ldd(2) = MINoldu_new(2),ldb(2))�oSUBRO�l(DO j=ldc(2),ldd(2)�oSUBRO�l((((DO i=ldc(1),ldd(1) issENDDDDDDDDDDwork(i,j) = a��US(i,j) � �! EcsDO ! EcsDO ! EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO�l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_2dl',DDD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_2dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_2dl_s #elifOos�����==�os�����������������oSUBROicstSUBReGOINE ---oc_2dl_d #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROicstSUBReGOINE ---oc_2dl_sc #elifOos�����==�os����������������_COMPLEX�oSUBROicstSUBReGOINE ---oc_2dl_dc #elifOos�����==�osost c-s�oSUBROicstSUBReGOINE ---oc_2dl_i #elifOos�����==�osLONGost�oSUBROicstSUBReGOINE ---oc_2dl_li #elifOos�����==�osLOGICAL�oSUBROicstSUBReGOINE ---oc_2dl_l #ent�� ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_3dl����������������������������������������������������������������������������������������������43457u(-en �inc5��17733���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEER ::---oc_3dl issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_3dl_s(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http3Dt,Gal-Te----inMpnRs #elifOos�����==�os�����������������oSUBROSUBReGOINE ---oc_3dl_d(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http3Dt,Gal-------inMpnRs #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_3dl_sc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http3Dt----lex-Te----inMpnRs #elifOos�����==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_3dl_dc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http3Dt----lex-------inMpnRs #elifOos�����==�osost c-s�oSUBROSUBReGOINE ---oc_3dl_i(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http3Dti8mGg�acnMpnRs #elifOos�����==�osLONGost�oSUBROSUBReGOINE ---oc_3dl_li(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http3Dt64bSS i8mGg�acnMpnRs #elifOos�����==�osLOGICAL�oSUBROSUBReGOINE ---oc_3dl_l(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http3Dtlogical-nMpnRs #ent�� � �! C!! (poi8mGOs) bas��.t wabsol Soflow�acn8m upp�acin ox bs dilR c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.h'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h MSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Argu 888yyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inindexpDost TEGa��US #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second inindexpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second inindexpDost TEGa��US #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second inindexpDost TEGa��US #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second inindexpDost TEGa��US #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second inindexpDost TEGa��US #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second inindexpDost TEGa��US #ent�� � �! C!! Poi8mGO----nMpnR whsENse y---b88(re)---ocANTd.�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdl issEND-!e!Low�acin ox limi8yyyyO inost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdu issEND-!e!Upp�acin ox limi8y (>Edl(1:3)).�oSUBROost c-s-------------------ost NT(INd--- TEGiHOU issEND-!e!A--ocANit w�_Ce. OnNpRE: issEND-!e issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::---oc_fit_pres�ave issEND-!e!*s_aagyyya::---oc_grow issEND-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inindexpDost TEGwork #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second inindexpDost TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second inindexpDost TEGwork #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second inindexpDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second inindexpDost TEGwork #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second inindexpDost TEGwork #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second inindexpDost TEGwork #ent�� � �! ost c-s�y�lO(second3) TEGEdS,ldb,ldc,ldd,ldl_new,ldu_new�oSUBROost c-s---------------TEGi,j,k�oSUBROLOGICAL---------------TEGEeo<,l---oc,lre---oc�oSUBRO in o---------------)E t0 c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opInitialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(CALL sION ---('R ::---oc_3dl',t0,mustn issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Poi8m----Rrop�acwork-nMpnRyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_3ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_3dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROwork-=>Owork_3dsc #elifOos�����==�os����������������_COMPLEX�oSUBROwork-=>Owork_3ddc #elifOos�����==�osost c-s�oSUBROwork-=>Owork_3di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_3dli #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_3dl #ent�� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_3dl',iHOU,ldl,3,must,ldu Chec-s�sttoF omusti.NE. 0) GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili--------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M stiomfits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.ldb(1).NE.Edu(1)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L�cgldl_new(1) = Edl(1)�oSUBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(1) = Eda(1)�oSUBRO�l( L�cgldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).NE.Edl(2).OR.ldb(2).NE.Edu(2)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L�cgldl_new(2) = Edl(2)�oSUBRO�l( L�cgldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(2) = Eda(2)�oSUBRO�l( L�cgldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issEND( L�cgldad3) = LBOUND(a��US,3)�oSUBRO�l(�cgldb(3) = UBOUND(a��US,3)�oSUBRO�l(�cgoF olda(3).NE.Edl(3).OR.ldb(3).NE.Edu(3)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L�cgldl_new(3) = Edl(3)�oSUBRO�l( L�cgldu_new(3) = Edu(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(3) = Eda(3)�oSUBRO�l( L�cgldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�UBRO�l( L�cgldl_new(3) = Edl(3)��UBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(�cgldu_new(3) = Edu(3)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_fit) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.ldb(1).NE.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(1) = Edl(1)�oSUBRO�l( L�cggldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).NE.Edl(2).OR.ldb(2).NE.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(2) = Edl(2)�oSUBRO�l( L�cggldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issEND( L�cgldad3) = LBOUND(a��US,3)�oSUBRO�l(�cgldb(3) = UBOUND(a��US,3)�oSUBRO�l(�cgoF olda(3).NE.Edl(3).OR.ldb(3).NE.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(3) = Edl(3)�oSUBRO�l( L�cggldu_new(3) = Edu(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(3) = Eda(3)�oSUBRO�l( L�cggldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�UBRO�l( L�cgldl_new(3) = Edl(3)��UBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(�cgldu_new(3) = Edu(3)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow_pres�ave) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.ldb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).GT.Edl(2).OR.ldb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldad3) = LBOUND(a��US,3)�oSUBRO�l(�cgldb(3) = UBOUND(a��US,3)�oSUBRO�l(�cgoF olda(3).GT.Edl(3).OR.ldb(3).LT.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L�cggldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3) = MAX(ldb(3),Edu(3)) �oSUBRO�l( L�cggldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2))�oSUBRO�l( L� cgldl_new(3) = MINolda(3),Edl(3))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L� cgldl_new(3) = Eda(3)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�cggldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�UBRO�l( L�cgldl_new(3) = Edl(3)��UBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(�cgldu_new(3) = Edu(3)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgldb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.ldb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldad2) = LBOUND(a��US,2)�oSUBRO�l(�cgldb(2) = UBOUND(a��US,2)�oSUBRO�l(�cgoF olda(2).GT.Edl(2).OR.ldb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldad3) = LBOUND(a��US,3)�oSUBRO�l(�cgldb(3) = UBOUND(a��US,3)�oSUBRO�l(�cgoF olda(3).GT.Edl(3).OR.ldb(3).LT.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L�cggldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3) = MAX(ldb(3),Edu(3)) �oSUBRO�l( L�cggldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2))�oSUBRO�l( L� cgldl_new(3) = MINolda(3),Edl(3))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L� cgldl_new(3) = Eda(3)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�cggldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�UBRO�l( L�cgldl_new(3) = Edl(3)��UBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l(�cgldu_new(3) = Edu(3)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::de---oc) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l((((DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�cgoF omusti.NE. 0) THE��oSUBRO�l( L�cggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_3dl',DDD& issEN&sENDDDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_3dl',DDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDD'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1):ldu_new(1),DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(2):ldu_new(2),DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(3):ldu_new(3)),STAT=mustn � �! oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#f�USlzeroi--���,t�DCALL R ::error(R ::err:n--oc,'R ::---oc_3dl',DDD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF oleo<) THE��oSUBRO�l(ldc(1) = MAX(ldl_new(1),lda(1))�oSUBRO�l(ldc(2) = MAX(ldl_new(2),lda(2)) oSUBRO�l(ldc(3) = MAX(ldl_new(3),lda(3)) �oSUBRO�l(ldd(1) = MINoldu_new(1),ldb(1))�oSUBRO�l(ldd(2) = MINoldu_new(2),ldb(2))�oSUBRO�l(ldd(3) = MINoldu_new(3),ldb(3))�oSUBRO�l(DO k=ldc(3),ldd(3)�oSUBRO�l((((DO j=ldc(2),ldd(2)�oSUBRO�l(((( ((DO i=ldc(1),ldd(1) issENDDDDDDDDDD DDwork(i,j,k) = a��US(i,j,k) issENDDDDDDDDDDEcsDO ! DDDEcsDO ! EcsDO ! EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_3dl',DDD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_3dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_3dl_s #elifOos�����==�os�����������������oSUBROicstSUBReGOINE ---oc_3dl_d #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROicstSUBReGOINE ---oc_3dl_sc #elifOos�����==�os����������������_COMPLEX�oSUBROicstSUBReGOINE ---oc_3dl_dc #elifOos�����==�osost c-s�oSUBROicstSUBReGOINE ---oc_3dl_i #elifOos�����==�osLONGost�oSUBROicstSUBReGOINE ---oc_3dl_li #elifOos�����==�osLOGICAL�oSUBROicstSUBReGOINE ---oc_3dl_l #ent�� -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_nMgcheck�����������������������������������������������������������������������������������������11646u(-en �inc5��21013���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEER ::---oc_nMgcheck issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBROSUBReGOINE R ::---oc_nMgcheck(c----r,iHOU,ldl,dimenlit ,must,ldu Chec-s�-!e!Checks�cg�snMgu 888yhttp://wR ::---oc aced,aesr issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h MSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M duls_aag�_CALL#��USrcls M duls_aag�_CALL#error issENDduls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie scls M oND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Argu 888yyyyO in om--------------------------------------------------------gin � �! Chec-syyO in 88RACTER(LEN=*) --ost NT(INd---:: c----rChec-s�-!e! frNpRE c---i88msubaced,aescls M ost c-s�y�lO(secondnd--- --ost NT(INd---:: Edl issEND-!e!Low�acin ox limi8NTABleadi88mdim.�oSUBROost c-s�yOPTconAL�y�lO(secondnd--ost NT(INd---:: Edu issEND-!e!Upp�acin ox limi8NTABleadi88mdim. (>Edl(1)).�oSUBRO-!e!OPTconALNTABR ::---oc_*dl���oSUBROost c-s --ost NT(INd---:: iHOU issEND-!e!A--ocANit w�_Ce. OnNpRE: issEND-!e issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::---oc_fit_pres�ave issEND-!e!*s_aagyyya::---oc_grow issEND-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s----------------- --ost NT(INd---:: dimenlit issEND-!e!Help y---ral��i,ae ://wdimenlit wttp://wc----rmsubaced,ae (1-5)�oSUBROost c-s----------------- --ost NT(eGO)--TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-soSUBROost c-s---------------TEGir issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opInitialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(!CALL sION ---('R ::---oc_nMgcheck',t0,mustn oSUBRO---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF oiHOUi.NE. _aagyyya::---oc_fit-----------.AND.---------------- & issEN&sENDiHOUi.NE. _aagyyya::---oc_fit_pres�ave--.AND.---------------- & issEN&sENDiHOUi.NE. _aagyyya::---oc_grows---------.AND.---------------- & issEN&sENDiHOUi.NE. _aagyyya::---oc_grow_pres�ave-.AND.---------------- & issEN&sENDiHOUi.NE. _aagyyya::de---oc) THE��oSUBRO�lmusti= R ::error#error issENDDDCALL R ::error(R ::err:nMgu 888,c----r,'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF i--���oF oiHOUi.NE. _aagyyya::de---oc) THE��oSUBRO�loF oPRES NT(ldu ) THE��oSUBRO�l((((DO i=1,dimenlit issENDDDDDDDDDDDoF oldl(i) .GT. Edu(i)) THE��oSUBRO�l( L�cgggmusti= R ::error#error issENDDDDDDDDDDDCALL R ::error(R ::err:nMgu 888,c----r,DD& issEN&sENDDDDDDDDDDD'Edu()wmusSe PA>= Edl()',__LINE__,mustn � �! GOTO 9999si--�������������EcsIF oSUBRO�l(�cgEcsDO ! ELSE�oSUBRO�l( L�DO i=1,dimenlit issENDDDDDDDDDDDoF oldl(i) .LT. 0) THE��oSUBRO�l( L�cgggmusti= R ::error#error issENDDDDDDDDDDDCALL R ::error(R ::err:nMgu 888,c----r,DD& issEN&sENDDDDDDDDDDD'Edl()wmusSe PA>= 0',__LINE__,mustn � �! GOTO 9999si--�������������EcsIF oSUBRO�l(�cgEcsDO ! EcsIF BRO�l(EcsIF BRO�l(---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBRO!CALL sION op('R ::---oc_nMgcheck',t0,mustn oSUBRORETURNsBRO�l(EcsOSUBReGOINE R ::---oc_nMgcheck ------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_4d�����������������������������������������������������������������������������������������������41363u(-en �inc5��175�����������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------BRO�l(---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEER ::---oc_4 oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_4d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt,Gal-Te----inMpnRs #elifOos�����==�os�����������������oSUBROSUBReGOINE ---oc_4d_d(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt,Gal-------inMpnRs #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_4d_sc(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt----lex-Te----inMpnRs #elifOos�����==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_4d_dc(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt----lex-------inMpnRs #elifOos�����==�osost c-s�oSUBROSUBReGOINE ---oc_4d_i(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dti8mGg�acnMpnRs #elifOos�����==�osLONGost�oSUBROSUBReGOINE ---oc_4d_li(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt64bSS i8mGg�acnMpnRs #elifOos�����==�osLOGICAL�oSUBROSUBReGOINE ---oc_4d_l(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dtlogical-nMpnRs #ent�� � �! C!! (poi8mGOs) bas��.t w://wnumb�acttpele 888y.�oSUBRO-!e � �! C!! [NOTE] � �! C!! ifOa��US-e yalre-dyin sociANTd�cg�s - Ge<hrequire 888 � �! C!! ttp:/e yaced,ae e y2*size(a��US) oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.h'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Argu 888yyyyO in om--------------------------------------------------------gin � �! uår�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second ininindexpDost TEGa��US #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second ininindexpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second ininindexpDost TEGa��US #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second ininindexpDost TEGa��US #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second ininindexpDost TEGa��US #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second ininindexpDost TEGa��US #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second ininindexpDost TEGa��US #ent�� � �! C!! Poi8mGO----nMpnR whsENse y---b88(re)---ocANTd�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEda � �! C!! Numb�acttpDyyiredpele 888yNTAB---wdimenlit 3iNaanMpnR. (>0)�oSUBROost c-s-------------------ost NT(INd--- TEGiHOU issEND-!e!---ocANit w�_Ce. OnNpRE: issEND-!e issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::---oc_fit_pres�ave issEND-!e!*s_aagyyya::---oc_grow issEND-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns 0 upt wsu----- c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second ininindexpDost TEGwork #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second ininindexpDost TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second ininindexpDost TEGwork #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second ininindexpDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second ininindexpDost TEGwork #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second ininindexpDost TEGwork #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second ininindexpDost TEGwork #ent�� � �! ost c-s�y�lO(second4) TEGEdb,ldc,lda_new�oSUBROost c-s---------------TEGi,j,k,l�oSUBROLOGICAL---------------TEGEeo<,l---oc,lre---oc�oSUBRO in o---------------)E t0 c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opInitialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(CALL sION ---('R ::---oc_4d',t0,mustn issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_4d',iHOU,lda,4,mustn � �! oF omusti.NE. 0) GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Poi8m----Rrop�acwork-nMpnRyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_4ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_4dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROwork-=>Owork_4dsc #elifOos�����==�os����������������_COMPLEX�oSUBROwork-=>Owork_4ddc #elifOos�����==�osost c-s�oSUBROwork-=>Owork_4di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_4dli #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_4dl #ent�� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili--------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldb(1) = SIZE(a��US,1)�oSUBRO�l(�cgoF oldb(1).NE.Eda(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L��cglda_new(1) = Eda(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cgldb(2) = SIZE(a��US,2)�oSUBRO�l(�cgoF oldb(2).NE.Eda(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�cgglda_new(2) = Eda(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issEND( L�cgldb(3) = SIZE(a��US,3)�oSUBRO�l(�cgoF oldb(3).NE.Eda(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�cgglda_new(3) = Eda(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(3) = Edb(3)�oSUBRO�l( L�EcsIF issEND( L�cgldb(4) = SIZE(a��US,4)�oSUBRO�l(�cgoF oldb(4).NE.Eda(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�cgglda_new(4) = Eda(4)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�lda_new(1) = Eda(1)�oSUBRO�l( L�lda_new(2) = Eda(2)�oSUBRO�l( L�lda_new(3) = Eda(3)�oSUBRO�l( L�lda_new(4) = Eda(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_fit) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldb(1) = SIZE(a��US,1)�oSUBRO�l(�cgoF oldb(1).NE.Eda(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cgglda_new(1) = Eda(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cgldb(2) = SIZE(a��US,2)�oSUBRO�l(�cgoF oldb(2).NE.Eda(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cgglda_new(2) = Eda(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issEND( L�cgldb(3) = SIZE(a��US,3)�oSUBRO�l(�cgoF oldb(3).NE.Eda(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cgglda_new(3) = Eda(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(3) = Edb(3)�oSUBRO�l( L�EcsIF issEND( L�cgldb(4) = SIZE(a��US,4)�oSUBRO�l(�cgoF oldb(4).NE.Eda(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cgglda_new(4) = Eda(4)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�lda_new(1) = Eda(1)�oSUBRO�l( L�lda_new(2) = Eda(2)�oSUBRO�l( L�lda_new(3) = Eda(3)�oSUBRO�l( L�lda_new(4) = Eda(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow_pres�ave) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldb(1) = SIZE(a��US,1)�oSUBRO�l(�cgoF oldb(1).LT.Eda(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldb(2) = SIZE(a��US,2)�oSUBRO�l(�cgoF oldb(2).LT.Eda(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldb(3) = SIZE(a��US,3)�oSUBRO�l(�cgoF oldb(3).LT.Eda(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldb(4) = SIZE(a��US,4)�oSUBRO�l(�cgoF oldb(4).LT.Eda(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cgglda_new(1) = MAX(ldb(1),Eda(1))�oSUBRO�l( L�cgglda_new(2) = MAX(ldb(2),Eda(2)) oSUBRO�l( L�cgglda_new(3) = MAX(ldb(3),Eda(3))�oSUBRO�l( L� L�lda_new(4) = MAX(ldb(4),Eda(4))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(1) = Edb(1)�oSUBRO�l( L�cgglda_new(2) = Edb(2)�oSUBRO�l( L�cgglda_new(3) = Edb(3)�oSUBRO�l( L� L�lda_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�lda_new(1) = Eda(1)�oSUBRO�l( L�lda_new(2) = Eda(2)�oSUBRO�l( L�lda_new(3) = Eda(3)�oSUBRO�l( L�lda_new(4) = Eda(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldb(1) = SIZE(a��US,1)�oSUBRO�l(�cgoF oldb(1).LT.Eda(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldb(2) = SIZE(a��US,2)�oSUBRO�l(�cgoF oldb(2).LT.Eda(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldb(3) = SIZE(a��US,3)�oSUBRO�l(�cgoF oldb(3).LT.Eda(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgldb(4) = SIZE(a��US,4)�oSUBRO�l(�cgoF oldb(4).LT.Eda(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cgglda_new(1) = MAX(ldb(1),Eda(1))�oSUBRO�l( L�cgglda_new(2) = MAX(ldb(2),Eda(2)) oSUBRO�l( L�cgglda_new(3) = MAX(ldb(3),Eda(3))�oSUBRO�l( L� L�lda_new(4) = MAX(ldb(4),Eda(4))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgglda_new(1) = Edb(1)�oSUBRO�l( L�cgglda_new(2) = Edb(2)�oSUBRO�l( L�cgglda_new(3) = Edb(3)�oSUBRO�l( L� L�lda_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�lda_new(1) = Eda(1)�oSUBRO�l( L�lda_new(2) = Eda(2)�oSUBRO�l( L�lda_new(3) = Eda(3)�oSUBRO�l( L�lda_new(4) = Eda(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::de---oc) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l((((DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�cgoF omusti.NE. 0) THE��oSUBRO�l( L�cggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_4d', DD& issEN&sENDDDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_4d', DDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDD'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(lda_new(1),lda_new(2),lda_new(3),lda_new(4)),STAT=mustn � �! oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#f�USlzeroi--���,t�DCALL R ::error(R ::err:n--oc,'R ::---oc_4d', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wold conl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF oleo<) THE��oSUBRO�l(DO k=1,4�oSUBRO�l( L�ldc(k) = MINolda_new(k),ldb(k))�oSUBRO�l(EcsDO ! DO l=1,ldc(4)�oSUBRO�l( L�DO k=1,ldc(3) issENDDDDDDDDDDDO j=1,ldc(2)�oSUBRO�l( L�cgg L�DO i=1,ldc(1)�oSUBRO�l( L�cgg L� DDwork(i,j,k,l) = a��US(i,j,k,l)�oSUBRO�l( L�cgg L�EcsDO ! DDD L�EcsDO ! DDDEcsDO ! EcsDO ! EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate ://wold ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_4d', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_4d',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_4d_s #elifOos�����==�os�����������������oSUBROicstSUBReGOINE ---oc_4d_d #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROicstSUBReGOINE ---oc_4d_sc #elifOos�����==�os����������������_COMPLEX�oSUBROicstSUBReGOINE ---oc_4d_dc #elifOos�����==�osost c-s�oSUBROicstSUBReGOINE ---oc_4d_i #elifOos�����==�osLONGost�oSUBROicstSUBReGOINE ---oc_4d_li #elifOos�����==�osLOGICAL�oSUBROicstSUBReGOINE ---oc_4d_l #ent�� -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_1dl��--------------------------------------------------------------������������������������������32406u(-en �inc5��17721���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEEEER ::---oc_1dl issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weahopeethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1dl_s(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs #elifOos�����==�os�����������������oSUBROSUBReGOINE ---oc_1dl_d(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_1dl_sc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-Te----inMpnRs #elifOos�����==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_1dl_dc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-------inMpnRs #elifOos�����==�osost c-s�oSUBROSUBReGOINE ---oc_1dl_i(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dti8mGg�acnMpnRs #elifOos�����==�osLONGost�oSUBROSUBReGOINE ---oc_1dl_li(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt64bSS i8mGg�acnMpnRs #elifOos�����==�osLOGICAL�oSUBROSUBReGOINE ---oc_1dl_l(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dtlogical-nMpnRs #ent�� � �! C!! (poi8mGOs) bas��.t wabsol Soflow�ac88m upp�acin ox bs di-R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.h'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l(duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Argu 888yyyyO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second dexpDost TEGa��US #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second dexpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second dexpDost TEGa��US #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second dexpDost TEGa��US #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second dexpDost TEGa��US #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second dexpDost TEGa��US #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second dexpDost TEGa��US #ent�� � �! C!! Poi8mGO----nMpnR whsENse y---b88(re)---ocANTd.�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdl issEND-!e!Low�acin ox limi8NTABleadi88mdim.�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdu issEND-!e!Upp�acin ox limi8NTABleadi88mdim. (>Edl(1)).�oSUBROost c-s-------------------ost NT(INd--- TEGiHOU issEND-!e!A--ocANit w�_Ce. OnNpRE: issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::---oc_fit_pres�ave issEND-!e!*s_aagyyya::---oc_grow issEND-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second dexpDost TEGwork #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second dexpDost TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second dexpDost TEGwork #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second dexpDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second dexpDost TEGwork #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second dexpDost TEGwork #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second dexpDost TEGwork #ent�� � �! ost c-s---------------TEGi,lda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBROLOGICAL---------------TEGEeo<,l---oc,lre---oc�oSUBRO in o---------------)E t0 c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opInitialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(CALL sION ---('R ::---oc_1dl',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_1dl',iHOU,ldl,1,must,ldu Chec-s� oF omusti.NE. 0) GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Poi8m----Rrop�acwork-nMpnRyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_1ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_1dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROwork-=>Owork_1dsc #elifOos�����==�os����������������_COMPLEX�oSUBROwork-=>Owork_1ddc #elifOos�����==�osost c-s�oSUBROwork-=>Owork_1di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_1dli #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_1dl #ent�� issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opCheck-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili--------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l( L�lda = LBOUND(a��US,1)�oSUBRO�l(�cgEdb = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda.NE.Edl(1).OR.Edb.NE.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L��cgldl_new = Edl(1)�oSUBRO�l( L�cggldu_new = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new = Eda�oSUBRO�l( L�cggldu_new = Edb�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�ldl_new = Edl(1)�oSUBRO�l( L�ldu_new = Edu(1)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_fit) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l( L�lda = LBOUND(a��US,1)�oSUBRO�l(�cgEdb = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda.NE.Edl(1).OR.Edb.NE.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new = Edl(1)�oSUBRO�l( L�cggldu_new = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new = Eda�oSUBRO�l( L�cggldu_new = Edb�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�ldl_new = Edl(1)�oSUBRO�l( L�ldu_new = Edu(1)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow_pres�ave) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l( L�lda = LBOUND(a��US,1)�oSUBRO�l(�cgEdb = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda.GT.Edl(1).OR.Edb.LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L��cgldl_new = MINolda,Edl(1))�oSUBRO�l( L�cggldu_new = MAX(ldb,Edu(1))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new = Eda�oSUBRO�l( L�cggldu_new = Edb�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�ldl_new = Edl(1)�oSUBRO�l( L�ldu_new = Edu(1)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l( L�lda = LBOUND(a��US,1)�oSUBRO�l(�cgEdb = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda.GT.Edl(1).OR.Edb.LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new = MINolda,Edl(1))�oSUBRO�l( L�cggldu_new = MAX(ldb,Edu(1))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new = Eda�oSUBRO�l( L�cggldu_new = Edb�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�ldl_new = Edl(1)�oSUBRO�l( L�ldu_new = Edu(1)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::de---oc) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l( L�DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�cgoF omusti.NE. 0) THE��oSUBRO�l( L�cggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_1dl', DD& issEN&sENDDDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_1dl', DDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDD'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new:ldu_new),STAT=mustn � �! oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#f�USlzeroi--���,t�DCALL R ::error(R ::err:n--oc,'R ::---oc_1dl', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF oleo<) THE��oSUBRO�l(ldc = MAX(lda,ldl_new)�oSUBRO�l(ldd = MINoldb,ldu_new)�oSUBRO�l(DO i=ldc,ldd � �! work(i) = a��US(i)�oSUBRO�l(EcsDO ! EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_1dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_1dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_1dl_s #elifOos�����==�os�����������������oSUBROicstSUBReGOINE ---oc_1dl_d #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROicstSUBReGOINE ---oc_1dl_sc #elifOos�����==�os����������������_COMPLEX�oSUBROicstSUBReGOINE ---oc_1dl_dc #elifOos�����==�osost c-s�oSUBROicstSUBReGOINE ---oc_1dl_i #elifOos�����==�osLONGost�oSUBROicstSUBReGOINE ---oc_1dl_li #elifOos�����==�osLOGICAL�oSUBROicstSUBReGOINE ---oc_1dl_l #ent�� ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_4dl��--------------------------------------------------------------������������������������������47407u(-en �inc5��17733���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEER ::---oc_4 l issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weah peethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_4dl_s(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt,Gal-Te----inMpnRs #elifOos�����==�os�����������������oSUBROSUBReGOINE ---oc_4dl_d(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt,Gal-------inMpnRs #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_4dl_sc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt----lex-Te----inMpnRs #elifOos�����==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_4dl_dc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt----lex-------inMpnRs #elifOos�����==�osost c-s�oSUBROSUBReGOINE ---oc_4dl_i(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dti8mGg�acnMpnRs #elifOos�����==�osLONGost�oSUBROSUBReGOINE ---oc_4dl_li(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dt64bSS i8mGg�acnMpnRs #elifOos�����==�osLOGICAL�oSUBROSUBReGOINE ---oc_4dl_l(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http4Dtlogical-nMpnRs #ent�� � �! C!! (poi8mGOs) bas��.t wabsol Soflow�ac88m upp�acin ox bs di-R c L�cg�!e � �! C!! [NOTE] � �! C!! ifOa��US-e yalre-dyin sociANTd�cg�s - Ge<hrequire 888 � �! C!! ttp:/e yaced,ae e y2*size(a��US) oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.h'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l(duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( h Argu 888yyyyO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second ininindexpDost TEGa��US #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second ininindexpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second ininindexpDost TEGa��US #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second ininindexpDost TEGa��US #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second ininindexpDost TEGa��US #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second ininindexpDost TEGa��US #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second ininindexpDost TEGa��US #ent�� � �! C!! Poi8mGO----nMpnR whsENse y---b88(re)---ocANTd.�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdl issEND-!e!Low�acin ox limi8s�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdu issEND-!e!Upp�acin ox limi8s (>Edl(1:4)).�oSUBROost c-s-------------------ost NT(INd--- TEGiHOU issEND-!e!A--ocANit w�_Ce. OnNpRE: issEND-!e issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::---oc_fit_pres�ave issEND-!e!*s_aagyyya::---oc_grow issEND-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second ininindexpDost TEGwork #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second ininindexpDost TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second ininindexpDost TEGwork #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second ininindexpDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second ininindexpDost TEGwork #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second ininindexpDost TEGwork #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second ininindexpDost TEGwork #ent�� � �! ost c-s�y�lO(second4) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBROost c-s---------------TEGi,j,k,l�oSUBROLOGICAL---------------TEGEeo<,l---oc,lre---oc�oSUBRO in o---------------)E t0 c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(CALL sION ---('R ::---oc_4dl',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_4dl',iHOU,ldl,4,must,ldu Chec-s� oF omusti.NE. 0) GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Poi8m----Rrop�acwork-nMpnRyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_4ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_4dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROwork-=>Owork_4dsc #elifOos�����==�os����������������_COMPLEX�oSUBROwork-=>Owork_4ddc #elifOos�����==�osost c-s�oSUBROwork-=>Owork_4di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_4dli #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_4dl #ent�� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili--------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.Edb(1).NE.Edu(1)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(1) = Edl(1)�oSUBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(1) = Eda(1)�oSUBRO�l( L�cgldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).NE.Edl(2).OR.Edb(2).NE.Edu(2)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(2) = Edl(2)�oSUBRO�l( L�cgldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(2) = Eda(2)�oSUBRO�l( L�cgldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).NE.Edl(3).OR.Edb(3).NE.Edu(3)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(3) = Edl(3) issENDDDDDDDDDldu_new(3) = Edu(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(3) = Eda(3)�oSUBRO�l( L�DDldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).NE.Edl(4).OR.Edb(4).NE.Edu(4)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(4) = Edl(4)�oSUBRO�l( L�DDldu_new(4) = Edu(4)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(4) = Eda(4)�oSUBRO�l( L�DDldu_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc s M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)� issENDDDDDDDldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_fit) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.Edb(1).NE.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(1) = Edl(1)�oSUBRO�l( L�cggldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).NE.Edl(2).OR.Edb(2).NE.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(2) = Edl(2)�oSUBRO�l( L�cggldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).NE.Edl(3).OR.Edb(3).NE.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(3) = Edl(3) issENDDDDDDDDDDldu_new(3) = Edu(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(3) = Eda(3)�oSUBRO�l( L�DDDldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).NE.Edl(4).OR.Edb(4).NE.Edu(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(4) = Edl(4)�oSUBRO�l( L�DDDldu_new(4) = Edu(4)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(4) = Eda(4)�oSUBRO�l( L�DDDldu_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc s M = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)� issENDDDDDDDldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow_pres�ave) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).GT.Edl(2).OR.Edb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(3).OR.Edb(3).LT.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).GT.Edl(4).OR.Edb(4).LT.Edu(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3) = MAX(ldb(3),Edu(3))�oSUBRO�l( L� L�ldu_new(4) = MAX(ldb(4),Edu(4)) �oSUBRO�l( L� L�ldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2)) oSUBRO�l( L�cggldl_new(3) = MINolda(3),Edl(3))�oSUBRO�l( L� L�ldl_new(4) = MINolda(4),Edl(4))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldl_new(3) = Eda(3)�oSUBRO�l( L�DDDldl_new(4) = Eda(4)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L� �ldu_new(2) = Edb(2)�oSUBRO�l( L� �ldu_new(3) = Edb(3)�oSUBRO�l( L� �ldu_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l( L�l---oc = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)� issENDDDDDDDldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).GT.Edl(2).OR.Edb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(3).OR.Edb(3).LT.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).GT.Edl(4).OR.Edb(4).LT.Edu(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3) = MAX(ldb(3),Edu(3))�oSUBRO�l( L� L�ldu_new(4) = MAX(ldb(4),Edu(4)) �oSUBRO�l( L� L�ldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2)) oSUBRO�l( L�cggldl_new(3) = MINolda(3),Edl(3))�oSUBRO�l( L� L�ldl_new(4) = MINolda(4),Edl(4))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldl_new(3) = Eda(3)�oSUBRO�l( L�DDDldl_new(4) = Eda(4)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L� �ldu_new(2) = Edb(2)�oSUBRO�l( L� �ldu_new(3) = Edb(3)�oSUBRO�l( L� �ldu_new(4) = Edb(4)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l� �l---oc = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)� issENDDDDDDDldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::de---oc) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l( L�DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�cgoF omusti.NE. 0) THE��oSUBRO�l( L�cggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_4dl', DD& issEN&sENDDDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_4dl', DDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDD'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1):ldu_new(1), DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(2):ldu_new(2), DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(3):ldu_new(3), DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(4):ldu_new(4)),STAT=mustn � �! oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#f�USlzeroi--���,t�DCALL R ::error(R ::err:n--oc,'R ::---oc_4dl', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF oleo<) THE��oSUBRO�l(DO k=1,4�oSUBRO�l( L�ldc(k) = MAX(ldl_new(k),Eda(k))�oSUBRO�l( L�ldd(k) = MINoldu_new(k),Edb(k))�oSUBRO�l(EcsDO ! �l(DO l=ldc(4),Edd(4)�oSUBRO�l( L�DO k=ldc(3),Edd(3)�oSUBRO�l( L� �DO j=ldc(2),Edd(2)�oSUBRO�l( L� � l(DO i=ldc(1),Edd(1)�oSUBRO�l( L� �������work(i,j,k,l) = a��US(i,j,k,l)�oSUBRO�l( L� ����EcsDO ! �l( ����EcsDO ! �l( �EcsDO ! �l(EcsDO ! EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_4dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_4dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_4dl_s #elifOos�����==�os�����������������oSUBROicstSUBReGOINE ---oc_4dl_d #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROicstSUBReGOINE ---oc_4dl_sc #elifOos�����==�os����������������_COMPLEX�oSUBROicstSUBReGOINE ---oc_4dl_dc #elifOos�����==�osost c-s�oSUBROicstSUBReGOINE ---oc_4dl_i #elifOos�����==�osLONGost�oSUBROicstSUBReGOINE ---oc_4dl_li #elifOos�����==�osLOGICAL�oSUBROicstSUBReGOINE ---oc_4dl_l #ent�� ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_ opo��-------------------------------------------------------------������������������������������20526u(-en �inc5��20222���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEER ::---oc_1 oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in weah peethatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBROSUBReGOINE R ::---oc_ opo( opo,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<httpone-dimenlit al-nMpnRs � �! C!! (poi8mGOs) bas��.t w://wnumb�acttpele 888-R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.h'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(duls_aag�_CALL#��USrcls M duls_aag�_CALL#m---_---oc�oSUBROduls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( h Argu 888yyyyO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l(TYPE(R ::t_ opo) expDost topo issENDEst c-s---------------------ost NT(INd--- TEGiHOU issEND-!e!A--ocANit w�_Ce. OnNpRE: issEND-!e issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s---------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�oSUBROost c-s�y�lO(second1) TEGEdc�oSUBROLOGICAL---------------TEGE---oc,lde---oc�oSUBRO in o---------------)E t0 c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(CALL sION ---('R ::---oc_topo',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRO! may PAadd ommn oahity checksRRANTY issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opCheck-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M E---oc M = .FALSER c L�cglde---oc = .FALSER c L�cgoF omHOU.EQ._aagyyya::---oc_fit) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED( opo))glde---oc = .TRUE.�oSUBRO�l(l---oc M = .TRUE.�oSUBROELSEoF omHOU.EQ._aagyyya::de---oc) THE��oSUBRO�l(lde---oc = .TRUE.��oSUBROELSE�oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_topo', & issEN&sENDDDDDDDDDDDDDDD'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USmfirst issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olde---oc) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED( opo))gTHE��oSUBRO�l( L�!mfirstmde---ocate ---yconl888http:opo issENDmustoF oASSOCIATED( opo%min_physs))gDEALLOCATE( opo%min_physs,STAT=mustn � �! oF oASSOCIATED( opo%max_physs))gDEALLOCATE( opo%min_physd,STAT=mustn � �! oF oASSOCIATED( opo%min_physd))gDEALLOCATE( opo%max_physs,STAT=mustn � �! oF oASSOCIATED( opo%max_physd))gDEALLOCATE( opo%max_physd,STAT=mustn � �! oF oASSOCIATED( opo%bcdef))gDEALLOCATE( opo%bcdef,STAT=mustn � �! oF oASSOCIATED( opo%min_sION))gDEALLOCATE( opo%min_sION,STAT=mustn � �! oF oASSOCIATED( opo%max_sION))gDEALLOCATE( opo%max_sION,STAT=mustn � �! oF oASSOCIATED( opo%min_sIOd))gDEALLOCATE( opo%min_sIOd,STAT=mustn � �! oF oASSOCIATED( opo%max_sIOd))gDEALLOCATE( opo%max_sIOd,STAT=mustn � �! oF oASSOCIATED( opo%sIO_costN))gDEALLOCATE( opo%sIO_costN,STAT=mustn � �! oF oASSOCIATED( opo%sIO_costd))gDEALLOCATE( opo%sIO_costd,STAT=mustn � �! oF oASSOCIATED( opo%sIO2proc))gDEALLOCATE( opo%sIO2proc,STAT=mustn � �! oF oASSOCIATED( opo%issve!st))gDEALLOCATE( opo%issve!st,STAT=mustn � �! oF oASSOCIATED( opo%sIOs_bc))gDEALLOCATE( opo%sIOs_bc,STAT=mustn � �! oF oASSOCIATED( opo%ineighsION))gDEALLOCATE( opo%ineighsION,STAT=mustn � �! oF oASSOCIATED( opo%nneighsION))gDEALLOCATE( opo%nneighsION,STAT=mustn � �! oF oASSOCIATED( opo%ineighproc))gDEALLOCATE( opo%ineighproc,STAT=mustn � �! oF oASSOCIATED( opo%icommseq))gDEALLOCATE( opo%icommseq,STAT=mustn � �! oF o opo%max_m---id .GT. 0) THE��oSUBRO�l( L�ldc(1)i= opo%max_m---id�oSUBRO�l( L�CALL R ::m---_---oc_equio opo%m---,�ldc, & issEN&sENDDDDDDDDDDDDDDDDDDDDDDD_aagyyya::de---oc,mustn � �! EcsIF oSUBRO�l(�DEALLOCATE( opo,iabl=mustn � �! � �!IFY( opo) � �! oF omusti.NE. 0) THE��oSUBRO�l( L�musti= R ::error#error issENDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_topo', & issEN&sENDDDDDDD'De---ocating topo',__LINE__,mustn � �! EcsIF BRO�l( L�EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE( opo,STAT=mustn � �! oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#f�USlzeroi--���,t�DCALL R ::error(R ::err:n--oc,'R ::---oc_topo', & issEN&sENDDDDDDD 'A--ocating topo',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l( � �!IFY( opo%min_physs) BRO�l( � �!IFY( opo%min_physd) BRO�l( � �!IFY( opo%max_physs) BRO�l( � �!IFY( opo%max_physd) BRO�l( � �!IFY( opo%bcdef) BRO�l( � �!IFY( opo%min_sION) BRO�l( � �!IFY( opo%max_sION) BRO�l( � �!IFY( opo%min_sIOd) BRO�l( � �!IFY( opo%max_sIOd) BRO�l( � �!IFY( opo%sIO_costN) BRO�l( � �!IFY( opo%sIO_costd) BRO�l( � �!IFY( opo%sIO2proc) BRO�l( � �!IFY( opo%issve!st) BRO�l( � �!IFY( opo%sIOs_bc) BRO�l( � �!IFY( opo%ineighsION) BRO�l( � �!IFY( opo%nneighsION) BRO�l( � �!IFY( opo%ineighproc) BRO�l( � �!IFY( opo%icommseq) BRO�l( � �!IFY( opo%m---) BRO�l( opo%IDi= 0 BRO�l( opo%preci= R ::yyya::in ofined BRO�l( opo%nsIONi= 0 BRO�l( opo%nssve!sti= 0 BRO�l( opo%nneighproci= 0 BRO�l( opo%max_m---id = 0 BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_topo',t0,mustn oSUBRORETURNsBRO�l(EcsOSUBReGOINE R ::---oc_ opo --------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_5dl��--------------------------------------------------------------������������������������������53321u(-en �inc5��17724���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEER ::---oc_5 l issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_5dl_s(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http5Dt,Gal-Te----inMpnRs #elifOos�����==�os�����������������oSUBROSUBReGOINE ---oc_5dl_d(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http5Dt,Gal-------inMpnRs #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_5dl_sc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http5Dt----lex-Te----inMpnRs #elifOos�����==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_5dl_dc(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http5Dt----lex-------inMpnRs #elifOos�����==�osost c-s�oSUBROSUBReGOINE ---oc_5dl_i(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http5Dti8mGg�acnMpnRs #elifOos�����==�osLONGost�oSUBROSUBReGOINE ---oc_5dl_li(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http5Dt64bSS i8mGg�acnMpnRs #elifOos�����==�osLOGICAL�oSUBROSUBReGOINE ---oc_5dl_l(a��US,ldl,ldu,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http5Dtlogical-nMpnRs #ent�� � �! C!! (poi8mGOs) bas��.t wabsol Soflow�ac88m upp�acin ox bs di-R c L�cg�!e � �! C!! [NOTE] � �! C!! ifOa��US-e yalre-dyin sociANTd�cg�s - Ge<hrequire 888 � �! C!! ttp:/e yaced,ae e y2*size(a��US) oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.h'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( h Argu 888yyyyO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inininindexpDost TEGa��US #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second inininindexpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second inininindexpDost TEGa��US #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second inininindexpDost TEGa��US #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second inininindexpDost TEGa��US #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second inininindexpDost TEGa��US #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second inininindexpDost TEGa��US #ent�� � �! C!! Poi8mGO----nMpnR whsENse y---b88(re)---ocANTd.�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdl issEND-!e!Low�acin ox limi8s�oSUBROost c-s�y�lO(secondnd-----ost NT(INd--- TEGEdu issEND-!e!Upp�acin ox limi8s (>Edl(1:5)).�oSUBROost c-s-------------------ost NT(INd--- TEGiHOU issEND-!e!---ocANit w�_Ce. OnNpRE: issEND-!e!*s_aagyyya::---oc_fit issEND-!e!*s_aagyyya::---oc_fit_pres�ave issEND-!e!*s_aagyyya::---oc_grow issEND-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inininindexpDost TEGwork #elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(second inininindexpDost TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--�lO(second inininindexpDost TEGwork #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--�lO(second inininindexpDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second inininindexpDost TEGwork #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second inininindexpDost TEGwork #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second inininindexpDost TEGwork #ent�� � �! ost c-s�y�lO(second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBROost c-s---------------TEGi,j,k,l,m�oSUBROLOGICAL---------------TEGEeo<,l---oc,lre---oc�oSUBRO in o---------------)E t0 c L�cg�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� issEND---------------------------------gin � �! Chec-s�yO is CONTINUE�� ��IF�_���s�l(CALL sION ---('R ::---oc_5dl',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oF omusti.NE. 0) GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Poi8m----Rrop�acwork-nMpnRyyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_5ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_5dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROwork-=>Owork_5dsc #elifOos�����==�os����������������_COMPLEX�oSUBROwork-=>Owork_5ddc #elifOos�����==�osost c-s�oSUBROwork-=>Owork_5di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_5dli #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_5dl #ent�� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Check-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili--------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���symax,phys,mis,t�lEmax,t�lE�å uårcls M M oF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.Edb(1).NE.Edu(1)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(1) = Edl(1)�oSUBRO�l( L�cgldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(1) = Eda(1)�oSUBRO�l( L�cgldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).NE.Edl(2).OR.Edb(2).NE.Edu(2)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(2) = Edl(2)�oSUBRO�l( L�cgldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(2) = Eda(2)�oSUBRO�l( L�cgldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issE�l( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).NE.Edl(3).OR.Edb(3).NE.Edu(3)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(3) = Edl(3) issENDDDDDDDDDldu_new(3) = Edu(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(3) = Eda(3)�oSUBRO�l( L�DDldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF issE�l( L�DDlda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).NE.Edl(4).OR.Edb(4).NE.Edu(4)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(4) = Edl(4)�oSUBRO�l( L�DDldu_new(4) = Edu(4)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(4) = Eda(4)�oSUBRO�l( L�DDldu_new(4) = Edb(4)�oSUBRO�l( L�EcsIF issE�l( L�DDlda(5) = LBOUND(a��US,5)�oSUBRO�l( L�ldb(5) = UBOUND(a��US,5)�oSUBRO�l(�cgoF olda(5).NE.Edl(5).OR.Edb(5).NE.Edu(5)) THE��oSUBRO�l( L�cglre---oc = .TRUE.�oSUBRO�l( L�cgl---oc M = .TRUE.�oSUBRO�l( L�cgleo<s M = .TRUE.�oSUBRO�l( L��cldl_new(5) = Edl(5)�oSUBRO�l( L�DDldu_new(5) = Edu(5)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cgldl_new(5) = Eda(5)�oSUBRO�l( L�DDldu_new(5) = Edb(5)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l� �l---oc = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)�UBRO�l( L��cldl_new(5) = Edl(5)��UBRO�l( L��cldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(�DDldu_new(5) = Edu(5)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_fit) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).NE.Edl(1).OR.Edb(1).NE.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(1) = Edl(1)�oSUBRO�l( L�cggldu_new(1) = Edu(1)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).NE.Edl(2).OR.Edb(2).NE.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(2) = Edl(2)�oSUBRO�l( L�cggldu_new(2) = Edu(2)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldu_new(2) = Edb(2)�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).NE.Edl(3).OR.Edb(3).NE.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(3) = Edl(3) issENDDDDDDDDDDldu_new(3) = Edu(3)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(3) = Eda(3)�oSUBRO�l( L�DDDldu_new(3) = Edb(3)�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).NE.Edl(4).OR.Edb(4).NE.Edu(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(4) = Edl(4)�oSUBRO�l( L�DDDldu_new(4) = Edu(4)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(4) = Eda(4)�oSUBRO�l( L�DDDldu_new(4) = Edb(4)�oSUBRO�l( L�EcsIF issE�l( L�DDlda(5) = LBOUND(a��US,5)�oSUBRO�l( L�ldb(5) = UBOUND(a��US,5)�oSUBRO�l(�cgoF olda(5).NE.Edl(5).OR.Edb(5).NE.Edu(5)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggldl_new(5) = Edl(5)�oSUBRO�l( L�DDDldu_new(5) = Edu(5)�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(5) = Eda(5)�oSUBRO�l( L�DDDldu_new(5) = Edb(5)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l� �l---oc = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)�UBRO�l( L��cldl_new(5) = Edl(5)��UBRO�l( L��cldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(�DDldu_new(5) = Edu(5)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow_pres�ave) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).GT.Edl(2).OR.Edb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(3).OR.Edb(3).LT.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).GT.Edl(4).OR.Edb(4).LT.Edu(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF issE�l( L�DDlda(5) = LBOUND(a��US,5)�oSUBRO�l( L�ldb(5) = UBOUND(a��US,5)�oSUBRO�l(�cgoF olda(5).GT.Edl(5).OR.Edb(5).LT.Edu(5)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�cggleo<s M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3) = MAX(ldb(3),Edu(3))�oSUBRO�l( L�cggldu_new(4) = MAX(ldb(4),Edu(4)) oSUBRO�l( L�cggldu_new(5) = MAX(ldb(5),Edu(5)) �oSUBRO�l( L� L�ldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2)) oSUBRO�l( L�cggldl_new(3) = MINolda(3),Edl(3))�oSUBRO�l( L� L�ldl_new(4) = MINolda(4),Edl(4))�oSUBRO�l( L� L�ldl_new(5) = MINolda(5),Edl(5))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldl_new(3) = Eda(3)�oSUBRO�l( L�DDDldl_new(4) = Eda(4)�oSUBRO�l( L� L�ldl_new(5) = Eda(5)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L� L�ldu_new(2) = Edb(2)�oSUBRO�l( L� �ldu_new(3) = Edb(3)�oSUBRO�l( L� �ldu_new(4) = Edb(4)�oSUBRO�l( L� ggldu_new(5) = Edb(5)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l� �l---oc = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)�UBRO�l( L��cldl_new(5) = Edl(5)��UBRO�l( L��cldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(�DDldu_new(5) = Edu(5)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::---oc_grow) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1).LT.Edu(1)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).GT.Edl(2).OR.Edb(2).LT.Edu(2)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(3).OR.Edb(3).LT.Edu(3)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4).GT.Edl(4).OR.Edb(4).LT.Edu(4)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF issE�l( L�DDlda(5) = LBOUND(a��US,5)�oSUBRO�l( L�ldb(5) = UBOUND(a��US,5)�oSUBRO�l(�cgoF olda(5).GT.Edl(5).OR.Edb(5).LT.Edu(5)) THE��oSUBRO�l( L�cgglre---oc = .TRUE.�oSUBRO�l( L�cggl---oc M = .TRUE.�oSUBRO�l( L�EcsIF oSUBRO�l(�cgoF olre---oc) THE��oSUBRO�l( L�cgg! no dimenlit wmusSeshrink�oSUBRO�l( L�cggldu_new(1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3) = MAX(ldb(3),Edu(3))�oSUBRO�l( L�cggldu_new(4) = MAX(ldb(4),Edu(4)) oSUBRO�l( L�cggldu_new(5) = MAX(ldb(5),Edu(5)) �oSUBRO�l( L� L�ldl_new(1) = MINolda(1),Edl(1))�oSUBRO�l( L�cggldl_new(2) = MINolda(2),Edl(2)) oSUBRO�l( L�cggldl_new(3) = MINolda(3),Edl(3))�oSUBRO�l( L� L�ldl_new(4) = MINolda(4),Edl(4))�oSUBRO�l( L� L�ldl_new(5) = MINolda(5),Edl(5))�oSUBRO�l( L�ELSE�oSUBRO�l( L�cggldl_new(1) = Eda(1)�oSUBRO�l( L�cggldl_new(2) = Eda(2)�oSUBRO�l( L�cggldl_new(3) = Eda(3)�oSUBRO�l( L�DDDldl_new(4) = Eda(4)�oSUBRO�l( L� L�ldl_new(5) = Eda(5)��oSUBRO�l( L�cggldu_new(1) = Edb(1)�oSUBRO�l( L� L�ldu_new(2) = Edb(2)�oSUBRO�l( L� �ldu_new(3) = Edb(3)�oSUBRO�l( L� �ldu_new(4) = Edb(4)�oSUBRO�l( L� ggldu_new(5) = Edb(5)�oSUBRO�l( L�EcsIF BRO�l( L�ELSE�oSUBRO�l� �l---oc = .TRUE.�oSUBRO�l( L�ldl_new(1) = Edl(1)�oSUBRO�l( L�ldl_new(2) = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(4) = Edl(4)�UBRO�l( L��cldl_new(5) = Edl(5)��UBRO�l( L��cldu_new(1) = Edu(1)�oSUBRO�l( L�ldu_new(2) = Edu(2)�oSUBRO�l( L�ldu_new(3) = Edu(3)�oSUBRO�l( L�ldu_new(4) = Edu(4)�oSUBRO�l(�DDldu_new(5) = Edu(5)�oSUBRO�l(EcsIF BRO�l(ELSEoF omHOU.EQ._aagyyya::de---oc) THE��oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l( L�DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�cgoF omusti.NE. 0) THE��oSUBRO�l( L�cggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! L�EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_5dl', DDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDD'unknownGiHOU',__LINE__,mustn � �! GOTO 9999si--���icsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1):ldu_new(1), DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(2):ldu_new(2), DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(3):ldu_new(3), DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(4):ldu_new(4), DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD& issEN&sENDDDDDDDDDDDDDDldl_new(5):ldu_new(5)),STAT=mustn � �! oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#f�USlzeroi--���,t�DCALL R ::error(R ::err:n--oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF oleo<) THE��oSUBRO�l(DO k=1,5�oSUBRO�l(�DDldc(k) = MAX(ldl_new(k),Eda(k))�oSUBRO�l( L�ldd(k) = MINoldu_new(k),Edb(k))�oSUBRO�l(EcsDO ! �l(DO m=ldc(5),Edd(5)�oSUBRO�l( L�DO l=ldc(4),Edd(4)�oSUBRO�l( L� L�DO k=ldc(3),Edd(3)�oSUBRO�l( L� � �DO j=ldc(2),Edd(2)�oSUBRO�l( L� � l( l(DO i=ldc(1),Edd(1)�oSUBRO�l( L� ������� ��work(i,j,k,l,m) = a��US(i,j,k,l,m)�oSUBRO�l( L� �������EcsDO ! �l( �������EcsDO ! �l( ����EcsDO ! �l( �EcsDO ! �l(EcsDO ! EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_5dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_5dl_s #elifOos�����==�os�����������������oSUBROicstSUBReGOINE ---oc_5dl_d #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_sc #elifOos�����==�os����������������_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_dc #elifOos�����==�osost c-s�oSUBROicstSUBReGOINE ---oc_5dl_i #elifOos�����==�osLONGost�oSUBROicstSUBReGOINE ---oc_5dl_li #elifOos�����==�osLOGICAL�oSUBROicstSUBReGOINE ---oc_5dl_l #ent�� ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------3�00000043610�116---oc/R ::---oc_1d��---------------------------------------------------------------������������������������������3���7u(-en �inc5��17546���������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae t_msCopyr_m�t (c (cEEER ::---oc_1 oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 88mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs #elifOos�����==�os�����������������oSUBROSUBReGOINE ---oc_1d_d(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_1d_sc(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-Te----inMpnRs #elifOos�����==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_1d_dc(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-------inMpnRs #elifOos�����==�osost c-s�oSUBROSUBReGOINE ---oc_1d_i(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dti8mGg�acnMpnRs #elifOos�����==�osLONGost�oSUBROSUBReGOINE ---oc_1d_li(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt64bSS i8mGg�acnMpnRs #elifOos�����==�osLOGICAL�oSUBROSUBReGOINE ---oc_1d_l(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dtlogical-nMpnRs #ent�� � �! C!! (poi8mGOs) bas��.t w://wnumb�acttpele 888s. issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Ih'n_DyyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issENDduls_aag�_CALL#error issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( h Argu 888yyyyO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R ----�lO(second dexpDost TEGa��US #elifOos�����==�os�����������������oSUBRO in o---------------)E ----�lO(second dexpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R----�lO(second dexpDost TEGa��US #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)----�lO(second dexpDost TEGa��US #elifOos�����==�osost c-s�oSUBROost c-s---------------------�lO(second dexpDost TEGa��US #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)-----�lO(second dexpDost TEGa��US #elifOos�����==�osLOGICAL�oSUBROLOGICAL---------------------�lO(second dexpDost TEGa��US #ent�� � �! C!! Poi8mGO----nMpnR whsENse y---b88(re)---ocANTd.�oSUBROost c-s�y�lO(secondnd-------ost NT(INd--- TEGEda � �! C!! Numb�acttpDyyia wpele 888sNTABleading lda(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r0)c-so---------i8m64)-----�lO(second aagyyya::---oc_fit_pres�ave issEAD-!e!*s_aagyyya::---oc_grow issENes�ave issE-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',----_(-ors_s(----id,d,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yyyO in om--------------------------------------------------------gin � �! Chec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inininindexpDost TEGwork elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(seconindexpDost TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--nd inininindexpDost TEGwork #elifOos�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--nd inininindexpDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second inininst TEGwork #elifOos�����==�osLONGost�oSUBROost c-so---------i8m64)---�lO(second inininst TEGwork #elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second inininst TEGwork #ent�� � �! ost c-s�y�lO(second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBR---------------TEGi,j,k,l,m�oSUBROLOGICdc,ldd,ldl_new,L�cg�o<,l--d5) TEGEda,Edb,ldc,ldd,ldl_nes,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� issEND------------is,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� SUBRO�TIN sION ---('R ::---oc_5dl',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(1dCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oF omusti.N, & issEN&sENDDDDDDDDDDCicsIF issEND---------------------1dCh-------a,1�lE�å uårclmax,t�lE�å uårcls M h Poi8m----Rro888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRChec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_5ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_5dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPL1X�oSUBROwork-=>Owork_5dsc #elifOos�����==�os�������������1��_COMPLEX�oSUBROwork-=>Owork_5ddc #elifOos�����==�osost c-s�oSUB1Owork-=>Owork_5di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_5dl1 #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_5dl1#ent�� issEND-------ICAL�oSUBROwork-=>Owork_5dl1#ys,max,phys,mis,t�lEmax,t�lE�å uårcls M h 1heck-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili-THE��oS------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���symax,phys,mis,t�lEmax,t�lE�å uårcls M M oF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRompop�bilityaofabs ut !!-condip���symax,phys,db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgo re------SIZE::error(R ::err:de---oc,---new(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).GT.EoF olda(2)�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl---��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a�ip���sy------��-� �db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgo re------SIZE::error(R ::err:de---oc,---new(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOU).GT.EoF olda(2)�l( L�ldl_new(3) = Edl(UBRO�l( L�ldb(2) = Uip���sy------��-� �EOFbs ut !!-condp���s array mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldaityaofabs ut !!-condip���sy------��db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgo re------SIZE::error(R ::err:de---oc,---nUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).GT.EoF olda(2)�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl---��-� �EOFbs ut !!-condp���s array mustioomgrows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgo re------SIZE::error(R ::err:de---oc,---nUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOU).GT.EoF olda(2)�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl---��-� �EOFbs ut !!-condp���s array stiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l( L�DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�(1) = UBOUND(a��US,1)�oSUBRO�l(�cgo reggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! L�EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(1dCh L�cmusti= R ::error#f�Undip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::---oc_5dl', DDDDDDDDDDDDDDDDDNDDDDDDDD'DATA',__LINE__,mustn � �! wnGiHOU',__LINE__,mustn � �! GOTO 9999s1dCh L���������������������-------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1):ldu_new(1), DDDDDDDDDDDDs,mis,t�lEmax,t�lE�å uåN&sENDDDDDDDDDDDDDDldl_new(2):ldu_new(2), a.TRUrror(R ::err:n--oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF is1dCh L�cmusti= R ::error#f----------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF oleo<) THE��oSUBRO�l(DO k=1,5�oSUBRO�l(�DDldc(k) = MAX(ldl_new(k),Eda(----ginys,max,phys,mis,t�lEmoldu_new(k),Edb(k))�oSUBRldcUBRO�l( Lb,, a.TRU(k))�oSUBRDO ! 1,l--d5) TEGGGGGGGcsDO ! �EcsDO ! ,Edd(3)�oSUBRO�l( L� �---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND-------------------1dCh L�cmusti= R ::error#f-,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_5dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_5dl_s #elifOo1dCheck-nMgu SUBReG��������oSUBROicstSUBReGOINE ---oc_5dl_d #elifOos�����==�ost_dG_Dyyyy�==��_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_sc #elifOos�����==�os��==�����������_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_dc #elifOos�����==�os�==�os�oSUBROicstSUBReGOINE ---oc_5dl_i #elifOos�����==�osLONGost�oSUBROicst�==�oOINE ---oc_5dl_li #elifOos�����==�osLOGICAL�oSUBROicstNGosGOINE ---oc_5dl_l #ent�� ----------------------------==�os------------------------------------------------------==�ock-cg�s------------issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Subaced,ae ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt����������������������������3���73(-en �inc5��17546���������������������incardon��������������������������������������������������6630���������������������������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssmGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin �,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 38mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs ----------------3s�����������������oSUBROSUBReGOINE ---oc_1d_d(a��US,lda,iHOU,mu3tn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs #elifOos�����==�3st_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_1d_sc(a��US,ld3,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-Te----inMpnRs #elifOos����3==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_1d_dc(a��US3lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-------inMpnRs #elifOos����3==�osost c-s�oSUBROSUBReGOINE ---oc_1d_i(a��US,lda,iHOU,mustn � 3! C!! (Re)---ocANTs�cg�s - Ge<http1Dti8mGg�acnMpnRs #elifOos�����==�osLO3Gost�oSUBROSUBReGOINE ---oc_1d_li(a��US,lda,iHOU,mustn � �! C!3 (Re)---ocANTs�cg�s - Ge<http1Dt64bSS i8mGg�acnMpnRs #elifOos�����3=�osLOGICAL�oSUBROSUBReGOINE ---oc_1d_l(a��US,lda,iHOU,mustn � �3 (Re)---ocANTs�cg�s - Ge<http1Dt64bSSl-nMpnRs #ent�� � �! C!! (po38mGOs) bas��.t w://wnumb�acttpele 888s. issEND----------------3----------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Ih'n_DyyyyydG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---t�lE�å E-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(duls_aag�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issE uårGLE�l(dulsror issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( h Argu 888yyyyO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�ifBROos�����==�ost_dG_Dyyyyy������oSUBRO in o------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�irk elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(seco,o,oxpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo----------E t�lO(seco,o,oxpDost TEGa��US #elifOos�����==�ost_s�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--,o,oxpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_C-s�oSUBROost c-s-------------------�lO(second ininin,o,oxpDost TEGa��US #elifOos�����==�ost_t�oSUBROost c-so---------i8m64)---�lO(second ininin,o,oxpDost TEGa��US #elifOos�����==�ost_L�oSUBROLOGICAL-------------------�lO(second ininin,o,oxpDost TEGa��US #elifOos�����==�ost_L�second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBR,o,oxpDost TEGa��US #eli(INd--- TEGEda � �! C!! Numb�acttpDyyia wpele 888sNTABleadiOLOGICAL------�r(3),Edl���r(3),l���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3)NTAr(3),Edl��s�r(3),Edl���r0)c-so---------i8m64)-----�lO(secd aagyyya::---oc_fit_pres�ave issEAD-!e!*s_aagyyya::---oc_grow issENes�ave issE-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',--i8m64)-----�lO(secd aagyyyamax,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�ifBROos���Oos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inininindexpDost TEGwork elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(seco,o,oxpDost TEGa�TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--,o,oxpDost TEGa�TEGwork #elifOos�����==s�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--,o,oxpDost TEGa�pDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second ininin,o,oxpDost TEGa�pDost TEGwork #elifOot�oSUBROost c-so---------i8m64)---�lO(second ininin,o,oxpDost TEGa�elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second ininin,o,oxpDost TEGa�elifOos�����==�osLOGICAL�second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBR,o,oxpDost TEGa�-TEGi,j,k,l,m�oSUBROLOGICldu_new�oSUB3)r(3),E<,l--s��. L�DOost c-so---------i8m64)---�lL�cg�j,kd5) TEGEda,Edb,ldc,ldd,ldl_nes,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� issEND------------is,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� SUBRO�TIN sION ---('R ::---oc_5dl',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(3dCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oF omusti.N & isEN&sENDDDDDDDDDDCicsIF issEND---------------------3dCh-------a,3�lE�å uårclmax,t�lE�å uårcls M h Poi8m----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRChec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_5ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_5dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPL3X�oSUBROwork-=>Owork_5dsc #elifOos�����==�os�������������3��_COMPLEX�oSUBROwork-=>Owork_5ddc #elifOos�����==�osost c-s�oSUB3Owork-=>Owork_5di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_5dl3 #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_5dl3#ent�� issEND-------L�oSUBROLOGICAk-=>Owork_5dl3#ys,max,phys,mis,t�lEmax,t�lE�å uårcls M h 3heck-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili-THE��oS------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���symax,phys,mis,t�lEmax,t�lE�å uårcls M M oF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRompop�bilityaofabs ut !!-condip���symax,phys,db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2db(1)aldl_new(4) = Eda(4)�oSUBRO�l( Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 L�DDaldu_new(5) = Eda(5)��oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_new(5) = Edb(5)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(4 L�DDaldu_nnew(1) = Edb(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_nO�l( L�ELSE�oSUBRO�l� � = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR---��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a�ip���sy------��-� �db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a)aldl_new(4) = Eda(4)�oSUBRO�l( Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(aDaldu_new(5) = Eda(5)��oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_new(5) = Edb(5)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(aDaldu_nnew(1) = Edb(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_nO�l( L�ELSE�oSUBRO�l� � = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl( SUBRO�l( L�ldb(4) = UBOUw(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR---��-� �EOFbs ut !!-condp���s array mustioray mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldaityaofabs ut !!-condip���sy------��db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2).GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOUND(a��US,4)�oSUBRO�l(�cgoF olda(41) = MAX(ldb(1),Edu(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3)aldl_new(4)3),Edu(3))�oSa.TRU(k))�oSUBRu_new(3)aldl_n(ldb(4),Edu(4)) oSaBRO�l( L� L�ldl_new(5)aldu_nnew(15),Edu(5)) �oaBRO�l( L�ELSE�oSU Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l(ew(3)aldl_n(ldb( = Edb(5)�oSUBRO�l( L�Ecaldu_nO�l( L�ELSE�oSUBRO�l� � = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl( SUBRO�l( L�ldb(4) = UBOUw(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR---��-� �EOFbs ut !!-condp���s array mustioray ows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOU).GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOU).GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOU1) = MAX(ldb(1),Edu(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3)aldl_new(4)3),Edu(3))�oSa.TRU(k))�oSUBRu_new(3)aldl_n(ldb(4),Edu(4)) oSaBRO�l( L� L�ldl_new(5)aldu_nnew(15),Edu(5)) �oaBRO�l( L�ELSE�oSU Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l(ew(3)aldl_n(ldb( = Edb(5)�oSUBRO�l( L�Ecaldu_nO�l( L�ELSE�oSUBRO�l� � = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl( SUBRO�l( L�ldb(4) = UBOUw(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR---��-� �EOFbs ut !!-condp���s array stiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l( L�DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�1) = UBOUND(a��US,1)�oSUBRO�l(�cgo reggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! L�EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(3dCh L�cmusti= R ::error#f�Undip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::-- �EOFbs ut !!-condp���s array DDDDD'DATA',__LINE__,mustn � �! wnGiHOU',__LINE__,mustn � �! GOTO 9999s3dCh L����������������������-------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1):ldu_new(1), DDDDDDDDDDDys,mis,t�lEmax,t�lE�å uåN&sENDDDDDDDDDDDDDDldl_new(2):ldu_new(2), aDDDDDDDDDDaldu_new,DDaldu_nneUrror(R ::err:n--oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF is3dCh L�cmusti= R ::error#f----------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls e---o<) THE��oSUBRO�l(DO k=1,5�oSUBRO�l(�DDldc(k) = MAX(ldl_new(k),Eda(----ginys,max,phys,mis,t�lEmoldu_new(k),Edb(k))�oSUBRldcnew(4)3�l( LaDDDDDDDDDDb.TRU(k))�oSUBRi,j,k,(4)3�l( LaDDDDD2DDDDb.2RU(k))�oSUBRi,j,3,(4)3�l( LaDDDDD3DDDDb.3RU(k))�oSUBRDO k 1,l--LSE�oSUBRO�l� ���US(1,l--Ldb(5)�oSUBRO�l( L�DO ! 1,l--������EcsDO ! �l( csDO ! �EcsDO ! ����EcsDO ! �hys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olrcls e---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(oF omusti.NE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND-------------------3dCh L�cmusti= R ::error#f-,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_5dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_5dl_s #elifOo3dCheck-nMgu SUBReG��������oSUBROicstSUBReGOINE ---oc_5dl_d #elifOos�����==�ost_dG_Dyyyy3==��_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_sc #elifOos�����==�os�3==�����������_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_dc #elifOos�����==�os3==�os�oSUBROicstSUBReGOINE ---oc_5dl_i #elifOos�����==�osLONGost�oSUBROicst3==�oOINE ---oc_5dl_li #elifOos�����==�osLOGICAL�oSUBROicst3GosGOINE ---oc_5dl_l #ent�� ----------------------------3=�os------------------------------------------------------3d-------------------------------------------------------------------------------------------------------------------����������������������������3���75(-en �inc5��17546���������������������incardon�������������������������������������������������44010�����������������43��������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssmGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin �,t�lEmax,t�lE�å uårcls M h(DTU)GOTO 58mGOTO 88mGOTO 88m Twisofils is pil� Naa weaPesellelaPes�acls M h L� �!!!-(PPM).GOTO 88mGOTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs ------------------�����������������oSUBROSUBReGOINE ---oc_1d_d(a��US,lda,iHOU,mu5tn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs #elifOos�����==�5st_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_1d_sc(a��US,ld5,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-Te----inMpnRs #elifOos����5==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_1d_dc(a��US5lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-------inMpnRs #elifOos����5==�osost c-s�oSUBROSUBReGOINE ---oc_1d_i(a��US,lda,iHOU,mustn � 5! C!! (Re)---ocANTs�cg�s - Ge<http1Dti8mGg�acnMpnRs #elifOos�����==�osLO5Gost�oSUBROSUBReGOINE ---oc_1d_li(a��US,lda,iHOU,mustn � �! C!5 (Re)---ocANTs�cg�s - Ge<http1Dt64bSS i8mGg�acnMpnRs #elifOos�����5=�osLOGICAL�oSUBROSUBReGOINE ---oc_1d_l(a��US,lda,iHOU,mustn � �5 (Re)---ocANTs�cg�s - Ge<http1Dt64bSSl-nMpnRs #ent�� � �! C!! (po58mGOs) bas��.t w://wnumb�acttpele 888s. issEND----------------5----------------ginys,max,phys,mis,t�lEmax,t�lE�å uårrcls M h Ih'n_DyyyyydG_DyyyENes�ave issE[NOTE]es�ave issE- G uåre fa THEdyOUTsocieadi------------requirn_Dyyes�ave issEO in e f�lEmax,te f2*size::error(R ::eryyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---t�lE�å E-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å Eg�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issE uårGLE�l(dulsror issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( h Argu 888yyyyO in om------------------------------s M duls_aag�_CALL#sION ie issE uårGLE�l(duls�����==�ost_dG_Dyyyyy������oSUBRO in o------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�irk elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(seco,o,o,o,oxpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo----------E t�lO(seco,o,o,o,oxpDost TEGa��US #elifOos�����==�ost_s�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--,o,o,o,oxpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_C-s�oSUBROost c-s-------------------�lO(second ininin,o,o,o,oxpDost TEGa��US #elifOos�����==�ost_t�oSUBROost c-so---------i8m64)---�lO(second ininin,o,o,o,oxpDost TEGa��US #elifOos�����==�ost_L�oSUBROLOGICAL-------------------�lO(second ininin,o,o,o,oxpDost TEGa��US #elifOos�����==�ost_L�second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBR,o,o,o,oxpDost TEGa��US #eli(INd--- TEGEda � �! C!! Numb�acttpDyyia wpele 888sNTABleadiOLOGICAL------�r(3),Edl���r(3),l���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3)NTAr(3),Edl��s�r(3),Edl���r0)c-so---------i8m64)-----�lO(secd aagyyya::---oc_fit_pres�ave issEAD-!e!*s_aagyyya::---oc_grow issENes�ave issE-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',--i8m64)-----�lO(secd aagyyyamax,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opLocal- yO in om------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uår�ifBROos���Oos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inininindexpDost TEGwork elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(seco,o,o,o,oxpDost TEGa�TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--,o,o,o,oxpDost TEGa�TEGwork #elifOos�����==s�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--,o,o,o,oxpDost TEGa�pDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second ininin,o,o,o,oxpDost TEGa�pDost TEGwork #elifOot�oSUBROost c-so---------i8m64)---�lO(second ininin,o,o,o,oxpDost TEGa�elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second ininin,o,o,o,oxpDost TEGa�elifOos�����==�osLOGICAL�second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBR,o,o,o,oxpDost TEGa�-TEGi,j,k,l,m�oSUBROLOGICldu_new�oSUB5)r(3),E<,l--s��. L�DOost c-so---------i8m64)---�lL�cg�j,k,l,md5) TEGEda,Edb,ldc,ldd,ldl_nes,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� issEND------------is,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� SUBRO�TIN sION ---('R ::---oc_5dl',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(5dCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oF omusti.N & isEN&sENDDDDDDDDDDCicsIF issEND---------------------5dCh-------a,5�lE�å uårclmax,t�lE�å uårcls M h Poi8m----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRChec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_5ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_5dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPL5X�oSUBROwork-=>Owork_5dsc #elifOos�����==�os�������������5��_COMPLEX�oSUBROwork-=>Owork_5ddc #elifOos�����==�osost c-s�oSUB5Owork-=>Owork_5di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_5dl5 #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_5dl5#ent�� issEND-------L�oSUBROLOGICAk-=>Owork_5dl5#ys,max,phys,mis,t�lEmax,t�lE�å uårcls M h 5heck-cg�s---ocANit wtypy issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili-THE��oS------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���symax,phys,mis,t�lEmax,t�lE�å uårcls M M oF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRompop�bilityaofabs ut !!-condip���symax,phys,db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a��US,2)�oSUBRO�l( L�oF olda(2db(1)aldl_new(4) = Eda(4)�oSUBRO�l( Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 L�DDaldu_new(5) = Eda(5)��oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_new(5) = Edb(5)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 L�DDaldu_nnew(1) = Edb(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_nO�l( L�ELSE�oSUBRO�l� � = Edldl(5).OR.Edb(5)-o4 = .SIZE::erro�4( L�cggl---oc M = .TIF4 iew(5)a.4RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 L�DDaldu_n4ew(1) = 4db(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_n4�l( L�EL4db(1)�oSUBRO�l = Edldl(5).OR.Edb(5)-o5 = .SIZE::erro�5( L�cggl---oc M = .TIF5 iew(5)a.5RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 L�DDaldu_n5ew(1) = 5db(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_n5�l( L�EL5db(1)�oSUBRO�l = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR L�DDaldu_n4ew(1) = 4db(1)�oSUBRO�lDDaldu_n5ew(1) = 5db(1)�oSUBR---��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a�ip���sy------��-� �db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOUND(a)aldl_new(4) = Eda(4)�oSUBRO�l( Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(aDaldu_new(5) = Eda(5)��oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_new(5) = Edb(5)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(aDaldu_nnew(1) = Edb(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_nO�l( L�ELSE�oSUBRO�l� � = Edldl(5).OR.Edb(5)-o4 = .SIZE::erro�4( L�cggl---oc M = .TIF4 iew(5)a.4RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(aDaldu_n4ew(1) = 4db(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_n4�l( L�EL4db(1)�oSUBRO�l = Edldl(5).OR.Edb(5)-o5 = .SIZE::erro�5( L�cggl---oc M = .TIF5 iew(5)a.5RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(aDaldu_n5ew(1) = 5db(1)�oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_n5�l( L�EL5db(1)�oSUBRO�l = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR L�DDaldu_n4ew(1) = 4db(1)�oSUBRO�lDDaldu_n5ew(1) = 5db(1)�oSUBR---��-� �EOFbs ut !!-condp���s array mustioray mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldaityaofabs ut !!-condip���sy------��db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOU D(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOU D(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOU D(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(5).OR.Edb(5)-o4 = .SIZE::erro�4( L�cggl---oc M = .TIF4 iUBRO�a.4RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 = Edldl(5).OR.Edb(5)-o5 = .SIZE::erro�5( L�cggl---oc M = .TIF5 iUBRO�a.5RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(31) = MAX(ldb(1),Edu(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3)aldl_new(4)3),Edu(3))�oSa.TRU(k))�oSUBRu_new(3)aldl_n(ldb(4),Edu(4)) oSaBRO�l( L� L�ldl_new(5)aldu_nnew(15),Edu(5)) �oaBRO�l( L�ELSE�oSU L�DDaldu_n4ew(15),Edu(54) �oaB4O�l( L�ELSE�oSU L�DDaldu_n5ew(15),Edu(55) �oaB5O�l( L�ELSE�oSU Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l(ew(3)aldl_n(ldb( = Edb(5)�oSUBRO�l( L�Ecaldu_nO�l( L�ELSE�oSUBRO�l� � L�DDaldu_n4ew(1L�EL4db(1)�oSUBRO�l L�DDaldu_n5ew(1L�EL5db(1)�oSUBRO�l = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR L�DDaldu_n4ew(1) = 4db(1)�oSUBRO�lDDaldu_n5ew(1) = 5db(1)�oSUBR---��-� �EOFbs ut !!-condp���s array mustioray ows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOU).GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOU).GT.Edl(5).OR.Edb(5)-o3 = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,4)�oSUBRO�l( L�ldb(4) = UBOU).GT.Edl(5).OR.Edb(5)-o4 = .SIZE::erro�4( L�cggl---oc M = .TIF4 iUBRO�a.4RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOU = Edldl(5).OR.Edb(5)-o5 = .SIZE::erro�5( L�cggl---oc M = .TIF5 iUBRO�a.5RUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOU = Edldl(5).OR.Edb(u(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3)aldl_new(4)3),Edu(3))�oSa.TRU(k))�oSUBRu_new(3)aldl_n(ldb(4),Edu(4)) oSaBRO�l( L� L�ldl_new(5)aldu_nnew(15),Edu(5)) �oaBRO�l( L�ELSE�oSU L�DDaldu_n4ew(15),Edu(54) �oaB4O�l( L�ELSE�oSU L�DDaldu_n5ew(15),Edu(55) �oaB5O�l( L�ELSE�oSU Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l(ew(3)aldl_n(ldb( = Edb(5)�oSUBRO�l( L�Ecaldu_nO�l( L�ELSE�oSUBRO�l� � L�DDaldu_n4ew(1L�EL4db(1)�oSUBRO�l L�DDaldu_n5ew(1L�EL5db(1)�oSUBRO�l = Edl(2)�oSUBRO�l( L�ldl_new(3) = Edl(3) issENDDDDDDDldl_new(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBRO�lDDaldu_nnew(1) = Edb(1)�oSUBR L�DDaldu_n4ew(1) = 4db(1)�oSUBRO�lDDaldu_n5ew(1) = 5db(1)�oSUBR---��-� �EOFbs ut !!-condp���s array stiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l( L�DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�1) = UBOUND(a��US,1)�oSUBRO�l(�cgo reggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! L�EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(5dCh L�cmusti= R ::error#f�Undip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::-- �EOFbs ut !!-condp���s array DDDDD'DATA',__LINE__,mustn � �! wnGiHOU',__LINE__,mustn � �! GOTO 9999s5dCh L���������������������-------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1):ldu_new(1), DDDDDDDDDDDys,mis,t�lEmax,t�lE�å uåN&sENDDDDDDDDDDDDDDldl_new(2):ldu_new(2), aDDDDDDDDDDaldu_new,DDaldu_nne,DDaldu_n4e,�����---------------DDaldu_n5eUrror(R ::err:n--oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF is5dCh L�cmusti= R ::error#f----------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls e---o<) THE��oSUBRO�l(DO k=1,5�oSUBRO�l(�DDldc(k) = MAX(ldl_new(k),Eda(----ginys,max,phys,mis,t�lEmoldu_new(k),Edb(k))�oSUBRDO k 1,5b(1)�oSUBRO�lDDc(k,(4)3�l( LaDDDDDkDDDDb.k)db(1)�oSUBR---å uårclDO m 1,l--�5db(1)�oSUBRO�lDO l 1,l--�4db(1)�oSUBRO�l L�DO k 1,l--LSE�oSUBRO�l� �O�l L�DO S(1,l--Ldb(5)�oSUBRO�l( L�O�l L�DO ! 1,l--������EcsDO ! �l( csDO ! ,l,m �EcsDO ! ,l,m ���EcsDO ! �l( hys,mis,t�lEmax,t�l( hys,mis,t�lEmax,t�l( hys,mis,t�lEmax,t�lE�å uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olrcls e---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(hys,mis,t�lE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R!CALL R ::error(R ::err:d'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsIF BRO�l(EcsIF issEND-------------------5dCh L�cmusti= R ::error#f-,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_5dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_5dl_s #elifOo5dCheck-nMgu SUBReG��������oSUBROicstSUBReGOINE ---oc_5dl_d #elifOos�����==�ost_dG_Dyyyy5==��_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_sc #elifOos�����==�os�5==�����������_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_dc #elifOos�����==�os5==�os�oSUBROicstSUBReGOINE ---oc_5dl_i #elifOos�����==�osLONGost�oSUBROicst5==�oOINE ---oc_5dl_li #elifOos�����==�osLOGICAL�oSUBROicst5GosGOINE ---oc_5dl_l #ent�� ----------------------------5=�os------------------------------------------------------5d-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------����������������������������3���72(-en �inc5��17546���������������������incardon�������������������������������������������������34257�����������������54��������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssmGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin �,t�lEmax,t�lE�å uårcls M �����3���72(ND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs ----------------2-�����������������oSUBROSUBReGOINE ---oc_1d_d(a��US,lda,iHOU,mu2tn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs #elifOos�����==�2st_dG_Dyyyyy�����_COMPLEX�oSUBROSUBReGOINE ---oc_1d_sc(a��US,ld2,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-Te----inMpnRs #elifOos����2==�os����������������_COMPLEX�oSUBROSUBReGOINE ---oc_1d_dc(a��US2lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt----lex-------inMpnRs #elifOos����2==�osost c-s�oSUBROSUBReGOINE ---oc_1d_i(a��US,lda,iHOU,mustn � 2! C!! (Re)---ocANTs�cg�s - Ge<http1Dti8mGg�acnMpnRs #elifOos�����==�osLO2Gost�oSUBROSUBReGOINE ---oc_1d_li(a��US,lda,iHOU,mustn � �! C!2 (Re)---ocANTs�cg�s - Ge<http1Dt64bSS i8mGg�acnMpnRs #elifOos�����2=�osLOGICAL�oSUBROSUBReGOINE ---oc_1d_l(a��US,lda,iHOU,mustn � �2 (64b88mRe)---ocANTs�cg�s - Ge<http1Dt64bSSl-nMpnRs #ent�� � �! C!! (po28mGOs) bas��.t w://wnumb�acttpele 888s. issEND----------------2----------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Ih'n_DyyyyydG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---t�lE�å E-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å Eg�_CALL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issE uårGLE�l(lE�åror issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( h Argu 888yyyyO in om------------------------------s M duls_aag�_CALL#sION ie issE uårGLE�l(duls�����==�ost_dG_Dyyyyy������oSUBRO in o------------s M duls_aag�_CALL#sION ie issE uårGLE�rk elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(seco,oxpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo----------E t�lO(seco,oxpDost TEGa��US #elifOos�����==�ost_s�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--,oxpDost TEGa��US #elifOos�����==�ost_dG_Dyyyyy�����_C-s�oSUBROost c-s-------------------�lO(second ininin,oxpDost TEGa��US #elifOos�����==�ost_t�oSUBROost c-so---------i8m64)---�lO(second ininin,oxpDost TEGa��US #elifOos�����==�ost_L�oSUBROLOGICAL-------------------�lO(second ininin,oxpDost TEGa��US #elifOos�����==�ost_L�second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBR,oxpDost TEGa��US #eli(INd--- TEGEda � �! C!! Numb�acttpDyyia wpele 888sNTABleadiOLOGICAL------�r(3),Edl���r(3),l���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3),Edl���r(3)NTAr(3),Edl��s�r(3),Edl��r0)c-so---------i8m64)-----�lO(secd aagyyya::---oc_fit_pres�ave issEAD-!e!*s_aagyyya::---oc_grow issENes�ave issE-!e!*s_aagyyya::---oc_grow_pres�ave issEND-!e!*s_aagyyya::de---oc�oSUBROost c-s-------------------ost NT(eGO)-- TEGiust issEND-!e!Returns iablus, 0 upt wsu-----R c L�cg�TINE-bs',--i8m64)-----�lO(secd aagyyyamax,phys,mis,t�lEmax,t�lESrGLE-opLocroSUBR�r(3s,t�lEmax,�l(-Local- yyO in om------------------------------s M duls_aag�_CALL#sION ie issE uårGLE�l(duls���Oos�����==�ost_dG_Dyyyyy������oSUBRO in o---------------R t�lO(second inininindexpDost TEGwork elifOos�����==�os�����������������oSUBRO in o---------------)E t�lO(seco,oxpDost TEGa�TEGwork #elifOos�����==�ost_dG_Dyyyyy�����_COMPLEX�oSUBROCOMPLEXo---------------R--,oxpDost TEGa�TEGwork #elifOos�����==s�����==�os����������������_COMPLEX�oSUBROCOMPLEXo---------------)--,oxpDost TEGa�pDost TEGwork #elifOos�����==�osost c-s�oSUBROost c-s-------------------�lO(second ininin,oxpDost TEGa�pDost TEGwork #elifOot�oSUBROost c-so---------i8m64)---�lO(second ininin,oxpDost TEGa�elifOos�����==�osLOGICAL�oSUBROLOGICAL-------------------�lO(second ininin,oxpDost TEGa�elifOos�����==�osLOGICAL�second5) TEGEda,Edb,ldc,ldd,ldl_new,ldu_new�oSUBR,oxpDost TEGa�-TEGi,j,k,l,m�oSUBROLOGICldu_new�oSUB2)r(3),E<,l--s��. L�DOost c-so---------i8m64)---�lL�cg�jd5) TEGEda,Edb,ldc,ldd,ldl_nes,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opExeM r-eyyyyO inUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår oSUBRO�TINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� issEND------------is,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-op.hitialis� SUBRO�TIN sION ---('R ::---oc_5dl',t0,mustn issEND--------------_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(2dCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oF omusti.N & isEN&sENDDDDDDDDDDCicsIF issEND---------------------2dCh-------a,2�lE�å uårclmax,t�lE�å uårcls M h Poi8m----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRChec-s�ifBROos�����==�ost_dG_Dyyyyy������oSUBROwork-=>Owork_5ds #elifOos�����==�os�����������������oSUBROwork-=>Owork_5dd #elifOos�����==�ost_dG_Dyyyyy�����_COMPL2X�oSUBROwork-=>Owork_5dsc #elifOos�����==�os�������������2��_COMPLEX�oSUBROwork-=>Owork_5ddc #elifOos�����==�osost c-s�oSUB2Owork-=>Owork_5di #elifOos�����==�osLONGost�oSUBROwork-=>Owork_5dl2 #elifOos�����==�osLOGICAL�oSUBROwork-=>Owork_5dl2#ent�� issEND-------L�oSUBROLOGICAk-=>Owork_5dl2#ys,max,phys,mis,t�lEmax,t�lE�å uårcls M h 2heck-cg�s--888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o-ls M Eeo<s M = .FALSER c L�cgl---oc M = .FALSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::---oc_fit_pres�ave) THE��oSUBRO�l(ompop�bili-THE��oS------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M M h fits - Ge<hn8m pres�ave-PeseRres�nSER c L�cglre---oc = .FALSER c L�cgoF (iHOU.EQ._aagyyya::- s,mis,t�lEmax,t�lE�å uårcls M M oF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRompop�bilityaofabs ut !!-condip���symax,phys,db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 L�DDaldu_new(4) = Eda(4)�oSUBRO�l( Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(a��US,3)�oSUBRO�l( L�oF olda(3 L�DDaldu_new(5) = Eda(5)��oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_new(5) = Edb(5)�oSUBRO�l().GT.E�oSUBRO�l Eda(3)�oSUBRO�l( = Edl( SUBRO�l( L�ldb(4) = UBOUw(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBR---��-� �EOFbs ut !!-condp���s array mustiomfits - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a�ip���sy------��-� �db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(4) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(aDaldu_new(4) = Eda(4)�oSUBRO�l( Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l().GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iew(5)a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOUND(aDaldu_new(5) = Eda(5)��oSUBRO�l Eda(3)�oSUBRO�l( L�DDaldu_new(5) = Edb(5)�oSUBRO�l().GT.E�oSUBRO�l Eda(3)�oSUBRO�l( = Edl( SUBRO�l( L�ldb(4) = UBOUw(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBR---��-� �EOFbs ut !!-condp���s array mustioray mustiomgrows - Ge<hn8m pres�ave-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cgldaityaofabs ut !!-condip���sy------��db(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOU D(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOU D(a��US,3)�oSUBRO�l( L�oF olda(3).GT.Edl(5).OR.Edb(u(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3)aldl_new(4)3),Edu(3))�oSa.TRU(k))�oSUBRu_new(3)aldl_n(ldb(4),Edu(4)) oSaBRO�l( L� L�ldl_n Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l(ew(3)aldl_n(ldb( = Edb(5)�oSUBRO�l().GT.E�oSUBRO�l Eda(3)�oSUBRO�l( = Edl( SUBRO�l( L�ldb(4) = UBOUw(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBR---��-� �EOFbs ut !!-condp���s array mustioray ows - Ge<h. Seskip-PeseRres�ntyconl888yyyyO in�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoF oASSOCIATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEdb(1) = UBOUND(a��US,1)�oSUBRO�l(�cgoF olda(1).GT.Edl(1).OR.Edb(1)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(2) = LBOUND(a��US,2)�oSUBRO�l( L�ldb(2) = UBOU).GT.Edl(5).OR.Edb(5)-oc = .SIZE::erro�l( L�cggl---oc M = .TIF iUBRO�a.TRUE.�oSUBRO�l( L�EcsIF issEND( L�cglda(3) = LBOUND(a��US,3)�oSUBRO�l( L�ldb(3) = UBOU).GT.Edl(5).OR.Edb(u(1))�oSUBRO�l( L� L�ldu_new(2) = MAX(ldb(2),Edu(2)) oSUBRO�l( L�cggldu_new(3)aldl_new(4)3),Edu(3))�oSa.TRU(k))�oSUBRu_new(3)aldl_n(ldb(4),Edu(4)) oSaBRO�l( L� L�ldl_n Eda(3)�oSUBRO�l( L�DDaldu_new(4) = Edb(4)�oSUBRO�l(ew(3)aldl_n(ldb( = Edb(5)�oSUBRO�l().GT.E�oSUBRO�l Eda(3)�oSUBRO�l( = Edl( SUBRO�l( L�ldb(4) = UBOUw(aldl_new(4) = Eda(4)�oSUBRO�l(DDaldu_new(5) = Eda(5)��oSUBR---��-� �EOFbs ut !!-condp���s array stiomde---ocate issENDelsompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustoFoASSOCIATED(a��US)) THE��oSUBRO�l( L�DEALLOCATE(a��US,STAT=mustn � �! � �!IFY(a��US) oSUBRO�l(�(1) = UBOUND(a��US,1)�oSUBRO�l(�cgo reggmusti= R ::error#error issENDDDDDDDDDDCALL R ::error(R ::err:de---oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! L�EcsIF BRO�l( L�EcsIF BRO�l(ELSE�oSUBRO�l(2dCh L�cmusti= R ::error#f�Undip���sy------��-� �EOFbs ut !!-condp���s array mustiomUnknownGiHOU issEND�l(ompop�bilityaofabs ut !!-condip���sy------��-� �EOFbs ut !!-condp���s array mustmusti= R ::error#error issENDDDDCALL R ::error(R ::err:nMgu 888,'R ::-- �EOFbs ut !!-condp���s array DDDDD'DATA',__LINE__,mustn � �! wnGiHOU',__LINE__,mustn � �! GOTO 9999s2dCh L���������������������-------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ol---oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1-------------ginys,max,phys,mis,t�lEmax,t�lE�å uåN&sENDDDDDDDDDDDDDDldl_new(2):ldu_new(2), aDDDDDDDDDDaldu_newUrror(R ::err:n--oc,'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'WORK',__LINE__,mustn � �! GOTO 9999si--��� L�EcsIF BRO�l(EcsIF is2dCh L�cmusti= R ::error#f----------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Makem seo<http://wRres�ntyconl888yyyyO in---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls mustoF oASSOCIATED(a��O�l(DO k=1,5�oSUBRO�l(�DDldc(k) = MAX(ldl_new(k),Eda(----ginys,max,phys,mis,t�lEmoldu_new(k),Edb(k))�oSUBRl--���(4)3�l( LaDDDDD1DDDDb.TRU(k))�oSUBRl--Ldb(4)3�l( LaDDDDD2DDDDb.RO�l( L� L�ldDO S(1,l--Ldb(5)�oSUBRO�l(DO ! 1,l--������EcsDO ! �csDO ! �EcsDO ! �EOFbs ut !!-conå uårcls M h If re---ocating,mde---ocate old ��USrcls M ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF olre---oc) THE��oSUBRO l(DEALLOCATE(a��US,STAT=mustn � �! !� �!IFY(a��US) oSUBRO�l(hys,mis,t�lE. 0) THE��oSUBRO�l( L�cmusti= R ::error#error issENDDDDDDDDCALL R!CALL R ::error(R ::err:d'R ::---oc_5dl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! EcsOTO 9999si--��� L�EcsIF BRO�l(EcsIF is2dCh L�cmusti= R ::error#f-,mis,t�lEmax,t�lE�å uårcls M h Setp://wRoi8mGO----://wnewsnMpnRyyyO in om--------------------------------------------------------gin � �! Chec-scls M oF ol---oc) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M h Return issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUE�oSUBROCALL sION op('R ::---oc_5dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy������oSUBROicstSUBReGOINE ---oc_5dl_s #elifOo2dCheck-nMgu SUBReG��������oSUBROicstSUBReGOINE ---oc_5dl_d #elifOos�����==�ost_dG_Dyyyy2==��_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_sc #elifOos�����==�os�2==�����������_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_dc #elifOos�����==�os2==�os�oSUBROicstSUBReGOINE ---oc_5dl_i #elifOos�����==�osLONGost�oSUBROicst2==�oOINE ---oc_5dl_li #elifOos�����==�osLOGICAL�oSUBROicst2GosGOINE ---oc_5dl_l #ent�� ----------------------------2=�os------------------------------------------------------2d---------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�����������������,t�lE�å map-en �inc5��17546���������������������incardon�����������������������������������������������������04236����������������117��������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssCALL sION*- f90 N*---oc_5dl',t0,mustn oSUBRORETURNs�ifBROos�����==�ost_dG_Dyyyyy��a RoINUEg�_CALlE�å E�å uårcls M ,t�lE�å mapND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---odG_DyyMODULE ,t�lE�å mapND------!R ,het E�å oASSains)NTAruldr-cNTA�ost �lEmax,s8mGOTOappT.Edl(1).O-!R p_(-ors_s-�---fieldlelaPes�acENes�ave issE� �!mayrc L�cg�`USE`---et E�å GOTdi 88tlY; w tE�å s8mGOTo<http://wwssEs,t�lEmax,sany l You shoulT.E�ldb(4) = UR ,ODO:TOap_field_ins���ddTH from Petros oAdelE�å (--et Em PPldb(4) = UR neTH revisuårcmayshotF esp_(toF h�--GT.EOUT ---88mGOTghost_ins�DDDDDCALL R!�����oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---db(4) = UR �cg�sm�_CALL#��USrcL R!�����oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---#��USrcL REmax,t�lE�å Oap_oASn88t#��USrcL REmax,t�lE�å Oap_field#��USrcL REmax,t�lE�å Oap_p----------L REmax,t�lE�å O iose_p---_bt�lE�å SUBRAINS-ocAbs',-- "Oap�,t�lEap_ .FA_isact ET.f"-#��USrc----MODULE ,t�lE�å mapN------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�����������������de C!!/ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss���0755�����������������������00000���������������5214� 5ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�������������������������������INE o�-------------------------------------------------------------------------------------------------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�����������������de C!!/ omust C!!_pruned_cell-en �inc5��17546���������������������incardon��������������������������������������34330��������������22065��������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssdG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---4) = UR ��,t�lEmax,t�lE�å uårcls omust C!!_pruned_cellND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc9999ta RoINUTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs ----------st C!!_pcell_s(xp,Nree ,min_phys,max_phys,�cmusti= R :ghostsize,min_s,t,max_s,t,n---ok-nMg,pcost)ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs #elifOos��st C!!_pcell_d(xp,Nree ,min_phys,max_phys,�cmusti= R :ghostsize,min_s,t,max_s,t,n---ok-nMg,pcost)ocA(INd--- TEGEda ,het �lEmax,tpermGOin a --main�st C!!osis M =ulT.E dl���r(3),Edpruned ::- C!! (te) cellaildex WAtelaPes�acENes�ave issE[CAfOoON]--- TEGEda ,hesnEy we C!!uolrcls min_s,t, max_s,t!mayr)GOTl���r(3),Edproostin -----rmplioff si--�s!��- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å Eg�_CALL �- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åror issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( Emax,t�lE�å c L�cg�TINE-b Argu 888yyyycANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRsROLOGICldPPMAME TEGa�MKDATA',_OMPLEXo----ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsROLOGICldPPMAME TEGa�MKDATA',_OMPLEopExeMocA(INd--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(-opMSE-bs'�--�cANdes�cgMPIinMpnRsROCLUDE 'mpif.h'ocA(INd--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E��==�ost_(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK(second ininin,oxpDaagyyya::E�å r-eyxpND------!R Posis M =årcls _(-ors_sinMpnRsROLOGIC pDaagyyya::E�å r-eyNp----------),Edl���r(3),E _(-ors_sinMpnRs uåMK(second ininin) pDaagyyya::E�å r-eymin_phys-------),EdMinimum Cordin olrercls hys----/ C!!uoet waU,musmaininMpnRs uåMK(second ininin) pDaagyyya::E�å r-eymax_phys-------),EdMaximum Cordin olrercls hys----/ C!!uoet waU,musmaininMpnRs uåMK(second ininin) pDOPOoONALd aagyyya::---eypcost-------),Ed��==�ostrerleng---Nree , specGOTT.E o<http://wwssE C!!uoet waU,mcost h IhachE _(-ors_inMpnRs uåMK( pDaagyyya::E�å r-eyghostsizettp://wwssESize (width)rercls ghostSE.yer�l(lE�å uåMK(second ininin,oxpDost TEEEEEEE-eymin_x,p-------),EdMinimum extostrercls x,pusmaininMpnRs uåMK(second ininin,oxpDost TEEEEEEE-eymax_s,t-------),EdMaximum extostrercls x,pusmaininMpnRsROLOGIC pDaagyyya max,p-eyn---o--- TEGEda ,otU,mcls M h Ix,pusmainsinMpnRsROLOGIC pDaagyyya max,p-eyis,t�lEmax,t�lE�oSUBR srGLE�l(-Local- ylEmax,t----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å���Oos�����==�ost_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK(second inini omusim,p-eydmxinMpnRsROLOGIC second inini omusim,p-eyNminMpnRsROLOGIC second inini3( (3),Ecg�TINE-bs',--i8L�cg�j,kh-----Mm,ibox,idx,jdx,kdx,ip----------bs',--i8L�cgsrG,n1,n2�l(lE�å uåMK(L�crdx,rdy,rdz,x0,y0,z0,rmean_npbx�l(lE�å uåMK(L�cyyyO inUTralRACT-------char r-eymesgylEmax,t----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å���E-bs',---å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E-bION ---(å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åmax,t�lE�å uårst C!!_pruned_cellCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oF omusti.N & il', DD& issEN&sENmax,t-----issEN&sENmax,t�lE�å uårcls M h Poi8m----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRCC!!uolrcls sizerercls box_s-�---cls requ��r(3oc) THE��oSUBRO�l(ALLOCATE(work(ldl_new(1-------------ginys,max,phys,mis,t�lEmax,t�lE�å uåMmDAT1 uåDO k 1, omusim-------L RNm(k,(DATbs'((max_phys(k,(-ymin_phys.k)d/ghostsizeDDDDDCALL Rdmx(k,(4)(max_phys(k,(-ymin_phys.k)d/ uåNm(k,,MK(DDDDCALL RMmDDDDD=RMm*Nm(k,h Poi8m---DOews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ot !!-comGOTcmpltT.E o<hmcls M h I _(-ors_ails.GOTbox_s-(npbx)ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----DATA',__aagyyya::---oc_grow_p,EcD=RMm�l(lE�åmax,t_s #elifO(npbx,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh -------------------------gi Eeo<s M =h Inpbx failed,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc-bION --zlrcls c) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,DO k 1,Mm-------L Rnpbx(k,(4)0h Poi8m---DOewcANdes�cgMPIinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc-bI _(s',---we neTH t !!-comGOTcls globU,mcoplt--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åmax,t_s #elifO(npbxg,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh -------------------------gi Eeo<s M =h Inpbxg failed,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc-bION --zlrcls c) THE��oSUBRO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,DO k 1,Mm-------L Rnpbxg(k,(4)0h Poi8m---DOe ck-cg�s--s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcCopltrcls (eo<l)mcls M h I _(-ors_sails.GOTbox_s- uårc(--et You �---cannot vector-zl; h Icopr-(åny letersortrclsm e.g.! Chec-s�=ulT.E d cella WAtE�lt �-clsls.GOTcella WAt do_s-not vector-zl)ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåys,mis,t omusimndp�2, DD& issEN&sENDrdxDAT1.0_MK/dmx(�����EcsDO !rdyDAT1.0_MK/dmx(db(5)�oSUBROx0DD=Rmin_phys.1)*rdx(5)�oSUBROy0DD=Rmin_phys.2)*rdy-------L Rn1DD=RNm(1�l( L� L�ldDO ip--- 1,Np----------L RRRRidxDD=RFLOOR(xp(1,ip---)*rdx(-yx0 �EOFbs ut !!-jdxDD=RFLOOR(xp(2,ip---)*rdy(-yy0 �EOFbs ut !!-iboxD=RidxD+ 1D+ jdx*n1D�EOFbs ut !!-npbx(ibox,(4)npbx(ibox,(+T1 uå cls M h If re-bs ut ! omusimndp�3, DD& issEN&sENDrdxDAT1.0_MK/dmx(�����EcsDO !rdyDAT1.0_MK/dmx(db(5)�oSUBROrdzDAT1.0_MK/dmx(3b(5)�oSUBROx0DD=Rmin_phys.1)*rdx(5)�oSUBROy0DD=Rmin_phys.2)*rdy-------L Rz0DD=Rmin_phys.3)*rdz-------L Rn1DD=RNm(1�l( L� L�ldn2DD=RNm(1�*Nm(2�l( L� L�ldDO ip--- 1,Np----------L RRRRidxDD=RFLOOR(xp(1,ip---)*rdx(-yx0 �EOFbs ut !!-jdxDD=RFLOOR(xp(2,ip---)*rdy(-yy0 �EOFbs ut !!-kdxDD=RFLOOR(xp(3,ip---)*rdz(-yz0 �EOFbs ut !!-iboxD=RidxD+ 1D+ jdx*n1D+-kdx*n2�l(lE�åut !!-npbx(ibox,(4)npbx(ibox,(+T1 uå cls M h If re-te n ewcANdes�cgMPIinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcAdd up o<hmcls M h I _(-ors_sailshachEboxD(ibupebupeotU,mcls M h uårc _(-ors_s)ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåsOTO MPI_ls Reduce(npbx,npbxg,Mm,MPI_ROLOGIClMPI_SUM, omu C!max,t�lE�å DO k 1,Mm-------L Rnpbx(k,(4)npbxg(k,h Poi8m---DOek-cg�s ews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ot !!-comGOTcls min_s,t �---max_s,t!ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----D DATA',__aagyyya::---oc_grow_p,Ec���(4) omusim-------l--Ldb(4)3m�l(lE�åmax,t_s #elifO(min_s,t,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh -------------------------gi Eeo<s M =h Imin_s,t failed,mis,t�lEmax,t�lE�å uårcls M h A--ocate nel(lE�åmax,t_s #elifO(max_s,t,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh -------------------------gi Eeo<s M =h Imax_s,t!failed,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcolda(ov!tribupbox_s-�---co',-ct-non-emplsGNnLL#��USrcls M duls_aag�_CALL#sION ---rcls M duls_aag�_CALL#sION ie issE uårGLE�l(lE�ån---o(4)0h Poi8mys,mis,t omusimndp�2, DD& issEN&sEND!�����oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---db(4) = UR �-bItw(ldb(2),EduATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEDO S(1,Nm(2�l( L� L�ldUS)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�l( L� L�ldUS))rcolda(ov!tribupbox_s-�---co',-ct-non-emplsGNnLL#��USrc�ldUS)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�l( L� L�ldUS)DO ! 1,Nm(1�l( L� L�ldddddddiboxD=Ri(+T(j(-y1�*Nm(1�l( L� L�ldddddddmax,npbx(ibox, & isEN&sENDDDDDDDDDDDDDDDDDDDn---o((((((((((((=Dn---o(+T1 uå cllllllllllmin_s,t(1,n---o)D=Rmin_phys.1)(+T uåi-1,MK(*dmx(�����EcsDO !lllllllllmin_s,t(2,n---o)D=Rmin_phys.2)(+T uåj-1,MK(*dmx(db(5)�oSUBRO�l( L�O�lmax_s,t(1,n---o)D=Rmin_phys.1)(+T uåi ,MK(*dmx(�����EcsDO !lllllllllmax_s,t(2,n---o)D=Rmin_phys.2)(+T uåj ,MK(*dmx(db(5)�oSUBRO�l( L�-te n eoSUBRO�l( L�-teå uårcls M h If re-bs ut ! omusimndp�3, DD& issEN&sEND!�����oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---db(4) = UR �-bIthoutidb(2),EduATED(a��US)) THE��oSUBRO�l(o loop peeling�oSUBRO�l(�cglda(1) = LBOUND(a��US,1)�oSUBRO�l(�cgEDO k 1,Nm(3)l( L� L�ldUS)DO S(1,Nm(2�l( L� L�ldUS) S)DO ! 1,Nm(1�l( L� L�lddddddd ddiboxD=Ri(+T(j(-y1�*Nm(1�(+T(k(-y1�*Nm(1�*Nm(2�l( L� L�lddddddddddmax,npbx(ibox, & isEN&sENDDDDDDDDDDDDDDDDDDD DDn---o((((((((((((=Dn---o(+T1 uå cllllllllll llmin_s,t(1,n---o)D=Rmin_phys.1)(+T uåi-1,MK(*dmx(�����EcsDO !lllllllll llmin_s,t(2,n---o)D=Rmin_phys.2)(+T uåj-1,MK(*dmx(db(5)�oSUBRO�l( L�O�l llmin_s,t(3,n---o)D=Rmin_phys.3)(+T uåk-1,MK(*dmx(3b(5)�oSUBRO�l( L�O�l llmax_s,t(1,n---o)D=Rmin_phys.1)(+T uåi ,MK(*dmx(�����EcsDO !lllllllll llmax_s,t(2,n---o)D=Rmin_phys.2)(+T uåj ,MK(*dmx(db(5)�oSUBRO�l( L�lll llmax_s,t(3,n---o)D=Rmin_phys.3)(+T uåk ,MK(*dmx(3b(5)�oSUBRO�l( L�O�l-te n eoSUBRO�l( L� L�-teå uårcl L�-teå uårcls M h If re-te n ew If ret----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å���Oet usoSUBRO�------------to fix exa8tlY; w tn---o(fmpliws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----D DATA',__aagyyya::---oce!Returns iablus,Ec���(4) omusim-------l--Ldb(4)n---o--- TEGmax,t_s #elifO(min_s,t,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh -------------------------gi Eeo<s M =h Imin_s,t failed,mis,t�lEmax,t�lE�å uårcls M h A- ocate nel(lE�åmax,t_s #elifO(max_s,t,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh -------------------------gi Eeo<s M =h Imax_s,t!failed,mis,t�lEmax,t�lE�å uårcls M h A--ocate news - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårchouti w tuårcspace againinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----DATA',__aagyyR c L�cg�TINE-max,t_s #elifO(npbx ,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh ---------------'ls M oF o M =h Inpbx failed,mis,t�lEmax,t�lE�å uårcls M h A--ocate necANdes�cgMPIinMpnRsmax,t_s #elifO(npbxg,l--s w://wnumb�acttpemax,t�lEå ', DD& issEN&sENDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_pruned_cellCh ---------------'ls M oF o M =h Inpbxg failed,mis,t�lEmax,t�lE�å uårcls M h A--ocate nek-cg�s--s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc�oSUBR -s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å ����oSUBROicstSUBReGOINE ---oc_5dl_s #st C!!_pruned_cellCheck-nMgu SUBReG�������SUBReGOUBRAINS-SUBReG #elifOos��-----issEN&sENmax,ghostsize.L '.0_MKEN&sENDDDDDDDDDDDDDDDD'DATA',__LINE__,mustn � �! EwnGiHOU',__LINE__,mustn � �! GOTOst C!!_pruned_cellCh -------------------------g---' w tfifth----debug(2)) obe > 0-----ginys,max,phys,mis,t�lEmrcls8888hys,mis,tcondp���s arraDO k 1, omusim-------L RsENmax,max_phys(k,.L ymin_phys.k)ddl', DD& issEN&sENDDDDDDDD'DATA',__LINE__,mustn � �! L�EcsIF BRO�l( L�EcsIF B � �! GOTOst C!!_pruned_cellCh -------------------------g-----'min_phys(2)) obe <ymax_phys-----ginys,max,phys,mis,t�lEmaEmrcls8888hys,mis,tis,tcondp���s arras M h 8888 oSUBROicstSUBReG--------------------i�oSUBROicstSUBReGOINE ---oc_5dl_d #elifOos�����==�ost_dGst C!!_pcell_s�_COMPLEX�oSUBROicstSUBReGOINE ---oc_5dl_sc #elifOos�����st C!!_pcell_dek-cg�s--------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss�����������������de C!!/ omust C!!_cartesian-en �inc5��17546���������������������incardon���������������������������������������1���11��������������21540��������������������������������������������������������������������������������������������������������������������������������������INE o�-------------------------------------------------------------------------------------------------------------------isssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss_5dl_syyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---4) = UR ��,t�lEmax,t�lE�å uårclsls omust C!!_cartesian-s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårTO 88m PPM is free softwese:lyou can redi!tribupe!it �EO/or moyyyy ���_��!!it underxtweo-ermsiNaa weaGNU Les or Genoral P�lR c L�cg�se yO in omsns p�lR ,het bya weaFree Softwese Fs ut t���,aei wer yO in omsve!s���i3iNaa weaL�cg�se, o (atlyour opt���inany leter yO in omsve!s���.GOTO 88mGOTO 88m PPM is di!tribupet in wear yO ihatlit w erfbe u oful,GOTO 88m bup WITHOUT ANY WARRANTY; w thoutieven weaimpliet warrc L�cg�se y 88m MERCHANTABILITY o FITNESS FOR A PARTICULAR PURPOSE. Seo weGOTO 88m GNU Genoral P�lR c L�cg�se for morsxdetails.GOTO 88mGOTO 88m You should omcoreceivet �-copyiNaa weaGNU Genoral P�lR c L�cg�seyO in omsnEOF elsGNU Les or Genoral P�lR c L�cg�se along w th PPM. Iflnot,GOTO 88m seo<http://www.gnu.org/l�cg�ses/>.GOTO 88mGOTO 88m PesellelaPes�acls M h L� �!!!-(PPM)GOTO 88m ETH ZurichyO in omsCH-8092 Zurich, Sw tzerlnEO o��-�--------------------------------------------------------gin � �! Chec-s�y__SINGLE�l(-o(SION ie issEND�SUBRLE INE oSUBROUTINE-bs',----_(-ors_s(----id,mis,phys,max,phys,mis,t�lEmax,t�lE�å uår #ifBROos�����==�ost_dG_Dyyyyy������oSUBROSUBReGOINE ---oc_1d_s(a��US,lda,iHOU,mustn � �! C!! (Re)---ocANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs ----------st C!!_cart_s(Nm,min_phys,max_phys,st C!!h -----------------------min_s,t,max_s,t,n---ok-nMg,ndom)ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs #elifOos��st C!!_cart_d(Nm,min_phys,max_phys,st C!!h -----------------------min_s,t,max_s,t,n---ok-nMg,ndom)ocA(INd--- TEGEda Dt C!!osescspace ulT.E d Cartesian --main�st C!!osis M =c_5ologyelaPes�acENes�ave issE[TIP]--- TEGEda Icg�seyuldrustfined caNESScls rlEmax,t2)) obe cNTAomsn----a-non-�==o --- TEGEda cls M h Ix,pusmainsails`min_s,t(n,ox`,s`max_s,t(n,ox`-�-----is --- TEGEda uldr-stfined st C!!osis M =is uldds dchanged. +--- TEGEda es�ave issE[NOTE]--- TEGEda ,het �lEmax,tis una weah I _(-ors_sa�---sO iny st C!!osescspace intt�lEmax,t�lEequ---grr Gvol�! s. WlslsulddsmGOT _(-ors_s,---is !!-(PPMb88mGllowdds�lEmax,t�lETY;a------yO in omcost ba�oscT.E d-conossibny i Seatomsn-------reasT.Edl(1).O-!R ndomelaPes�acENes�ave issE[NOTE]--- TEGEda ,heE C!!uoet waU,m--main�is !,puividetailsexa8tlY;UT mRPOSx,pusmainsa--- TEGEda UT L�cgs c)s mo ors. ,het iT ---88to-minim-zlr-------usageah I--- TEGEda ghostSE.yerP�lgrr s neTH ghostSE.yerP�also TO 8ntra- mo or--- TEGEda x,pusmain bmplieries!)-�----o get goo--con88mgencerercls grr GsolvSeo weGOTOda (_(-oficialailbs',-- bmpliery-condis M s TO x,pusmain bmplierieso weGOTOda Peerioeato-con88mgence).th qu-d-/oct-toutidt C!!osis M =erclso weGOTOda C!!uoet waU,m--main�is madeyuntil-cls remainT.E cls M h Ix,psa--- TEGEda do_s-not oASSainURPOO 88maonowM h I2 factor. ,heEremainT.E factor�is--- TEGEda uld---o domaon-bs',---slesedt C!!osis M ,cal-hmGOTO cls --- TEGEda x,rface-to-vol�! ret w�is minim-zld ::-pet in wecls M n wegrr G--- TEGEda ec-scs). ,het way, n mo Eequ--lY;s-zld x,pusmainsan----minimU,mo weGOTOda C',-ct ET x,rface-nod_sa�88m-reated. +--- TEGEda ,heEpencil-dt C!!osis M =uårs exa8tlY; w tsamso weGOTOda exceptmGOTO cutsails--88di 88t M =c)s mohibited.-s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcg�_CALL �- ---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åror issENDEND�SUBRLE INE---------------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårclE�l( Emax,t�lE�å c L�cg�TINE-Emax,t�lE�å wriATED(a��Ub Argu 888yyyycANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRsROLOGICldPPMAME TEGa�MKDATA',_OMPLEXo----ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsROLOGICldPPMAME TEGa�MKDATA',_OMPLEopExeMocA(INd--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E��==�ost_(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK(second ininin,oxpDost TEEEEEEE-eymin_x,p-------),EdMinimum extosdrercls x,psinMpnRs uåMK(second ininin,oxpDost TEEEEEEE-eymax_s,t-------),EdMaximum extosdrercls x,psinMpnRs uåMK(second ininin) pDaagyyya::E�å r-eymin_phys-------),EdMinimum Cordin olrercls hys----/ C!!uoet waU,musmaininMpnRs uåMK(second ininin) pDaagyyya::E�å r-eymax_phys-------),EdMaximum Cordin olrercls hys----/ C!!uoet waU,musmaininMpnRsROLOGIC second ininin) pDaagyyya::E�å r-eyNminMpnRs),Edl���r(3),Em----ec-scs (not oells)ailshachEdi 88t M =erclso weGOTOda globU,mco!!uo.musmain. ::- ludT.E o<ose ONribupboplieries)inMpnRsROLOGIC pDaagyyya::max,p-eyn---o--- TEGEda ,otU,mcls M h Ix,pusmainsinMpnRsROLOGIC pDaagyyya::E�å r-eydt C!!--- TEGEda D-main�st C!!osis M =eterb88--88of:laPes�acENes�ave issE*TA',__aagyyR C!!_xpenciles�ave issE*TA',__aagyyR C!!_ypenciles�ave issE*TA',__aagyyR C!!_zpenciles�ave issE*TA',__aagyyR C!!_cuboides�ave issE*TA',__aagyyR C!!_uldrustfinedinMpnRsROLOGIC seOPOoONAL pDaagyyya::E�å r-eyndominMpnRs),Edl���r(3),Ex,pusmainsa-o b8m-reated. in � � specGOied,inMpnRs),Edo<hmcls M h Ix,pusmainsan-ou shoequ---M oF ol-ls M h I mo ors.inMpnRsROLOGIC pDaagyyya max,p-eyis,t�lEmax,t�lE�oSUnsasrGLE�l(-upLocal- ylEmax,t----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å���Oos�����==�ost_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK( L�cyy,minsv,lc,lx,ux,ly,uy,lz,uzinMpnRsROLOGIC L�ci,icut,jcut,kcut,nsrem,ncut,j,kinMpnRsROLOGIC L�ccutdim,oASstdim,tx,ty,tzinMpnRsROLOGIC L�cix,iy,iz,lduold,nup,ndn,iup,idn-s - Ge<onowM -of-tw(lree Softwese-ls M h IbL�crs (i.e.lree SmGOTROB)inMpnRsROLOGIC L�crc-s - Ge<om----spacT.Edl(1).O uåMK(second inini omusim,p L�cdx(5)�oSU! hys---- extostrerco!!uo.musmaindl(1).O uåMK(second inini omusim,p L�clen_phys-------)e-ls M h IbL�crs intt whi-hmGo !,puividercls xpaceinMpnRsROLOGIC second inini omusim,p L�cnbL�crsinMpnRsROLOGIC second inini omusim,p L�cx,rface,vol�! ,Nc-------)e-ls M h Igrr Gec-scs ilshachE!,p.aildex: (1: omusim,1:n---)inMpnRsROLOGIC second ininin,oxpDost TE-eyNpxpnRs=>DCALL()inMpnRsROLOGIC second ininin,oxpDost TE-eyNpx---o=>DCALL()inMpnRs uåMK( L�cgo--- TEGmalRACT---LEN=----char r L�cmesgylEmax,ROLOGICldcond inini2) L�clduinMpnRsROLOGIC L�ci ::error#et----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å���E-bs',---å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E-bION ---(å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åmax,t�lE�å uårst C!!_cartesianCheck-nMgu 888yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBROoF o----debug.GT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oF omusti.N & il', DD& issEN&sENmax,t-----issEN&sENmax,t�lE�å uårcls M h Poi8m----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRl���r(3),Ex,pusmainsGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oFal-Syyyandom)ddl', DD& issEN&sn---o(4)ndominMpnRs Eda(3)�oSUBRO�n---o(4) omun mo h Poi8m----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRM----spacT.Edl(1).ORO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max,DO i 1, omusim-------L RsNc(i) =RNm(i)-1 uå clllen_phys(i) =ymax_phys(i) -ymin_phys.iphys,mis,t�ldx(i) =Rlen_phys(i)/ uåNc(i),MK(DDDDCAL---DOews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ot !!-comGOTcls x,ps in � � a THEdy ---88soNTY; w tuldrGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� oFst C!!�å A',__aagyyR C!!_uldrustfinedddl', DD& issEN&s----DATA',__aagyyya::---oc_grow_p cllldu���(4) omusim------- cllldu�db(4)n---o--- TEGGGGGmax,t_s #elifO(min_s,t,l-us w://wnumb�acttpe-s� oF'R ::---oc_5dl', DD& issEN&sENDDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_cartesianCh --------------------'minimU h Ix,pusmainsaMIN_SUB-----ginys,max,phys,mis,t�lEmaEx,t�lE�å uårcl-condp���s arrayåmax,t_s #elifO(max_s,t,l-us w://wnumb�acttpe-s� oF'R ::---oc_5dl', DD& issEN&sENDDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_cartesianCh --------------------'maximU h Ix,pusmainsaMAX_SUB-----ginys,max,phys,mis,t�lEmaEx,t�lE�å uårcl-condp���s ar----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRpencil-�---cuboid�st C!!osis M sGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� ooooo(Fst C!!�åEQ A',__aagyyR C!!_xpencil) .OR. ----------------Fst C!!�åEQ A',__aagyyR C!!_ypencil) .OR. ----------------Fst C!!�åEQ A',__aagyyR C!!_zpencil) .OR. ----------------Fst C!!�åEQ A',__aagyyR C!!_cuboid)ddl', DD& issEN&ss�y_tin omcoSstastrdb(2),Edu (i.e.ln om--88tOTO n-ou � � b8m-u�DDDDDCALL R oASstdim(4)0ssEN&ss�0 means:-none ->-cuboids�acttpe-s� oFst C!!�åEQ A',__aagyyR C!!_xpencil) oASstdim(4)1�acttpe-s� oFst C!!�åEQ A',__aagyyR C!!_ypencil) oASstdim(4)2�acttpe-s� oFst C!!�åEQ A',__aagyyR C!!_zpencil) oASstdim(4)3DD& issEN&ssSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSUBRDt C!!osis M =lE�åd-Locm---DD& issEN&ssSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSUB-reate UT f--ox,ps UT Aossibne�lt �-TO least;UT mRPOSashec-s� -soSUBL�cgs cs mo ors. reason�cx,b bordM n nly cauld extrahec-s� -soSUBneTHs8mGOTO !!-co,ghosts)-�---communiF o M =,ghost updateDDDDDCALL R nsrem(4)n---o-DD& issEN&ssSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSUBRFactor�intt nowM n weawo-�---remainderDD& issEN&ssSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSncut (4)0h Poi8mmmmmDO WHILE (MOD(nsrem,db(åEQ 0phys,mis,t�lEmaEnsrem(4)n-rem/2hys,mis,t�lEmaEncut (4)ncut +T1 uå cll-teå uårcl )e-ls M h IremainT.E cutsDDDDCALL R nsrem(4)n-rem(-)1�acttpe-s� oF omusti.N & il', DD& issEN&sENNNNNNNWRITE(mesg,'(A,I4)') 'now-2 half-cuts: ',ncut � �! sOTO 9999wriATF omurank�l(Ecsst C!!_cartesianChmesg,max,phys,mis,t�lEmaEWRITE(mesg,'(A,I4)') 'remainT.E cuts : ',n-rem � �! sOTO 9999wriATF omurank�l(Ecsst C!!_cartesianChmesg,max,phys,mis,t�l----Rro88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrcls M oF ot !!-comGOTcut s-zls ::-punitsrercls grr GspacT.E)o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soS----DATA',__aagyyya::---oc_grow_p cllldu���(4) omusim------- cllldu�db(4)1�acttpe-s� max,t_s #elifO(Npx,l-us w://wnumb�acttpe-s� oF'R ::---oc_5dl', DD& issEN&sENDDD'WORK',__LINE__,mustn � �! sOTO 9999si--��� L�EcsIF BRO�l(Ecsst C!!_cartesianCh--------------------'Nls M h Igrr GunitsrNPXCh-----------------------ginys,max,phys,mis,t�lEmaEx,t�lE�å uårcl-condp�o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrcC �-Tou piec_sailshalf,tperpA(INculas M oF ol----esthec-s� -soSrcdi 88t M ,yuntil-nowM n we2=c)s exhaultedo88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSNpx(1: omusim,1) =sNc(1: omusimDDDDDCALL R nbL�crs(1: omusimD(4)0h Poi8mmmmmlduolds,mis,t�lEmaE4)1�acttpe-s� DO icut=1,ncut hys,mis,t�lEmaE)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRDtet ii-88di 88t M =ercut � �! )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaEut ! omusim & il2, DD& issEN&sENDs,t�lEmaEut !oASstdim(åEQ 1EN&sENDDDDDDDDDDDDDDDDDDD DDccutdim(4)3DD& issEN&sENDs,t�lEmaEut !Npx(2,1) & ilNpx(3,1))ccutdim(4)2hys,mis,t�lEmaEEEEE-bs ut !oASstdim(åEQ 2, DD& issEN&sENDs,t�lEmaE DDccutdim(4)3DD& issEN&sENDs,t�lEmaEut !Npx(1,1) & ilNpx(3,1))ccutdim(4)1 uå cllllllllll-bs ut !oASstdim(åEQ 3, DD& issEN&sENDs,t�lEmaE DDccutdim(4)2hys,mis,t�lEmaEEEEEEmaEut !Npx(1,1) & ilNpx(2,1))ccutdim(4)1 uå cllllllllll-bs DDDDDDDDDDDDDDDDDDD DDccutdim(4)3DD& issEN&sENDs,t�lEmaEut !Npx(2,1) & ilNpx(3,1))ccutdim(4)2hys,mis,t�lEmaEEEEEEmaEut !Npx(1,1) & ilNpx(cutdim,1))ccutdim(4)1 uå cllllllllll-ondp���s arrayållll-bs DDDDDDDDDDDDDDDDDDDut !oASstdim(åEQ 1EN&sENDDDDDDDDDDDDDDDDDDD DDccutdim(4)2hys,mis,t�lEmaEEEEE-bs ut !oASstdim(åEQ 2, DD& issEN&sENDs,t�lEmaE DDccutdim(4)1 uå cllllllllll-bs DDDDDDDDDDDDDDDDDDD DDccutdim(4)2hys,mis,t�lEmaEEEEEEmaEut !Npx(1,1) & ilNpx(2,1))ccutdim(4)1 uå cllllllllll-ondp���s arrayållll-ondp���s arrayållll)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRC �-ibItw(lpiec_saerilbsgM multiplerleng---h Igrr hys,mis,t�lEmaE)BRspacT.Edl(1).Orayållll)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaErcD=R2**nbL�crs(cutdimphys,mis,t�lEmaEut !MINV uåNpx(cutdim,1:rc))c.L y2, DD& issEN&sENDs,t�lEmaEDDDDD'DATA',__LINE__,mustn � �! L sOTO 9999si--��� L�EcsIbad_m---�l(Ecsst C!!_cartesianCh------------------------'Too littleIgrr Gec-scs mGOTclis cls M h Ix,ps.Ch---------------------------ginys,max,phys,mis,t�lEmaEm aEx,t�lE�å uårcl-----condp�o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRRs M oF o ot !!-coircoo smaln � �! )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE----DATA',__aagyyya::--growhys,mis,t�lEmaEldu���(4) omusim------- cllllllIF(2*rc & ilduold, DD& issEN&sENDs,t�lEmaldu�db(4)2*rc���s arrayållll-bs DDDDDDDDDDDDDDDDDDldu�db(4)lduold���s arrayållll-ondp���s arrayållllmax,t_s #elifO(Npxnew,l-us w://wnumb�acttpe-s� llllIFoF'R ::---oc_5dl', DD& issEN&sENDDEmaE-'WORK',__LINE__,mustn � �! llllmax,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_cartesianCh------------------------'Newe-ls M h Igrr GunitsrNPXNEWCh---------------------------ginys,max,phys,mis,t�lEmaEm aEx,t�lE�å uårcl-----condp�o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRS,puividercls boxDin�si 88t M =cutdim( nlyo88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)B!Returns-Tou oL�cg�db(2),EduATED(a��US))))))ut ! omusim EQ 3, DD& issEN&sENDs,t�lEmaEDO k 1,lduold���s arrayållllllllllllNpxnew(1,k,(4)Npx(1,kphys,mis,t�lEmaEm aEllllNpxnew(2,k,(4)Npx(2,kphys,mis,t�lEmaEm aEllllNpxnew(3,k,(4)Npx(3,kphys,mis,t�lEmaEm aE-teå uårcl L�ll-bs DDDDDDDDDDDDDDDDDDDDO k 1,lduold���s arrayållllllllllllNpxnew(1,k,(4)Npx(1,kphys,mis,t�lEmaEm aEllllNpxnew(2,k,(4)Npx(2,kphys,mis,t�lEmaEm aE-teå uårcl L�ll-ondp�o88yyyyrcl DO i 1,rc���s arrayållllllll!Tcut in�si 88t M =cutdim���s arrayållllllllNpxnew(cutdim,2*i-��(4)))))))))))))))------------------------CEI-giG( uåNpx(cutdim,i),MK(*0.5_MK(DDDDCALL RållllllllNpxnew(cutdim,2*i,(4)Npx(cutdim,i)-Npxnew(cutdim,2*i-�� uårcl L�ll-onDOews - Gellllllll!SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRls M oF owese---ox,p c) THE��oSUBllllllll!SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaEmax,t_s #elifO(Npx,l-us w://wnumb�acttpe-s� IFoF'R ::---oc_5dl', DD& issEN&sENDDEmaE-'WORK',__LINE__,mustn � �! llllmax,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_cartesianCh------------------------'Nls M h Igrr GunitsrNPXCh---------------------------ginys,max,phys,mis,t�lEmaEm aEx,t�lE�å uårcl-----condp�o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRUpdateoweseUBRL TO cls osdrercls i Seat M o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaElduolds=Dldu�dbhys,mis,t�lEmaEnbL�crs(cutdimp(4)nbL�crs(cutdimp(+T1 uå cllllllNpxp=lNpxnew uå cll-teå �o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrcCC!!uolr�---st 88mo<hmcls M h Ix,psailshachEdi 88t M o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSDO i 1, omusim-------L RsEmaEnbL�crs(i)D=R2**nbL�crs(ibhys,mis,t�lEmaE!ailION --zlrx,rface-�---vol�! al-hmGOTO clshys,mis,t�lEmaE!ax,rface-to-vol�! ret w�is max.hys,mis,t�lEmaEx,rface(i)D=RHUGE(x,rface(i)bhys,mis,t�lEmaEvol�! (i) =T1 uå cll-teå o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrcS,puividerTou piec_sailsn-rem(equ---ree s mGOTclehec-s� -soSrcremainder.RC �-al-hmasa-o yieldsminiclsax,rface-to-vol�! hec-s� -soSrcret w�::-pet in wecls M h Igrr Gec-scs)o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSmax,n-rem( & il', DD& issEN&sENNNNNNN)e-ls M h Icuts ->mcls M h Ix,pusmainsinMpnRsL RsEmaEnsrem(4)n-rem+1 uå cllllll)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRDtet ii-88aggregateox,rface-to-vol�! ret ws mGOhys,mis,t�lEmaE)BRtestomscuttT.E inURllIthoutidb 88t M sinMpnRsL RsEmaE)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaEut !oASstdim(å--oc1EN&sENDDDDDDDDDDDDDDDDDDDx,rface(1D(4)0h Poi8mmmmmmmmmmmmmvol�! (1) (4)0h Poi8mmmmmmmmmmmmmDO icut=1,nbL�crs(1phys,mis,t�lEmaEm aEllllrcD=RNbs'(Npx(1,icut)/ uånsrem,MK()+1 uå cllllll,t�lEmaEut ! omusim & il2, DD& issEN&sENDs,t�lEmaEL RsEmaE)peotU,mgrr Gec-scs ilsy-�---zissEN&sENDs,t�lEmaEL RsEmaEty(4)nbL�crs(db(5)�oSUBRO�l( L�lll llmmmmmDO k =T1,nbL�crs(db(5)�oSUBRO�l( L�lll llmmmmmEmaEty(4)ty(+)Npx(2,kphys,mis,t�lEmaEm aEllllllll-teå uårcl L�ll llmmmmmEmaEtz(4)nbL�crs(3b(5)�oSUBRO�l( L�O�l llmmmmmDO k =T1,nbL�crs(3b(5)�oSUBRO�l( L�O�l llmmmmmEmaEtz(4)tz(+)Npx(3,kphys,mis,t�lEmaEm aEllllllll-teå uårcl L�ll llmmmmmEmaEx,rface(1D=x,rface(1D(+R2*ånsrem*tz*ty+ -------------------------g-----)nbL�crs(3b*rc*ty+nbL�crs(db*rc*tzphys,mis,t�lEmaEm aEllllllllvol�! (1) =vol�! (1) (+ (rc*ty*tzphys,mis,t�lEmaEm aEllll-bs DDDDDDDDDDDDDDDDDDD DDcccccty(4)nbL�crs(db(5)�oSUBRO�l( L�lll llmmmmmDO k =T1,nbL�crs(db(5)�oSUBRO�l( L�lll llmmmmmEmaEty(4)ty(+)Npx(2,kphys,mis,t�lEmaEm aEllllllll-teå uårcl L�ll llmmmmmEmaEx,rface(1D=x,rface(1D(+R2*ånbL�crs(db*rc+typhys,mis,t�lEmaEm aEllllllllvol�! (1) =vol�! (1) (+ (rc*typhys,mis,t�lEmaEm aEllll-ondp���s arrayållllllll-teå uårcl L�ll-ondp���s arrayållllut !oASstdim(å--oc2, DD& issEN&sENDs,t�lEmaEx,rface(2D(4)0h Poi8mmmmmmmmmmmmmvol�! (2) (4)0h Poi8mmmmmmmmmmmmmDO jcut=1,nbL�crs(db(5)�oSUBRO�l( L�lll llmrcD=RNbs'(Npx(2,jcut)/ uånsrem,MK()+1 uå cllllll,t�lEmaEut ! omusim & il2, DD& issEN&sENDs,t�lEmaEL RsEmaE)peotU,mgrr Gec-scs ilsx-�---zissEN&sENDs,t�lEmaEL RsEmaEtxp=lSUM!Npx(1,1:nbL�crs(1p()+nbL�crs(1phys,mis,t�lEmaEm aEllllEmaEtzp=lSUM!Npx(3,1:nbL�crs(3p()+nbL�crs(3b(5)�oSUBRO�l( L�O�l llmmmmmx,rface(2D=x,rface(2D(+R2*ånsrem*tx*tz+ -------------------------g-----)nbL�crs(1b*rc*tz+nbL�crs(3b*rc*txphys,mis,t�lEmaEm aEllllllllvol�! (2) =vol�! (2) (+ (rc*tz*txphys,mis,t�lEmaEm aEllll-bs DDDDDDDDDDDDDDDDDDD DDccccctxp=lSUM!Npx(1,1:nbL�crs(1p()+nbL�crs(1phys,mis,t�lEmaEm aEllllEmaEx,rface(2D=x,rface(2D(+R2*ånbL�crs(1b*rc*txphys,mis,t�lEmaEm aEllllllllvol�! (2) =vol�! (2) (+ (rc*txphys,mis,t�lEmaEm aEllll-ondp���s arrayållllllll-teå uårcl L�ll-ondp���s arrayållllut !!oASstdim(å--oc3) .AND. ! omusim & il2,, DD& issEN&sENDs,t�lEmaEx,rface(3D(4)0h Poi8mmmmmmmmmmmmmvol�! (3) (4)0h Poi8mmmmmmmmmmmmmDO kcut=1,nbL�crs(3b(5)�oSUBRO�l( L�O�l llmrcD=RNbs'(Npx(3,kcut)/ uånsrem,MK()+1 uå cllllll,t�lEmaE)peotU,mgrr Gec-scs ilsx-�---HE��oSUBlllllllllllllllltxp=lnbL�crs(1phys,mis,t�lEmaEm aEllllDO k =T1,nbL�crs(1phys,mis,t�lEmaEm aEllllEmaEtxp=ltx(+)Npx(1,kphys,mis,t�lEmaEm aEllll-teå uårcl L�ll llmmmmmty(4)nbL�crs(db(5)�oSUBRO�l( L�lll llmDO k =T1,nbL�crs(db(5)�oSUBRO�l( L�lll llmmmmmty(4)ty(+)Npx(2,kphys,mis,t�lEmaEm aEllll-teå uårcl L�ll llmmmmmx,rface(3D=x,rface(3D(+R2* ånsrem*ty*tx+ -------------------------g--nbL�crs(db*rc*tx+nbL�crs(1b*rc*typhys,mis,t�lEmaEm aEllllvol�! (3) =vol�! (3) (+ (rc*tx*typhys,mis,t�lEmaEm aE-teå uårcl L�ll-ondp���s arrayållll! NOTE:Ex,rface(i)D�---vol�! (i)D�rupebupeotU,mx,rface-NU Les orrayållll! RllIx,ps U------irpeotU,mvol�! ::-pcls M h Igrr Les orrayållll! ost S)oirchescuttT.E w-(PPMb88---88perpA(INculas M Les orrayållll! cls i----axis. ,o get ------ters,rface-�---vol�! h Ia Les orrayållll! s,t, uividerTY; w tcls M h Ix,ps. Herupebet iT not � �! )8---88becauld cls x,rface-to-vol�! ret w�is in��==�nt � �! )8M oF e forvi GNU G uå cllllll)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRFind-minimU,m--ters,rface-to-vol�! ret w uå cllllll)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaEminsvD=RHUGE(minsvphys,mis,t�lEmaEDO i 1, omusim-------L RsEmaEEEEEIFoF' EQ oASstdim) CYCL DDDDDDDDDDDDDDDDDDDlcD=R uåx,rface(i),MK(/ uåvol�! (i),MK(DDDDCALL RållllllllIFoFlcD.LT.Eminsv, DD& issEN&sENDs,t�lEmaEL RsminsvDs=Dlc���s arrayållllllllllllcutdim(4)ihys,mis,t�lEmaEm aE-tedp���s arrayållll-onDOews - Gellllllll!SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRC �-ibInsrem(piec_saerilbsgM multiplerleng---h Igrr hys,mis,t�lEmaE)BRspacT.Edl(1).Orayållll)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaEut !MINV uåNpx(cutdim,1:nbL�crs(cutdimp))c.L ynsrem, DD& issEN&sENDs,t�lEmaEDDDDD'DATA',__LINE__,mustn � �! L sOTO 9999si--��� L�EcsIbad_m---�l(Ecsst C!!_cartesianCh------------------------'Too littleIgrr Gec-scs mGOTclis cls M h Ix,ps.Ch---------------------------ginys,max,phys,mis,t�lEmaEm aEx,t�lE�å uårcl-----condp� uårcl-----rcD=Rnsrem*nbL�crs(cutdimphys,mis,t�lEmaEws - Gellllllll!SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE)BRGrowowese---ogrr Gec-sc c) TH in �eede hys,mis,t�lEmaE)SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,lhys,mis,t�lEmaE----DATA',__aagyyya::--growhys,mis,t�lEmaEldu���(4) omusim------- cllllllIF(rc & ilduold, DD& issEN&sENDs,t�lEmaldu�db(4)rc���s arrayållll-bs DDDDDDDDDDDDDDDDDDldu�db(4)lduold���s arrayållll-ondp����s arrayållllmax,t_s #elifO(Npxnew,l-us w://wnumb�acttpe-s� llllIFoF'R ::---oc_5dl', DD& issEN&sENDDEmaE-'WORK',__LINE__,mustn � �! llllmax,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_cartesianCh------------------------'Newe-ls M h Igrr Gec-scs NPXNEWCh---------------------------ginys,max,phys,mis,t�lEmaEm aEx,t�lE�å uårcl-----condp� uårcl-----lcD=R1.0_MK/ uånsrem,MK(hys,mis,t�lEmaE)B!Returns-Tou oL�cg�db(2),EduATED(a��US))))))Npxnew(1: omusim,1:lduold, =SNpx(1: omusim,1:lduold,hys,mis,t�lEmaEDO i 1,nbL�crs(cutdimphys,mis,t�lEmaEEmaE)B-ls M h IceilT.E-s-zlrx,bATED(a��US))))))))))nup =SMOD(Npx(cutdim,i),nsrem,hys,mis,t�lEmaEEmaE)B-ls M h Ifloor-s-zlrx,bATED(a��US))))))))))ndnD=Rnsrem-nuphys,mis,t�lEmaEEmaE)Bebupewo s-zlsDD& issEN&sENDDEmaE-up =SCEI-giG( uåNpx(cutdim,i),MK(*lc�l( L� L�lddddddd ddidnD=RFLOOR( uåNpx(cutdim,i),MK(*lc�l( L� L�lddddddd dd!Tcut ceilT.E-s-zlrx,bATED(a��US))))))))))DO S(1,nuphys,mis,t�lEmaEEmaEEEEENpxnew(cutdim,nsrem*åi-1)+j, =Siuphys,mis,t�lEmaEEmaE-teå uårcl L�ll llm!Tcut floor-s-zlrx,bATED(a��US))))))))))DO S((nup+1),(nup+ndnphys,mis,t�lEmaEm aEllllNpxnew(cutdim,nsrem*åi-1)+j, =Sid o88yyyyrcl EmaE-teå uårcl L�ll llm!TcoF o-irchesst C!!osedIgrr Goellsrx,m up oo clshys,mis,t�lEmaE llm!TcC!!let88mGOmM x,pusmainDDDDCALL RållllllllIFoF(nup*iup+ndn*id ):---ocNpx(cutdim,i), DD& issEN&sENDs,t�lEmaEL RsDDDDD'DATA',__LINE__,mustn � �! L max,t_s #si--��� L�EcsIm---_missh -------------------------g--l(Ecsst C!!_cartesianCh ------------------------------g--lDt C!!osedIusmainsado � � s,m up oo wholeCh -------------------------g-----ginys,max,phys,mis,t�lEmaEm aEEEEEx,t�lE�å uårcl----------tedp���s arrayållll-onDOe��s arrayållllmax,t_s #elifO(Npx,l-us w://wnumb�acttpe-s� IFoF'R ::---oc_5dl', DD& issEN&sENDDEmaE-'WORK',__LINE__,mustn � �! llllmax,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_cartesianCh------------------------'Nls M h Igrr Gec-scs NPXCh---------------------------ginys,max,phys,mis,t�lEmaEm aEx,t�lE�å uårcl-----condp� uårcl-----Npxp=lNpxnew uå cllllllnbL�crs(cutdimp(4)nsrem*nbL�crs(cutdimphys,mis,t�lcondp�o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrcDs M oF o ote!!omis,pst 8ageo88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soS----DATA',__aagyyR c L�cg�TINE-----max,t_s #elifO(Npxnew,l-us w://wnumb�acttpe-s� oF'R ::---oc_5dl', DD& issEN&sENDDD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIR c L�c�l(Ecsst C!!_cartesianCh--------------------'Newe-ls M h Igrr Gec-scs NPXNEWCh-----------------------ginys,max,phys,mis,t�lcondp�o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrcDset ii-88a---st 88mo<hmx,pusmain bmplieries-ibI hys----hec-s� -soSrc Cordin ols. EachE!,pusmain n-ou measugs cnrilbsgM hec-s� -soSrcmultiplerercls grr GspacT.EailshachEdi 88t M .o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrTw tsams valu,tis nly cC!!uold-Loce-�---assignd---o boL�hec-s� -soSrii-(i+1) �---max(i)Dils-ri!trio-TouowoE. Sefloathec-s� -soSrcC!!erisduA.�acttpe-s� oF omusim EQ 3, DD& issEN&sENDs,t�ln---o(4)0h Poi8mmmmmmmmmuzD=Rmin_phys.3)DD& issEN&sENDDDzD=R1issEN&sENDD! �å aildexDilsglobU,mm---DD& issEN&ssssstzp=l0issEN&sENDD! grr -ec-sc ildexDilszEdi 88t M o88yyyyrcl DO kcut=1,nbL�crs(3b(5)�oSUBRO�l( L�O�ltz(4)tz(+)Npx(3,k-u�DDDDDCALL R lz(4)uzDsENDD! lowM x,b boplieryDDDDCALL R uzD=Rmin_phys.3)(+)tz*dx(3) (! uppM x,b boplieryDDDDCALL R uy =Rmin_phys.2)( aE)Bebupsams ilsy-...hys,mis,t�lEmaEENDDDy(4)1 uå cllllllllllty(4)0h Poi8mmmmmmmmmmmmmDO jcut=1,nbL�crs(db(5)�oSUBRO�l( L�lll llmty(4)ty(+)Npx(2,j-u�DDDDDCALL R ly(4)uHE��oSUBlllllllllllllllluy =Rmin_phys.2)(+)ty*dx(db(5)�oSUBRO�l( L�lll llmux =Rmin_phys.1)( ��-�---ilsx-...hys,mis,t�lEmaEENDDDDDDix(4)1 uå cllllllllll llmtx(4)0h Poi8mmmmmmmmmmmmmmmmmDO icut=1,nbL�crs(1phys,mis,t�lEmaEm aEllll llmtx(4)tx(+)Npx(1,i-u�DDDDDCALL R lx(4)uxDDDDCALL R ux =Rmin_phys.1)(+)tx*dx(1phys,mis,t�lEmaEm aEllll llmn---o(4)n---o(+T1 uå cllllllllll lllllll!cS,p bmplierieso weGOTTTTTTTTTTTTTTTTTTTTTmin_s,t(1,n---o)D=RlxDDDDCALL R max_s,t(1,n---o)D=RuxDDDDCALL R min_s,t(2,n---o)D=Rlyo88yyyyrcl max_s,t(2,n---o)D=RuHE��oSUBllllllllllllllll min_s,t(3,n---o)D=RlzissEN&sENDs,t�lEmaEL RsEmaEmax_s,t(3,n---o)D=RuzissEN&sENDs,t�lEmaEL RsEmaEix(4)ix(+)Npx(1,i-u�DDDDDCALL R -teå uårcl L�ll llmmmmmDy(4)iy(+)Npx(2,j-u�DDDDDCALL R -teå uårcl L�ll llmDzD=Riz(+)Npx(3,k-u�DDDDDCALL R -teå uårcl -bs DDDDDDDDDDDDDDDn---o(4)0h Poi8mmmmmmmmmuy =Rmin_phys.2)DD& issEN&sENDDDy(4)1 uå cllllllty(4)0h Poi8mmmmmmmmmDO jcut=1,nbL�crs(db(5)�oSUBRO�l( L�lllty(4)ty(+)Npx(2,j-u�DDDDDCALL R ly(4)uHE��oSUBlllllllllllluy =Rmin_phys.2)(+)ty*dx(db(5)�oSUBRO�l( L�lllux =Rmin_phys.1) uårcl L�ll llmDx(4)1 uå clllllllllltx(4)0h Poi8mmmmmmmmmmmmmDO icut=1,nbL�crs(1phys,mis,t�lEmaEm aElllltx(4)tx(+)Npx(1,i-u�DDDDDCALL R lx(4)uxDDDDCALL R ux =Rmin_phys.1)(+)tx*dx(1phys,mis,t�lEmaEm aElllln---o(4)n---o(+T1 uå cllllllllll lll!cS,p bmplierieso weGOTTTTTTTTTTTTTTTTTmin_s,t(1,n---o)D=RlxDDDDCALL R max_s,t(1,n---o)D=RuxDDDDCALL R min_s,t(2,n---o)D=Rlyo88yyyyrcl max_s,t(2,n---o)D=RuHE��oSUBllllllllllllllllix(4)ix(+)Npx(1,i-u�DDDDDCALL R -teå uårcl L�ll llmDy(4)iy(+)Npx(2,j-u�DDDDDCALL R -teå uårcl -ondp�o88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soSrcSomtidbagnosticso88yyyyrcl )SUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu Chec-s� -soS oF omusti.N & il', DD& issEN&sENNNNNNNWRITE(mesg,'(A,I5)') 'cls M h Ix,psa-reated: ',n-,bATED(a��US))))))sOTO 9999wriATF omurank�l(Ecsst C!!_cartesianChmesg,max,phys,mis,t�l----Rrec-s� -soS oF omusti.N & il1EN&sENDDDDDDDDDDDDDDD oF omusim LT.E3, DD& issEN&sENDs,t�lEmaEDO i 1,nx,bATED(a��US))))))))))NNNNWRITE(mesg,'(I4,A,2F12.6)') i,' min: ',min_s,t(1:2,ibhys,mis,t�lEmaEUS))))))sOTO 9999wriATF omurank�l(Ecsst C!!_cartesianCh -------------------------g--mesg,max,phys,mis,t�lEmaE))))NNNNWRITE(mesg,'(I4,A,2F12.6)') i,' max: ',max_s,t(1:2,ibhys,mis,t�lEmaEUS))))))sOTO 9999wriATF omurank�l(Ecsst C!!_cartesianCh -------------------------g--mesg,max,phys,mis,t�lEmaE))))NNNNsOTO 9999wriATF omurank�l(Ecsst C!!_cartesianCh -------------------------g--'R ::---oc_5dl',iHOU,ldl,5,must,ldu C',max,phys,mis,t�lEmaE))))-teå uårcl L�ll-bs DDDDDDDDDDDDDDDDDDDDO i 1,nx,bATED(a��US))))))))))NNNNWRITE(mesg,'(I4,A,3F12.6)') i,' min: ',min_s,t(1:3,ibhys,mis,t�lEmaEUS))))))sOTO 9999wriATF omurank�l(Ecsst C!!_cartesianCh -------------------------g--mesg,max,phys,mis,t�lEmaE))))NNNNWRITE(mesg,'(I4,A,3F12.6)') i,' max: ',max_s,t(1:3,ibhys,mis,t�lEmaEUS))))))sOTO 9999wriATF omurank�l(Ecsst C!!_cartesianCh -------------------------g--mesg,max,phys,mis,t�lEmaE))))NNNNsOTO 9999wriATF omurank�l(Ecsst C!!_cartesianCh ---------------------'R ::---oc_5dl',iHOU,ldl,5,must,ldu C5,must,ldu C',max,phys,mis,t�lEmaE))))-teå uårcl L�ll----Rrec-s� -soS----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRuldr-providetast C!!osis M o88yyyyO in om--------------------------------------------------------gin � �! Chec-soS-bs ut !st C!!�åEQ A',__aagyyR C!!_uldrustfinedddl', DD& issEN&s!ado � � domanythT.E ds; w tuldr has a THEdy providetamin_s,t,hec-s� -soSriax_s,t. Tr)) o w tuldr GOTO Tou c) THs=c)s moperlyo88yyyyrcl ! RlloF o d.o88yyyyrcl )o88yyyyrcl ! MAYBE CHECK HERED ol',-EmaRs #eSR uLY MATCH UP-copyol',-GRIDo88yyyyrcl ! SPACINGhec-soS----Rro88yyyyO in om--------------------------------------------------------gin � �hec-soSUBRDs M oF o ot !!-co88yyyyO in om--------------------------------------------------------gin � �hec-soS----DATA',__aagyyR c L�cg�TINE-max,t_s #elifO(Npx,l-us w://wnumb�acttpe oF'R ::---oc_5dl', DD& issEN&sD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIR c L�c�l(Ecsst C!!_cartesianCh----------------'Nls M h Igrr Gec-scs pM x,b NPXCh---ginys,max,phys,mis----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBR�oSUrnå--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�lE�å oSUBROicstSUBReGmax,t�lE�åop uårst C!!_cartesianCheck-nMgu SUBReGRETUR DD& issSUBRAINSDD& iss----------------i--------DO i 1, omusim-------L Rsut !Nm(i) LT.E2, DD& issEN&sENDs,tD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_cartesianCh ------------------------'Nmt2)) obe >1 inURllIspace db(2),EduA-----ginys,max,phys,mis,t�lEmx,t�l8888hys,mis,t�l----Rrec-s� -soS oFmax_phys(i) .L ymin_phys.ip, DD& issEN&sENDs,tD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_cartesianCh ------------------------'max_physt2)) obe >ymin_phys-----ginys,max,phys,mis,t�lEmx,t�l8888hys,mis,t�l----Rrec-s� -s-teå uårcIFoF(st C!!�å A',__aagyyR C!!_xpencil) .AND. --------------(st C!!�å A',__aagyyR C!!_ypencil) .AND. --------------(st C!!�å A',__aagyyR C!!_zpencil) .AND. --------------(st C!!�å A',__aagyyR C!!_cuboid) .AND. --------------(st C!!�å A',__aagyyR C!!_uldrustfinedd5dl', DD& issEN&sD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_cartesianCh ------------------'Invalid�st C!!osis M type specGOied-----ginys,max,phys,mis,t�lEmx,t�l8888hys,mis,t----Rrec-s� -sIFoF(st C!!�åEQ A',__aagyyR C!!_zpencil) .AND. --------------( omusim LT.E3,, DD& issEN&sENDs,tD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_cartesianCh ------------------'zpencil-dt C!!osis M =is nly Aossibne mGOT3D mobnems-- ---------------------ginys,max,phys,mis,t�lEmx,t�l8888hys,mis,t----Rrec-s� -sIFoF(st C!!�åEQ A',__aagyyR C!!_uldrustfineddd.AND. --------------(n---o(.L y0,, DD& issEN&sENDs,tD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_cartesianCh --------'TO least;--88s,pusm.t2)) obe specGOied mGOTuldr-stfined st C!!osis M Ch-----------------------ginys,max,phys,mis,t�lEmx,t�l8888hys,mis,t----Rrec-s� -sIFoFal-Syyyandom)ddl', DD& issEN&soSmax,ndom LT.E(Ecsn mo , DD& issEN&sENDs,t�lEmDDDDD'DATA',__LINE__,mustn � �! L max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_cartesianCh ----------------------'cls M h Ix,psa2)) obe >= n mo -----ginys,max,phys,mis,t�lEmaEEmx,t�l8888hys,mis,t�l�l----Rrec-s� -s-te-Rre8888 oSUBROicstSUBReG-tes----------------icANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-tes-----------st C!!_cart_socANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-tes-----------st C!!_cart_docA(INd- �������������������������������������������������������lib(Ec-1.2.1/src/st C!!/(Ecsst C!!_tout.f�����������������������������������������������������������0000644�0001752�0001753�00000065607�11616003525�020543� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nMpnRsO in om--------------------------------------------------------gin � �! Chec-soSUBRSub�lEmax,t :ys,mis,t�lEmaEEm (Ecsst C!!_touto88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBCopyright ( , 2010 CSE Lab (EpyoZurich), MOSAICRGroup (EpyoZurich), hec-soSUBRRRRRRRRRRRRRRRRRRRCen SefGOTFluid�Dynamics (DTUphys,mis!hys,mis!hys,mis! ,het fil,tis ree SoftweseP-bs',---P_(-ocl,tM----Libmis,p(PPM).hys,mis!hys,mis! PPMtis foutisoftware: you=eterredistribuolrit-�--/GOTOoINdco88yyyyOrit-uni!tribupet in weibupGNU Lesldr Genebs' Public-Lic2),(å--- TEGE cs ublished TY; w tFoutiSoftware Fmpliet M ,yeiL�cg�--- TEGE ver,Edu 3 weibupLic2),(, GOT(TO you hpt M ) �-yoE. Se--- TEGE ver,Edu.hys,mis!hys,mis! PPMtis distribuol--ilsibuphop88tOTO itan-ou shouldful,inMpnRs)lt �-copy--- ANY WARRANTY;an---lEm evelsibupimplied wc) Tnty-NU Les or! MERCHANTABILITY GOTFITNESS FOR AdPPMTICULAR PURPOS ySeerclso weGOTOpGNU Genebs' Public-Lic2),(åmGOTO 88mdetails.hys,mis!hys,mis! You=sh-(PPMhaveEreceived a copy weibupGNU Genebs' Public-Lic2),(--- TEGE c------pGNU Lesldr Genebs' Public-Lic2),(åa----an----PPM. in � �,inMpnRs)lseer<http://www.gnu.org/lic2),(s/>.hys,mis!hys,mis! P-bs',---P_(-ocl,tM----Libmis,p(PPM)hys,mis! EpyoZurichhec-soSUBCH-8092oZurich, Sn--zerlc--o88yyyyO in om--------------------------------------------------------gin � �! ChicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-----------st C!!_tout_s(xp,Nree ,min_phys,max_phys- -----------minboxs-zl,tolebsnce,min_s,t,max_s,t,nx,bA,max,,pcost)ocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-----------st C!!_tout_d(xp,Nree ,min_phys,max_phys- -----------minboxs-zl,tolebsnce,min_s,t,max_s,t,nx,bA,max,,pcost)ocA(INd--- TEGE!! PermGOms a tout-like st C!!osis M .--- TEGE!! It !,puividesIspace until- w tcls M h Ileaves-ibIclso weGOTOda tout exceTHs8F ol-ls M h I mo ors *c--* until- w o weGOTOda ��==�ncerercls -ls M h I _(-ocl,s-ibIclsIleaves-io--- TEGEda beuowoa certain tolebsnce.ro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRModust_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åUSE (Ecsmodust_UBRL�l(lE�åUSE (Ecsmodust_�lE�å �l(lE�åUSE (Ecsmodust_�lE�åop�l(lE�åUSE (Ecsmodust_E__,mustn � USE (Ecsmodust_c L�cg�TINE-USE (Ecsmodust_wriAT�acttpe MPLICIT NONEicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRsROLOGICldPPMAME TE-eyMKD'DATA'kind_singleocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsROLOGICldPPMAME TE-eyMKD'DATA'kind_doubleocA(INd--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E-b ludesGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu ChcANstf<htMPIinMpnRsROCLUDE 'mpif.h'ocA(INd--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å EA--debug.(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK(second ininin,oxpDaagyyya::E�å r-eyx!--- TEGEda Posis M =ercls _(-ocl,sinMpnRsROLOGIC pDaagyyya::E�å r-eyNree --- TEGEda Nls M h I _(-ocl,s�l(lE�å uåMK(second ininin) pDaagyyya::E�å r-eymin_phys--- TEGEda Minimumc Cordin ol=ercls hys----/cC!!uoet M s' usmaindl(1).O uåMK(second ininin) pDaagyyya::E�å r-eymax_phys--- TEGEda Maximumc Cordin ol=ercls hys----/cC!!uoet M s' usmaindl(1).O uåMK(second ininin) pDOPTninALpDaagyyya:: r-eypcost--- TEGEda A--debug h Ileng---Nree , specGOyT.E w o weGOTOda cC!!uoet M s' cost h IhachE _(-ocl,.dl(1).O uåMK( pDaagyyya::E�å r-eyminboxs-zl--- TEGEda MinimumcboxDs-zl--- TEG uåMK( pDaagyyya::E�å r-eytolebsnce--- TEGEda MaximumcreE. ive ��==�ncerercls boxDcost Touowed TemGOso weGOTOda tt ii-atT.E w tout;ytolebsnce >= 0�l(lE�å uåMK(second ininin,oxpDost TEEEEEEE-eymin_�lE--- TEGEda Minimumcextostrero<hmx,pusmain�l(lE�å uåMK(second ininin,oxpDost TEEEEEEE-eymax_s,t--- TEGEda Maximumcextostrero<hmx,pusmain�l(lE�åROLOGIC pDaagyyya --- r-eynx,bATED(a��Eda TotU,mcls M h Ix,pusmainsinMpnRsROLOGIC pDaagyyya --- r-eymax,TED(a��Eda �oSUrnå�å tus- 0-Locsuc --- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å ELo--- ��==�bst_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK(second inini omusim,p L�clen_phys�l(lE�å uåMK(second inini2) L�cvector_in,vector_out � �! uåMK( L�c--te_npbx,��=_npbx � �! uåMK( L�ct0�l(lE�å uåMK(second ininin,oxpDost TE-eymin_boxD=>DCALL()inMpnRs uåMK(second ininin,oxpDost TE-eymax_boxD=>DCALL()inMpnRs uåMK(second ininin,oxpDost TE-eyworkpnRs=>DCALL()inMpnRsROLOGIC second ininin)pDost TEEE-eynpbxpnRs=>DCALL()inMpnRsROLOGIC second ininin)pDost TEEE-eynpbxgnRs=>DCALL()inMpnRsROLOGIC second ininin)pDost TEEE-eyppb pnRs=>DCALL()inMpnRsROLOGIC second inini omusim,pL�cldc,lddinMpnRsROLOGIC -eymbox,fbox,jbox,kbox,lbox,nbox,ilevel,nlevel,is-zl--- TEGROLOGIC -eym,j,ks w://wree ,im,jj,mem_req--- TEGROLOGIC -eym�å t,n1,n2,Nree Edl(1).OLOGICALpL�clcontinul--- TEGCHPMAC Ti omuchar r-eymesEdl(1).ORO�l(a��US-=>Owork BRO�l(EcsIF issEND---------------------------------ginys,max, EExtor s'_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E-bION --,(å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åmax,t�lE�åee uårst C!!_toutCheck-nMgu --- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å EcoF o-inp �-T--debug.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å oF omusti.N & il', DD& issEN&sENmax,t-----i-------- oF'R ::---oc_5dx,t�lE�å uå-te-R ews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF ot !!-comGOTa copy weibup _(-ocl,s-(n omcopy is ceede Ds-nce uårcibup _(-ocl,s-n-ou shorec) Tngl--ilsibup mo h IcreatT.E w tout)ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----D DATA',__aagyyya::---oc_grow_pldc���(4) omusim-------ldc�2, =SNpee --- TEGmax,t_s #elifO(work,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Iworkpc) TH failed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcMakeTa copy weibup _(-ocl,s-(s-nce ibuy-n-ou shorec) Tngl--ilsibu uårc mo h IcreatT.E w tout)ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå oF omusimåEQ 2, DD& issEN&sENDDO i _(-=1,Npee --- TEGGGGGGGwork(1,ipee , =Sxp(1,ipee ,--- TEGGGGGGGwork(2,ipee , =Sxp(2,ipee ,--- TEGGGG-teå uå-bs DDDDDDDDDDDO i _(-=1,Npee --- TEGGGGGGGwork(1,ipee , =Sxp(1,ipee ,--- TEGGGGGGGwork(2,ipee , =Sxp(2,ipee ,--- TEGGGGGGGwork(3,ipee , =Sxp(3,ipee ,--- TEGGGG-teå uå-te-R ewcANstf<htMPIinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcCountpebupeotU,m-ls M h I _(-ocl,s--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åmax,tMPI_ls Reduce(Nree ,Nree E,1,MPI_ROLOGIClMPI_SUM, omu C!m,max,ph#el,(--- TEGNree E =SNpee -cA(INd ews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcls M oF osomtit !!-comGOT w toutws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----D DATA',__aagyyya::--growhys,misldc���(4) omusim-------ldc�2, =S2000 �l(lE�åmax,t_s #elifO(min_box,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Imin_boxDfailed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Gemax,t_s #elifO(max_box,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Imax_boxDfailed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Gemax,t_s #elifO(min_s,t,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Imin_s,tDfailed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Gemax,t_s #elifO(max_s,t,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Imax_s,tDfailed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Geldc���(4)ldc�2,ws - Gemax,t_s #elifO(ppb p,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Ippb failed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Gemax,t_s #elifO(npbxp,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Inpbxpfailed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ew< issEND---------------------------------ginys,max, UBRRRRRRmax,t_s #elifO(cost ,ldc, w://wnumb�UBRRRRRR oF'R :---o_5dl', DUBRRRRRRRRR-'WORK',__LINE__,mustn UBRRRRRRRRRmax,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh --UBRRRRR------------------g'F BRO h Icost failed!-----ginys,max,phUBRRRRRRRRRx,t�lE�å UBRRRRRR-te-R e< issEND---------------------------------ginys,max, ws - Gemax,t_s #elifO(npbxg,ldc, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'F BRO h Inpbxg failed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc-bION --,(å w fir) oboxws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåfbox =T1 uåDO k 1, omusim-------L Rmin_box(k,fbox) =Rmin_phys.kphys,mis,t�max_box(k,fbox) =Rmax_phys(kphys,mis,t�len_phys(kpis,t�=Rmax_phys(kp -Rmin_phys.kphys,mis-teå uåppb(fbox) =T1 uånpbx(fbox) =SNpee --- TEGnpbxg(fbox) =RNpee -inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcCo!!uolr-----aximumccls M h Ileve'_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�ånlevel =Rbs'(LOG!MINV uålen_phys)/minboxs-zl)/LOG!2.0_MK)p(+T1 inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcSplitrcls boxes, �å T.E dtIleve' 0-(n omfuou soxphys,misrckbox denotesrcls boxDbeT.E uividedhys,misrcnboxDisrchescurrostreotU,m-ls M h Iboxeshys,misrcfboxDisrchesidrercls fir) obox-Locchescurrostrleve'hys,misrclboxDisrchesidrercls last;obox-Locchescurrostrleve'hys,mis issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåilevels,t�=R0�l(lE�ålcontinul�=R.TRUE.dl(1).OlboxDis,t�=Rfboxws - GenboxDis,t�=Rlboxws - Genx,psas,t�=R0�l(lE�åDO WHILEoFlcontinulphys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcSplitrcls boxes TO clisrleve'hys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�DO kbox=fbox,lbox--- TEGGGGGGG issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGrcSplitrnon-empty boxes into four/eight (nboxDisrincreebuged,hys,mis,t�lEm issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGmax,npbxg(kbox) & i_5dl', DD& issEN&sENDDEmax,t_s #st C!!_boxsplit(work,ppb,npbx,kbox,nbox, -------------------------g-----)))))))))))min_box,max_box,max,phys,mis,t�lEmaEE oF'R :---o_5dx,t�l100h Poi8mmmmmmm-bs DDDDDDDDDDDDDDDD issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDD -irempty saveEit-�s a !,pusmain ierincreebugro<hmx,pIcoun SeDDDDDDDDDDDDDDDD -c---coF o-mGOTO !!-coDDDDDDDDDDDDDDDD issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDn---o(4)n---o(+T1 uå clllllllmax,n-,ps.& iSIZE(min_s,t,2,, DD& issEN&sENDs,t�lEmaEldc���(4) omusim-------ENDs,t�lEmaEldc�2, =S2*nx,bATED(a��US))))))))))----D DATA',__aagyyya::--grow_!ReturnsTED(a��US))))))))))max,t_s #elifO(min_s,t,ldc, w://wnumb�acttpe uå clllllllmax,'R :---o_5dx,t�l200h Poi8mmmmmmmmmmmmmmax,t_s #elifO(max_s,t,ldc, w://wnumb�acttpe uå clllllllmax,'R :---o_5dx,t�l200h Poi8mmmmmmmmmmmmmldc���(4)ldc�2,ws - GeeeeeeUBRRRRRRmax,t_s #elifO(cost,ldc, w://wnumb�acttpe uå cUBRRRRRR oF'R :---o_5dx,t�l200h Poi8mmmmmmmmmm-te-R ews - Gettpe uå cU issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDD -saveEo<hmx,pusmain�l(lE�åttpe uå cU issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDDO k 1, omusim-------L RRRRRRRRRRmin_s,t(k,n---o)D=Rmin_box(k,ksoxphys,misL RRRRRRRRRRmax_s,t(k,n---o)D=Rmax_box(k,ksoxphys,misL RRRRRRR-teå uårcl LUBRRRcost(n---o)D=R0h Poi8mmmmmmm-te-R eL RRRRRRR-teå hys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCatch si--�s-ibI s #st C!!_boxsplithys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mi100oSUBROicstcANstf<htMPIinMpnRs �å oF omusti.N & i_5dl', DD& issEN&sEN issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGrcMPI ls ReduceDisrexpensive so we nly d oF e fibIsti.NgT.E mode )o88yyyyrcl EN issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGmax,tMPI_ls Reduce(max,,i,1,MPI_ROLOGIClMPI_SUM, omu C!m,max,ph-- TEGGGGGGG-'WORK'ieL RRRRRRR-teIFocA(INd--- TEG RR oF'R :---o_5dx,t�lE�å hys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCatch si--�s-ibI s #c L�cg�TINE---- issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mi200oSUBROicstcANstf<htMPIinMpnRs �å oF omusti.N & i_5dl', DD& issEN&sEN issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGrcMPI ls ReduceDisrexpensive so we nly d oF e fibIsti.NgT.E mode )o88yyyyrcl EN issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGmax,tMPI_ls Reduce(max,,i,1,MPI_ROLOGIClMPI_SUM, omu C!m,max,ph-- TEGGGGGGG-'WORK'ieL RRRRRRR-teIFocA(INd--- TEG RR issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcWriATmdetailed si--�ymessageomGOT w M oF o M o88yyyyrcl issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t� oF'R :---o_5dl', DD& issEN& N&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g---'rs M oF oT.E w tout failed ���!-----ginys,max,phys,mis,t� aEx,t�lE�å uårcl-te-R ews - Gettp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcUpdaolr----levelscoun Se-c---boxes ie oASsii!trnowowese---oboxeshys,misttp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�ilevel =Rilevel +T1 uå clfbox �=Rlbox +T1 uå cllbox �=RnboxtcANstf<htMPIinMpnRs �å issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCC!municaolr-----ls M h I _(-ocl,s-fmpli-ilsibupboxes ercls -ew uå cl! boxes TO cls -extIleve' (F e fn-ou shoexpensive mGOTn mo >> 1phys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�max,tMPI_ls Reduce(npbx(fbox),npbxg(fbox),lbox-fbox+1,MPI_ROLOGICl -------------------------g----MPI_SUM, omu C!m,max,ph#el,(--- TEG �å issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCCpY; w tglobU,mnpbxpfromr----lo--- (ebupsams ilsturial,lt �-M Les orrayrckeepr----Rettrero<hmcode ebupsams mGOTboL�I _(s',--/turial-...phys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�DO kbox=fbox,lbox--- TEGGGGGGGnpbxg(kbox)�=Rnpbx(ksoxphys,misL R-teå cA(INd- -- TEG �å issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCoF o-irco continul�oo cls -extIleve' hys,mis,t�rc(A)oirwhorecched cls finettrleve' whoexithys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,miiiii oF'leve'åEQ nlevel)ålcontinul�=R.FALSE.- -- TEG �å issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCoF o-irco continul�oo cls -extIleve' ...hys,mis,t�rc(B)oirches��==�ncerercls --ter-ls M h I _(-ocl,s-ibIclsIboxes is uå cl! beuowoebupeolebsnce whoexithys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,miiiii oFnbox & i(Ecsn mo , DD& issEN&sENDs,t issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGrcCo!!uolr------ter�---v�==�ncerercls _(-ocl,-ibIclsIboxes at--- TEGGGGGGGrccls -extIleve'issEN&sENDs,t issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGG ��=_npbxD=R0.0_MKoDDDDDDDDDDDDD--te_npbxD=R0.0_MKoDDDDDDDDDDDDDIFoFal-Syyyapcost), DD& oDDDDDDDDDDDDDDDD issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDrc-rcls cost is rRetuugroakeTF e fibio-Tccoun �l(lE�åttpe uå cU issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDDO kbox=fbox,lbox--- TEGGGGGGGDDDDDDDO k=ppb(ksoxp,ppb(ksoxp+npbx(ksoxp-1 uå cllllllllll ll--te_npbxD=R--te_npbxD+ cost(kpis,t uå cllllllllll ll ��=_npbxD=R ��=_npbxD+ cost(kp**2t uå cllllllllll-teå uårcl L�ll -teå hcANstf<htMPIinMpnRs �åe uå cU issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDrc-bI _(s',-- whoceed io-Tccumulaolr----contrips. fromrRllI mo ATED(a��US)))))))U issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDvector_in���(4)--te_npbxDDDDDDDDDDDDDDDDvector_in�2, =S ��=_npbxicANTcg�s - Ge<http1Dt,Gal-Te----inMpnRssssssssssmax,tMPI_ls Reduce(vector_in,vector_out,2,MPI_ u, -------------------------g-----)))))MPI_SUM, omu C!m,max,ph#el,(--- TEG �åssssssmax,tMPI_ls Reduce(vector_in,vector_out,2,MPI_tp1Dt,Gal-------, -------------------------g-----)))))MPI_SUM, omu C!m,max,ph#e(INd--- TEG RRRRRRRR--te_npbxD=Rvector_out���( uå cllllllll��=_npbxD=Rvector_out�2, h#e(INd--- TEG RRRRR-bs DDDDDDDDDDDDDDDD issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDD --rcls cost is � � rRetuugrco!!uolr----cost TsEo<hmx,mrerclsDDDDDDDDDDDDDDDD -(globU,)r-ls M h I _(-ocl,s-ibIclsIboxes�l(lE�åttpe uå cU issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDDO kbox=fbox,lbox--- TEGGGGGGGDDDDDD--te_npbxD=R--te_npbxD+ uånpbxg(kbox),MK(DDDDCALL Rållllllll ��=_npbxD=R ��=_npbxD+ uånpbxg(kbox),MK(**2hys,misL RRRRRRR-teå uårcl L-condp� uårcl--- issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGrcCo!!uolr------ter�---ches��==�nce� uårcl--- issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGG--te_npbxD=R--te_npbx/ uålbox -lfbox +T1,MK(DDDDCALL Rålll��=_npbxD=Rv�=_npbx/ uålbox -lfbox +T1,MK( -Rm-te_npbx**2h� uårcl--- issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGrcIrches��==�nceris Tccept�bst ierl thanoebupeolebsnce timt_å--- TEGGGGGGGrccls --ter-ls M h I _(-ocl,s,cclsnå�åop � uårcl--- issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGIFoFv�=_npbx LT.eolebsnce*m-te_npbx, DD& issEN&sENDs,t�lElcontinul�=R.FALSE.- uårcl L-condp eL RRRRRRR-te-R ews - Gettp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCo!!uolr----required amountph Im !!-coTO cls -extIleve'ws - Gettp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�mem_req�=Rnbox +T(lbox +T1 -lfbox)*(2** omusim,- -- TEG �å issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCoF o-irwhohaveEenoughot !!-co88yyyy �å issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�IFoFlcontinul.AND.SIZE(npbx, LT.mem_req, DD& oDDDDDDDDDDDDD----D DATA',__aagyyya::---oc_!ReturnsTED(a��US))))ldc���(4) omusim-------ENDs,tldc�2, =Smem_req--- TEGGGGGGGmax,t_s #elifO(min_box,ldc, w://wnumb�acttpemis,t�IFoF'R :---o_5dx,t�l300h Poi8mmmmmmmmax,t_s #elifO(max_box,ldc, w://wnumb�acttpemis,t�IFoF'R :---o_5dx,t�l300h Poi8mmmmmmmldc���(4)mem_req--- TEGGGGGGGmax,t_s #elifO(ppb p,ldc, w://wnumb�acttpemis,t�IFoF'R :---o_5dx,t�l300h Poi8mmmmmmmmax,t_s #elifO(npbxp,ldc, w://wnumb�acttpemis,t�IFoF'R :---o_5dx,t�l300h Poi8mmmmmmmmax,t_s #elifO(npbxg,ldc, w://wnumb�acttpemis,t�IFoF'R :---o_5dx,t�l300h� uårcl--- issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TEGGGGGGGrcCatch si--�s-ibI s #c L�cfibIsti.NgT.E mode� uårcl--- issEND---------------------------------ginys,max,phys,mis,t�lEmax,--- TE300mmmmmUBROicstcANstf<htMPIinMpnRs �å �å oF omusti.N & i_5dl', DD& issEN&sEN--- issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDD -MPI ls ReduceDisrexpensive so we nly d oF e fibIsti.NgT.E DD& issEN&sEN--- issEND---------------------------------ginys,max,phys,mis,t�lEmDDDDDDDDDDDDDDDDmax,tMPI_ls Reduce(max,,i,1,MPI_ROLOGIClMPI_SUM, omu C!m,max,ph-- TEGGGGGGG GG-'WORK'ieL RRRRRRR RR-teIFocA(INd--- TEG RR t� oF'R :---o_5dl', DD& issEN& N& N&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g-----)'rs M oF oT.E w tout failed �2�!-----ginys,max,phys,mis,t� aE aEx,t�lE�å uårcl---condp eL RRRRRRR-te-R eL RRRR-teå D A(I h ImaibIDO WHILEoloop inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcNowouldIclsIboxes as ou usmainsaF'R ludT.E empty boxes,Ds-nce we don �l(lE�årcwantpvor Gspace which w-(PP/c-(PPMcauldI _(-ocl,s-movT.Eailto empty �l(lE�årcspace ... welloF e fc-(PPMbe k: w-(PPoceed cnrimmediaolrrti.ild-NU Les or! IclsIdt C!!osis M = -lt �-MlsnåagaibI- pM hapsoF e fw-(PPMhappen quitu uårcfrequuugly.inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåmem_req�=Rn---o(+T(lbox +T1 -lfbox) �l(lE�å oFmem_req.& iSIZE(min_s,t,2,, DD& issEN&sEND----D DATA',__aagyyya::---oc_!ReturnsTED(a��US)ldc���(4) omusim-------ENDldc�2, =Smem_req--- TEGGGGmax,t_s #elifO(min_s,t,ldc, w://wnumb�acttpe uåIFoF'R :---o_5dx,t�l400h Poi8mmmmmax,t_s #elifO(max_s,t,ldc, w://wnumb�acttpe uåIFoF'R :---o_5dx,t�l400h Poi8mmmmldc���(4)mem_req--400mmmmoSUBROicstSUBReG uåIFoF'R :---o_5dl', DD& issEN& N&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g---'rs M oF oT.E w ---o(failed!-----ginys,max,phys,mis,t� aEx,t�lE�å uårcl-te-R euårcl-te-R einMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcPermGOm n omcopyinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå-R F omusimåEQ 2, DD& issEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcibI2DissEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�DO ibox=fbox,lbox--- TEGGGGGGGnx,psas,t��������4)n---o(+T1 uå cllllmin_s,t(1,n---o)D=Rmin_box(1,isoxphys,misL RRRRmin_s,t(2,n---o)D=Rmin_box(2,isoxphhys,misL RRRRmax_s,t(1,n---o)D=Rmax_box(1,isoxphys,misL RRRRmax_s,t(2,n---o)D=Rmax_box(2,isoxphys,misL R-teå uå-bs oF omusimåEQ 3, DD& issEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcibI3DissEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�DO ibox=fbox,lbox--- TEGGGGGGGnx,psas,t��������4)n---o(+T1 uå cllllmin_s,t(1,n---o)D=Rmin_box(1,isoxphys,misL RRRRmin_s,t(2,n---o)D=Rmin_box(2,isoxphys,misL RRRRmin_s,t(3,n---o)D=Rmin_box(3,isoxphhys,misL RRRRmax_s,t(1,n---o)D=Rmax_box(1,isoxphys,misL RRRRmax_s,t(2,n---o)D=Rmax_box(2,isoxphys,misL R aEmax_s,t(3,n---o)D=Rmax_box(3,isoxphys,misL R-teå uå----Rro88yyyyO in om--------------------------------------------------------gin � �! Chec-soSUBRDti.NgT.E: wriATmout w tout inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå-R F omusti.N & i_5dl', DD& issEN&-R F omurankåEQ _5dl', DD& issEN& N&mesED=R'WriAT.E w tout oo cls fil,: tout.dat' � �! max,t_s #wriATF omurank�l(Ecsst C!!_toutChmesg,max,phys,mis,t�lEmOPEN(10,FILE='tout.dat'phys,mis,t�lEmDO i 1,nx,bATED(a��US)))))))WRITE(10,'(2e12.4)') min_s,t(1,i),min_s,t(2,ibhys,mis,t�lEmaEUWRITE(10,'(2e12.4)') max_s,t(1,i),min_s,t(2,ibhys,mis,t�lEmaEUWRITE(10,'(2e12.4)') max_s,t(1,i),max_s,t(2,ibhys,mis,t�lEmaEUWRITE(10,'(2e12.4)') min_s,t(1,i),max_s,t(2,ibhys,mis,t�lEmaEUWRITE(10,'(2e12.4)') min_s,t(1,i),min_s,t(2,ibhys,mis,t�lEmaEUWRITE(10,'(A)'phys,mis,t�lEm-teå uårcl L-CLOSE(10phys,misL R-tedp� uå-te-R einMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcFouticls --!!-coTgain�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----DATA',__aagyyR c L�cg�TINE-max,t_s #elifO(ppb pnR,ldc, w://wnumb�acttpe oF'R :---o_5dx,t�l500h Poi8mmax,t_s #elifO(npbxpnR,ldc, w://wnumb�acttpe oF'R :---o_5dx,t�l500h Poi8mmax,t_s #elifO(npbxgnR,ldc, w://wnumb�acttpe oF'R :---o_5dx,t�l500h Poi8mmax,t_s #elifO(min_box,ldc, w://wnumb �acttpe oF'R :---o_5dx,t�l500h Poi8mmax,t_s #elifO(max_box,ldc, w://wnumb �acttpe oF'R :---o_5dx,t�l500h Poi8mmax,t_s #elifO(workpnR,ldc, w://wnumb �acttpe oF'R :---o_5dx,t�l500h P500oSUBROicstacttpe oF'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_toutCh -------------------------g'ds M oF oT.E workpc) THo(failed!-----ginys,max,phys,mis,t�x,t�lE�å uå-te-R ews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc�oSUrnå--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�lE�å oSUBROicstSUBReGmax,t�lE�åop uårst C!!_toutCheck-nMgu SUBReGRETUR DD& issSUBRAINSDD& iss----------------i--------å oFminboxs-zl(.L y0.0_MK) DD& issEN&sENDs,tD'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_toutCh ------------------'cls -inimumcboxDs-zlt2)) obe >y0 !-----ginys,max,phys,mis,t� aEx,t�l8888hys,mis,t�condp� uårclut !Nree S LT.E_5dl', DD& issEN& N&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_toutCh ------------------'cls -ls M h I _(-ocl,s-2)) obe >= 0 !-----ginys,max,phys,mis,t� aEx,t�l8888hys,mis,t�condp� uårclDO i 1, omusim-------L Rs-å oFmin_phys(i) .& ilmax_phys(i)5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_toutCh ---------------------'min_phys-2)) obe <=Rmax_phys !-----ginys,max,phys,mis,t� aE� aEx,t�l8888hys,mis,t�,t�condp� uårcl-teå 8888 ooSUBROicstSUBReG-tes----------------icANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-tes-----------st C!!_tout_socANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-tes-----------st C!!_tout_docA(INd-�������������������������������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/st C!!/(Ecsst C!!_boxsplit.f�������������������������������������������������������0000644�0001752�0001753�00000027640�11616003525�021443� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcSub�lEmax,t :ys,mis,t�lEmaEEm (Ecsst C!!_boxsplit_[s,d]ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårCopyright ( , 2010 CSE Lab (EpyoZurich), MOSAICRGroup (EpyoZurich), hec-soSUBRRRRRRRRRRRRRRRRRRRCen SefGOTFluid�Dynamics (DTUphys,mis!hys,mis!hys,mis! ,het fil,tis ree SoftweseP-bs',---P_(-ocl,tM----Libmis,p(PPM).hys,mis!hys,mis! PPMtis foutisoftware: you=eterredistribuolrit-�--/GOTOoINdco88yyyyOrit-uni!tribupet in weibupGNU Lesldr Genebs' Public-Lic2),(å--- TEGE cs ublished TY; w tFoutiSoftware Fmpliet M ,yeiL�cg�--- TEGE ver,Edu 3 weibupLic2),(, GOT(TO you hpt M ) �-yoE. Se--- TEGE ver,Edu.hys,mis!hys,mis! PPMtis distribuol--ilsibuphop88tOTO itan-ou shouldful,inMpnRs)lt �-copy--- ANY WARRANTY;an---lEm evelsibupimplied wc) Tnty-NU Les or! MERCHANTABILITY GOTFITNESS FOR AdPPMTICULAR PURPOS ySeerclso weGOTOpGNU Genebs' Public-Lic2),(åmGOTO 88mdetails.hys,mis!hys,mis! You=sh-(PPMhaveEreceived a copy weibupGNU Genebs' Public-Lic2),(--- TEGE c------pGNU Lesldr Genebs' Public-Lic2),(åa----an----PPM. in � �,inMpnRs)lseer<http://www.gnu.org/lic2),(s/>.hys,mis!hys,mis! P-bs',---P_(-ocl,tM----Libmis,p(PPM)hys,mis! EpyoZurichhec- uårCH-8092oZurich, Sn--zerlc--o88yyyyO in om--------------------------------------------------------gin � �! ChicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-----------st C!!_bsplit_s(xp,ppb,npbx,kbox,nbox, -------------------------g-----))))))))))min_box,max_box,max,phcANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-----------st C!!_bsplit_d(xp,ppb,npbx,kbox,nbox, -------------------------g-----))))))))))min_box,max_box,max,phcA(INd--- TEGE!! ,het �lEmax,tsplits a (reeen )cboxDin its 4 GOT8---ildeenåmGO--- TEGE!! 2D c---3D mobnems. ,hdI _(-ocl,s-contained n---in�l(lE�å<!! cls _(uugrboxDare sorol--iloo cls respec ive --ild boxes.inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåUBRModust_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åUSE (Ecsmodust_UBRL�l(lE�åUSE (Ecsmodust_�lE�å �l(lE�åUSE (Ecsmodust_�lE�åop�l(lE�åUSE (Ecsmodust_E__,mustn � USE (Ecsmodust_c L�cg�TINE-USE (Ecsmodust_Emal_sorotacttpe MPLICIT NONEicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRsROLOGICldPPMAME TE-eyMKD'DATA'kind_singleocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsROLOGICldPPMAME TE-eyMKD'DATA'kind_doubleocA(INd--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E-b ludesGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu ChcANstf<htMPIinMpnRsROCLUDE 'mpif.h'ocA(INd--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å EA--debug.(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åROLOGIC pDaagyyya::E�å r-eykbox--- TEGE!! IDrercls _(uugrbox SUBReGRE uåMK(second ininin,oxpDaagyyya::--- r-eyx!--- TEGEda P_(-ocl,t Cordin ols�l(lE�å uåMK(second ininin,oxpDaagyyya::--- r-eymin_box--- TEGEda Sms',-) oextoum,mrerclst�lE-usmainsinMpnRs uåMK(second ininin,oxpDaagyyya::--- r-eymax_box--- TEGEda Larg-) oextoum,mrerclst�lE-usmainsinMpnRsROLOGIC second ininin) pDaagyyya::--- r-eyppb--- TEGEda ppb(i_box) roSUrnsrcls fir) oindexrercls _(-ocl,-ibIclsIbox-NU Les or!da indexribox--- TEGROLOGIC second ininin) pDaagyyya::--- r-eynpbxDDDDDDD!da npbx(i_box) roSUrnsrcls -ls M h I _(-ocl,s-ibIclsIbox h Iindexribox--- TEGROLOGIC pDaagyyya::--- r-eynbox--- TEGEda Currostr-ls M h Iboxeshys,misROLOGIC pDaagyyya --- r-eymax,TED(a��Eda �oSUrnså�å tus- 0-upLocsuc --- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å ELo--- ��==�bst_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK( L�ct0�l(lE�å uåMK(second inini omusim, L�cc2)_box--- TEGROLOGIC second ininin)pDost TE-eynpbx_temps=>DCALL()inMpnRsROLOGIC second inini omusim,p L�cNmhys,misROLOGIC L�cidx,jdx,ks w:/inMpnRsROLOGIC second inini1) L�cldaå dummcomGOT s #c L�cg�TINE-E----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å EExtor s'_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å E-bION --,(å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�åmax,t�lE�åee uårst C!!_boxsplitCheck-nMgu --- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å ECoF o-T--debug.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å oF omusti.N & il', DD& issEN&sENmax,t-----i-------- oF'R ::---oc_5dx,t�lE�å uå-te-R-inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcCo!!uolr----c2)tourero<hmcurrostrkbox--- TEGE issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåDO k 1, omusim-------L Rc2)_box(kpi=R0.5_MK*(min_box(k,ksoxp +Rmax_box(k,ksoxpphys,mis-teå inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcDefinerclst�-zltero<hmcelloindexr(2 x 2 x 2)ws - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåNm��4)2hys,misidxD'DATb(ksoxp inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcSororcls _(-ocl,-ibIcwo simension_å--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å oF omusimåEQ 2, DD& issEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcibIcwo simension_issEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�jdxD'DidxD+Rnpbx(ksoxp -T1 uå clmax,t_s #Emal_soro2d(xp(1:2,idx:jdx),npbx(kbox), -------------------------g-----)min_box(1:2,kbox),max_box(1:2,kbox), -------------------------g-----)Nm,npbx_temp/wnumb�acttpe uåIFoF'R :---o_5dx,t�lE�å hys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcst 88mcls oin Ses oo cls _(-ocl,s-c------p-ls M h I _(-ocl,s-ibhys,mis,t�rcwese---oboxeshys,misttp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�ATb(nbox+1) D'DATb(ksoxp ys,mis,t�npbx(nbox+1) =ynpbx_temp(1phys,mis,t�DO k 2,4hys,mis,t�,t�ATb(k+nbox) =SATb(k-1+nbox) +ynpbx_temp(k-1phys,mis,t� aEnpbx(nbox+k) =ynpbx_temp(kphys,misL R-teå hys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcSt 88mcls cornSes ercls -ewoboxeshys,misttp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�min_box(1,nbox+1) =ymin_box(1,ksoxp ys,mis,t�min_box(2,nbox+1) =ymin_box(2,ksoxp ys,mis,t�max_box(1,nbox+1) =yc2)_box(1p ys,mis,t�max_box(2,nbox+1) =yc2)_box(2phhys,misL Rmin_box(1,nbox+2) =yc2)_box(1p ys,mis,t�min_box(2,nbox+2) =ymin_box(2,ksoxp ys,mis,t�max_box(1,nbox+2)D=Rmax_box(1,ksoxp ys,mis,t�max_box(2,nbox+2) =yc2)_box(2phhys,misL Rmin_box(1,nbox+3) =ymin_box(1,ksoxp ys,mis,t�min_box(2,nbox+3) =yc2)_box(2phys,mis,t�max_box(1,nbox+3) =yc2)_box(1p ys,mis,t�max_box(2,nbox+3)D=Rmax_box(2,ksoxp inMpnRsL Rmin_box(1,nbox+4) =yc2)_box(1p ys,mis,t�min_box(2,nbox+4) =yc2)_box(2phys,mis,t�max_box(1,nbox+4)D=Rmax_box(1,ksoxp ys,mis,t�max_box(2,nbox+4)D=Rmax_box(2,ksoxp inMpnRsL R issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcUpdaolr----boxDcoun �l(lE�åttp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�nbox =Rnbox +T4hys,mis-bs DDDDDDDDDD issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcibIchoutisimension_issEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�jdxD'DidxD+Rnpbx(ksoxp -T1 uå clmax,t_s #Emal_soro3d(xp(1:3,idx:jdx),npbx(kbox), -------------------------g-----)min_box(1:3,kbox),max_box(1:3,kbox), -------------------------g-----)Nm,npbx_temp/wnumb�acttpe uåIFoF'R :---o_5dx,t�lE�å hys,mis,t�ATb(nbox+1) D'DATb(ksoxp ys,mis,t�npbx(nbox+1) =ynpbx_temp(1phys,mis,t�DO k 2,8hys,mis,t�,t�ATb(k+nbox) =SATb(k-1+nbox) +ynpbx_temp(k-1p DD& issEN&sENnpbx(nbox+k) =ynpbx_temp(kphys,misL R-teå hys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcSt 88mcls cornSes ercls -ewoboxeshys,misttp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mi---)min_box(1,nbox+1) =ymin_box(1,ksoxp ys,mis,t�min_box(2,nbox+1) =ymin_box(2,ksoxp ys,mis,t�min_box(3,nbox+1) =ymin_box(3,ksoxp ys,mis,t�max_box(1,nbox+1) =yc2)_box(1p ys,mis,t�max_box(2,nbox+1) =yc2)_box(2phys,mis,t�max_box(3,nbox+1) =yc2)_box(3phhys,misL Rmin_box(1,nbox+2) =yc2)_box(1p ys,mis,t�min_box(2,nbox+2) =ymin_box(2,ksoxp ys,mis,t�min_box(3,nbox+2) =ymin_box(3,ksoxp ys,mis,t�max_box(1,nbox+2)D=Rmax_box(1,ksoxp ys,mis,t�max_box(2,nbox+2) =yc2)_box(2phys,mis,t�max_box(3,nbox+2) =yc2)_box(3phhys,misL Rmin_box(1,nbox+3) =ymin_box(1,ksoxp ys,mis,t�min_box(2,nbox+3) =yc2)_box(2phys,mis,t�min_box(3,nbox+3) =ymin_box(3,ksoxp ys,mis,t�max_box(1,nbox+3) =yc2)_box(1p ys,mis,t�max_box(2,nbox+3)D=Rmax_box(2,ksoxp ys,mis,t�max_box(3,nbox+3) =yc2)_box(3phhys,misL Rmin_box(1,nbox+4) =yc2)_box(1p ys,mis,t�min_box(2,nbox+4) =yc2)_box(2phys,mis,t�min_box(3,nbox+4) =ymin_box(3,ksoxp ys,mis,t�max_box(1,nbox+4)D=Rmax_box(1,ksoxp ys,mis,t�max_box(2,nbox+4)D=Rmax_box(2,ksoxp ys,mis,t�max_box(3,nbox+4) =yc2)_box(3phhys,misL Rmin_box(1,nbox+5) =ymin_box(1,ksoxp ys,mis,t�min_box(2,nbox+5) =ymin_box(2,ksoxp ys,mis,t�min_box(3,nbox+5) =yc2)_box(3phys,mis,t�max_box(1,nbox+5) =yc2)_box(1p ys,mis,t�max_box(2,nbox+5) =yc2)_box(2phys,mis,t�max_box(3,nbox+5)D=Rmax_box(3,ksoxp inMpnRsL Rmin_box(1,nbox+6) =yc2)_box(1p ys,mis,t�min_box(2,nbox+6) =ymin_box(2,ksoxp ys,mis,t�min_box(3,nbox+6) =yc2)_box(3phys,mis,t�max_box(1,nbox+6)D=Rmax_box(1,ksoxp ys,mis,t�max_box(2,nbox+6) =yc2)_box(2phys,mis,t�max_box(3,nbox+6)D=Rmax_box(3,ksoxp inMpnRsL Rmin_box(1,nbox+7) =ymin_box(1,ksoxp ys,mis,t�min_box(2,nbox+7) =yc2)_box(2phys,mis,t�min_box(3,nbox+7) =yc2)_box(3phys,mis,t�max_box(1,nbox+7) =yc2)_box(1p ys,mis,t�max_box(2,nbox+7)D=Rmax_box(2,ksoxp ys,mis,t�max_box(3,nbox+7)D=Rmax_box(3,ksoxp inMpnRsL Rmin_box(1,nbox+8) =yc2)_box(1p ys,mis,t�min_box(2,nbox+8) =yc2)_box(2phys,mis,t�min_box(3,nbox+8) =yc2)_box(3phys,mis,t�max_box(1,nbox+8)D=Rmax_box(1,ksoxp ys,mis,t�max_box(2,nbox+8)D=Rmax_box(2,ksoxp ys,mis,t�max_box(3,nbox+8)D=Rmax_box(3,ksoxp inMpnRsL R issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcUpdaolr----boxDcoun �l(lE�åttp issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�nbox =Rnbox +T8hys,mis-te-R ews - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcDs M oF o--lo--- c) THows - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----D DATA',__aagyyR c L�cg�TINE-lda���(4)0å dummcg�TINE-max,t_s #elifO(npbx_temp/lda, w://wnumb�acttpe oF'R :---o_5dl', DD& issEN&&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsst C!!_boxsplitCh ----------------'ds M oF oTon erst C!!_boxsplit(failed-----ginys,max,phys,mis,t� x,t�lE�å uå-te-R-s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårc�oSUrnå--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�lE�å oSUBROicstSUBReGmax,t�lE�åop uårst C!!_boxsplitCheck-nMgu SUBReGRETUR DD& issSUBRAINSDD& iss----------------i-------- oFksox LT.1.OR.ksox GT.nbox) l', DD& issEN& N& -'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsst C!!_boxsplitCh ---------------'kbox 2)) os oTsfy:)0å<ckbox <=Rnbox-----ginys,max,phys,mis,t� aE�x,t�l8888hys,mis,t-te-R-s8888 oSUBROicstSUBReG-tes----------------icANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-tes-----------st C!!_bsplit_socANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-tes-----------st C!!_bsplit_d cA(INd- ������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/rmsh/������������������������������������������������������������������������������0000755�0001752�0001753�00000000000�11616003523�014714� 5����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/rmsh/ omurmsh_cre o-__aat.f��������������������������������������������������������0000644�0001752�0001753�00000101420�11616003523�021257� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcSub�lEmax,t :ys,mis,t�lEmaEEm m (Ecsrmsh_cre o-__aat-s - Ge< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårCopyright ( , 2010 CSE Lab (EpyoZurich), MOSAICRGroup (EpyoZurich), hec-soSUBRRRRRRRRRRRRRRRRRRRCen SefGOTFluid�Dynamics (DTUphys,mis!hys,mis!hys,mis! ,het fil,tis ree SoftweseP-bs',---P_(-ocl,tM----Libmis,p(PPM).hys,mis!hys,mis! PPMtis foutisoftware: you=eterredistribuolrit-�--/GOTOoINdco88yyyyOrit-uni!tribupet in weibupGNU Lesldr Genebs' Public-Lic2),(å--- TEGE cs ublished TY; w tFoutiSoftware Fmpliet M ,yeiL�cg�--- TEGE ver,Edu 3 weibupLic2),(, GOT(TO you hpt M ) �-yoE. Se--- TEGE ver,Edu.hys,mis!hys,mis! PPMtis distribuol--ilsibuphop88tOTO itan-ou shouldful,inMpnRs)lt �-copy--- ANY WARRANTY;an---lEm evelsibupimplied wc) Tnty-NU Les or! MERCHANTABILITY GOTFITNESS FOR AdPPMTICULAR PURPOS ySeerclso weGOTOpGNU Genebs' Public-Lic2),(åmGOTO 88mdetails.hys,mis!hys,mis! You=sh-(PPMhaveEreceived a copy weibupGNU Genebs' Public-Lic2),(--- TEGE c------pGNU Lesldr Genebs' Public-Lic2),(åa----an----PPM. in � �,inMpnRs)lseer<http://www.gnu.org/lic2),(s/>.hys,mis!hys,mis! P-bs',---P_(-ocl,tM----Libmis,p(PPM)hys,mis! EpyoZurichhec- uårCH-8092oZurich, Sn--zerlc--o88yyyyO in om--------------------------------------------------------gin � �! ChicANTs�cg�s - Ge<http1Dt,Gal-Te----icANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_sss_2d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_ssv_2d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vp/lda2phcA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_svs_2d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_svv_2d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights, -------s,t� a& field_wp,wp,vp/lda2phcA(INd-cA(INd-cANTs�cgcond Ge<ht3DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_sss_3d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_ssv_3d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vp/lda2phcA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_svs_3d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_svv_3d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights, -------s,t� a& field_wp,wp,vp/lda2phcA(INd-cA(INd-cA(INd-cANTs�cg�s - Ge<http1Dt,Gal-------icANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_dss_2d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_dsv_2d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vp/lda2phcA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_dvs_2d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_dvv_2d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights, -------s,t� a& field_wp,wp,vp/lda2phcA(INd-cA(INd-cANTs�cgcond Ge<ht3DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_dss_3d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_dsv_3d(åopoidhmeshidhxp,Np,up,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,field_wp,wp,vp/lda2phcA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-----------(Ecsrmsh_cre o-__aat_dvs_3d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights,field_wp,wp,vpphcANTs�cgMODd2 Ge<htVECi88yyyy-----------(Ecsrmsh_cre o-__aat_dvv_3d(åopoidhmeshidhxp,Np,up,lda,&hys,mis,t� a& field_up,cutoff,max,,Retutpos,cutoff_weights, -------s,t� a& field_wp,wp,vp/lda2phcA(INd-cA(INd-cA(INd-cA(INd--- TEGE!! Cre o-sI _(-ocl,s-up fromrfield_up--- TEGE!!--- TEGE!! [NOTE]--- TEGE!! Sh-(PPMoakeTsquare cutoffåmGOT C!!arison�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå E-b ludesGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu ChT.0) TUSE (Ecsmodust_E__,mustn � USE (Ecsmodust_c L�cg�TINE-USE (Ecsmodust_�lE�å �l(lE�åUSE (Ecsmodust_�lE�åop�l(lE�åUSE (Ecsmodust_UBRLsrmsh�l(lE�åUSE (Ecsmodust_UBRLsmesh�l(lE�åUSE (Ecsmodust_typedef�l(lE�åUSE (Ecsmodust_UBRL�l(lE�åUSE (Ecsmodust_-----_idews - Ge MPLICIT NONEiicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRsROLOGICldPPMAME TE-eyMKD'DATA'kind_singleocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsROLOGICldPPMAME TE-eyMKD'DATA'kind_doubleocA(INd-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EA--debug.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåmk), cond ininin,ox-s,t� apDost TEEEEEEEE-eyx!--- TEGEda P_(-ocl,t!osis M sinMpnRsROLOGICldaagyyyaout( EEEEE-eyn!--- TEGEda Newp-ls M h I _(-ocl,sicANTs�cgMODd Ge<htSCAil(lE�å uåMK( second ininin) -s,t� apDost TEEEEEEEE-eyu!--- TEGEda Newpmas Se _(-ocl,-valu,sicANTs�cgcond Ge<ht2Dil(lE�å uåMK( second ininin,n,nlE�å)apDost TEEEEEEEE-eyfield_up-cANTs�cgcond Ge<ht3Dil(lE�å uåMK( second ininin,n,n,nlE)apDost TEEEEEEEE-eyfield_up-cA(INd--- TEGE!! P_(-ocl,-valu,s on ayfield e.g. cs genebsted TY;rmsh_remesh�cANTs�cgMODd Ge<htVECinMpnRsROLOGIC EEEEEldaagyyyain)EEEEE-eylda--- TEGE!! LeadT.E simensionil(lE�å uåMK( second ininin,nx-s,t� apDost TEEEEEEEE-eyu!--- TEGEda Newpmas Se _(-ocl,-valu,sicANTs�cgcond Ge<ht2Dil(lE�å uåMK( second ininin,n,n,nlE)apDost TEEEEEEEE-eyfield_up-cANTs�cgcond Ge<ht3Dil(lE�å uåMK( second ininin,n,n,n,nx-pDost TEEEEEEEE-eyfield_up-cA(INd--- TEGE!! P_(-ocl,-valu,s on ayfield e.g. cs genebsted TY;rmsh_remesh�cA(INd--- TEGROLOGIC EEEE, Daagyyya::E�å r L�ctopoid--- TEGE!! Topology ID--- TEGROLOGIC EEEE, Daagyyya::E�å r L�cmeshid--- TEGE!! M----ID�l(lE�å uåmk), cond inini2) EEEE, DaagyyyainE�å r L�ccutoff--- TEGE!! LowSe(eleebug 1) c---uppSe(eleebug 2)cbou(I h I _(-ocl,--- TEGE!! strengths. Only _(-ocl,s-n----strengths-ilsibis bc--o88yyyyO!! n-ou shocre o-d.--- TEGROLOGIC EEEE, Daagyyya --- rr-eymax,TED(a��Eda �oSUrnså0-upLocsuc --- TEGLOGICALE, OPTninALE EEEE, DaagyyyainE�å r L�cRetutposTED(a��Eda �otutrcls _(-ocl,-!osis M s? (default .false.)icANTs�cgMODd Ge<htVECinMpnRs uåmk), OPTninALsecond ininin)pDost TEEEEEEEEL�ccutoff_weightsTED(a��Eda Givesrcls weights weibuplineaO--- TEGE!! C!bin oTon erches�ector eleebugs. ,hdIcutoffåis-Mlsnåapplied--- TEGE!! oo cls weighted sum.-cA(INd-cANTs�cgMODd2 Ge<htSCAi88yyyy uåMK( second ininin) -s,t� apDost T, OPTninALEL�cw!--- TEGEda NewpslaveE _(-ocl,-valu,s. Has oo shorRetuugrANTfield_wpåis.icANTs�cgcond Ge<ht2Dil(lE�å uåMK( second ininin,n,nlE�å)apDost T, OPTninALEL�cfield_wp-cANTs�cgcond Ge<ht3Dil(lE�å uåMK( second ininin,n,n,nlE)apDost T, OPTninALEL�cfield_wp-cA(INd--- TEGE!! ApslaveEfield mGOTwhich co cre o- _(-ocl,s-cs wellowhereyfield_up --- TEGE!! is n---inIcutoff. hcANTs�cgMODd2 Ge<htVECi88yyyyROLOGIC EEEEEldaagyyyain)EEEEE-eylda2--- TEGE!! Has oo shorRetuugrANTfield_wpåis c---ANTit is as�ector field.il(lE�å uåMK( second ininin,nx-s,t� apDost TEEEEEEEE-eyw!--- TEGEda NewpslaveE _(-ocl,-valu,s. Has oo shorRetuugrANTfield_wpåis.icANTs�cgcond Ge<ht2Dil(lE�å uåMK( second ininin,n,n,nlE)apDost TEEEEEEEE-eyfield_wp-cANTs�cgcond Ge<ht3Dil(lE�å uåMK( second ininin,n,n,n,nx-pDost TEEEEEEEE-eyfield_wp-cA(INd--- TEGE!! ApslaveEfield mGOTwhich co cre o- _(-ocl,s-cs wello88yyyyO!! nhereyfield_up is n---inIcutoff.-cA(INd--- TEG uåmk), cond ininin) -s,t� apDost T, OPTninALEL�cv!--- TEGEda P_(-ocl,tvoldeb --- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å ELo---.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å OLOGIC EEEEEEEEEEEEEEEEEEEEEE-eyms,t,yms,tl�l(lE�å OLOGIC EEEEEEEEEEEEEEEEEEEEEE-eysim-------ROLOGIC seecond ininin,oxpDDDDDDDDost TEEEEEEEE-eyi�å s=>DCALL()inMpnRsROLOGIC seecond ininin,oxpDDDDDDDDost TEEEEEEEE-eylieta s=>DCALL()inMpnRsLOGICALE EEEEEEEEEEEEEEEEEEEEEE-eyRetutinMpnRsROLOGIC seecond inini2�å r EEEEEEEEEEEEEEEEEEEEEE-eyldu,yldl�l(lE�å OLOGIC EEEEEEEEEEEEEEEEEEEEEE-ey w:/inMpnRs uåmk) second ininin,nxpDDDDDDDDost TEEEEEEEE-eymin_s,ts=>DCALL()inMpnRs uåmk) second ininin), ost TEEEEEEEE-eymin_phys =>DCALL()inMpnRs uåmk) second ininin), ost TEEEEEEEE-eymax_phys =>DCALL()inMpnRs uåmk) EEEEEEEEEEEEEEEEEEEEEE-eydx,dy,dzinMpnRsROLOGICldeecond ininin�å pDDDDDDDDost TEEEEEEEE-eylms=>DCALL()inMpnRsROLOGIC EEEEEEEEEEEEEEEEEEEEEE-eyinp, nnx, nny, nnzinMpnRsROLOGIC EEEEEEEEEEEEEEEEEEEEEE-ey�å x, �å y, �å zinMpnRsROLOGIC EEEEEEEEEEEEEEEEEEEEEE-eyi,j,kinMpnRsROLOGIC EEEEEEEEEEEEEEEEEEEEEE-eyilowbc,ymhighbcinMpnRsROLOGIC EEEEEEEEEEEEEEEEEEEEEE-eyjlowbc,yjhighbcinMpnRsROLOGIC EEEEEEEEEEEEEEEEEEEEEE-eyklowbc,ykhighbcinMpnRs uåmk) EEEEEEEEEEEEEEEEEEEEEE-eyxbc_factor, ybc_factorinMpnRs uåmk) EEEEEEEEEEEEEEEEEEEEEE-eyzbc_factorinMpnRs uåmk) EEEEEEEEEEEEEEEEEEEEEE-eystrengthinMpnRsLOGICALE EEEEEEEEEEEEEEEEEEEEEE-eylok,lslaveinMpnRsLOGICALE EEEEEEEEEEEEEEEEEEEEEE-eyn---_volinMpnRsTYPE�� L�t_equismesh)pDost TEEEEEEEEEEEEEEEEEEE-eypsmeshs=>DCALL()inMpnRsTYPE�� L�t_topo) pDost TEEEEEEEEEEEEEEEEEEE-eytopo s=>DCALL()icANTscgMODd Ge<htVECinMpnRsLOGICALE EEEEEEEEEEEEEEEEEEEEEE-eyn---_weighting-cA(INd--- TEGmax,t�lE�åee uårrmsh_cre o-__aatCheck-nMgu --- TEGsim(4) omusim-------E----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å ECoF o-A--debug.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å oF omusti.N & il', DD& issEN&sENmax,t-----i-------- oF'R ::---oc_5dx,t�lE�å uå-te-R-inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcCoF o-topoid--- TEGE issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå oF omusti.N & il', DD& issEN&sEN max,t_s #-----_topoid(åopoidhlok,wnumb�acttpe uåIFoF'R ::---oc_ .OR.:--OT.lok5dl', DD& issEN& N&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'åopo_id e fibvalid!-----ginys,max,phys,mis,t� aEx,t�lE�å uårcl-te-R uå-te -R-inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcCoF o-meshid--- TEGE issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå oF omusti.N & il', DD& issEN&sEN max,t_s #-----_meshid(åopoidhmeshidhlok,wnumb�acttpe uåIFoF'R ::---oc_ .OR.:--OT.lok5dl', DD& issEN& N&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'mesh_id e fibvalid!-----ginys,max,phys,mis,t� aEx,t�lE�å uårcl-te-R uå-te -R-inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcGet-meshid--- TEGE issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå!meshidRK',__Låopo(åopo_id)%t%mesh(mesh_idp inMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårcGet-i�å �l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåtopo s=>D,__Låopo(åopoid)%t uåpsmeshs=>Dåopo%mesh(meshidp EN& N&-�å s=>Dpsmesh%i�å �l(lE�ålms s=>D,smesh%nm-------lieta s=>D,smesh%nnod,sicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRsmin_s,tss=>Dåopo%min_s,tsinMpnRsmin_phys =>Dåopo%min_physsinMpnRsmax_phys =>Dåopo%max_physsocANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsmin_s,tss=>Dåopo%min_s,tdinMpnRsmin_phys =>Dåopo%min_physdinMpnRsmax_phys =>Dåopo%max_physdocA(INd-�l(lE�ådxD'D(max_phys(1)-min_phys(1))/ uånm(1)-1,mkphys,misdyD'D(max_phys(2)-min_phys(2))/ uånm(2)-1,mkphys,misIF(simåEQ 3, dzD'D(max_phys(3)-min_phys(3))/ uånm(3)-1,mkphicANTscgMODd Ge<htVECinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårccoF o-thdIcutoffåweights ANTrRetuuginMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uån---_weightingD'Dal-Syyyacutoff_weightsphys,misIF( omusti.N & i_5dl', DD& issEN&-R(n---_weighting5dl', DD& issEN& N&-R(--OT.ASSOCIATEDacutoff_weightsp5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa aa& 'cutoff_weights e fnot M oF o-d-----ginys,max,phys,mis,t� x,t�lE�å uårcl is-bs DDDDDDDDDDDDDDDDDO i 1,lda--- TEGD& issEN& N&-R(cutoff_weights(i) LT.0.0_mk-------s,t� aaaaaaa aa aa&.OR.cutoff_weights(i) GT.1.0_mk5dl', DD& issEN& N& N& N& N&-'WORK',__LINE__,E__,mustn � �! LLLLLLLmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_cre o-__aatCh-------s,t� aaaaaaa aa aa aa& '0 <=Rcutoff_weights <=R1 e fviol o-d.'-------s,t� aaaaaaa aa aa aa&----ginys,max,phys,mis,t� aE� aEEEEEEx,t�lE�å uårcl isssssss-te -R-uårcl isssssss-te å uårcl L--te -R-uårcl is-te -R-uårcl-te -R-cA(INd-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EcoF o-wheL�cg�toyRetutmcls osis M sinMpnRsE issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå (al-SyyyaRetutposp5dl', DD& issEN&Retutm=cRetutposTED(a��-bs DDDDDDDDDDRetutm=c.FAbs .-uårcl-te -R-uårcl�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EcoF o-wheL�cg�toyRetutmcls osis M sinMpnRsE issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uån---_volD'Dal-Syyyavpphuårcl�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå ECoF o-wheL�cg�weMhaveEslaveEfieldsGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu ChcAN s�cgMODd2 Ge<htSCAi88yyyylslavem=c.FAbs .-uårclIFoFal-Syyyafield_wpp5dlslavem=c.TRUE.hcANTs�cgMODd2 Ge<htVECi88yyyylslavem=c.TRUE.hcA(INd-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå ELoop ov!tribup---o(c---co!!uolr-----ls M h I _(-ocl,s-tOTO n-ou sh uå Ecre o-d�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåinp(4)0 uåDO i--- 1,åopo%nx,bli�åDDDDDDDDDDms,tl(4)åopo%ix,bli�å(ix,bphys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rccoF o-thdIbou(Iis,pco(INtion_issEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t��å x(4)1 uå cl (åopo%---o_bc(1,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(1)åEQ A',__aagyybcdef_foutspace5dl', DD& issEN& N&�å x(4)2DD& issEN&-te -R-uårcl is (åopo%---o_bc(2,ix,b)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(2)---oA',__aagyybcdef_periodic -------s,t� aaaa&.AND.åopo%bcdef(2)---oA',__aagyybcdef_foutspace5dl', DD& issEN& N&nnx =Rnieta(1,ix,bl)DD& issEN&-bs DDDDDDDDDDDDDnnx =Rnieta(1,ix,bl)-1DD& issEN&-te -R-hys,mis,t��å y(4)1 uå cl (åopo%---o_bc(3,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(3)åEQ A',__aagyybcdef_foutspace5dl', DD& issEN& N&�å y(4)2DD& issEN&-te -R-uårcl is (åopo%---o_bc(4,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(4)---oA',__aagyybcdef_periodic -------s,t� aaaa&.AND.åopo%bcdef(4)---oA',__aagyybcdef_foutspace5dl', DD& issEN& N&nny =Rnieta(2,ix,bl)DD& issEN&-bs DDDDDDDDDDDDDnny =Rnieta(2,ix,bl)-1DD& issEN&-te -R-hcANTs�cgcond Ge<ht3Dil(lE�å N&�å z(4)1 uå cl (åopo%---o_bc(5,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(5)åEQ A',__aagyybcdef_foutspace5dl', DD& issEN& N&�å z(4)2DD& issEN&-te -R-uårcl is (åopo%---o_bc(6,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(6)---oA',__aagyybcdef_periodic -------s,t� aaaa&.AND.åopo%bcdef(6)---oA',__aagyybcdef_foutspace5dl', DD& issEN& N&nnz =Rnieta(3,ix,bl)DD& issEN&-bs DDDDDDDDDDDDDnnz =Rnieta(3,ix,bl)-1DD& issEN&-te -R-cANTs�cgcond Ge<ht2Dil(lE�å N&�å z(4)1 uå clnnz =R1hcA(INd-�cANTs�cgcond Ge<ht3Dil(lE�å N&DO k �å z,nnzinMpnRsE�å N&DO j=�å y,nnyDDDDDDDDDDDDDDDDDO i �å x,nnx uårcl isssssss issEND---------------------------------ginys,max,phys,mis,t� uårcl isssssss -co!!uolrstrengthinMpnRsrcl isssssss issEND---------------------------------ginys,max,phys,mis,t� cANTs�cgMODd Ge<htSCAil(lE�åååååååååååååstrength =RABS(field_up(i,j,k,ix,b))�cANTs�cgMODd Ge<htVECinMpnRsssssssssssss-R(n---_weighting5dl', DD& issEN& N&åååååååååstrength =RSQRT(SUM(-------s,t� aaaaaaa aa & (field_up(1:lda, ,j,k,ix,b)*cutoff_weights(1:lda))**2 -------s,t� aaaaaaa aa----)phys,mis,t� aE� aEEE-bs DDDDDDDDDDDDDDDDååååååstrength =RSQRT(SUM(field_up(1:lda, ,j,k,ix,b)**2)phys,mis,t� aE� aEEE-te -R-cA(INd-nMpnRsssssssssssss-R((strength GT.cutoff(1)).AND.(strength LT.cutoff(2)p5dl', DD& issEN& N& N& N& N&-'p(4)-'p(+)1 uå cl aE� aEEE-te -R- uå cl aE� aEEE-te å uårcl L--te å uårcl-te å cANTs�cgcond Ge<ht2Di uåDO j=�å y,nnyDDDDDDDDDDDDDDO i �å x,nnx uårcl issss issEND---------------------------------ginys,max,phys,mis,t�lEm uårcl issss -co!!uolrstrengthinMpnRsrcl issss issEND---------------------------------ginys,max,phys,mis,t�lEm cANTs�cgMODd Ge<htSCAil(lE�ååååååååååstrength =RABS(field_up(i,j,ix,b))�cANTs�cgMODd Ge<htVECinMpnRssssssssss-R(n---_weighting5dl', DD& issEN& N&ååååååstrength =RSQRT(SUM(-------s,t� aaaaaaa aa a & (field_up(1:lda, ,j,ix,b)*cutoff_weights(1:lda))**2 -------s,t� aaaaaaa aa-a----)phys,mis,t� aE� a-bs DDDDDDDDDDDDDDDDåååstrength =RSQRT(SUM(field_up(1:lda, ,j,ix,b)**2)phys,mis,t� aE� a-te -R-cA(INd-nMpnRssssssssss-R((strength GT.cutoff(1)).AND.(strength LT.cutoff(2)p5dl', DD& issEN& N& N& N&-'p(4)-'p(+)1 uå cl aE� a-te -R- uå cl aE� a-te å uårcl-te å cA(INd-nMpnRs-te å uå'p(4)-'p-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Egrow-thdIup c) THcsuch as oo acco!odaolr-'p(eleebugsGT.0) THE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu ChcAN s�cgMODd Ge<htSCAi88yyyyldl���(4)1i88yyyyldu(1) =ynp�cANTs�cgMODd Ge<htVECinMpnRsldl���(4)1i88yyyyldu(1) =ylda--- TEGldl�2�(4)1i88yyyyldu(2) =ynp�cA(INd-nMpnRs----DATA',__aagyy M oF_fiåDDDDDDDmax,t_s #elifO(up,ldu, w://wnumb�acttpe F'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_cre o-__aatCh -------s,t� aaaa& 'c-(PPMnot M oF o- -ewo _(-ocl,s-(up)-----ginys,max,phys,mis,t�x,t�lE�å uå-te -R-hys,misIFoFlslave5dl', DcAN s�cgMODd2 Ge<htSCAi88yyyypnRsldl���(4)1i88yyyyyyyyldu(1) =ynp�cANTs�cgMODd2 Ge<htVECi88yyyypnRsldl���(4)1i88yyyyyyyyldu(1) =ylda2--- TEG TEGldl�2�(4)1i88yyyyyyyyldu(2) =ynp�cA(INd-nMpnRspnRs----DATA',__aagyy M oF_fiåDDDDDDDDDDDmax,t_s #elifO(wp,ldu, w://wnumb�acttpettpe F'R :---o_5dl', DD& issEN&sEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaaa& 'c-(PPMnot M oF o- -ewo _(-ocl,s-(wp)-----ginys,max,phys,mis,t�����x,t�lE�å uårcl -te -R-uårcl-te -R-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Egrow-thdIxp c) THcTs�ne ary�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå FRetut5dl', DD& issEN&ldu(1) =ysim-------L Rldu(2) =ynp�DD& issEN&----DATA',__aagyy M oF_fiåDDDDDDDDDDmax,t_s #elifO(xp,ldu, w://wnumb�acttpettp F'R :---o_5dl', DD& issEN&sEN-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'c-(PPMnot M oF o- -ewo _(-ocl,s-(xp)-----ginys,max,phys,mis,t����x,t�lE�å uårcl-te -R-uårcl-te -R-uårcl�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Egrow-thdIvp c) THcTs�ne ary�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Fn---_vol5dl', DD& issEN&ldu(1) =ynp�DD& issEN&----DATA',__aagyy M oF_fiåDDDDDDDDDDmax,t_s #elifO(vp,ldu, w://wnumb�acttpettp F'R :---o_5dl', DD& issEN&sEN-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'c-(PPMnot M oF o- -ewovoldeb avpp-----ginys,max,phys,mis,t����x,t�lE�å uårcl-te -R-uårcl-te -R-uårcl�l(lE�åinp(4)0 uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Eloop ov!tr---o(cgain(c---cre o- _(-ocl,s uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåDO i--- 1,åopo%nx,bli�åDDDDDDDDDDms,tl(4)åopo%ix,bli�å(ix,bphys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rccoF o-thdIbou(Iis,pco(INtion_issEN&sEND issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t��å x(4)1 uå cl (åopo%---o_bc(1,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(1)åEQ A',__aagyybcdef_foutspace5dl', DD& issEN& N&�å x(4)2DD& issEN&-te -R-uårcl is (åopo%---o_bc(2,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(2)---oA',__aagyybcdef_periodic -------s,t� aaaa&.AND.åopo%bcdef(2)---oA',__aagyybcdef_foutspace5dl', DD& issEN& N&nnx =Rnieta(1,ix,bl)DD& issEN&-bs DDDDDDDDDDDDDnnx =Rnieta(1,ix,bl)-1DD& issEN&-te -R-hys,mis,t��å y(4)1 uå cl (åopo%---o_bc(3,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(3)åEQ A',__aagyybcdef_foutspace5dl', DD& issEN& N&�å y(4)2DD& issEN&-te -R-uårcl is (åopo%---o_bc(4,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(4)---oA',__aagyybcdef_periodic -------s,t� aaaa&.AND.åopo%bcdef(4)---oA',__aagyybcdef_foutspace5dl', DD& issEN& N&nny =Rnieta(2,ix,bl)DD& issEN&-bs DDDDDDDDDDDDDnny =Rnieta(2,ix,bl)-1DD& issEN&-te -R-cANTs�cgcond Ge<ht3Dihys,mis,t��å z(4)1 uå cl (åopo%---o_bc(5,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(5)åEQ A',__aagyybcdef_foutspace5dl', DD& issEN& N&�å z(4)2DD& issEN&-te -R-uårcl is (åopo%---o_bc(6,ix,bl)åEQ 1-------s,t� aaaa&.AND.åopo%bcdef(6)---oA',__aagyybcdef_periodic -------s,t� aaaa&.AND.åopo%bcdef(6)---oA',__aagyybcdef_foutspace5dl', DD& issEN& N&nnz =Rnieta(3,ix,bl)DD& issEN&-bs DDDDDDDDDDDDDnnz =Rnieta(3,ix,bl)-1DD& issEN&-te -R-cANTs�cgcond Ge<ht2Dil(lE�å N&�å z(4)1 uå clnnz =R1hcA(INd- uå cl�cANTs�cgcond Ge<ht3Dil(lE�å N&ilowbc(4)0 uå is (åopo%---o_bc(1,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(1)å--oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(1)å--oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&ilowbc(4)1 DD& issEN&-te -R-uårcl ismhighbc =Rnieta(1,ix,bl)+1 uå cl (åopo%---o_bc(2,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(2)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(2)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&ihighbc =Rnieta(1,ix,bl)DD& issEN&-te -R-uårcl isjlowbc(4)0 uå is (åopo%---o_bc(3,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(3)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(3)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&jlowbc(4)1 DD& issEN&-te -R-uårcl isjhighbc =Rnieta(2,ix,bl)+1 uå cl (åopo%---o_bc(4,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(4)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(4)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&jhighbc =Rnieta(2,ix,bl)DD& issEN&-te -R-uårcl isklowbc(4)0 uå is (åopo%---o_bc(5,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(5)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(5)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&klowbc(4)1 DD& issEN&-te -R-uårcl iskhighbc =Rnieta(3,ix,bl)+1 uå cl (åopo%---o_bc(6,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(6)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(6)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&khighbc =Rnieta(3,ix,bl)DD& issEN&-te -R-hys,mis,t�DO k �å z,nnzinMpnRsE�å N& oFkåEQ klowbc(.OR.:kåEQ khighbc5dl', DD& issEN& N& N&zbc_factor(4)0.5_mkDD& issEN& N&-bs DDDDDDDDDDDDDDDDzbc_factor(4)1.0_mkDD& issEN& N&-te -R- uå cl aE� aDO j=�å y,nnyDDDDDDDDDDDDDDDD oFjåEQ jlowbc(.OR.:jåEQ jhighbc5dl', DD& issEN& N& N&&&&ybc_factor(4)0.5_mkDD& issEN& N& N&-bs DDDDDDDDDDDDDDDD&&&ybc_factor(4)1.0_mkDD& issEN& N& N&-te -R- uå cl aE� a DDDO i �å x,nnx uårcl isssssssIFoF'åEQ ilowbc(.OR.:'åEQ ihighbc5dl', DD& issEN& N& N&&&&&&&xbc_factor(4)0.5_mkDD& issEN& N& N& N&-bs DDDDDDDDDDDDDDDD&&&&&&xbc_factor(4)1.0_mkDD& issEN& N& N& N&-te -R- uå cl aE� a DD ss issEND---------------------------------ginys,max,phys,mis,t� uårcl isssssss -co!!uolrstrengthinMpnRsrcl isssssss issEND---------------------------------ginys,max,phys,mis,t� cANTs�cgMODd Ge<htSCAil(lE�åååååååååååååstrength =RABS(field_up(i,j,k,ix,b))�cANTs�cgMODd Ge<htVECinMpnRsssssssssssss-R(n---_weighting5dl', DD& issEN& N&åååååååååstrength =RSQRT(SUM(-------s,t� aaaaaaa aa & (field_up(1:lda, ,j,k,ix,b)*cutoff_Weights(1:lda))**2 -------s,t� aaaaaaa aa----)phys,mis,t� aE� aEEE-bs DDDDDDDDDDDDDDDDååååååstrength =RSQRT(SUM(field_up(1:lda, ,j,k,ix,b)**2)phys,mis,t� aE� aEEE-te -R-cA(INd-nMpnRsssssssssssss-R((strength GT.cutoff(1)).AND.(strength LT.cutoff(2)p5dl', DD& iiiiiiiiiiiiiiiiii-'p(4)-'p(+)1 cANTs�cgMODd Ge<htSCAil(lE�ååååååååååååååååup(inp) =yxbc_factor*ybc_factor*zbc_factor* -------------------------g-----) field_up(i,j,k,ix,b)�cANTs�cgMODd Ge<htVECinMpnRsssssssssssssåååup(1:lda, np) =yxbc_factor*ybc_factor*zbc_factor* -------------------------g-----) ----) field_up(1:lda, ,j,k,ix,b)-cA(INd-nMpnRsssssssssssss isIFoFlslave5dl', DcAN s�cgMODd2 Ge<htSCAi88yyyypnRsssssssssssssssswp(inp) =yxbc_factor*ybc_factor*zbc_factor* -------------------------g-----) --) field_wp(i,j,k,ix,b)�cANTs�cgMODd2 Ge<htVECi88yyyypnRsssssssssssssssswp(1:lda2, np) =yxbc_factor*ybc_factor*zbc_factor* -------------------------g-----) ----) --) field_wp(1:lda2, ,j,k,ix,b)-cA(INd-nMpnRsssssssssssss is-te-R uå FRetut5dl', DD& issEN&&&&&&&&&&&&&&&&xp(1, np) =y uåi-1,mkp*dxD+Rmin_s,t(1,ix,bl)DD& issEN&&&&&&&&&&&&&&&&xp(2, np) =y uåj-1,mkp*dyD+Rmin_s,t(2,ix,bl)DD& issEN&&&&&&&&&&&&&&&&xp(3, np) =y uåk-1,mkp*dzD+Rmin_s,t(3,ix,bl)DD& issEN&sssssssss is-te -R- uå cl aE� a DD ss-te -R- uå cl aE� aEEE-te å uårcl L--te å uårcl-te å cANTs�cgcond Ge<ht2Di uårclilowbc(4)0 uå is (åopo%---o_bc(1,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(1)å--oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(1)å--oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&ilowbc(4)1 DD& issEN&-te -R-uårcl ismhighbc =Rnieta(1,ix,bl)+1 uå cl (åopo%---o_bc(2,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(2)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(2)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&ihighbc =Rnieta(1,ix,bl)DD& issEN&-te -R-uårcl isjlowbc(4)0 uå is (åopo%---o_bc(3,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(3)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(3)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&jlowbc(4)1 DD& issEN&-te -R-uårcl isjhighbc =Rnieta(2,ix,bl)+1 uå cl (åopo%---o_bc(4,ix,bl)åEQ 1-------s,t� aaaa&.AND.((åopo%bcdef(4)---oA',__aagyybcdef_periodic)-------s,t� aaaa& .AND.(åopo%bcdef(4)---oA',__aagyybcdef_foutspace5p5dl', DD& issEN& N&jhighbc =Rnieta(2,ix,bl)DD& issEN&-te -R-uårcl isDO j=�å y,nnyDDDDDDDDDDDDD oFjåEQ jlowbc(.OR.:jåEQ jhighbc5dl', DD& issEN& N& N&ybc_factor(4)0.5_mkDD& issEN& N&-bs DDDDDDDDDDDDDDDDybc_factor(4)1.0_mkDD& issEN& N&-te -R- uå cl aE� aDO i �å x,nnx uårcl issssIFoF'åEQ ilowbc(.OR.:'åEQ ihighbc5dl', DD& issEN& N& N&&&&xbc_factor(4)0.5_mkDD& issEN& N& N&-bs DDDDDDDDDDDDDDDDåååxbc_factor(4)1.0_mkDD& issEN& N& N&-te -R- uå cl aE� aEEE issEND---------------------------------ginys,max,phys,mis,t�lEm uårcl issss -co!!uolrstrengthinMpnRsrcl issss issEND---------------------------------ginys,max,phys,mis,t�lEm cANTs�cgMODd Ge<htSCAil(lE�ååååååååååstrength =RABS(field_up(i,j,ix,b))�cANTs�cgMODd Ge<htVECinMpnRssssssssss-R(n---_weighting5dl', DD& issEN& N&ååååååstrength =RSQRT(SUM((field_up(1:lda, ,j,ix,b)* -------------------------g-----cutoff_Weights(1:lda))**2)phys,mis,t� aE� a-bs DDDDDDDDDDDDDDDDåååstrength =RSQRT(SUM(field_up(1:lda, ,j,ix,b)**2)phys,mis,t� aE� a-te -R-cA(INd-nMpnRssssssssss-R((strength GT.cutoff(1)).AND.(strength LT.cutoff(2)p5dl', DD& issEN& N& N& N&-'p(4)-'p(+)1 cANTs�cgMODd Ge<htSCAil(lE�åååååååååååååup(inp) =yxbc_factor*ybc_factor*field_up(i,j,ix,b)�cANTs�cgMODd Ge<htVECinMpnRsssssssssssssup(1:lda, np) =yxbc_factor*ybc_factor* -------------------------g-----) ---field_up(1:lda, ,j,ix,b)-cA(INd-nMpnRsssssssssssss-RoFlslave5dl', DcAN s�cgMODd2 Ge<htSCAi88yyyypnRssssssssssssswp(inp) =yxbc_factor*ybc_factor*field_wp(i,j,ix,b)�cANTs�cgMODd2 Ge<htVECi88yyyypnRssssssssssssswp(1:lda2, np) =yxbc_factor*ybc_factor* -------------------------g-----) ----) -field_wp(1:lda2, ,j,ix,b)-cA(INd-nMpnRsssssssssssss-te-R uå FRetut5dl', DD& issEN&&&&&&&&&&&&&xp(1, np) =y uåi-1,mkp*dxD+Rmin_s,t(1,ix,bl)DD& issEN&&&&&&&&&&&&&xp(2, np) =y uåj-1,mkp*dyD+Rmin_s,t(2,ix,bl)DD& issEN&&&&&&&&&&-te -R- uå cl aE� a DD ss Fn---_vol5dl', DD& issEN&&&&&&&&&&&&&vp(inp) =yxbc_factor*ybc_factor-nMpnRsssssssssssss-te-R uå-te-R uå-teå uårcl-teå cA(INd-nMpnRs-te å -nMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Edone-nMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å E�å ooSUBROicstSUBReGmax,t�lE�åop uårrmsh_cre o-__aatCheck-nMgu SUBReGRETUR DD& issSUBRAINSDD& iss----------------i--------!ccoF o-x!--- TEG ss FASSOCIATEDaxpp5dl', DD& issEN& N& FSIZE(xp,1) LT.dim5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug� -------s,t� aaaaaaa aa& '(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa aa& 'leadT.E simension h Ixp&-'sufficibug-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-te-R uå-te-R uå!ccoF o-field_up--- TEG N&-R(--OT.ASSOCIATEDafield_upp5dl', DD& issEN& N&i'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug� -------s,t� aaaaaaa& '(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'field_up empty. Run-(Ecsrmsh_remesh-first.-----ginys,max,phys,mis,t����x,t�l8888hys,mis,tt-te-R cAN s�cgMODd2 Ge<htVECi88yyyypnR-R(lda2 LT. 1) l', DD& issEN& N&i'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug� -------s,t� aaaaaaa& '(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'lda2 must sho>)0.-----ginys,max,phys,mis,t����x,t�l8888hys,mis,tt-te-R cANTs�cgMODd2 Ge<htSCAi88yyyypnR (al-Syyyawp).AND.--OT.al-Syyyafield_wpp5dl', DD& issEN& N&i'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug� -------s,t� aaaaaaa& '(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'field_wpåmust shorRetuugrANTwpåis.-----ginys,max,phys,mis,t����x,t�l8888hys,mis,tt-te-R 88yyyypnR (al-Syyyafield_wpp.AND.--OT.al-Syyyawpp5dl', DD& issEN& N&i'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug� -------s,t� aaaaaaa& '(Ecsrmsh_cre o-__aatCh -------s,t� aaaaaaa& 'wpåmust shorRetuugrANTfield_wpåis.-----ginys,max,phys,mis,t����x,t�l8888hys,mis,tt-te-R cA(INd-n8888 mUBROicstSUBReG-te ----------------iicANTs�cg�s - Ge<http1Dt,Gal-Te----icANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_sss_2d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_ssv_2d�cA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_svs_2d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_svv_2d�cA(INd-cA(INd-cANTs�cgcond Ge<ht3DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_sss_3d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_ssv_3d�cA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_svs_3d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_svv_3d�cA(INd-cA(INd-cA(INd-cANTs�cg�s - Ge<http1Dt,Gal-------icANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dss_2d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dsv_2d�cA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dvs_2d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dvv_2d�cA(INd-cA(INd-cANTs�cgcond Ge<ht3DicANTs�cgMODd Ge<htSCAicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dss_3d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dsv_3d�cA(INd-cANTs�cgMODd Ge<htVECicANTs�cgMODd2 Ge<htSCAi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dvs_3d�cANTs�cgMODd2 Ge<htVECi88yyyy-te -----------(Ecsrmsh_cre o-__aat_dvv_3d�cA(INd-cA(INd-cA(INd-cA(INd-������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/rmsh/(Ecsrmsh_remesh.f�������������������������������������������������������������0000644�0001752�0001753�00000103571�11616003523�020262� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������88yyyy< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå ESubroutine uå:-----s,t� aaaaaaaaaaa(Ecsrmsh_remesh-nMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Copyright (c) 2010 CSE Lab (ETH Zurich)pDMOSAIC Group (ETH Zurich)pD uå EEEEEEEEEEEEEEEEEEECuuger mGOTFluid Dynamics (DTUphys,mis!hys,mis!hys,mis! Tbis file e f_aat erchesParallel P_(-ocl,tM----Libris,p(PPM).hys,mis!hys,mis! PPM e ffout software: you can redistribuolrit(c--/GOTmoINdy�l(lE�å<rit(und!tribupgerms weibupGNU Less!trGenebsl P,blic-LicenseD uå a f_,bli�hed TY;ibupFout Software Fou(Iition, eiL�cg� uå version 3 weibupLicense, GOT(at your option) c-y l o-g� uå version.hys,mis!hys,mis! PPM e fdistribuold-ilsibe hope-tOTO iO n-ou sh useful,hys,mis! buo WITH--- ANY WARRANTY;ån---out evelsibe implied wc) Tnty whys,mis! MERCHANTABILITY GOTFITNESS FOR AdPPMTICULAR PURPOSE. Selr---hys,mis! GNU Genebsl P,blic-LicenseDfGOTmore details.hys,mis!hys,mis! You sh-(PPMhaveEreceived a copy weibupGNU Genebsl P,blic-License uå andeibupGNU Less!trGenebsl P,blic-LicenseDalong-n----PPM. IfMnot,hys,mis! selr<http://www.gnu.org/licenses/>.hys,mis!hys,mis! Parallel P_(-ocl,tM----Libris,p(PPM)hys,mis! ETH Zurich uå CH-8092 Zurich, Sn--zerlc--o88yyyyO issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å -nMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå TODO: uå EHaveEtoTmoINdyyfield_up oo shooptional.-ANTit fnot rRetuugrMlsnåan uå EiugernalEfield is aM oF o-d; Uax,rtun o-ly a littl,tbit eraf_ainIcause uå eibupov!tloadT.E e fnot goT.E oo get(c grip on wOTOs goT.E olsiben.hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å icANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htSCAicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-----------(Ecsrmsh_remesh_ss_2d(åopoidhmeshidhxp,Np,up,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-----------(Ecsrmsh_remesh_ds_2d(åopoidhmeshidhxp,Np,up,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cA(INd-cANTs�cgMODd Ge<htVECicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-----------(Ecsrmsh_remesh_sv_2d(åopoidhmeshidhxp,Np,up,lda,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-----------(Ecsrmsh_remesh_dv_2d(åopoidhmeshidhxp,Np,up,lda,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cA(INd-cA(INd-cANTs�cgcond Ge<ht3DicANTs�cgMODd Ge<htSCAicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-----------(Ecsrmsh_remesh_ss_3d(åopoidhmeshidhxp,Np,up,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-----------(Ecsrmsh_remesh_ds_3d(åopoidhmeshidhxp,Np,up,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cA(INd-cANTs�cgMODd Ge<htVECicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnRs-----------(Ecsrmsh_remesh_sv_3d(åopoidhmeshidhxp,Np,up,lda,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-----------(Ecsrmsh_remesh_dv_3d(åopoidhmeshidhxp,Np,up,lda,kernel, -------------ghostsize,max,,field_up,wx1_user,wx2_user,wx3_user)-cA(INd-cA(INd-cA(INd-ys,mis!!! Tbis routine reco!!uolr-----ewo _(-ocl,s-valu,s,-tOTnks oo-ys,mis!!! cls reco!!uoldåweights...hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eInclud,s uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eModul,s uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåUS--(Ecsmodul,,E__,mustn � US--(Ecsmodul,,aM oFustn � US--(Ecsmodul,,�lE�åee ustn � US--(Ecsmodul,,�lE�åopustn � US--(Ecsmodul,,mapustn � US--(Ecsmodul,,ietaustn � US--(Ecsmodul,,ieta_mesh-nMpnRsUS--(Ecsmodul,,ieta_rmsh-nMpnRsUS--(Ecsmodul,,-----_id-hys,misIMPLICIT NONEiicANTs�cg�s - Ge<http1Dt,Gal-Te----iys,misIOLOGICldPPMAME TE:: MKRK',__Lkind_sT.Ele-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsIOLOGICldPPMAME TE:: MKRK',__Lkind_do,blehcA(INd-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EA--debug.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å uåMK( second ininin,nx-s,t� apDost TEEEEEEEE-eyx!--- TEGEda Posis M weibup _(-ocl,s uåROLOGIC second ininin) -s,t� apDaagyyya::E�å r L�cghostsize--- TEGEda Nls M h Ighostp _(-ocl,s cANTs�cgMODd Ge<htSCAil(lE�å uåMK( second ininin) -s,t� apDost TEEEEEEEE-eyup-ys,mis!!! Tbe c) THcoo shoremesh-d�l(lE�å uåmk) EEEEEEEEEEEEEEEEEEEEEE-eytup-cANTs�cgcond Ge<ht2Dil(lE�å uåMK( second ininin,n,nlE�å)apDost TEEEEEEEE-eyfield_up-cANTs�cgcond Ge<ht3Dil(lE�å uåMK( second ininin,n,n,nlE)apDost TEEEEEEEE-eyfield_up-cA(INd-ys,mis!!! M----on wOich _(-ocl,s-haveEbesnådistribuold-(ANTfieldfnot-ys,mis!!! rRetuug)�cANTs�cgMODd Ge<htVECinMpnRsROLOGIC EEEEEldaagyyyain)EEEEE-eylda-ys,mis!!! LeadT.E simension�l(lE�å uåMK( second ininin,nx-s,t� apDost TEEEEEEEE-eyup-ys,mis!!! Tbe c) THcoo shoremesh-d�l(lE�å uåmk) second ininilda) EEEEEEEEEEEEEEEEEEEEEE-eytup-cANTs�cgcond Ge<ht2Dil(lE�å uåMK( second ininin,n,n,nlE)apDost TEEEEEEEE-eyfield_up-cANTs�cgcond Ge<ht3Dil(lE�å uåMK( second ininin,n,n,n,nx-pDost TEEEEEEEE-eyfield_up-cA(INd-ys,mis!!! M----on wOich _(-ocl,s-haveEbesnådistribuold-(ANTfieldfnot-ys,mis!!! rRetuug)�cA(INd-ys,misROLOGIC EEEEEldaagyyya::E�å r L�cNp--- TEGEda Nls M h I _(-ocl,s-(on pro or)inMpnRsROLOGIC EEEEEldaagyyya::E�å r L�ctopoid--- TEGE!! Topology iduugifie h IåeegutinMpnRsROLOGIC EEEEEldaagyyya::E�å r L�cmeshid--- TEGE!! ID weibupmesh-nMpnRsROLOGIC EEEEEldaagyyya::E�å r L�ckernel--- TEGE!! Choice weibupkernel used co co!!uolr----weights-nMpnRsROLOGIC EEEEEldaagyyya ---)EE-eyinfo-ys,mis!!! Returns 0yupon suc il(lE�å uåMK(, OPTninALsecond ininin,n,n pDDost TEEE-eynx1_user--- TEGE!! INTrRetuug,-tOetuåweights are used,&-'stead whys,mis!!! iugernalEweights-nMpnRs uåMK(, OPTninALsecond ininin,n,n pDDost TEEE-eynx2_user--- TEGE!! INTrRetuug,-tOetuåweights are used,&-'stead whys,mis!!! iugernalEweights-nMpnRs uåMK(, OPTninALsecond ininin,n,n pDDost TEEE-eynx3_user--- TEGE!! INTrRetuug,-tOetuåweights are used,&-'stead whys,mis!!! iugernalEweights-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå ELo----variabl,s uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå uåMK(, cond inini,__Ldim5ddddddddddddd-eylen_phys uå uåMK(, cond ininin,n,nx- apDost TEEE-eynx1 =>DCALL()inMpnRs uåMK(, cond ininin,n,nx- apDost TEEE-eynx2 =>DCALL()inMpnRs uåMK(, cond ininin,n,nx- apDost TEEE-eynx3 =>DCALL()inMpnRs uåMK(, cond inininx-s,t� apDost TEEE-eymin_phys =>DCALL()inMpnRs uåMK(, cond inininx-s,t� apDost TEEE-eymax_phys =>DCALL()inMpnRs uåMK(, cond inini,__Ldim5ddddddddddddd-eydxi,dxil(lE�å uåMK( -eydv1,dv2,dv3,epsilon�l(lE�åROLOGICldecond inini,__Ldim5ddddddddddddd-eyNc�l(lE�åROLOGICldecond inini,__Ldim+2)ddddddddddd-eyldu,ldlil(lE�å uåMK( -eykernel,�lpportinMpnRsROLOGIC EEEEE -ey ,j,k,i ,jj,kk,i dec,linMpnRsROLOGIC EEEEE -eykkdec,ip1,ip2,ip3inMpnRsROLOGIC EEEEE -eynb,�lE,ix,b,dim,n _(-,ix,blinMpnRsROLOGIC EEEEE -ey from,ito,ip,max_p_(--ls M inMpnRsROLOGIC EEEEE -ey _(-,nli�å2,nli�å1inMpnRsROLOGIC EEEEE -eyjjdec,iw://wdom,kkkinMpnRsROLOGIC EEEEE -eynieta1,max,nieta2,maxinMpnRsROLOGIC EEEEE -eynieta3,max,n�lE�/wdim-------ROLOGICldecond inini,__Ldim5ddddddddddddd-eyNm-------ROLOGICldecond ininin,n pDDDDDDost TEEE-eylieta s=>DCALL()inMpnRsROLOGICldecond ininin,n pDDDDDDost TEEE-ey-�å s=>DCALL()inMpnRsROLOGICldecond inini6( -eybcdefinMpnRsLOGICALE EEEEEEEEEEEEEE-eyconsistentinMpnRsROLOGIC EEEEE -eymaptype--- TEGTYPE�� L�t_equismesh)pDost TEEEEEEEEEEE-eypsmeshs=>DCALL()inMpnRsTYPE�� L�t_topo) pDost TEEEEEEEEEEE-eytopo s=>DCALL()inMpnRsLOGICALE EEEEEEEEEEEEEE-eyvalid-cANTcgMODd Ge<htSCAil(lE�åROLOGIC EEEEE -eylda =R1hcA(INd- uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EExgernals uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eInitialize-nMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å nMpnRsmax,t�lE�å uårrmsh_remeshCheck-nMgu hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eTbis is a-hack! Somehow-havT.E oro,ble-n----constructors-ilsibe uå e(Ecsmodul,,ieta_rmsh modul,hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåuårrmsh_kernelsize =R(/1,2,2,4/u hys,misdimRK',__Ldim-------consistentm=c.TRUE.hhys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eCoF o-a--debug.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å oF omusti.N & il', DD& issEN&sENmax,t-----i--------IFoF'R ::---oc_)�x,t�lE�å uå-te-R-hys,mistopo =>D,__Låopo(åopoid)%t uåpsmeshs=>Dåopo%mesh(meshidp hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eGet-i�å �l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå-�å s=>Dpsmesh%i�å ��l(lE�å ( omusti.N & i_5dl', DD& issEN& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCoF o-weights againDD& issEN& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�SELECTNmaSEi,__Ldim5-hys,mis,t�maSEi2phys,mis,t���� (al-Syyyawx1_userp5dl', DD& issEN& N& N& ( N&--OT.ASSOCIATEDawx1_userp.OR.-------------------------OT.ASSOCIATEDawx2_user) 5dl', DD& issEN& N& N& N&-'WORK',__LINE__,E__,mustn � �! LLLLmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ------------------------'cannot remesh-n----empty-weights-----ginys,max,phys,mis,t� EEx,t�lE�å uårcl issss-te -R- uå cl aE� a-te -R-hys,mis,t�maSEi3phys,mis,t���� (al-Syyyawx1_userp5dl', DD& issEN& N& N& ( N&--OT.ASSOCIATEDawx1_userp.OR.-------------------------OT.ASSOCIATEDawx2_user).OR.-------------------------OT.ASSOCIATEDawx3_userp5dl', DD& issEN& N& N& N&-'WORK',__LINE__,E__,mustn � �! LLLLmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ------------------------'cannot remesh-n----empty-weights-----ginys,max,phys,mis,t� EEx,t�lE�å uårcl issss-te -R- uå cl aE� a-te -R-hys,mis,t�-te -ELECT-hys,mis,t�-R(--OT.al-Syyyawx1_userp5dl', DcANTs�cg�s - Ge<http1Dt,Gal-Te----iys,mismis,t�-R(--OT.ASSOCIATEDawx1_sp5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'co!!uolrweights before remeshT.E-----ginys,max,phys,mis,t� x,t�lE�å uårcl is-te -R-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsmis,t�-R(--OT.ASSOCIATEDawx1_dp5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'co!!uolrweights before remeshT.E-----ginys,max,phys,mis,t� x,t�lE�å uårcl is-te -R-cA(INd-nMpnRssss-te -R-uårcl-te -R-�l(lE�å-R(npåEQ _)�x,t�l5555hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eDone-n----A--debugt-----s, do aliasT.E--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å (al-Syyyawx1_userp5dl', DD& issEN&nx1 =>Dnx1_user--- TEGEN&nx2 =>Dnx2_user--- TEGEN& ( omusimåEQ 3)ynx3 =>Dnx3_user--- TEG-bs DcANTs�cg�s - Ge<http1Dt,Gal-Te----iys,mismisnx1 =>Dnx1_s--- TEGEN&nx2 =>Dnx2_s--- TEGEN& ( omusimåEQ 3)ynx3 =>Dnx3_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsmisnx1 =>Dnx1_d--- TEGEN&nx2 =>Dnx2_d--- TEGEN& ( omusimåEQ 3)ynx3 =>Dnx3_d-cA(INd-nMpnRs-te -R-�l5555 mUBROicstSUBReG< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå ESomeTmore aliasT.E.hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uån�lE� 4)åopo%nx,bli�åDDDDDDD!Rnieta(1:dim,1:n�lE�)RK',__Lcaat_mesh(åopoidhmeshid)%nnod,s uålieta s 4>Dpsmesh%nnod,s uåNm(1:dim( =Dpsmesh%Nm-------bcdef(1:2*,__Ldim5ddd4)åopo%bcdef(1:2*,__Ldim5-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EAM oF o- memoryDfGOTfield is�ne ary�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uånieta1,maxd4)MAXVAL(nieta(1,åopo%ix,bli�å(1:n�lE�))phys,misnieta2,maxd4)MAXVAL(nieta(2,åopo%ix,bli�å(1:n�lE�))phys,mis ( omusimåEQ 3)ynieta3,max=MAXVAL(nieta(3,åopo%ix,bli�å(1:n�lE�))phys,mis! WARNp1D:ådistT.Euish-betwesnåsca andevector(aM oF oion�l(lE�å! WARNp1D:ådistT.Euish-betwesnå2d ande3d(aM oF oion!!hys,mis (ASSOCIATEDafield_upp5dl', DD& issEN&----D =Dpp,__aagyy M oF_grow--- TEG-bs DD& issEN&----D =Dpp,__aagyy M oF_fiåDDDDDDD-te -R-cANTs�cgcond Ge<ht3DicANTs�cgMODd Ge<htVECinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EAM oF o M fGOT3DevectorinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåldl���(D =D1 uåldl�2�(D =D1 -cghostsize��� uåldl�3�(D =D1 -cghostsize�2� uåldl�4�(D =D1 -cghostsize�3� uåldl�5�(D =D1 uåldu���(D =Dlda--- TEGldu�2�(D =Dnieta1,maxd+cghostsize��� uåldu�3�(D =Dnieta2,maxd+cghostsize�2� uåldu�4�(D =Dnieta3,maxd+cghostsize�3� uåldu�5�(D =Dn�lE��cANTs�cgMODd Ge<htSCAil(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EAM oF o M fGOT3DescalarinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåldl���(D =D1 -cghostsize��� uåldl�2�(D =D1 -cghostsize�2� uåldl�3�(D =D1 -cghostsize�3� uåldl�4�(D =D1 uåldu���(D =Dnieta1,maxd+cghostsize��� uåldu�2�(D =Dnieta2,maxd+cghostsize�2� uåldu�3�(D =Dnieta3,maxd+cghostsize�3� uåldu�4�(D =Dn�lE��cA(INd-cANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htVECinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EAM oF o M fGOT2DevectorinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåldl���(D =D1 uåldl�2�(D =D1 -cghostsize��� uåldl�3�(D =D1 -cghostsize�2� uåldl�4�(D =D1 uåldu���(D =Dlda--- TEGldu�2�(D =Dnieta1,maxd+cghostsize��� uåldu�3�(D =Dnieta2,maxd+cghostsize�2� uåldu�4�(D =Dn�lE��cANTs�cgMODd Ge<htSCAil(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EAM oF o M fGOT2DevectorinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåldl���(D =D1 -cghostsize��� uåldl�2�(D =D1 -cghostsize�2� uåldl�3�(D =D1 uåldu���(D =Dnieta1,maxd+cghostsize��� uåldu�2�(D =Dnieta2,maxd+cghostsize�2� uåldu�3�(D =Dn�lE��cA(INd-cA(INd-nMpnRsmax,t_s #elifO(field_up,ldl,ldu, w://wnumb�acttpe F'R :---o_5dl', DD& issEN&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_remeshCh ---------------'field_up-----ginys,max,phys,mis,t�x,t�lE�å uå-te -R-hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eInitializer----fieldhys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåfield_up 4)0.0_mkDD& iss-R(npåEQ _)�x,t�lE�å uå! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eRecov!tr _(-ocl, li�å.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å Edont�need co dor--is asr---y are in-(Ecsmodul,,ieta_rmsh---- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLE�l(lE�å EPre co!!uoT.E operation_issEN&sHE��oSUBRO�l(CALL R ::---oc_nMgcheck('R ::---oc_5dl',iHOU,ldl,5,must,ldu ChcAN s�cg�s - Ge<http1Dt,Gal-Te----iys,mismin_phys =>Dåopo%min_phys_issEN&smax_phys =>Dåopo%max_physs-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsmin_phys =>Dåopo%min_physdissEN&smax_phys =>Dåopo%max_physd-cA(INd-nMpnRsDO i =D1,,__Ldim----------Nc(i( =åNm(i)-1DD& issEN&len_phys(i( =smax_phys(i( -smin_phys(i(DD& issEN&dx(i( =ålen_phys(i(/ uåNc(i(,MK) uå-te å -nMpnRsdxi(4)1.0_mk/dxil(lE�ådv1(4)dx(�� uådv2(4)dx(2� uåif( omusimåeq 3)ydv3(4)dx(35-�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå ESå sco!!uoition, takT.E ougrMls select caseDfGOTspeedhys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåSELECTNmaSEikernelphys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rM prime 4hys,mis,t� issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mismaSEi,__L_aagyyrmsh_kernel_mp4phys,mis,t�DO i--- =D1,n�lE�� ms,tl(4)åopo%ix,bli�å(ix,bphys,mis,t�,t�DO ip=1,store_max,(ix,bphys,mis,t�,t� mp1(4)INT((xp(1,li�å_s,t(ix,b,ip))-min_phys(��(-------------------------g--p*dxi(1))+2-i�å (1,ix,bl)DD& issEN&&&&&&&ip2(4)INT((xp(2,li�å_s,t(ix,b,ip))-min_phys(2�(-------------------------g--p*dxi(2))+2-i�å (2,ix,bl)DcANTs�cgcond Ge<ht3Dil(lE�å N&&&&&&&ip3(4)INT((xp(3,li�å_s,t(ix,b,ip))-min_phys(3�(-------------------------g--p*dxi(3))+2-i�å (3,ix,bl)DcA(INd-cANTs�cgMODd Ge<htVECinMpnRsssssssssstup(1:lda( =sup(1:lda,li�å_s,t(ix,b,ip))�cANTs�cgMODd Ge<htSCAil(lE�åssssssssstupssssssss=sup(li�å_s,t(ix,b,ip))�cA(INd-nMpnRssssssssss issEND---------------------------------ginys,max,phys,mis,t�lEm uårcl issss -flipped upside dow fGOT,__-confGOmance-nMpnRssssssssss issEND---------------------------------ginys,max,phys,mis,t�lEm uårcl issssif(ldaåeq 3.and. omusimåeq 3)yiben-cANTs�s�cgcond Ge<ht3Dil(lE�å N&&&&&&&kkdec(4)0 uå isssssssDO kk=ip3-1,ip3+2 uå isssssss&&&kkdec(4)kkdec(+R1hcA(INd- uå clllllllllljjdec(4)0 uå issssssssssDO jj=ip2-1,ip2+2 uå isssssss&&&llljjdec(4)jjdec(+R1h uå isssssss&&&llli dec(4)0 uå isssssssssssssDO ii=ip1-1,ip1+2 uå isssssss&&&lllllli dec(4)i dec(+)1 cANTcgcond Ge<ht3DicANTs�cgMODd Ge<htVECi EEEEEEEEEEEEEEEEEEE --field_up(1:lda, ,jj,kk,ix,bp&i EEEEEEEEEEEEEEEEEEE -------&=field_up(1:lda, ,jj,kk,ix,bp&i EEEEEEEEEEEEEEEEEEE -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i EEEEEEEEEEEEEEEEEEE -------&*wx3(kkdec,ix,b,ip)*tup(1:lda( uå isssssss&&&llllllfield_up(1, ,jj,kk,ix,bp -------------------------g----=field_up(1, ,jj,kk,ix,bp -------------------------g----+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip) -------------------------g----*wx3(kkdec,ix,b,ip)*tup(1( uå isssssss&&&llllllfield_up(2, ,jj,kk,ix,bp -------------------------g----=field_up(2, ,jj,kk,ix,bp -------------------------g----+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip) -------------------------g----*wx3(kkdec,ix,b,ip)*tup(2( uå isssssss&&&llllllfield_up(3, ,jj,kk,ix,bp -------------------------g----=field_up(3, ,jj,kk,ix,bp -------------------------g----+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip) -------------------------g----*wx3(kkdec,ix,b,ip)*tup(35-��cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&llllllfield_up( ,jj,kk,ix,bp=field_up( ,jj,kk,ix,bp -------------------------g----+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip) -------------------------g----*wx3(kkdec,ix,b,ip)*tup�cA(INd-cANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htVECinMpnRssssssssss&&&llllllfield_up(1:lda, ,jj,ix,bp=field_up(1:lda, ,jj,ix,bp -------------------------g----+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip) -------------------------g----*tup(1:lda( cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&llllllfield_up( ,jj,ix,bp=field_up( ,jj,ix,bp -------------------------g----+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip) -------------------------g----*tup�cA(INd-cA(INd-nMpnRssssssssssssssss-te å uårcl L-ssssss-te å cANTscgcond Ge<ht3Dil(lE�å N&&&&&&&-te å cA(INd-nMpnRsssssss-bs -RoFldaåeq 4.and. omusimåeq 3)yiben-cANTs�s�cgcond Ge<ht3Dil(lE�å N&&&&&&&kkdec(4)0 uå isssssssDO kk=ip3-1,ip3+2 uå isssssss&&&kkdec(4)kkdec(+R1hcA(INd- uå clllllllllljjdec(4)0 uå issssssssssDO jj=ip2-1,ip2+2 uå isssssss&&&llljjdec(4)jjdec(+R1h uååååååååååååååååi dec(4)0 uå isssssssssssssDO ii=ip1-1,ip1+2 uå isssssss&&&lllllli dec(4)i dec(+)1 cANTcgcond Ge<ht3DicANTs�cgMODd Ge<htVECi EEEEEEEEEEEEEEEEEEE --field_up(1:lda, ,jj,kk,ix,bp&i EEEEEEEEEEEEEEEEEEE -------&=field_up(1:lda, ,jj,kk,ix,bp&i EEEEEEEEEEEEEEEEEEE -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i EEEEEEEEEEEEEEEEEEE -------&*wx3(kkdec,ix,b,ip)*tup(1:lda( uå isssssss&&&llllllfield_up(1, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&=field_up(1, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- -------&*wx3(kkdec,ix,b,ip)*tup(1( uå isssssss&&&llllllfield_up(2, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&=field_up(2, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- -------&*wx3(kkdec,ix,b,ip)*tup(2( uå isssssss&&&llllllfield_up(3, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&=field_up(3, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- -------&*wx3(kkdec,ix,b,ip)*tup(3( uå isssssss&&&llllllfield_up(4, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&=field_up(4, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- -------&*wx3(kkdec,ix,b,ip)*tup(45-��cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&llllllfield_up( ,jj,kk,ix,bp=field_up( ,jj,kk,ix,bp-------s,t� aaaaaaa aa- -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- -------&*wx3(kkdec,ix,b,ip)*tup�cA(INd-cANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htVECinMpnRssssssssss&&&llllllfield_up(1:lda, ,jj,ix,bp=field_up(1:lda, ,jj,ix,bp&i-----s,t� aaaaaaa aa- ----&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ----&*tup(1:lda( cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&llllllfield_up( ,jj,ix,bp=field_up( ,jj,ix,bp-------s,t� aaaaaaa aa- -------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- -------&*tup�cA(INd-cA(INd-nMpnRssssssssssssssss-te å uårcl L-ssssss-te å cANTscgcond Ge<ht3Dil(lE�å N&&&&&&&-te å cA(INd-nMpnRsssssss-bs -cANTs�s�cgcond Ge<ht3Dil(lE�å N&&&&&&kkdec(4)0 uå issssssDO kk=ip3-1,ip3+2 uå isssssss&&kkdec(4)kkdec(+R1h-cA(INd-nMpnRssssssssssssjjdec(4)0 uå isssssssssDO jj=ip2-1,ip2+2 uå isssssss&&&lljjdec(4)jjdec(+R1h uåååååååååååååååi dec(4)0 uå issssssssssssDO ii=ip1-1,ip1+2 uå isssssss&&&llllli dec(4)i dec(+)1 cANTcgcond Ge<ht3DicANTs�cgMODd Ge<htVECi uå isssssss&&&lllllDO l=1,lda--- TEGGGGGGGGGGGGGGGGGGGGGfield_up(l, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- ---------&=field_up(l, ,jj,kk,ix,bp-------s,t� aaaaaaa aa- ---------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ---------&*wx3(kkdec,ix,b,ip)*tup(l)DD& issEN&&&&&&&&&&&&&&&-te å -cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&lllllfield_up( ,jj,kk,ix,bp=field_up( ,jj,kk,ix,bp-------s,t� aaaaaaa aa- ------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ------&*wx3(kkdec,ix,b,ip)*tup�cA(INd-cANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htVECinMpnRssssssssss&&&lllllfield_up(1:lda, ,jj,ix,bp=field_up(1:lda, ,jj,ix,bp&i-----s,t� aaaaaaa aa- ---&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ---&*tup(1:lda( cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&lllllfield_up( ,jj,ix,bp=field_up( ,jj,ix,bp-------s,t� aaaaaaa aa- ------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ------&*tup�cA(INd-cA(INd-nMpnRsssssssssssssss-te å uårcl L-sssss-te å cANTscgcond Ge<ht3Dil(lE�å N&&&&&&-te å cA(INd-nMpnRssssss-te -R- uå cl aE� -te å uårc-te å uårc! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE uårc! BS2 uårc! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE uåmaSEi,__L_aagyyrmsh_kernel_bsp2( uå iDO i--- =D1,n�lE�� ms,tl(4)åopo%ix,bli�å(ix,bphys,mis,t�,tDO ip=1,store_max,(ix,bphys,mis,t�,t� mp1(4)INT((xp(1,li�å_s,t(ix,b,ip))-min_phys(��&i-----s,t� aaaaaaa a&p*dxi(1))+2-i�å (1,ix,bl)DD& issEN&&&&&&ip2(4)INT((xp(2,li�å_s,t(ix,b,ip))-min_phys(2�&i-----s,t� aaaaaaa a&p*dxi(2))+2-i�å (2,ix,bl)DcANTs�cgcond Ge<ht3Dil(lE�å N&&&&&&ip3(4)INT((xp(3,li�å_s,t(ix,b,ip))-min_phys(3�&i-----s,t� aaaaaaa a&p*dxi(3))+2-i�å (3,ix,bl)DcA(INd-s,t� aaaaaaa a! issEND---------------------------------ginys,max,phys,mis,t�lEma-s,t� aaaaaaa a! -flipped upside dow fGOT,__-confGOmance-nMpnRsssssssss! issEND---------------------------------ginys,max,phys,mis,t�lEma-cANTs�s�cgcond Ge<ht3Dil(lE�å N&&&&&&kkdec(4)0 uå issssssDO kk=ip3,ip3+1i-----s,t� aaaaaaakkdec(4)kkdec(+R1hcA(INd- uå cllllllllljjdec(4)0 uå isssssssssDO jj=ip2,ip2+1i-----s,t� aaaaaaa lljjdec(4)jjdec(+R1h uåååååååååååååååi dec(4)0 uå issssssssssssDO ii=ip1,ip1+1i-----s,t� aaaaaaa ll lli dec(4)i dec(+)1 cANTcgcond Ge<ht3DicANTs�cgMODd Ge<htVECi uå isssssss&&&lllllfield_up(1:lda, ,jj,kk,ix,bp&i uå isssssss&&&llllllllll&=field_up(1:lda, ,jj,kk,ix,bp&i uå isssssss&&&llllllllll&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ------&*wx3(kkdec,ix,b,ip)*up(1:lda,li�å_s,t(ix,b,ip))�cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&lllllfield_up( ,jj,kk,ix,bp=field_up( ,jj,kk,ix,bp-------s,t� aaaaaaa aa- ------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ------&*wx3(kkdec,ix,b,ip)*up(li�å_s,t(ix,b,ip))�cA(INd-cANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htVECinMpnRssssssssss&&&lllllfield_up(1:lda, ,jj,ix,bp=field_up(1:lda, ,jj,ix,bp&i-----s,t� aaaaaaa aa- ------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ------&*up(1:lda,li�å_s,t(ix,b,ip))�cANTs�cgMODd Ge<htSCAil(lE�åsssssssss&&&lllllfield_up( ,jj,ix,bp=field_up( ,jj,ix,bp-------s,t� aaaaaaa aa- ------&+wx1(i dec,ix,b,ip)*wx2(jjdec,ix,b,ip)&i-----s,t� aaaaaaa aa- ------&*up(li�å_s,t(ix,b,ip))�cA(INd-cA(INd-nMpnRsssssssssssssss-te å uårcl L-sssss-te å cANTscgcond Ge<ht3Dil(lE�å N&&&&&&-te å cA(INd-nMpnRssssss-te å uårc-te å uå-te -ELECT-hys,mis< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå ENowymaprMls ghosts in-ord!trio get(consistentmvalu,s agrMls bord!tr whys,mis! rMls subdomains.hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å hys,mismax,t_s #map_field_ghost_put(åopoidhmeshidhghostsize,max,b�acttpe oF'R ::---oc_)�x,t�lE�å cANTs�cgMODd Ge<htSCAil(lE�åmax,t_s #map_field_push(åopoidhmeshid,field_up,max,b�cANTs�cgMODd Ge<htVECinMpnRsmax,t_s #map_field_push(åopoidhmeshid,field_up,lda, nx,b�cA(INd-ys,misR oF'R ::---oc_)�x,t�lE�å nMpnRsmax,t_s #map_field_sA(I(max,b�acttpe oF'R ::---oc_)�x,t�lE�å cANTs�cgMODd Ge<htSCAil(lE�åmax,t_s #map_field_pop(åopoidhmeshid,field_up,ghostsize,max,b�cANTs�cgMODd Ge<htVECinMpnRsmax,t_s #map_field_pop(åopoidhmeshid,field_up,lda,ghostsize,max,b�cA(INd-�l(lE�! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eReturn�l(lE�! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uE�å omUBROicstSUBRemax,t�lE�åop uårrmsh_remeshCheck-nMgu SUBReRETUR DD& issSUBRAINSDD& iss----------------i-------- ( omusimåEQ 3)yl', DD& issEN& N& F N&(al-Syyyawx1_userp5.AND.--------------------(al-Syyyawx2_userp5.AND.--------------------(al-Syyyawx3_userp55dl', DD& issEN& N& N&consistentm=c.TRUE.hissEN& N& N&-bs -R(al-Syyyawx1_userp.AND.(--OT.(al-Syyyawx2_userp5p.AND. ------------------(--OT.(al-Syyyawx3_userp555dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'Dnx2_user GOTwx3_userrweights lackT.E-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-bs -R(al-Syyyawx2_userp.AND.(--OT.(al-Syyyawx3_userp5p.AND. -----------------(--OT.(al-Syyyawx1_userp555dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'Dnx1_user GOTwx3_userrweights lackT.E-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-bs -R(al-Syyyawx3_userp.AND.(--OT.(al-Syyyawx1_userp5p.AND. -----------------(--OT.(al-Syyyawx2_userp555dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'Dnx1_user GOTwx2_userrweights lackT.E-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-te-R 88yyyypnR-bs DD& issEN&�å (al-Syyyawx3_userp5dl', DD& issEN& N& N& issEND---------------------------------ginys,max,phys,mis,t�lEm uårcl issss -WeEdont�care,ymaybe e sue a wc)nT.E..DD& issEN& N& N& issEND---------------------------------ginys,max,phys,mis,t�lEm uårcl is-bs -RoFal-Syyyawx1_userp.AND.--OT.al-Syyyawx2_userp5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'wx2_userrnot �lpplied-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-bs -R-(al-Syyyawx2_userp.AND.--OT.al-Syyyawx1_userp5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'wx1_userrnot �lpplied-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-te-R 88yyyypnR-te-R-hys,mis N& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCoF o-a--debug.--- TEG N& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�-R-(Np & il', DD& issEN&sENs,t�-R-(SIZE(xp,2) .L ilNp5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'not enough _(-ocl,s-containld-ilsxp-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-te-R 88yyyypnR,t�-R-(SIZE(xp,1) .L il,__Ldim5dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'leadT.E simension wexp&-'sufficibug-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-te-R 88yyyypnR-te-R-yyypnR,t�-R-(Np LEil', DD& issEN&sENs,t�-R-(Np L il', DD& issEN&sENs,t� N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------' _(-ocl,s-must shospecified-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-te -R- uå cl aE� ax,t�l8888hys,mis,tt-te-R-hys,mis N& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcCoF o-Ts�kernel is impleebuged--- TEG N& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�-R-(ikernel L i1).OR.ikernel & i4p5dl', DD& issEN& N&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ------------------'wrong-kernel definis M -----ginys,max,phys,mis,t� x,t�l8888hys,mis,tt-te-R-hys,mis N& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcTbis can nev!trhappen,-ANTitEdoesrMlsnåMls libris,pis si--i--------& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�kernel,�lpportRK',__Lrmsh_kernelsizeikernelp*2 uårc!kernel,�lpportRK',__Lrmsh_kernelsizeikernelp*2 uårc!-R-(--OT.((kernel,�lpportåEQ 2).OR.ikernel,�lpportåEQ 4) -------,t�rc-----.OR.ikernel,�lpportåEQ 6555dl', DD& issEN! N&-'WORK',__LINE__,E__,mustn � �!! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh -------,t�rc------------'wrong-kernel �lpport-----ginys,max,phys,mis,t! x,t�l8888hys,mis,t!-te -R-hys,mis,t�-R-(SIZE(up) L iNp5dl', DD& issEN& N&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh -----------------'wrong-up c) THcsize-----ginys,max,phys,mis,t� x,t�l8888hys,mis,tt-te-R-ys,mis,tt issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�rcTbis is aMso wrong: Ghostsize can b,tbigger...DD& issEN& issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis,t�DO isim=1,dim----------!,t�-R-(ghostsize�isim)---o,__Lrmsh_kernelsizeikernelp5dl', DD& issEN&EN& N&-'WORK',__LINE__,E__,mustn � �! !�! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ------- �! !�! -----------'wrong-size h Ighostsize-----ginys,max,phys,mis,t�!,t� x,t�l8888hys,mis,tt! tt-te -R- uå cl aE!-te å uårclDO isim=1,dim----------,t�-R-(ghostsize�isim)-L i(,__Lrmsh_kernelsizeikernelp-155dl', DD& issEN& N& N&-'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'ghostsize too small fGOT--is kernel-----ginys,max,phys,mis,t� x,t�l8888hys,mis,ttttt-te-R 88yyyypnR-teå uårclmax,t_s #-----_åopoid(åopoidhvalid,max,phys,mis,t�-R-(--OT.yvalid5dl', DD& issEN& N& -'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_remeshCh ---------------------'åopoidfnot rointT.E oo ayvalid)åopology-----ginys,max,phys,mis,t� x,t�l8888hys,mis,tt-te-R-yyypnR,t�-R-(meshid & il,__Låopo(åopoid)%t%max_meshid)dl', DD& issEN& N&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh,remeshCh -------------------'meshid is invalid-----ginys,max,phys,mis,t� x,t�l8888hys,mis,t-te-R-hy8888 mUBROicstSUBReG-te ----------------icANTs�cgcond Ge<ht2DicANTs�cgMODd Ge<htSCAicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnR-te -----------(Ecsrmsh_remesh_ss_2d-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnR-te -----------(Ecsrmsh_remesh_ds_2d-cA(INd-cANTs�cgMODd Ge<htVECicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnR-te -----------(Ecsrmsh_remesh_sv_2d-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnR-te -----------(Ecsrmsh_remesh_dv_2d-cA(INd-cA(INd-cANTs�cgcond Ge<ht3DicANTs�cgMODd Ge<htSCAicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnR-te -----------(Ecsrmsh_remesh_ss_3d-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnR-te -----------(Ecsrmsh_remesh_ds_3d-cA(INd-cANTs�cgMODd Ge<htVECicANTs�cg�s - Ge<http1Dt,Gal-Te----inMpnR-te -----------(Ecsrmsh_remesh_sv_3d-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnR-te -----------(Ecsrmsh_remesh_dv_3d-cA(INd-cA(INd-cA(INd-���������������������������������������������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/rmsh/(Ecsrmsh_co!!_weights.f�������������������������������������������������������0000644�0001752�0001753�00000112272�11616003523�021465� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SUBReG< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå EEEESubroutine :-----------------uåuårrmsh_co!!_weights SUBReG< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Copyright (c) 2010 CSE Lab (ETH Zurich)pDMOSAIC Group (ETH Zurich)pD uå EEEEEEEEEEEEEEEEEEECbuger fGOTFluid Dynamics (DTUphys,mis!hys,mis!hys,mis!cTbis file e _(- weibupParallel P_(-ocl, M----Libris,p(PPM).hys,mis!hys,mis!cPPM e free software: you can redistribuolTitEand/GOTmoINdy�l(lE�å<TitEund!tribupgerms weibupGNU LesserrGeneral P,blic-LicenseD uå a ,bli�hed byeibupFree Software Founietion, eiiburD uå version 3 weibupLicense, GOT(at your option)Eany laturD uå version.hys,mis!hys,mis!cPPM e distribuold-ilsibe hoper--at itEwill be useful,hys,mis!cbuo WITH--- ANY WARRANTY;-n---ougrevsnåMls implild-wc) Tntyr whys,mis! MERCHANTABILITY GOTFITNESS FOR AdPPMTICULAR PURPOSE. Seesibe uå GNU General P,blic-LicenseDfGOTmore details.hys,mis!hys,mis!cYou s-ould-haveEreceivld-a copy weibupGNU General P,blic-License uå andeibupGNU LesserrGeneral P,blic-LicenseDalong-n----PPM. INTnot,hys,mis!csees<http://www.gnu.org/licenses/>.hys,mis!hys,mis!cParallel P_(-ocl, M----Libris,p(PPM)hys,mis!cETH Zurich uå CH-8092 Zurich, Sn--zerland SUBReG< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å hcAN s�cg�s - Ge<http1Dt,Gal-Te----iys,mis-----------(Ecsrmsh_co!!_weights_s(åopoidhmeshid,xp,Np,kernel,max,h -------------------------------------------wx1_user,wx2_user,wx3_userp-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-----------(Ecsrmsh_co!!_weights_d(åopoidhmeshid,xp,Np,kernel,max,h -------------------------------------------wx1_user,wx2_user,wx3_userp-cA(INd-ys,mis!!! Tbis routine co!!uolsr----weights weibup _(-ocl,s ys,mis!!! wOich need co shoremesh-d-ils2D.hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eINCLUDES SUBReG< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå eModul,s SUBReG< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uåUSE-(Ecsmodul,,E__,mustn � USE-(Ecsmodul,,F BROustn � USE-(Ecsmodul,,slE�å ustn � USE-(Ecsmodul,,slE�åopustn � USE-(Ecsmodul,,ietaustn � USE-(Ecsmodul,,ieta_mesh-nMpnRsUSE-(Ecsmodul,,ieta_rmsh-nMpnRsUSE-(Ecsmodul,,write-nMpnRsUSE-(Ecsmodul,,util_time-nMpnRsUSE-(Ecsmodul,,-----_id--- TEGIMPLICIT NONE hcAN s�cg�s - Ge<http1Dt,Gal-Te----iys,misROLOGICldPPMAME TE:: MKRK',__Lkind_sT.Ele-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsROLOGICldPPMAME TE:: MKRK',__Lkind_do,blehcA(INd- uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå A--debug.--- TEGE----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uårGLEå uå uåMK(, cond ininin,nx- aaaaapDost TEEEEEEE:: xp ys,mis!!! P_(-ocl, position_issEN&sROLOGIC EEEEldaagyyya::E�å r-eyNp ys,mis!!! Nls M we _(-ocl,s ys,misROLOGIC EEEEldaagyyya::E�å r-eyåopoid-ys,mis!!! Topology idbugifie weå getinMpnRsROLOGIC EEEEldaagyyya::E�å r-eymeshid-ys,mis!!! ID weibupmesh-nMpnRsROLOGIC EEEEldaagyyya::E�å r-eykernel-ys,mis!!! Choice weibupkernel used co co!!uolr----weights.-nMpnRsROLOGIC EEEEldaagyyya --- r-eymax,-ys,mis!!! Returns 0 upon suc uå uåMK(, OPTninALsecond ininin,n,n pDost TEE-eynx1_user--- TEGE!! INTrRetuug,-tOis routine doesrnothT.E, shcause-tOetu ys,mis!!! weights are used afger fGOTremeshT.E uå uåMK(, OPTninALsecond ininin,n,n pDost TEE-eynx2_user--- TEGE!! INTrRetuug,-tOis routine doesrnothT.E, shcause-tOetu ys,mis!!! weights are used afger fGOTremeshT.E uå uåMK(, OPTninALsecond ininin,n,n pDost TEE-eynx3_user--- TEGE!! INTrRetuug,-tOis routine doesrnothT.E, shcause-tOetu ys,mis!!! weights are used afger fGOTremeshT.E - uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå Local variabl,s SUBReG< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å-inMpnRsROLOGICld cond ininin,nx- aaapDost TE-ey-�å s s=>DCALL()inMpnRsROLOGICldecond inininx- aaaaapDost TE-ey-li�å1s s=>DCALL()inMpnRsROLOGICldecond inininx- aaaaapDost TE-ey-li�å2s s=>DCALL()inMpnRs uåMK(, cond inininx- aaaaapDost TE-eymin_phys =>DCALL()inMpnRs uåMK(, cond inininx- aaaaapDost TE-eymax_phys =>DCALL()inMpnRs uåMK(, econd inini,__Ldim5ddddddddddd-eydxi,dxil(lE�å uåMK(, econd inini,__Ldim5ddddddddddd-eylen_physil(lE�å uåMK( :: x1,x2,x3,epsilon�l(lE�åROLOGIC EEEEE -eykernel,�lpportinMpnRsROLOGICldecond inini,__Ldim+2)EE -eyldu,ldlinMpnRsROLOGICldecond inini,__Ldim5ddddddddddd-eyNc�l(lE�åROLOGIC EEEEE -eyi,j,k, ,jj,kk,i dec�l(lE�åROLOGIC EEEEE -eyjjdec,nb,slE,n _(-, _(-�l(lE�åROLOGIC EEEEE -eykkdec,ip1,nbpt_z,nli�å1�l(lE�åROLOGIC EEEEE -eyip2,ip3,nbpt_x,nbpt_y,iface-nMpnRsROLOGIC EEEEE -eyix,b,ifrom,ito,ip, w://wx,bl-nMpnRsROLOGIC EEEEE -eymax_p_(-nls M ,idom,nli�å2,idomlinMpnRsROLOGICldcond inini1( -eyldainMpnRsROLOGICldcond inini,__Ldim5dddddddddddd-eyNm-nMpnRsROLOGIC EEEEE -eyn�lE�� ROLOGICldcond inini6( -eybcdef� LOGICALE EEEEEEEEEEEE-eymagernal_weights SUBReG< aliasesil(lE�å uåmk(, cond ininin,nx,l(lE�åost TE-eymin_--- =>DCALL()inMpnRs uåmk(, cond ininin,nx,l(lE�åost TE-eymax_--- =>DCALL()inMpnRs uåMK(, cond ininin,n,nx- apDost TE-eynx1 =>DCALL()inMpnRs uåMK(, cond ininin,n,nx- apDost TE-eynx2 =>DCALL()inMpnRs uåMK(, cond ininin,n,nx- apDost TE-eynx3 =>DCALL()inMpnRs uåmk( EEEEEEEEEEEE-eymyepsinMpnRs uåmk( EEEEEEEEEEEE-eytim1s,ytim1e-nMpnRsCHPMAC T(len=256( EEE-eymsg� LOGICALE EEEEEEEEEEEE-eyvalid� TYPEi,__Lt_equi_mesh)pDost TEEEEEEEEE-eypsmeshs =>DCALL()inMpnRsTYPEi,__Lt_åopox- aaapDost TEEEEEEEEE-eytopo s =>DCALL()i - uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå eInitialis,hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å-i - uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå eTbis is a hack!ESomehow-havT.E oro,ble-n----constructors-ilsibe uå e(Ecsmodul,,ieta_rmsh modul,- uå< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå,__Lrmsh_kernelsize = (/1,2,2,4/5-�l(lE�åCALLIFYawx1,wx2,wx3) nMpnRsmax,tslE�å uårrmsh_co!!_weightsCheck-nMgu nMpnRsmagernal_weightsm=c.FALSE.��l(lE�å ( omusimåEQ 3)yl', DD& issEN-R(al-Syyyawx1_userp.AND.(--OT.(al-Syyyawx2_userp5p.AND. ---------------&-(--OT.(al-Syyyawx3_userp555dl', DD& issEN& N-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------&--'Dnx2_user GOTwx3_userrweights lackT.E-----ginys,max,phys,mis,t� x,t�lE�å uårc-bs -R(al-Syyyawx2_userp.AND.(--OT.(al-Syyyawx3_userp5p.AND. ---------------&-(--OT.(al-Syyyawx1_userp555dl', DD& issEN& N-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------&--'Dnx1_user GOTwx3_userrweights lackT.E-----ginys,max,phys,mis,t� x,t�lE�å uårc-bs -R(al-Syyyawx3_userp.AND.(--OT.(al-Syyyawx1_userp5p.AND. ---------------&-(--OT.(al-Syyyawx2_userp555dl', DD& issEN& N-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------&--'Dnx1_user GOTwx2_userrweights lackT.E-----ginys,max,phys,mis,t� x,t�lE�å uårc-te -R-uårcl-bs -R-( omusimåEQ 2)yl', DD& issEN-R(al-Syyyawx1_userp.AND.(--OT.al-Syyyawx2_userp5.OR.---------------&al-Syyyawx2_userp.AND.(--OT.al-Syyyawx1_userp5pdl', DD& issEN& N-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------&--'aTwx_userrc) THcis missT.E-----ginys,max,phys,mis,t� x,t�lE�å uårc-te -R-uårcl-te -R-hys,mi! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eCoF o-a--debug.--- TE< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å-inMpnRsRR-( omusebug & il', DD& issEN&sENmax,t-----i-------- oF'R ::---oc_)�x,t�lE�å uårcl-te-R-hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå eCoF o-meshid andeiopoidfvalidity�l(lE�å< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å-inMpnRsRR-( omusebug & il', DD& issEN&sENlmax,t_s #-----_åopoid(åopoidhvalid,max,phys,mis,t�-R-(--OT.yvalid5dl', DD& issEN& N& -'WORK',__LINE__,E__,mustn � �! Lmax,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ---------------------'åopoidfnot rointT.E oo ayvalid)åopology-----ginys,max,phys,mis,t� x,t�lE�å uårct-te-R-yyypnR,t�-R-(meshid & il,__Låopo(åopoid)%t%max_meshid)dl', DD& issEN& N&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh -------------------'mesh_id is invalid-----ginys,max,phys,mis,t� x,t�lE�å uårc-te-R-uårcl-te-R-uårcltopo 4>Dp__Låopo(åopoid)%t uå,smeshs=>Dåopo%mesh(meshid)hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå eGety-�å hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå-�å s=>psmesh%-�å hhys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå eAssTgnebug weibupusefulrc) THs/scalarinMpnRs< issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uåNm(1:,__Ldim5d=Dpsmesh%Nm-------bcdef(1:(2*,__Ldim5)d4)åopo%bcdef(1:(2*,__Ldim5)-------n�lE�d4)åopo%nx,bli�åhhys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå eA BRO memoryDfGOT _(-ocl, li�å.--- TEGE eTbe awesomet_s #elifOEwill (re)aM oF o- ibum, so weEdont�need an inis--- TEGE eor(a finalizerroutine.hys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uå----D =Dpp,__aagyy M oF_fiåDDDDDDDldu���(=yNp ys,mismax,t_s #elifO(-li�å1,ldu, w://wnumb�acttpe oF'R ::---oc_)�l', DD& issE-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_co!!_weightsCh -----------------------' _(-ocl, li�å 1 ILIST1-----ginys,max,phys,mis,x,t�lE�å uårcl-te-R-ys,mismax,t_s #elifO(-li�å2,ldu, w://wnumb�acttpe oF'R ::---oc_)�l', DD& issE-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_co!!_weightsCh -----------------------' _(-ocl, li�å 2 ILIST2-----ginys,max,phys,mis,x,t�lE�å uårcl-te-R- uå----D =Dpp,__aagyy M oF_fiåDDDDDDDldu���(=yn�lE�� max,t_s #elifO(store_max,,ldu, w://wnumb�acttpe oF'R ::---oc_)�l', DD& issE&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_co!!_weightsCh ----------------------- 'store_max, aM oF o M : problem-----ginys,max,phys,mis,tx,t�lE�å uårcl-te-R- u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eM----spacT.E u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå cAN s�cg�s - Ge<http1Dt,Gal-Te----iys,mismin_phys =>Dåopo%min_phys_issEN&smax_phys =>Dåopo%max_physs-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsmin_phys =>Dåopo%min_physdissEN&smax_phys =>Dåopo%max_physd-cA(INd-issEN&sDO i =D1,,__Ldim---------Nc(i( =åNm(i) - 1i-----s,tlen_phys(i( =smax_phys(i( -smin_phys(i(DD& issENdx(i( =ålen_phys(i(/ uåNc(i(,MK) uå-teå uådxi( =å1.0_mk/dxil(lE�åepsilon 4)0.000001_mkD u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eInitializer---- _(-ocl, li�å u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå unli�å1s s (4)0 ustore_max, 4)0 sEN&sDO i _(-=1,Np ys,mis unli�å1s s ( s (4)nli�å1s+ 1i-----s,t-li�å1(nli�å1( =s _(-�l(lE�-teå cAN s�cg�s - Ge<http1Dt,Gal-Te----iys,mimyepsRK',__Lmyeps_issEN&min_--- =>Dåopo%min_�lE�� max_--- =>Dåopo%max_slE��cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRmyepsRK',__LmyepsdissEN&min_--- =>Dåopo%min_�lEd� max_--- =>Dåopo%max_slEd�cA(INd-�l(lE�! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eLoop ov!trMls subdomains (sincer----firstEdomains are mostElikely u eco shoempty, weElook backwardseco reducer----nls M weeleebugs in u enli�å2 a fastEa ossTble)�l(lE�! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uDO isomd4)åopo%nx,bli�å,1,-1DD& issENidoml(4)åopo%ix,bli�å(idomphys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u u eLoop ov!trMls remainT.E _(-ocl,s ys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u unli�å2 4)0 uå in _(- 4)0 uå iDO i=1,nli�å1�l(lE�åissENi _(- 4)-li�å1(iphys,mis,t� !sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lEhys,mis,t� ! INT---- _(-ocl, is inside ----currbug subdomain,Ea sTgn iåDDDDDDD,t� !sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lEhys,mis,t� ( omusimåEQ 3)yl', DD& issEN& N& !sEND---------------------------------ginys,max,phys,mis,t�lEmax,tDD& issEN& N& !T---- _(-ocl, is in ----closure weibupsubdomainDD& issEN& N& !sEND---------------------------------ginys,max,phys,mis,t�lEmax,tDD& issEN& N& F ( xp(1,i _(-).GE.min_�lE(1,idoml) .AND. ---------------------&xp(2,i _(-).GE.min_�lE(2,idoml) .AND. ---------------------&xp(3,i _(-).GE.min_�lE(3,idoml) .AND. ---------------------&xp(1,i _(-).LE.max_slE(1,idoml) .AND. ---------------------&xp(2,i _(-).LE.max_slE(2,idoml) .AND. ---------------------&xp(3,i _(-).LE.max_slE(3,idoml) ) ) l', D------------------ F (xp(1,i _(-).LT.max_slE(1,idoml) .OR. ------------------------& (åopo%slE�_bc(2,idoml)åEQ 1s s.AND. ------------------------& bcdef(2)---oDpp,__aagyybcdef_periodicp5.AND.------------------------&(xp(2,i _(-).LT.max_slE(2,idoml) .OR. ------------------------& (åopo%slE�_bc(4,idoml)åEQ 1s s.AND. ------------------------& bcdef(4)---oDpp,__aagyybcdef_periodicp5.AND.------------------------&(xp(3,i _(-).LT.max_slE(3,idoml) .OR. ------------------------& (åopo%slE�_bc(6,idoml)åEQ 1s s.AND. ------------------------& bcdef(6)---oDpp,__aagyybcdef_periodicp5 ) l', D------------------ in _(- 4)n _(- + 1i-----s,tttttttttttttstore_max,(idomp 4)n _(-i-----s,tttttttttt-bs DD& issEN&�å------ inli�å2s sssssss=inli�å2s+ 1i-----s,ttttttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,tttttttttt-te-R 88yyyypnR,t�tt-bs DD& issEN&�å------nli�å2s sssssss=inli�å2s+ 1i-----s,tttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,ttttttt-te -R- uå cl aE� -bs -R-( omusimåEQ 2)yl', DDD& issEN& N& F ( xp(1,i _(-).GE.min_�lE(1,idoml) .AND. ---------------------&xp(2,i _(-).GE.min_�lE(2,idoml) .AND. ---------------------&xp(1,i _(-).LE.max_slE(1,idoml) .AND. ---------------------&xp(2,i _(-).LE.max_slE(2,idoml) ) ) l', D------------------ F (xp(1,i _(-).LT.max_slE(1,idoml) .OR. ------------------------& (åopo%slE�_bc(2,idoml)åEQ 1s s.AND. ------------------------& bcdef(2)---oDpp,__aagyybcdef_periodicp5.AND.------------------------&(xp(2,i _(-).LT.max_slE(2,idoml) .OR. ------------------------& (åopo%slE�_bc(4,idoml)åEQ 1s s.AND. ------------------------& bcdef(4)---oDpp,__aagyybcdef_periodicp5) l', D------------------ in _(- 4)n _(- + 1i-----s,tttttttttttttstore_max,(idomp 4)n _(-i-----s,tttttttttt-bs DD& issEN&�å------ inli�å2s sssssss=inli�å2s+ 1i-----s,ttttttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,tttttttttt-te-R 88yyyypnR,t�tt-bs DD& issEN&�å--- inli�å2s sssssss=inli�å2s+ 1i-----s,tttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,ttttttt-te -R- uå cl aE� -te -R- uå cl a-te å uårc! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE uårc! CopyåMls lists (well, only-ANTnli�å2schanged - decreasedphys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u u-R-(nli�å2---onli�å1( l', DD& issEN& Nnli�å1s=inli�å2DD& issEN& NDO i=1,nli�å1�l(lE�åissEN )-li�å1(ip 4)-li�å2(iphys,mis,t� -teå uårc-te-R-hys,mis N! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE uårc! Exit-ANTMls list is emptyhys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u u-R-(nli�å1åEQ 0) EXIT�l(lE�-te å uå! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eCoF o---at we sold aM eibup _(-ocl,s ys,mi! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u-R-(nli�å2-GT._)�l', DD& issE&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsI _(-_una s�l(Ecsrmsh_co!!_weightsCh -----------------------'MAJOR PROBLEM-----ginys,max,phys,mis,tx,t�lE�å uårc-te-R- u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u selectT---- _(-ocl, fGOTn----sev!talEdomain co!!uo o M (frbuch)�l(lE�! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå � max_p_(-nls M 4)0 uDO isom=1,åopo%nx,bli�åh u u-R(store_max,(idomp.GE.max_p_(-nls M ( l', DD& issEN& Nmax_p_(-nls M 4)store_max,(idomp- uå cl a-te -R- uå c-te å uå----D =Dpp,__aagyy M oF_fiåDDDDDDldu���(=yåopo%nx,bli�åh uldu�2( =smax_p_(-nls M � max,t_s #elifO(li�å_s,t,ldu, w://wnumb�acttp-R(wnum---o_)�l', DD& issE&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsIF BRO�l(Ecsrmsh_co!!_weightsCh ----------------'problem in magernal aM oF o M -----ginys,max,phys,mis,tx,t�lE�å uårc-te -R-hys,mili�å_s,t=0D u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eInitializer---- _(-ocl, li�å u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå unli�å1s s (4)0 uDO i _(-=1,Np ys,mis unli�å1s s ( s (4)nli�å1s+ 1i-----s,t-li�å1(nli�å1( =s _(-�l(lE�-teå �l(lE�! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eLoop ov!trMls subdomains (sincer----firstEdomains are mostElikely u eco shoempty, weElook backwardseco reducer----nls M weeleebugs in u enli�å2 a fastEa ossTble)�l(lE�! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå uDO isomd4)åopo%nx,bli�å,1,-1DD& issENidoml(4)åopo%ix,bli�å(idomphys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u u eloop ov!trMls remainT.E _(-ocl,s ys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u unli�å2 4)0 uå in _(- 4)0 uå iDO i=1,nli�å1�l(lE�åissENi _(- 4)-li�å1(iphhys,mis,t� !sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lEhys,mis,t� ! INT---- _(-ocl, is inside ----currbug subdomain,Ea sTgn iåDDDDDDD,t� !sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lEhys,mis,t� ( omusimåEQ 3)yl', DD& issEN& N& F ( xp(1,i _(-).GE.min_�lE(1,idoml) .AND. ---------------------&xp(2,i _(-).GE.min_�lE(2,idoml) .AND. ---------------------&xp(3,i _(-).GE.min_�lE(3,idoml) .AND. ---------------------&xp(1,i _(-).LE.max_slE(1,idoml) .AND. ---------------------&xp(2,i _(-).LE.max_slE(2,idoml) .AND. ---------------------&xp(3,i _(-).LE.max_slE(3,idoml) ) ) l', D------------------ F (xp(1,i _(-).LT.max_slE(1,idoml) .OR. ------------------------& (åopo%slE�_bc(2,idoml)åEQ 1s s.AND. ------------------------& bcdef(2)---oDpp,__aagyybcdef_periodicp5.AND.------------------------&(xp(2,i _(-).LT.max_slE(2,idoml) .OR. ------------------------& (åopo%slE�_bc(4,idoml)åEQ 1s s.AND. ------------------------& bcdef(4)---oDpp,__aagyybcdef_periodicp5.AND.------------------------&(xp(3,i _(-).LT.max_slE(3,idoml) .OR. ------------------------& (åopo%slE�_bc(6,idoml)åEQ 1s s.AND. ------------------------& bcdef(6)---oDpp,__aagyybcdef_periodicp5 ) l', D------------------- in _(- 4)n _(- + 1i-----s,tttttttttttttli�å_s,t(idom,n _(-) =s _(-�l(lE�s,tttttttttt-bs DD& issEN&�å------ inli�å2s sssssss=inli�å2s+ 1i-----s,ttttttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,tttttttttt-te-R 88yyyypnR,t�tt-bs DD& issEN&�å--- inli�å2s sssssss=inli�å2s+ 1i-----s,tttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,ttttttt-te -R- uå cl aE� -bs -R-( omusimåEQ 2)yl', DDD& issEN& N& F ( xp(1,i _(-).GE.min_�lE(1,idoml) .AND. ---------------------&xp(2,i _(-).GE.min_�lE(2,idoml) .AND. ---------------------&xp(1,i _(-).LE.max_slE(1,idoml) .AND. ---------------------&xp(2,i _(-).LE.max_slE(2,idoml) ) ) l', D------------------ F (xp(1,i _(-).LT.max_slE(1,idom) .OR. ------------------------& (åopo%slE�_bc(2,idoml)åEQ 1s s.AND. ------------------------& bcdef(2)---oDpp,__aagyybcdef_periodicp5.AND.------------------------&(xp(2,i _(-).LT.max_slE(2,idoml) .OR. ------------------------& (åopo%slE�_bc(4,idoml)åEQ 1s s.AND. ------------------------& bcdef(4)---oDpp,__aagyybcdef_periodicp5) l', D------------------ in _(- 4)n _(- + 1i-----s,tttttttttttttli�å_s,t(idom,n _(-) =s _(-�l(lE�s,tttttttttt-bs DD& issEN&�å------ inli�å2s sssssss=inli�å2s+ 1i-----s,ttttttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,tttttttttt-te-R 88yyyypnR,t�tt-bs DD& issEN&�å--- inli�å2s sssssss=inli�å2s+ 1i-----s,tttttttttt-li�å2(nli�å2( =s _(-�l(lE�s,ttttttt-te -R- uå cl aE� -te -R-- uå cl a-te å uårc! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE uårc! CopyåMls lists (well, only-ANTnli�å2schanged - decreasedphys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u u-R-(nli�å2---onli�å1( l', DD& issEN& Nnli�å1s=inli�å2DD& issEN& NDO i=1,nli�å1�l(lE�åissEN )-li�å1(ip 4)-li�å2(iphys,mis,t� -teå uårc-te-R-hys,mis N! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE uårc! Exit-ANTMls list is emptyhys,mis,t!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u u-R-(nli�å1åEQ 0) EXIT�l(lE�-te å uå! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eCoF o---at we sold aM eibup _(-ocl,s ys,mi! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u-R-(nli�å2-GT._)�l', DD& issE&-'WORK',__LINE__,mustn � �! max,t_s #si--��� L�EcsI _(-_una s�l(Ecsrmsh_co!!_weightsCh -----------------------'MAJOR PROBLEM-----ginys,max,phys,mis,tx,t�lE�å uårc-te-R- u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eA BRO o- andealiasr----weights ANTwe need chem. u! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå umax_p_(-nls M 4)0 uDO isom =D1,åopo%nx,bli�åh u u-R(store_max,(idomp.GE.max_p_(-nls M ( l', DD& issEN& Nmax_p_(-nls M 4)store_max,(idomp- uå cl a-te -R- uå c-te å uå----D=Dpp,__aagyy M oF_fiåDDDDDDldl���(=y1DDDDDDldl�2�(=y1DDDDDDldl�3�(=y1 - ,__Lrmsh_kernelsizeikernelpDDDDDDldu���(=y,__Lrmsh_kernelsizeikernelp*2 uåldu�2( =såopo%nx,bli�åh uldu�3( =smax_p_(-nls M s+ ,__Lrmsh_kernelsizeikernelpD�acttp-R(((al-Syyyawx1_userp5.AND.al-Syyyawx2_userp.AND. ------------& al-Syyyawx3_userp.AND. omusimåEQ 3).OR.------------&(al-Syyyawx1_userp.AND.al-Syyyawx2_userp.AND.------------ omusimåeq 2))�l', DD& issE&-'gernal_weightsm=c.FALSE.��l(lE�åt�-R-(--OT.(ASSOCIATEDawx1_userp5.OR. ---------------------OT.(ASSOCIATEDawx2_userp5pdl', DcAN s�cg�s - Ge<http1Dt,Gal-Te----iys,missssssmax,t_s #elifO(wx1_s,ldl,ldu, w://wnumb�acttpeE�åt�-R-(wnum---o_)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ ---------------'pb in weights aM oF o M -----ginys,max,phys,mis,tttttttx,t�lE�å uårcttt-te -R- uå cl aE� nx1_user => nx1_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRssssssmax,t_s #elifO(wx1_d,ldl,ldu, w://wnumb�acttpeE�åt�-R-(wnum---o_)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ ---------------'pb in weights aM oF o M -----ginys,max,phys,mis,tttttttx,t�lE�å uårcttt-te -R- uå cl aE� nx1_user => nx1_d-cA(INd-cAN s�cg�s - Ge<http1Dt,Gal-Te----iys,missssssmax,t_s #elifO(wx2_s,ldl,ldu, w://wnumb�acttpeE�åt�-R-(wnum---o_)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ ---------------'pb in weights aM oF o M -----ginys,max,phys,mis,tttttttx,t�lE�å uårcttt-te -R- uå cl aE� nx2_user => nx2_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRssssssmax,t_s #elifO(wx2_d,ldl,ldu, w://wnumb�acttpeE�åt�-R-(wnum---o_)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ ---------------'pb in weights aM oF o M -----ginys,max,phys,mis,tttttttx,t�lE�å uårcttt-te -R- uå cl aE� nx2_user => nx2_dhcA(INd- uått-te -R- uå cl a (al-Syyyawx3_userp5dl', DD& issEN& N ( omusimåEQ 3.AND.------------------&--OT.ASSOCIATEDawx3_userp5dl', DcAN s�cg�s - Ge<http1Dt,Gal-Te----iys,missssss ssmax,t_s #elifO(wx3_s,ldl,ldu, w://wnumb�acttpeE�åt� t�-R-(wnum---o_)�l', DD& issE& issE& & -'WORK',__LINE__,E__,mustn � �! L max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ -- ---------------'pb in weights aM oF o M -----ginys,max,phys,mis,ttttttt ttx,t�lE�å uårcttt � -te -R-- uå cl aaaaaaawx3_userr=> nx3_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRssssss ssmax,t_s #elifO(wx3_d,ldl,ldu, w://wnumb�acttpeE�åt� t�-R-(wnum---o_)�l', DD& issE& issE& & -'WORK',__LINE__,E__,mustn � �! L max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ --------------'pb in weights aM oF o M -----ginys,max,phys,mis,ttttttt ttx,t�lE�å uårcttt � -te -R- uå cl aaaaaaawx3_userr=> nx3_dhcA(INd- uått � -te -R- uå cl a-te -R- uå cl anx1 => nx1_user--- TEG� nx2 => nx2_user--- TEG� ( omusimåEQ 3)ynx3 => nx3_user--- TE-bs DcAN s�cg�s - Ge<http1Dt,Gal-Te----iys,misssmax,t_s #elifO(wx1_s,ldl,ldu, w://wnumb�acttpeE�-R-(wnum---o_)�l', DD& issE& is-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ---------------------------'pb in weights aM oF o M -----ginys,max,phys,mis,ttttx,t�lE�å uårc-te -R-uårcl anx1 => nx1_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsssmax,t_s #elifO(wx1_d,ldl,ldu, w://wnumb�acttpeE�-R-(wnum---o_)�l', DD& issE& is-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh -------------------------------'pb in weights aM oF o M -----ginys,max,phys,mis,ttttx,t�lE�å uårc-te -R-uårcl anx1 => nx1_d-cA(INd-cAN s�cg�s - Ge<http1Dt,Gal-Te----iys,misssmax,t_s #elifO(wx2_s,ldl,ldu, w://wnumb�acttpeE�-R-(wnum---o_)�l', DD& issE& is-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh -------------------------------'pb in weights aM oF o M -----ginys,max,phys,mis,ttttx,t�lE�å uårc-te -R-uårcl anx2 => nx2_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRsssmax,t_s #elifO(wx2_d,ldl,ldu, w://wnumb�acttpeE�-R-(wnum---o_)�l', DD& issE& is-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh -------------------------------'pb in weights aM oF o M -----ginys,max,phys,mis,ttttx,t�lE�å uårc-te -R-uårcl anx2 => nx2_dhcA(INd- uått ( omusimåEQ 3)yl', DcAN s�cg�s - Ge<http1Dt,Gal-Te----iys,missssssmax,t_s #elifO(wx3_s,ldl,ldu, w://wnumb�acttpeE�åt�-R-(wnum---o_)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ ---------------'pb in weights aM oF o M -----ginys,max,phys,mis,tttttttx,t�lE�å uårcttt-te -R- uå cl aE� nx3 => nx3_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRssssssmax,t_s #elifO(wx3_d,ldl,ldu, w://wnumb�acttpeE�åt�-R-(wnum---o_)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ ---------------'pb in weights aM oF o M -----ginys,max,phys,mis,tttttttx,t�lE�å uårcttt-te -R- uå cl aE� nx3 => nx3_dhcA(INd- uått-te -R- uå c-te -R- uå c! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eInitializerWeights SUBRe! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå umax,t_s #util_time(tim1sphys,minx1 =)0.0_mkDys,minx2 =)0.0_mkDys,mi ( omusimåEQ 3)ynx3 =)0.0_mkDys,mi! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eBeginnT.E weibupco!!uo o M Dys,mi! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå u eloop ov!tr�lE�� SELECTumaSEikernelpD�acttpmaSEipp,__aagyyrmsh_kernel_bsp2) uå iDO i--- =D1,åopo%nx,bli�åh u u u eloop ov!tr _(-ocl,seibureinDD& issEN& NDO i =D1,store_max,(ix,bphys,mis,tttttttix,bl(4)åopo%ix,bli�å(ix,bphhys,mis,tttttttip1 =)Iyya(xp(1,li�å_s,t(ix,b,ip))-min_phys(1) ---------------------)*dxi(1))+2--�å (1,ix,blphhys,mis,tttttttip2 =)Iyya(xp(2,li�å_s,t(ix,b,ip))-min_phys(2) ---------------------)*dxi(2))+2--�å (2,ix,blphys,mis,ttttttt ( omusimåEQ 3)yl', DD& issEN& N& tttip3 =)Iyya(xp(3,li�å_s,t(ix,b,ip))-min_phys(3) ---------------------)*dxi(3))+2--�å (3,ix,blphys,mis,ttttttt-te -R-- uå cl aaaaaaai dec 4)0 uå iiiiiiijjdec 4)0 uå iiiiiiikkdec 4)0 uå iiiiiii!sEND---------------------------------ginys,max,phys,mis,t�lEmax,tDD& issEN& N& !T Bsplin,se2 uå iiiiiii!sEND---------------------------------ginys,max,phys,mis,t�lEmax,tD uå iiiiiiiDO ii( =s 1,i 1+1i-----s,tttttttttt- dec 4)- dec + 1i-----s,ttttttttttx1 =)ABS( uåii-2+-�å (1,ix,blp,mk)-( -----------------------xp(1,li�å_s,t(ix,b,ip))-min_phys(1))*dxi(1))D------------------ Fx1.LE.1.0_mk)yl', DD& issEN& N& ttt minx1(- dec,ix,b,ip) =)å1.0_mk -tx1DD& issEN& N& ttt-te -R- uå cl aaaaaaa-te å uåååååååååå!eLoop ov!try direco M Dys,miiiiiiiiiiDO jjiiii=yip2,ip2+1i-----s,ttttttttttjjdec 4)jjdec + 1i-----s,ttttttttttx2 =)ABS( uåjj-2+-�å (2,ix,blp,mk)-( -----------------------xp(2,li�å_s,t(ix,b,ip))-min_phys(2))*dxi(2))D------------------ Fx2.LE.1.0_mk)yl', DD& issEN& N& ttt minx2(jjdec,ix,b,ip) =)å1.0_mk -tx2 uå iiiiiii tt-te -R- uå cl aaaaaaa-te å -------------- F omusimåEQ 3)yl', DD& issEN& N& ttt!eLoop ov!trz direco M Dys,miiiiiiiiii iiDO kki ii=yip3,i 3+1i-----s,tttttttttt iikkdec 4)kkdec + 1i-----s,tttttttttttttx3 =)ABS( uåkk-2+-�å (3,ix,blp,mk)- (--------------------------xp(3,li�å_s,t(ix,b,ip))-min_phys(3))*dxi(3))D------------------ i Fx3.LE.1.0_mk)yl', DD& issEN& N& ttt mi � nx3(kkdec,ix,b,ip) =)å1.0_mk -tx3DD& issEN& N& ttt mi-te -R- uå cl aaaaaaa aa-te å ---------------te -R-- uå cl aaaa-te å uåååå-te å uåmaSEipp,__aagyyrmsh_kernel_mp4)-hys,mis N! issEND---------------------------------ginys,max,phys,mis,t�lEmahys,mis N! M Prime Fourhys,mis N! issEND---------------------------------ginys,max,phys,mis,t�lEmahys,mis NDO i--- =D1,åopo%nx,bli�åh u u u eloop ov!tr _(-ocl,seibureinDD& issEN& NDO i =D1,store_max,(ix,bphys,mis,tttttttix,bl(4)åopo%ix,bli�å(ix,bphhys,mis,tttttttip1 =)Iyya(xp(1,li�å_s,t(ix,b,ip))-min_phys(1) -------------------------------)*dxi(1))+2--�å (1,ix,blphhys,mis,tttttttip2 =)Iyya(xp(2,li�å_s,t(ix,b,ip))-min_phys(2) -------------------------------)*dxi(2))+2--�å (2,ix,blphys,mis,ttttttt ( omusimåEQ 3)yl', DD& issEN& N& tttip3 =)Iyya(xp(3,li�å_s,t(ix,b,ip))-min_phys(3) -------------------------------)*dxi(3))+2--�å (3,ix,blphys,mis,ttttttt-te -R-- uå cl aaaaaaai dec 4)0 uå iiiiiiijjdec 4)0 uå iiiiiiikkdec 4)0 uå iiiiiiiDO ii(=s 1-1,i 1+2 uå iiiiiii tt- dec 4)- dec + 1i-----s,ttttttttttx1 =)ABS( uåii-2+-�å (1,ix,blp,mk)-( -----------------------xp(1,li�å_s,t(ix,b,ip))-min_phys(1))*dxi(1))D-----s,tttttttttt Fx1.LE.2.0_mk)yl', DD& issEN& N& ttt mi Fx1.LE.1.0_mk)yl', DD& issEN& N& ttt mi minx1(- dec,ix,b,ip) =)1.0_mk -tx1**2*(2.5_mk-1.5_mk*x1)D-----s,tttttttttt tt-bs DD& issEN&�å------ i minx1(- dec,ix,b,ip) =)2.0_MK + (-4.0_MK + -----------------------------(2.5_MK -)0.5_MK *tx1)*x1)*x1DD& issEN& N& ttt mi-te -R- uå cl aaaaaaa aa-te -R- uå cl aaaaaaa-te å uååååååååååDO jji=yip2-1,i 2+2 uå iiiiiii ttjjdec 4)jjdec + 1i-----s,ttttttttttx2 =)ABS( uåjj-2+-�å (2,ix,blp,mk)-( -----------------------xp(2,li�å_s,t(ix,b,ip))-min_phys(2))*dxi(2))D------------------ Fx2.LE.2.0_mk)yl', DD& issEN& N& ttt mi Fx2.LE.1.0_mk)yl', DD& issEN& N& ttt mi minx2(jjdec,ix,b,ip) =)1.0_mk -tx2**2*(2.5_mk-1.5_mk*x2)D-----s,tttttttttt tt-bs DD& issEN&�å------ i minx2(jjdec,ix,b,ip) =)2.0_MK + (-4.0_MK + -----------------------------(2.5_MK -)0.5_MK *tx2)*x2)*x2DD& issEN& N& ttt mi-te -R- uå cl aaaaaaa aa-te -R-- uå cl aaaaaaa-te å uåååååååååå ( omusimåEQ 3)yl', DDys,miiiiiiiiii iiDO kki ii=yip3 - 1,yip3+2 i-----s,tttttttttt iikkdec 4)kkdec + 1i-----s,tttttttttttttx3 =)ABS( uåkk-2+-�å (3,ix,blp,mk)- (--------------------------xp(3,li�å_s,t(ix,b,ip))-min_phys(3))*dxi(3))D-----s,ttttttttttttt Fx3.LE.2.0_MK)yl', DD& issEN& N& ttt mi mi Fx3.LE.1.0_MK)yl', DD& issEN& N& ttt mi mi � nx3(kkdec,ix,b,ip) =)å1.0_MK -)x3**2*(2.5_MK -)------------------ -- -----------& 1.5_MK*x3) -------- -- ------------bs DD& issEN&�å------ i mi � nx3(kkdec,ix,b,ip) =)å2.0_MK + (-4.0_MK + ------------------ -- -----------& (2.5_MK -)0.5_MK*x3)*x3)*x3 -------- -- ------------te -R- uå cl aaaaaaa aa----te -R- uå cl aaaaaaa aa-te å ---------------te -R- aaaaaaa aa-te å ---------te å ------te SELECT � max,t_s #util_time(tim1epD�acttp-R-( omusebug.gto_)�l', DD& issE&WRITE(msg,*) 'naked calc weweights took [ms]: ',1000.0*(tim1e-tim1sphys,mi max,t_s #write( omurank�l(Ecsrmsh_co!!_weightsChmsg,max,phys,mi-te -R-- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå DeaM oF o M weibupc) THs....- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå----D=Dpp,__aagyydeF BROustn � lda���(=y0 uåmax,t_s #elifO(-li�å1,lda, w://wnumb�acttpe oF'R :---o_)�l', DD& issE& -'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIdeF BROh ---------------'pEcsrmsh_co!!_weightsCh ---------------'pb in -li�å1sdeaM oF o M -----ginys,max,phys,mis,ttx,t�lE�å uårcl-te-R-ys,mismax,t_s #elifO(-li�å2,lda, w://wnumb�acttpe oF'R :---o_)�l', DD& issE& -'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIdeF BROh ---------------'(Ecsrmsh_co!!_weightsCh ---------------'(b in -li�å2sdeaM oF o M -----ginys,max,phys,mis,ttx,t�lE�å uårcl-te-R-- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Now why M e h would you wanteco deaM oF o- ibum?- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #ifdes�cgCOMPLETELY_LOCO�acttpe oF'Rgernal_weights, DD& issEN&sENlmax,t_s #elifO(wx1,lda, w://wnumb�acttpetpe oF'R :---o_)�l', DD& issE& E& -'WORK',__LINE__,E__,mustn � �! �! max,t_s #si--��� L�EcsIdeF BROh -------------------'(Ecsrmsh_co!!_weightsCh -------------------'(b in weightsdeaM oF o M -----ginys,max,phys,mis,tt,ttx,t�lE�å uårcl ---te -R- aaaaaaa max,t_s #elifO(wx2,lda, w://wnumb�acttpetpe oF'R :---o_)�l', DD& issE& E& -'WORK',__LINE__,E__,mustn � �! �! max,t_s #si--��� L�EcsIdeF BROh -------------------'(Ecsrmsh_co!!_weightsCh -------------------'(b in weightsdeaM oF o M -----ginys,max,phys,mis,tt,ttx,t�lE�å uårcl ---te -R- aaaaaaa ( omusimåEQ 3)yl', DD& issEN& N&max,t_s #elifO(wx3,lda, w://wnumb�acttpetpetpe oF'R :---o_)�l', DD& issE& E& E& -'WORK',__LINE__,E__,mustn � �! �! �! max,t_s #si--��� L�EcsIdeF BROh ---------------------'(Ecsrmsh_co!!_weightsCh ---------------------'(b in weightsdeaM oF o M -----ginys,max,phys,mis,tt,tt,ttx,t�lE�å uårcl -- tt-te-R 88yyyypnR-te-R-uårcl-te-R-cA(INd- uå (--OT.'Rgernal_weights, DD& issEN&sENlCALLIFYawx1_s,nx1_d)issEN&sENlCALLIFYawx2_s,nx2_d)issEN&sENlCALLIFYawx3_s,nx3_d)issEN&s-te -R-- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Return- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å E�å ! mONTINU DD& issmax,tslE�åop uårrmsh_co!!_weightsCheck-nMgu D& issRETUR issEN&smONTAINSissEN&sSUBROUTINEt-----i-------- oFNp & il', DD& issEN&sENl-- oFSIZE(xp,2) .LT. Np)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ -----'not enoughr _(-ocl,secontained in xp-----ginys,max,phys,mis,tttttttx,t�l8888- aaaaaaa aa-te-R- aaaaaaa aa oFSIZE(xp,1) .LT. omusim)�l', DD& issE& issE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ -----'leadT.E simens M wexp insufficibug-----ginys,max,phys,mis,tttttttx,t�l8888- aaaaaaa aa-te-R- aaaaaaa-te-R- aaaaaaa oFNp L-oc_)�l', DD& issE&aaa oFNp L il', DD& issEN&sENl--sE&-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------ -----' _(-ocl,semust shospecified-----ginys,max,phys,mis,t� ttx,t�l8888- aaaaaaa aa-te -R- aaaaaaa aax,t�l8888- aaaaaaa-te -R- uå cl a (ikernel L i15.OR.ikernel & i455dl', DD& issEN& N-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------&-----'wro.E kernelsdefinis M -----ginys,max,phys,mis,ttttx,t�l8888- aaaaaaa-te -R- uå cl akernel_suppor-D=Dpp,_rmsh_kernelsizeikernelp*2 uå uå (--OT.(ikernel_suppor-åEQ 2).OR.ikernel_suppor-åEQ 4) ---------------&--.OR.ikernel_suppor-åEQ 6555dl', DD& issEN& N-'WORK',__LINE__,E__,mustn � �! max,t_s #si--��� L�EcsIF--debug�l(Ecsrmsh_co!!_weightsCh ------------------&-----'wro.E kernelssuppor------ginys,max,phys,mis,ttttx,t�l8888- aaaaaaa-te-R- 8888 ! mONTINU DD& iss-te SUBROUTINEt-----icAN s�cg�s - Ge<http1Dt,Gal-Te----iys,mis-te SUBROUTINEt(Ecsrmsh_co!!_weights_s-cANTs�cg�s - Ge<http1Dt,Gal-------inMpnRs-te SUBROUTINEt(Ecsrmsh_co!!_weights_d�cA(INd-� ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/(Ecsmodul,,ieta_io.f���������������������������������������������������������������0000644�0001752�0001753�00000007102�11616003523�017733� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nMpnRs! i*- f90 i*-----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å MpnRs! Modul,aaaaaaa:----------------(Ecsmodul,,ieta_io- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Copyrights(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), MpnRs! CeRger fGOTFluid Dynamics (DTU)hys,mis!hys,mis!hys,mis! This fil, is _(- weibupParaM elsP_(-ocl, M----Library (PPM).hys,mis!hys,mis! PPM is free software: you can redistribut, it and/GOTmodify�l(lE�å< it und!trMls germs weibupGNU LesserrGen!talEP,blic-License MpnRs! a ,bli�hed byåMls Free Software Found o M , eiibur MpnRs! vers M 3 weibupLicense,eor((at your w:/ M ) any latur MpnRs! vers M .hys,mis!hys,mis! PPM is distribut,d in ----hope---at it will bupuseful,hys,mis! but WITHOUT ANY WARRANTY;Tn---out even ----implied wc) Tnty whys,mis! MERCHANTABILITYeor(FITNESS FOR A PARTICULAR PURPOS-ocSe- ibuhys,mis! GNU Gen!talEP,blic-License fGOTmore details.hys,mis!hys,mis! You should havs received aecopy weibupGNU Gen!talEP,blic-License MpnRs! andeibupGNU LesserrGen!talEP,blic-License alo.E n----PPM. INTnot,hys,mis! se- <http://www.gnu.org/licenses/>.hys,mis!hys,mis! ParaM elsP_(-ocl, M----Library (PPM)hys,mis! ETH Zurich uå CH-8092 Zurich, Sn--zerland- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å - uå clMODULE-(Ecsmodul,,ieta_io- uå cl!!! This modul,econtains deta structur,seandedefinis M s---at- uå cl!!! are used in ----PPM I/Orroutines.hys,mis!!!- uå cl!!! [-OTE]- uå cl!!! The members weibis modul,s should not bupaccessed direcoly byåMls PPM- uå cl!!! clibugedeveloper. They are managed ingernally byåMls library.hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! Modul,shys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clUSE-(Ecsmodul,,ieta, ONLY:-(Ecskind_sT.Ele,e(Ecskind_do,ble MpnRssssPRIVATE ::-(Ecskind_sT.Ele,e(Ecskind_do,ble hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! Mode (paraM elsGOTserial) fGOTeach unit F'Rgernal-nls M T.E)hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clINTEGER, DIMEN----(:), POINTER ::-(Ecsiosmod,aa=>lCALL() hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! IO fGOmat (ASCIIsGOTbinary) fGOTeach unit F'Rgernal-nls M T.E)hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clINTEGER, DIMEN----(:), POINTER ::-(EcsiosfGOmat a=>lCALL() hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! Inverss list wecurrbugly used unit nls M s byå(Ecsmodul,,io.hys,mis cl! Index is For- Tn Unit nls M , valu, is index to abovs lists ,mustn � �! ! 0-ANTMlat _(-ocul For- Tn unit is not used byå(Ecsio.hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clINTEGER, DIMEN----(:), POINTER ::-(Ecsiosunit a=>lCALL() hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! I/OrbuffM s fGOTsT.Eleeandedo,ble precis M typ,shys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl uå(Ecskind_sT.Ele5 , DIMEN----(:), POINTER ::-sbuffM a=>lCALL() ys,mis cl uå(Ecskind_do,ble5 , DIMEN----(:), POINTER ::-dbuffM a=>lCALL() ys,mis clCOMPLEXå(Ecskind_sT.Ele5, DIMEN----(:), POINTER ::-scbuffM a=>lCALL() ys,mis clCOMPLEXå(Ecskind_do,ble5, DIMEN----(:), POINTER ::-dcbuffM a=>lCALL() inMpnRs-te MODULE-(Ecsmodul,,ieta_io-��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/(Ecsmodul,,tree_cutpos.f�����������������������������������������������������������0000644�0001752�0001753�00000005000�11616003523�020662� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������mis cl! i*- f90 i*-----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å MpnRs! Modul,aaaaaaa:----------------(Ecsmodul,,tree_cutpos- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Copyrights(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), MpnRs! CeRger fGOTFluid Dynamics (DTU)hys,mis!hys,mis!hys,mis! This fil, is _(- weibupParaM elsP_(-ocl, M----Library (PPM).hys,mis!hys,mis! PPM is free software: you can redistribut, it and/GOTmodify�l(lE�å< it und!trMls germs weibupGNU LesserrGen!talEP,blic-License MpnRs! a ,bli�hed byåMls Free Software Found o M , eiibur MpnRs! vers M 3 weibupLicense,eor((at your w:/ M ) any latur MpnRs! vers M .hys,mis!hys,mis! PPM is distribut,d in ----hope---at it will bupuseful,hys,mis! but WITHOUT ANY WARRANTY;Tn---out even ----implied wc) Tnty whys,mis! MERCHANTABILITYeor(FITNESS FOR A PARTICULAR PURPOS-ocSe- ibuhys,mis! GNU Gen!talEP,blic-License fGOTmore details.hys,mis!hys,mis! You should havs received aecopy weibupGNU Gen!talEP,blic-License MpnRs! andeibupGNU LesserrGen!talEP,blic-License alo.E n----PPM. INTnot,hys,mis! se- <http://www.gnu.org/licenses/>.hys,mis!hys,mis! ParaM elsP_(-ocl, M----Library (PPM)hys,mis! ETH Zurich uå CH-8092 Zurich, Sn--zerland- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å - uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Define typ,shys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #define http1Dt,Gal-Te---- 1 #define http1Dt,Gal------- 2 - uå clMODULE-(Ecsmodul,,tree_cutpos- uå cl!!! This modul,eprovid,seibu- uå cl!!! routine---at determin,seibupw:/ malEposis M wbure to cut aebox.hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! Define 'Rgerfaceseco Mls routine(s)hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clINTERFACE-(Ecstree_cutpos- uå cl uå clMODULE-PROCEDURE-(Ecstree_cutpos_s- uå cl uå clMODULE-PROCEDURE-(Ecstree_cutpos_d- uå cl uå-te -NTERFACE hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! include ----sourcehys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clmONTAINSi #define ht�s - http1Dt,Gal-Te----i#include "tree/(Ecstree_cutpos.f" #und!s�cg�s -i #define ht�s - http1Dt,Gal-------i#include "tree/(Ecstree_cutpos.f" #und!s�cg�s -i cl uå-te MODULE-(Ecsmodul,,tree_cutpos-lib(Ec-1.2.1/src/(Ecsmodul,,iefine_slE�_bc.f��������������������������������������������������������0000644�0001752�0001753�00000004765�11616003525�021303� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������mis cl! i*- f90 i*-----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å MpnRs! Modul,aaaaaaa:--------------(Ecsmodul,,iefine_slE�_bc- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Copyrights(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), MpnRs! CeRger fGOTFluid Dynamics (DTU)hys,mis!hys,mis!hys,mis! This fil, is _(- weibupParaM elsP_(-ocl, M----Library (PPM).hys,mis!hys,mis! PPM is free software: you can redistribut, it and/GOTmodify�l(lE�å< it und!trMls germs weibupGNU LesserrGen!talEP,blic-License MpnRs! a ,bli�hed byåMls Free Software Found o M , eiibur MpnRs! vers M 3 weibupLicense,eor((at your w:/ M ) any latur MpnRs! vers M .hys,mis!hys,mis! PPM is distribut,d in ----hope---at it will bupuseful,hys,mis! but WITHOUT ANY WARRANTY;Tn---out even ----implied wc) Tnty whys,mis! MERCHANTABILITYeor(FITNESS FOR A PARTICULAR PURPOS-ocSe- ibuhys,mis! GNU Gen!talEP,blic-License fGOTmore details.hys,mis!hys,mis! You should havs received aecopy weibupGNU Gen!talEP,blic-License MpnRs! andeibupGNU LesserrGen!talEP,blic-License alo.E n----PPM. INTnot,hys,mis! se- <http://www.gnu.org/licenses/>.hys,mis!hys,mis! ParaM elsP_(-ocl, M----Library (PPM)hys,mis! ETH Zurich uå CH-8092 Zurich, Sn--zerland- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå cl- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Define typ,shys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #define http1Dt,Gal-Te---- 1 #define http1Dt,Gal------- 2 - uå clMODULE-(Ecsmodul,,iefine_slE�_bc- uå cl!!! This modul,eprovid,seibu decomposis M routines.hys,mismis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! Define 'Rgerfaceeco sound ry condis M definis M routinehys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clINTERFACE-(Ecsiefine_slE�_bc- uå cl uå clMODULE-PROCEDURE-iefine_slE�bc_s- uå cl uå clMODULE-PROCEDURE-iefine_slE�bc_d- uå cl uå-te -NTERFACE hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! include ----source hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clmONTAINSi #define ht�s - http1Dt,Gal-Te----i#include "topo/(Ecsiefine_slE�_bc.f" #und!s�cg�s -i #define ht�s - http1Dt,Gal-------i#include "topo/(Ecsiefine_slE�_bc.f" #und!s�cg�s -i cl uå-te MODULE-(Ecsmodul,,iefine_slE�_bc-�����������lib(Ec-1.2.1/src/(Ecsmodul,,tree_cutdir.f�����������������������������������������������������������0000644�0001752�0001753�00000005003�11616003524�020643� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������mis cl! i*- f90 i*-----------------------------ginys,max,phys,mis,t�lEmax,t�lE�å MpnRs! Modul,aaaaaaa:----------------(Ecsmodul,,tree_cutdir- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Copyrights(c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), MpnRs! CeRger fGOTFluid Dynamics (DTU)hys,mis!hys,mis!hys,mis! This fil, is _(- weibupParaM elsP_(-ocl, M----Library (PPM).hys,mis!hys,mis! PPM is free software: you can redistribut, it and/GOTmodify�l(lE�å< it und!trMls germs weibupGNU LesserrGen!talEP,blic-License MpnRs! a ,bli�hed byåMls Free Software Found o M , eiibur MpnRs! vers M 3 weibupLicense,eor((at your w:/ M ) any latur MpnRs! vers M .hys,mis!hys,mis! PPM is distribut,d in ----hope---at it will bupuseful,hys,mis! but WITHOUT ANY WARRANTY;Tn---out even ----implied wc) Tnty whys,mis! MERCHANTABILITYeor(FITNESS FOR A PARTICULAR PURPOS-ocSe- ibuhys,mis! GNU Gen!talEP,blic-License fGOTmore details.hys,mis!hys,mis! You should havs received aecopy weibupGNU Gen!talEP,blic-License MpnRs! andeibupGNU LesserrGen!talEP,blic-License alo.E n----PPM. INTnot,hys,mis! se- <http://www.gnu.org/licenses/>.hys,mis!hys,mis! ParaM elsP_(-ocl, M----Library (PPM)hys,mis! ETH Zurich uå CH-8092 Zurich, Sn--zerland- uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å - uå cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å uå Define typ,shys,mis! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #define http1Dt,Gal-Te---- 1 #define http1Dt,Gal------- 2 - uå clMODULE-(Ecsmodul,,tree_cutdir- uå cl!!! This modul,eprovid,seibu routine---at- uå cl!!! determin,seibupw:/ malEdireco M wesubdividT.E aebox.hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! Define 'Rgerfaceseco Mls routine(s)hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clINTERFACE-(Ecstree_cutdir- uå cl uå clMODULE-PROCEDURE-(Ecstree_cutdir_s- uå cl uå clMODULE-PROCEDURE-(Ecstree_cutdir_d- uå cl uå-te -NTERFACE hys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis cl! include ----sourcehys,mis cl! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mis clmONTAINSi #define ht�s - http1Dt,Gal-Te----i#include "tree/(Ecstree_cutdir.f" #und!s�cg�s -i #define ht�s - http1Dt,Gal-------i#include "tree/(Ecstree_cutdir.f" #und!s�cg�s -i cl uå-te MODULE-(Ecsmodul,,tree_cutdir-�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib(Ec-1.2.1/src/(Ecsmodul,,ctrl.f������������������������������������������������������������������0000644�0001752�0001753�00000163664�11616003525�017321� 0����������������������������������������������������������������������������������������������������u�å �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������! iss*- f90 i*-----------------------------ginys,max,phys,mis,t�lEmax,t�lE� ! Modul,aaaaaaa:--------------------(Ecsmodul,,ctrl ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå ! ! Purposeaaaaaa:-Easy definis M ande _(sT.E wecommandelin, and ! control fil, F--debugs.h! ! Remarksaaaaaa:h! ! Referenceseaa:h! ! Revis M saaaa:h! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå ! ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå ! Milan Mitrovic ! ETH Zurich eCH-8092 Zurich, Sn--zerland-! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�åå MODULE-(Ecsmodul,,ctrl !!! This modul,eprovid,sea e sy wayeco handl,ecommandelin, !!! ar-debugs andecontrol fil,s.h!!! !!! .IRgend!d Usageh!!! !!! This modul,eassdebs---at you will creao- a modul,e--at contains !!! all your globalEvariabl,s (whichTwe will call +clibug_global+) and !!! gives you a e sy waye wesupplyT.E valu,s fGOT---seavariabl,s, !!! eiibur throughrcommandelin, ar-debugs GOTcontrol fil,s.h!!! !!! To doeibis, you havs to creao- a subroutine-(whichTwe will call !!! +iefine_ar-s+) --at will hold ----initializ o M codeocSe- ibuh!!! followT.E example.h!!! !!! [source,for- Tn] !!! E�åå !!! MODULE-clibug_global !!! clUSE-(Ecsmodul,,ctrl !!! clINTEGER ::-example !!! mONTAINSi!!! clSUBROUTINEtiefine_ar-si!!! cl max,tar-(exampe, 'exampleCh &i!!! cl flag = '-eCh &i!!! cl ctrl_name = 'exampleC)i!!! cl-te SUBROUTINEtiefine_ar-si!!! -te MODULE-clibug_global !!! E�åå !!! !!! This will creao- an ar-debug weiyp, +'Rgeger+e--at can shoset !!! eiibur throughribupco!mandelin, flag _'-eC_ GOT---Tcontrol fil, !!! variabl, _'exampleC_. Ple s- iakeTnot,e--at ibupco!mandelin, flag !!! will ov!tride ----settT.E in ----control fil, ifeboth are !!! supplied.h!!! !!! FGOT--is code to work you need co +call iefine_ar-s+-somewbure in !!! your initializ o M code, followed byåa +call _(se_ar-sF'R :)+. !!! Aftur + _(se_ar-s+pco!!letes your globals will bupinitialized !!! withribupsupplied valu,s.h!!! !!! The funco M +ar-+ is ov!tloaded co suppor-D+'Rgeger+, +real+, !!! +character+, +logical+ ande+co!!lex+ ar-debugs GOTfixed sized !!! c) THs weibuse typ,s. The first iwo ar-debugs ars required and !!! they are:ribupvariabl, itself (to whichTa po'Rger will bu !!! stored) andeibupname weibupvariabl, (used fGOTpr'RgT.E help !!! ebssages).h!!! !!! All oibur ar-debugs ars w:/ M alEandeibupdetails wehow they work !!! can shofound shlow. Hure is just a sho(- v!tviewEandereference !!! weibupcvailabl, w:/ M s: !!! [ho(izontal] !!! flag ::-[_'-f'_]TsT.Eleecharacterpco!mandelin, flag !!! lo.E_flag ::-[_'--lo.E-flag'_]Tlo.E co!mandelin, flag (�å s with !!! E�)i!!! ctrl_name ::-[_'name'_]Tname weibupcontrol fil, varibl, !!! iefault ::-[_42_]Tiefault valu, !!! ein ::-[_4_]Teinimum valu, fGOTndebric typ,sh!!! eax ::-[_30_]Teaximum valu,h!!! help ::-['Descri:/ M .'] help ebssageeco displayein ----auto !!! gen!tat,d ctrl fil, Fndeco!mandelin, help. You can use +\n+e-oh!!! force aelin, break. !!! iefault_func ::-[_exgernal_func_]Tcustom funco M to co!!uo- ibuh!!! valu, weibupvariabl, aftur oibur globals havs been-set (only !!! cvailabl, wbun co!!il,d withrF2003 suppor-)h!!! validator ::-[_exgernal_func_]Tcustom funco M to validat- ibuh!!! variabl, valu, (only cvailabl, wbun co!!il,d withrF2003 suppor-)h!!!h!!! ByTiefault ibupmodul,esuppor-s _-h_ Fnde_--help_ flags fGOh!!! pr'RgT.E ----help ebssage, Fnde_--pr'Rg-ctrl_ fGOTpr'RgT.E a !!! samplepcontrol fil,. There is also an w:/ M alEfirst posis M al !!! ar-debug --at is 'Rgerpret,d aseibupname weibupcontrol fil,.h!!! !!! ToTeake ----out!uo prettT!tryou can add callse-oh!!! +ar-_group(_'name'_)+e-o your +iefine_ar-s+ Fndeall callse-oh!!! +ar-+ followT.E a group definis M will bup!uo 'Rgo --at group.h!!! !!! If any one weibuppr'RgT.E flags is ruseug + _(se_ar-s+pwill return-!!! _exig_gracefully_ whichTyou should ----- fGOTFndeexig gracefully.h!!! is! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! Modul,s is! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsUSE-(Ecsmodul,,ieta, ONLY:-(Ecsrank�-(Ecsco!m RsUSE-(Ecsmodul,,typ,def RsUSE-(Ecsmodul,,slE�å RsUSE-(Ecsmodul,,slE�åop RsUSE-(Ecsmodul,,E__,mustIMPLICIT NONE is! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! IRgerface is! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsPUBLIC ::-ar-, ar-_group, _(se_ar-s, disabl,_help, disabl,_ctrl, ---------&----set_ctrl_name,------------------------------------------& #ifdes�cgF2003--------&----'Rgeger_func,Tlo.E'Rg_func,TsT.Ele_func,Tdo,ble_func,T--&---------&----logical_func,Tst T.E_func,Tco!!lex_func,Tdco!!lex_func,T&---------&----'Rgeger_c) TH_func,Tlo.E'Rg_c) TH_func,T----------------& -------&----sT.Ele_c) TH_func,Tdo,ble_c) TH_func,T------------------& -------&----logical_c) TH_func,Tst T.E_c) TH_func,T-----------------& -------&----co!!lex_c) TH_func,Tdco!!lex_c) TH_func,T---------------& #A(INd- uåt&----ruset, add_cmd, ctrl_fil,_test, break_help, ------------& -------&----find_ar-, find_flag, ar-_count,-------------------------& -------&----enabli.E_flag, disabli.E_flag, exig_gracefully isPRIVATE #ifdes�cgMPIustINCLUDE '!!if.h' #A(INd- ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! Typ,shys! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! scalari #define DTYPElINTEGER #define htINTEGER #include "ctrl/typ,.f" #define DTYPElLONGINT #define htLONGINT #include "ctrl/typ,.f" #define DTYPEltp1Dt, #define http1Dt, #include "ctrl/typ,.f" #define DTYPEltp1Dt, #define http1Dt, #include "ctrl/typ,.f" #define DTYPElLOGICAL #define htLOGICAL #include "ctrl/typ,.f" #define DTYPEltTRp1D #define httTRp1D #include "ctrl/typ,.f" #define DTYPElCOMPLEX #define htCOMPLEX #include "ctrl/typ,.f" #define DTYPEltCOMPLEX #define htDCOMPLEX #include "ctrl/typ,.f" Rs! a) TH #define ARRAYi #define DTYPElINTEGER_a) TH #define htINTEGER #include "ctrl/typ,.f" #define DTYPElLONGINT_a) TH #define htLONGINT #include "ctrl/typ,.f" #define DTYPEltp1Dt,_a) TH #define http1Dt, #include "ctrl/typ,.f" #define DTYPEltp1Dt,_a) TH #define http1Dt, #include "ctrl/typ,.f" #define DTYPElLOGICAL_a) TH #define htLOGICAL #include "ctrl/typ,.f" #define DTYPEltTRp1D_a) TH #define httTRp1D #include "ctrl/typ,.f" #define DTYPElCOMPLEX_a) TH #define htCOMPLEX #include "ctrl/typ,.f" #define DTYPEltCOMPLEX_a) TH #define httCOMPLEX #include "ctrl/typ,.f" #und!s�ARRAYi is! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! IRgerfaceshys! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsINTERFACE-ar- -----! scalari-----MODULE-PROCEDURE-INTEGER_add_ar-i-----MODULE-PROCEDURE-LONGINT_add_ar-i-----MODULE-PROCEDURE-tp1Dt,_add_ar-i-----MODULE-PROCEDURE-tp1Dt,_add_ar-i-----MODULE-PROCEDURE-LOGICAL_add_ar-i-----MODULE-PROCEDURE-tTRp1D_add_ar-i-----MODULE-PROCEDURE-COMPLEX_add_ar-i-----MODULE-PROCEDURE-tCOMPLEX_add_ar-i-----! a) TH -----MODULE-PROCEDURE-INTEGER_a) TH_add_ar-i-----MODULE-PROCEDURE-LONGINT_a) TH_add_ar-i-----MODULE-PROCEDURE-tp1Dt,_a) TH_add_ar-i-----MODULE-PROCEDURE-tp1Dt,_a) TH_add_ar-i-----MODULE-PROCEDURE-LOGICAL_a) TH_add_ar-i-----MODULE-PROCEDURE-tTRp1D_a) TH_add_ar-i-----MODULE-PROCEDURE-COMPLEX_a) TH_add_ar-i-----MODULE-PROCEDURE-tCOMPLEX_a) TH_add_ar-i---te -NTERFACE h#ifdes�cgF2003---ABtTRACT -NTERFACE -----!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs cl! Defaults andeValidators -----!sEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs cl! scalari-----LOGICAL FUNCT--- INTEGER_func(variabl,)hys,mis INTEGER, POINTER ::-variabl,hys,mi-te FUNCT--- INTEGER_func i-----LOGICAL FUNCT--- LONGINT_func(variabl,)hys,mis INTEGER(8), POINTER ::-variabl,hys,mi-te FUNCT--- LONGINT_func i-----LOGICAL FUNCT--- tp1Dt,_func(variabl,)hys,mis uå�s -(1.0E0)), POINTER ::-variabl,hys,mi-te FUNCT--- tp1Dt,_func i-----LOGICAL FUNCT--- tp1Dt,_func(variabl,)hys,mis uå�s -(1.0D0)), POINTER ::-variabl,hys,mi-te FUNCT--- tp1Dt,_func i-----LOGICAL FUNCT--- LOGICAL_func(variabl,)hys,mis LOGICAL, POINTER ::-variabl,hys,mi-te FUNCT--- LOGICAL_func i-----LOGICAL FUNCT--- tTRp1D_func(variabl,)hys,mis CHARACTER(LEN=*), POINTER ::-variabl,hys,mi-te FUNCT--- tTRp1D_func i-----LOGICAL FUNCT--- COMPLEX_func(variabl,)hys,mis COMPLEXå�s -(1.0E0)), POINTER ::-variabl,hys,mi-te FUNCT--- COMPLEX_func i-----LOGICAL FUNCT--- tCOMPLEX_func(variabl,)hys,mis COMPLEXå�s -(1.0D0)), POINTER ::-variabl,hys,mi-te FUNCT--- tCOMPLEX_func i-----! a) TH -----LOGICAL FUNCT--- INTEGER_c) TH_func(variabl,)hys,mis INTEGER, DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- INTEGER_c) TH_func i-----LOGICAL FUNCT--- LONGINT_c) TH_func(variabl,)hys,mis INTEGER(8), DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- LONGINT_c) TH_func i-----LOGICAL FUNCT--- tp1Dt,_c) TH_func(variabl,)hys,mis uå�s -(1.0E0)), DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- tp1Dt,_c) TH_func i-----LOGICAL FUNCT--- tp1Dt,_c) TH_func(variabl,)hys,mis uå�s -(1.0D0)), DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- tp1Dt,_c) TH_func i-----LOGICAL FUNCT--- LOGICAL_c) TH_func(variabl,)hys,mis LOGICAL, DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- LOGICAL_c) TH_func i-----LOGICAL FUNCT--- tTRp1D_c) TH_func(variabl,)hys,mis CHARACTER(LEN=*), DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- tTRp1D_c) TH_func i-----LOGICAL FUNCT--- COMPLEX_c) TH_func(variabl,)hys,mis COMPLEXå�s -(1.0E0)), DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- COMPLEX_c) TH_func i-----LOGICAL FUNCT--- tCOMPLEX_c) TH_func(variabl,)hys,mis COMPLEXå�s -(1.0D0)), DIMEN----(:), POINTER ::-variabl,hys,mi-te FUNCT--- tCOMPLEX_c) TH_func i---te -NTERFACE #A(INd- ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! Constantshys! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER ::-enabli.E_flag = .tru,.h!!!eValu, fGOTiyp, w:/ M welogical-ar-s. Pruseuce weflag setsh!!! variabl, co +.TRUE.+ RsLOGICAL, PARAMETER ::-disabli.E_flag = .fals,.h!!!eValu, fGOTiyp, w:/ M welogical-ar-s. Pruseuce weflag setsh!!! variabl, co +.FALSE.+ RsINTEGER, PARAMETER ::-exig_gracefully = 42h!!!eValu, weibup+'R :+ ar-debug we+ _(se_ar-s+p--at signals --at-!!! theeprogram should exig n---out e__,m.- ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! Variabl,s- ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! byehow much co grow storagehRsINTEGER, PARAMETER ::-di =)10 cl! scalari--TYPE(INTEGER_c)g), POINTER, DIMEN----(:) ::-INTEGER_c)gsaaaa=>lCALL() ysINTEGER ::-INTEGER_c)gs_i (=y0 TYPE(LONGINT_c)g), POINTER, DIMEN----(:) ::-LONGINT_c)gsaaaa=>lCALL() ysINTEGER ::-LONGINT_c)gs_i (=y0 TYPE(tp1Dt,_c)g), POINTER, DIMEN----(:) ::-tp1Dt,_c)gsaaaaa=>lCALL() ysINTEGER ::-tp1Dt,_c)gs_i ((=y0 TYPE(tp1Dt,_c)g), POINTER, DIMEN----(:) ::-tp1Dt,_c)gsaaaaa=>lCALL() ysINTEGER ::-tp1Dt,_c)gs_i ((=y0 TYPE(LOGICAL_c)g), POINTER, DIMEN----(:) ::-LOGICAL_c)gsaaaa=>lCALL() ysINTEGER ::-LOGICAL_c)gs_i (=y0 TYPE(tTRp1D_c)g), POINTER, DIMEN----(:) ::-tTRp1D_c)gsaaaaa=>lCALL() ysINTEGER ::-tTRp1D_c)gs_i ((=y0 TYPE(COMPLEX_c)g), POINTER, DIMEN----(:) ::-COMPLEX_c)gsaaaa=>lCALL() ysINTEGER ::-COMPLEX_c)gs_i (=y0 TYPE(DCOMPLEX_c)g), POINTER, DIMEN----(:) ::-tCOMPLEX_c)gsaaa=>lCALL() ysINTEGER ::-tCOMPLEX_c)gs_i =y0 ! add c) THsi--TYPE(INTEGER_c) TH_a)g), POINTER, DIMEN----(:) ::-INTEGER_c) TH_a)gsaaaa=>lCALL() ysINTEGER ::-INTEGER_c) TH_a)gs_i (=y0 TYPE(LONGINT_c) TH_a)g), POINTER, DIMEN----(:) ::-LONGINT_c) TH_a)gsaaaa=>lCALL() ysINTEGER ::-LONGINT_c) TH_a)gs_i (=y0 TYPE(tp1Dt,_a) TH_a)g), POINTER, DIMEN----(:) ::-tp1Dt,_c) TH_a)gsaaaaa=>lCALL() ysINTEGER ::-tp1Dt,_c) TH_a)gs_i ((=y0 TYPE(tp1Dt,_c) TH_a)g), POINTER, DIMEN----(:) ::-tp1Dt,_c) TH_a)gsaaaaa=>lCALL() ysINTEGER ::-tp1Dt,_c) TH_a)gs_i ((=y0 TYPE(LOGICAL_a) TH_a)g), POINTER, DIMEN----(:) ::-LOGICAL_a) TH_a)gsaaaa=>lCALL() ysINTEGER ::-LOGICAL_c) TH_a)gs_i (=y0 TYPE(tTRp1D_a) TH_a)g), POINTER, DIMEN----(:) ::-tTRp1D_a) TH_a)gsaaaaa=>lCALL() ysINTEGER ::-tTRp1D_c) TH_a)gs_i ((=y0 TYPE(COMPLEX_a) TH_a)g), POINTER, DIMEN----(:) ::-COMPLEX_a) TH_a)gsaaaa=>lCALL() ysINTEGER ::-COMPLEX_c) TH_a)gs_i (=y0 TYPE(tCOMPLEX_a) TH_a)g), POINTER, DIMEN----(:) ::-tCOMPLEX_c) TH_a)gsaaa=>lCALL() ysINTEGER ::-tCOMPLEX_c) TH_a)gs_i =y0 ! arg storagehRsCHARACTER(LEN=(Ecschar), POINTER, DIMEN----(:) ::-cmd_a)gsaaaaaaa=>lCALL() ysINTEGER, POINTER, DIMEN----(:) ::-cmd_a)gs_lenaaa=>lCALL() ysLOGICAL, POINTER, DIMEN----(:) ::-cmd_a)gs_used a=>lCALL() ysINTEGER ::-cmd_a)gs_iaaaaa= y0 INTEGER ::-cmd_i = y0 ! arg groupshRsCHARACTER(LEN=(Ecschar), POINTER, DIMEN----(:) ::-groups =>lCALL() ysINTEGER, POINTER, DIMEN----(:) ::-group_size =>lCALL() ysINTEGER, POINTER, DIMEN----(:) ::-group_max_lenaa=>lCALL() ysLOGICAL, POINTER, DIMEN----(:) ::-group_has_ctrla=>lCALL() ysLOGICAL, POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER ::-groups_i = y-1 cl! special-ar-s ysLOGICAL ::-help_enabled a = .TRUE. ysLOGICAL ::-ctrl_enabled a = .TRUE. ysCHARACTER(LEN=(Ecschar) ::-ctrl_fil,_name = 'Ctrl' ysCHARACTER(LEN=(Ecschar) ::-ctrl_fil,_test = '' cl! test run ysLOGICAL ::-in_test = .FALSE. mONTAINSiss! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� Rs! Mastur procedure is! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsSUBROUTINEt(_(se_ar-sF'R :)hys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Ar-debugshys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mINTEGER, INTENT( OUT) ::-infohys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! LocalEvariabl,shys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m uå8) ::-t0hys,mCHARACTER(LEN=*), PARAMETER ::-caM er='(_(se_ar-s'hys,mCHARACTER(LEN=256) ::-valu,h LOGICAL ::-okhys,mINTEGER ::-info2hys,mINTEGER ::-ihys,mINTEGER ::-rank =y0 ,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Exgernalshys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mEXTERNAL iar-chys,mINTEGER iar-chys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Initializehys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,mmax,tslE�å (caM er,-t0, 'R :)hys,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Do everythT.E n-rank 0 andebcast at ibupend- uå ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lh#ifdes�cgMPIust,mmax,tMPI_Comm_Rank(MPI_COMM_WORLD, rank�-'R :)h#A(INd- (rank åEQ 05dl', DD& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! CopyTiefault valu,s 'Rgo variabl,shys,mssE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issEmax,tapply_iefaultsF'R :)hys,m (-'WOR.NE 05dl', DD& issE N-'WORK',__LINE__,fatalDD& issE Nmax,t_s #si--��� L�EcsIF--debug� caM er,------------------'ApplyT.E iefaults fail,d!', ---ginys, max,phys,mis,tttx,t�l100hys,mis,-te -FDD& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! Read in ----commandelin, D& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE (.NOT.-in_test5dl', DD& issE Nmax,tread_cmd_a)gs(max,phys,mis,ttt (-'WOR.NE 05dl', DD& issE N N-'WORK',__LINE__,fatalDD& issE N Nmax,t_s #si--��� L�EcsIFlloc� caM er,---------------------'Readi.E co!mandelin, a)gsafail,d!', ---ginys, max,phys,mis,ttttttx,t�l100hys,mis,is,-te -FDD& issE-te -FDD& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! P_(se-help flag D& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE (help_enabled5dl', DD& issE Nmax,tfind_flag('-h', okphys,mis,ttt (.NOT.-okpNmax,tfind_flag('--help', okphys,mis,ttt (okpNl', DD& issE N Nmax,t_r'Rg_helpDD& issE N N-'WORK'exig_gracefully ys,mis,ttttttx,t�l100hys,mis,is,-te -FDD& issE-te -FDD& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! P_(se-rest weibupcommandelin, D& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issEmax,t__(se_cmd_lin,F'R :)hys,m (-'WOR.NE 05dl', DD& issE N-'WORK',__LINE__,fatalDD& issE Nmax,t_s #si--��� L�EcsIF--debug� caM er,---------------------'P_(sT.E co!mandelin, a)gsafail,d!', ---ginys, max,phys,mis,tttx,t�l100hys,mis,-te -FDD& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! Control fil, D& issE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE (ctrl_enabled5dl', DD& issE Nmax,tfind_flag('--pr'Rg-ctrl', okphys,mis,ttt (okpNl', DD& issE N Nmax,t_r'Rg_ctrl D& issE N N-'WORK'exig_gracefully ys,mis,ttttttx,t�l100hys,mis,is,-te -FDD& issE Nmax,tfind_ar-(1, ok,-ctrl_fil,_namephys,mis,ttt! issEND---------------------------------ginys,max,phys,mis,t�lEmhys,mis,ttt! P_(se-control fil, D& issEttt! issEND---------------------------------ginys,max,phys,mis,t�lEmhys,mis,tttmax,t__(se_ctrl_fil,(max,phys,mis,ttt (-'WOR.NE 05dl', DD& issE N N-'WORK',__LINE__,fatalDD& issE N Nmax,t_s #si--��� L�EcsIF--debug� caM er,---------------------'P_(sT.E control fil, fail,d!', ---ginys, max,phys,mis,ttttttx,t�l100hys,mis,is,-te -FDD& issE-te -FD#ifdes�cgF2003--------! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! Call iefault funcshys,mssE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issEmax,tcaM _iefault_funcsF'R :)hys,m (-'WOR.NE 05dl', DD& issE N-'WORK',__LINE__,fatalDD& issE Nmax,t_s #si--��� L�EcsIF--debug� caM er,------------------'CallT.E iefault funco M safail,d!', ---ginys, max,phys,mis,tttx,t�l100hys,mis,-te -FD#A(INd- uåt! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! C---- minmaxhys,mssE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issEmax,tc----_minmaxF'R :)hys,m (-'WOR.NE 05dl', DD& issE N-'WORK',__LINE__,fatalDD& issE Nmax,t_s #si--��� L�EcsIF--debug� caM er,------------------'Min/eax ----- fail,d!', ---ginys, max,phys,mis,tttx,t�l100hys,mis,-te -FD#ifdes�cgF2003--------! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! Run validatorshys,mssE! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issEmax,tcaM _validator_funcsF'R :)hys,m (-'WOR.NE 05dl', DD& issE N-'WORK',__LINE__,fatalDD& issE Nmax,t_s #si--��� L�EcsIF--debug� caM er,------------------'CallT.E validator funco M safail,d!', ---ginys, max,phys,mis,tttx,t�l100hys,mis,-te -FD#A(INd- uåt! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& issE! DONE!- uåt! issEND---------------------------------ginys,max,phys,mis,t�lEmax,DD& i-te -FE! ((Ecsrank åEQ 05 ,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Exchange ieta ,m! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lh100 mONTINUEh#ifdes�cgMPIu! ,mmax,tMPI_BCast(whag� length,tMPI_TYPE, 0,Tco!m, max,phys,mmax,tMPI_BCast(max,, 1,tMPI_INTEGER, 0�-(Ecsco!m, max,2)- (-'WOR.NE 05dx,t�l9999 hys,m! scalari ys,mDO i=1,INTEGER_c)gs_iDD& issEmax,tMPI_BCast(INTEGER_c)gs(i)%variabl,, 1,tMPI_INTEGER, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,LONGINT_c)gs_iDD& issEmax,tMPI_BCast(LONGINT_c)gs(i)%variabl,, 1,tMPI_INTEGER8, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tp1Dt,_c)gs_iDD& issEmax,tMPI_BCast(tp1Dt,_c)gs(i)%variabl,, 1,tMPI_ u, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tp1Dt,_c)gs_iDD& issEmax,tMPI_BCast(tp1Dt,_c)gs(i)%variabl,, 1,tMPI_tp1Dt,Gal-------, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tTRp1D_c)gs_iDD& issEmax,tMPI_BCast(tTRp1D_c)gs(i)%variabl,, (Ecschar,tMPI_CHARACTER, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,LOGICAL_c)gs_iDD& issEmax,tMPI_BCast(LOGICAL_c)gs(i)%variabl,, 1,tMPI_LOGICAL, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,COMPLEX_c)gs_iDD& issEmax,tMPI_BCast(COMPLEX_c)gs(i)%variabl,, 1,tMPI_COMPLEX, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tCOMPLEX_c)gs_iDD& issEmax,tMPI_BCast(DCOMPLEX_c)gs(i)%variabl,, 1,tMPI_tp1Dt,GCOMPLEX, 0�-(Ecsco!m, max,)DD& i-te DO hys,m! a) TH ys,mDO i=1,INTEGER_c) TH_a)gs_iDD& issEmax,tMPI_BCast(INTEGER_c) TH_a)gs(i)%variabl,, -------------------SIZE(INTEGER_c) TH_a)gs(i)%variabl,),tMPI_INTEGER, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,LONGINT_c) TH_a)gs_iDD& issEmax,tMPI_BCast(LONGINT_c) TH_a)gs(i)%variabl,, -------------------SIZE(LONGINT_c) TH_a)gs(i)%variabl,),tMPI_INTEGER8, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tp1Dt,_c) TH_a)gs_iDD& issEmax,tMPI_BCast(tp1Dt,_c) TH_a)gs(i)%variabl,, -------------------SIZE(tp1Dt,_c) TH_a)gs(i)%variabl,),tMPI_ u, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tp1Dt,_c) TH_a)gs_iDD& issEmax,tMPI_BCast(tp1Dt,_c) TH_a)gs(i)%variabl,, -------------------SIZE(tp1Dt,_c) TH_a)gs(i)%variabl,),tMPI_tp1Dt,Gal-------, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tTRp1D_c) TH_a)gs_iDD& issEmax,tMPI_BCast(tTRp1D_c) TH_a)gs(i)%variabl,, -------------------SIZE(tTRp1D_c) TH_a)gs(i)%variabl,) * (Ecschar,tMPI_CHARACTER, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,LOGICAL_c) TH_a)gs_iDD& issEmax,tMPI_BCast(LOGICAL_c) TH_a)gs(i)%variabl,, -------------------SIZE(LOGICAL_c) TH_a)gs(i)%variabl,),tMPI_LOGICAL, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,COMPLEX_c) TH_a)gs_iDD& issEmax,tMPI_BCast(COMPLEX_c) TH_a)gs(i)%variabl,, -------------------SIZE(COMPLEX_c) TH_a)gs(i)%variabl,),tMPI_COMPLEX, 0�-(Ecsco!m, max,)DD& i-te DO ys,mDO i=1,tCOMPLEX_c) TH_a)gs_iDD& issEmax,tMPI_BCast(tCOMPLEX_c) TH_a)gs(i)%variabl,, -------------------SIZE(tCOMPLEX_c) TH_a)gs(i)%variabl,),tMPI_tp1Dt,GCOMPLEX, 0�-(Ecsco!m, max,)DD& i-te DO h#A(INd- ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Ei--� handlT.E- ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhys,m! cleanuphys,mmax,tdeFllocate_memory(-'WOR.NE 05hys,mmax,tslE�åop(caM er,-t0, 'R :)hys,mRETUR DD&elp, disabl,_ct(i)%variab0, 'R :)hdltssEmax,tMPI_=1,tTRp1D_c) TH_a)gs_iDD& issEmax,a,mRETUR DD&elp, disabl,_ct(ig6b.(OR.NE 05hys,mmax,tslE�åop(caM er,-t0, 'R :)hys,mRETUR DD&elp, disabl,_ct Zsa=>lCALL() ysLOGICAL, POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER ::-groups_i = y-1 cl! specie,fogrouriab ::CallT.E validriabASSOCIATED(-��� L�E) D%vaLOCATE(-��� L�E).E validriabASSOCIATED(-��� L�E ) D%vaLOCATE(-��� L�E ).E validriabASSOCIATED(-��� L�E ) D%vaLOCATE(-��� L�E )ys,m! Exch(Ecsco!m, max,alidriabASSOCIATED(,tMPI_BCast() D%vaLOCATE(,tMPI_BCast(),alidriabASSOCIATED(,tMPI_BCast() D%vaLOCATE(,tMPI_BCast(),alidriabASSOCIATED(_BCast(tp1D) D%vaLOCATE(_BCast(tp1D),alidriabASSOCIATED(issEmax,tMP) D%vaLOCATE(issEmax,tMP),alidriabASSOCIATED(,tMPI_BCast() D%vaLOCATE(,tMPI_BCast(),alidriabASSOCIATED(_issEmax,tM) D%vaLOCATE(_issEmax,tM),alidriabASSOCIATED(GER_c) TH_a)) D%vaLOCATE(GER_c) TH_a)),alidriabASSOCIATED(iGER_c) TH_a)) D%vaLOCATE(iGER_c) TH_a)),alidhys,mi-te FUriabASSOCIATED(,tMPI_BCas--------) D%vaLOCATE(,tMPI_BCas--------),alidriabASSOCIATED(,tMPI_BCas--------) D%vaLOCATE(,tMPI_BCas--------),alidriabASSOCIATED(_BCast(tp--------) D%vaLOCATE(_BCast(tp--------),alidriabASSOCIATED(a)gs_iDD& issEmax) D%vaLOCATE(a)gs_iDD& issEmax),alidriabASSOCIATED(,tMPI_BCas--------) D%vaLOCATE(,tMPI_BCas--------),alidriabASSOCIATED(_issEmax,--------) D%vaLOCATE(_issEmax,--------),alidriabASSOCIATED(GER_c) TH_--------) D%vaLOCATE(GER_c) TH_--------),alidriabASSOCIATED(iGER_c) TH_--------) D%vaLOCATE(iGER_c) TH_--------),alid!al_fun,alidriabASSOCIATED(.TRUE.) D%vaLOCATE(.TRUE.),alidriabASSOCIATED(.TRUE ) D%vaLOCATE(.TRUE ),alidriabASSOCIATED(.TRUE ) D%vaLOCATE(.TRUE ),alidriabASSOCIATED(.TRUE D%vaLOCATE(.TRUE l,_ct(ig6b.(OR.NE -----lEmaxDebuggse_arbupcesceful exampl. R----spr'Rg !!! saultsF'R :.variab0, 'R :)hdltssEmax,tMP) )(Ecsco!m, max,alidr D------- D------- D------- D------- D------- D------- D------- D--------ys,mi-te FUr) ysINTEGER L() ysINTEGER -- GER -- GER --() ysINTEGER L() ysINTEGER L() ysINTEGER aaa=>lCALL() ysINTEGER, id!al_fun,alidRsCHARACTER(LEN D-------LL() ysINTEGER, D-------.TRUE. ysLOGICA D- ACTER(LEN=(Ecsch D-) ACTER(LEN=(Ecsch D-) ACTER(OGICAL D- SE. mONTAINSiss D- SE� Rs! Mastur D-)cedure ,_ct(ig6b.(OR.NE -----lssEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #define( O-------------lssEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #defineg6b.(OR.NE � L�EcsIF--debug� caM er,mis,t�lEmax,t�lhys,m! s,m! issEND-hys,mis,t�lEmax,t�lhys,nys,max,pr funco id!am, max,lude "ctrl/typ,.f" #de�lE� Rs! IRgesIF--de�����e "ctrl/typ,.f" #defi�lE� Rs! IRgesIF--de�����e "ctrl/typ,.TYPElLOGICAL_a) TH #desIF--de�����e "ctrl/typ,. DTYPEltTRp1D_a) TH #dsIF--de�����e "ctrl/typ,.f"YPElCOMPLEX_a) TH #desIF--de�����e "ctrl/typ,.TDTYPEltCOMPLEX_a) TH sIF--de�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRgesIF--de�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRgesIF--de����lLONGINT_a) TH #de#include "ctrl/typ,.f�lE� Rs! IRgesIF--de�����e "ctrl/typ,.f" #del/typ,.f�lE� Rs! IRgesIF--de�����e "ctrl/typ,.ctrl/typ,.f" ICAL_a) TH #desIF--de�����e "ctrl/typ,. DTYPEl/typ,.f�lE� Rs! IRgesIF--de�����e "ctrl/typ,.f"ctrl/typ,.f" PLEX_a) TH #desIF--de�����e "ctrl/typ,.TDTYPEtyp,.f" PLEX_a) TH #desIF--de�����e "ctrl/typ,.------ginys,max�lE� Rs! IRgesIF--de�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRgesIF--de����,_ct(ig6b.(OR.NE � L�EcsIF--debx,tslE�åop(caM er,-t0, 'R :)hys,mRETUR DD&elp, disabl,_ct Zsa=>lCALL() ysLOGICAL, (.NOT----------------- POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER #si--��� L�EcsIFlloc� cmis,t�lEmax,t�lhys,m! LocalEvars,m! issEND- ::-in_ bufsEND-hys,mis,t�lEmax,t�lhys,LocalEvars,m!& #Aart, nEND--ER, 0�-(EcscoER, 0�-(ESUPtrlUX.E validnEND-ncosEND-().E valid#Aartnco #elif _(se_ad-(ESunOS .E validnEND-ncosEND-() - 6.E valid#Aartnco #elif _(se_ad-(EHPlUX .E validnEND-ncosEND-() + 1.E valid#Aartnco1 #elif _(se_ad-(EIRIX64 .E validnEND-ncosEND-() - 4.E valid#Aartnco1 #elif _(se_ad-(ELinux.E validnEND-ncoys,mAND_ARGUMt�l_COU�lh).E valid#Aartnco #elif _(se_ad-(EMacOS.E validnEND-ncosEND-() - 4.E valid#Aartnco #el/licensesdnEND-ncoys,mAND_ARGUMt�l_COU�lh).E valid#Aartnco #e issE#el/licensesdnEND-ncoys,mAND_ARGUMt�l_COU�lh).E valid#Aartnco #e issEE validRsCHARACTER=dnEND---------ggggggvalu,dltss POINNNNNNriabASSOCIATED(-��� L�E) D%vaLOCATE(-��� L�E).E validriabASSOCIATED(-��� L�E ) D%vaLOCATE(-��� L�E ).E validriabASSOCIATED(-��� L�E ) D%vaLOCATE(-��� L�E )ys,m!!!!vaLOCATE(-��� L�E(1:RsCHARACTE ::-tCOSTAT=,mis,t�lEmax,vaLOCATE(-��� L�E (1:RsCHARACTE ::STAT=,mis,t�lEmax,vaLOCATE(-��� L�E (1:RsCHARACTE :STAT=,mis,t�lEmax,riabl,, 1,tMPI_IN disabl,_validRsCHARACT D-)cedure ,_gggggvar (.NOTr'Rg---- DCOMPLERsCHARACTE#A(INd- b0, 'ge---gult va+!& buf,t�lEmax,DD&-��� L�E (i) D- _DTYM( buf,t�lEmax,DD&-��� L�E(i) = buf(1:RsCHARACT (i),t�lEmax,------SIZct(ig6b.(OR.NE --si--��� L�ElssEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #define( ,t__(se__lin,F'R :)hyEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #defineg6b.(OR.NE � L�EcsIF--debug� caM er,mis,t�lEmax,t�lhys,m! Locals,m! issEND- GICAL D- � L�EcsIF--debmINTEGER :: vax,alidr s,m!& ios --() ysIN s,mmINTEGE() ysIN s,merr D-)cedure ,_ggER fo2hys,mINTEG!am, max,lude "ctrl/typ,.f" #de�lE� Rs! IRge 05hys,mm�����e "ctrl/typ,.f" #defi�lE� Rs! IRge 05hys,mm�����e "ctrl/typ,.TYPElLOGICAL_a) TH #de 05hys,mm�����e "ctrl/typ,. DTYPEltTRp1D_a) TH #d 05hys,mm�����e "ctrl/typ,.f" #define DTYPElCOMPLEX #define htCOMPL 05hys,mm�����e "ctrl/typ,.TDTYPEltCOMPLEX_a) TH 05hys,mm�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRge 05hys,mm�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRge 05hys,mm����lLONGINT_a) TH #de#include "ctrl/typ,.f�lE� Rs! IRge 05hys,mm�����e "ctrl/typ,.f" #del/typ,.f�lE� Rs! IRge 05hys,mm�����e "ctrl/typ,.ctrl/typ,.f" ICAL_a) TH #de 05hys,mm�����e "ctrl/typ,. DTYPEl/typ,.f�lE� Rs! IRge 05hys,mm�����e "ctrl/typ,.f"ctrl/typ,.f" PLEX_a) TH #de 05hys,mm�����e "ctrl/typ,.TDTYPEtyp,.f" PLEX_a) TH #de 05hys,mm�����e "ctrl/typ,.t�lEmaxinys,max�lE� Rs! IRge 05hys,mm�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRge 05hys,mm����ETUR DD&elp, disct(ig6b.(OR.NE 05hyssIF--debx,tslE�åop(caM er,-t0, 'R :)hys,mRETUR DD&elp, disabl,_ct Zsa=>lCALL() ysLOGICAL, ,t__(sbled5dl', DD& i! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Ar-debugshys,m--��� L�EcsIF--debugmis,t�lEmax,t�lhys,m! Locals,m! issEND- GICAL ::-ok--��� L�EmINTEGER :: buf, vas,m-te ly vax,alidER :: urrghrivax,alidER 1����) fo2errmsg,alidr s,m! k,-ctrl_fr s,m!Unit, ilt t& ios --() ysIN s,mlExilt,alidr s,m! R :)hys,r s,m! ,alidr s,m!&j,idx.E va! issEND---------------------------------ginys,max,phys,mis,t�INTEG!aminmaxF!! FGOT--iunc_]Tcusexilt iar-chys,m! issEND---------------------------------ginys,max,phys,max,pr k,-c D- _DTYM( e-control fil, D& iriabl k,-c .LT. 1:CallT.E validr funco M safail,d!', ---ginysax,phys,mis,tttx,t�l100hys,mis,-te -FD#A(INd- uåt! i'No-iunc_]Tcuscontninys,max,phys,mis,t�lEmax,TEGER, 0�-max, Exch(EcscINQUIRE(FILE= e-control fil, EXIST=lExilt, D& iriabRK'exilExilt,CallT.E validr funco M safail,d!', ---ginysWRITE(-vax,'(2A)')i'No-s)g),ntro: '_(se-control fil(1:l k,-c)---ginysax,phys,mis,tttx,t�l100hys,mis,-te -FD#A(-vax,ys,max,phys,mis,t�lEmax,TEGER, 0�-max, Exch(Ecsc! issEND---------------------------------ginys,max,phys,mis,t�INTEG!amOpeOT.-inil,(max,pchys,m! issEND---------------------------------ginys,max,phys,max,prUnitnco1�-max,OPEN(!Unit, FILE= e-control fil, IOSTAT=,os, Amis,t='READ', D& iriablos-------'CallT.E validr funco M safail,d!', ---ginysWRITE(-vax,'(2A)')i'F-----, opeOTntro: '_(se-control fil(1:l k,-c)---ginysax,phys,mis,tttx,t�l100hys,mis,-te -FD#A(-vax,ys,max,phys,mis,t�lEmax,TEGER, 0�-max, Exch(Ecsc! issEND---------------------------------ginys,max,phys,mis,t�INTEG!amSp deil,(max,pchys,m! issEND---------------------------------ginys,max,phys,max,pr-----co idvax_loop:---SIZE(x,pr-----cor-----+ 1.E validchys,m! issEND---------------------------------ginys,max,ph ,_gggggva (.'R :)hys,m (-'WOR.NE 05dl', DD& issE N-'WORK',__LINE__,fatalDD& )hys,m READ(!Unit,'(A)',, E 1��,, RR=2��) bufsEND- ,pr D- _DTYM( buf,t�lEmax,chys,m! issEND---------------------------------ginys,max,ph ,_gggggva Skipse__l-----r empty.'R :s t�lEmax,chys,m! issEND---------------------------------ginys,max,ph ,_gggggriabl .Gexi0 .AND. buf(1:1:C-----'#''CallT.E validatochys,m! issEND---------------------------------ginys,max.E validatoca move sp _(se_validatochys,m! issEND---------------------------------ginys,max.E validatoj-co idddddddDCOMPLE! ,aliddddddddddt_r'Rbuf(i:i:C-----' ''CallT.E validatolidatoj-coj-+ 1.E validdddddddddRbuf(j:j) = buf(i:i:.E validddddddys,max,phys,mis,t------SIZE(lidatochys,m! issEND---------------------------------ginys,max.E validatoca UpsuppoNE 05t__(#A(INdSIZE(lidatochys,m! issEND---------------------------------ginys,max.E validator D-jSIZE(lidatochys,m! issEND---------------------------------ginys,max.E validatoca FindttT!tryout__(=SIZE(lidatochys,m! issEND---------------------------------ginys,max.E validatordx D-INDEX( buf, '=', D& issEttt! issEND---------------------------------ginys,max,phys,.E validatoca Es- if missINdSIZE(lidatochys,m! issEND---------------------------------ginys,max.E validatoriabldx .LT. ----------'P_(sT.E control fil, fail,d!', ---ginys, max,pWRITE(-vax,'(A,I5)')i'Incorrgct.'R :: '_(i'R :)hys,m ax,phys,mis,tttx,t�l100hys,mis,-te -FD#A(-vax,ys,max,phys,mis,t�lEmax,,,,,,,TEGER, 0�-max,,,,,,,---ax,phys,mis,t! issEND---------------------------------ginys,max,phys,.E validatoca Get----------in,Fhys,mINTEG,mis,t! issEND---------------------------------ginys,max,phys,.E validatoe ly = ADJUSTL( buf(1:ldx-1),t�lEmax,DD&-elp_ f= ADJUSTL( buf(ldx+1:l ), D& issEttt! issEND---------------------------------ginys,max,phys,.E validatoca blevert, upp_namasmINTEG,mis,t! issEND---------------------------------ginys,max,phys,.E validatoax,phUpp_nCasm(e ly ldx-1ys,mis,t�lEmax,,,,chys,m! issEND---------------------------------ginys,max.E validatoca Findtidator ::-[_t�lEmax,,,,chys,m! issEND---------------------------------ginys,max�lEmax,,,,.E validatocam, max,lude "ctrl/typ,.f" #de�lE� Rs! IRge 05hys IRg�����e "ctrl/typ,.f" #defi�lE� Rs! IRge 05hys IRg�����e "ctrl/typ,.TYPElLOGICAL_a) TH #de 05hys IRg�����e "ctrl/typ,. DTYPEltTRp1D_a) TH #d 05hys IRg�����e "ctrl/typ,.f"MPLEX #define htCOMPL 05hys IRg�����e "ctrl/typ,.T" #define DTYPEltCOMPLEX #define htDC 05hys IRg�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRge 05hys IRg�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRge 05hys IRg����lLONGINT_a) TH #de#include "ctrl/typ,.f�lE� Rs! IRge 05hys IRg�����e "ctrl/typ,.f" #del/typ,.f�lE� Rs! IRge 05hys IRg�����e "ctrl/typ,.ctrl/typ,.f" ICAL_a) TH #de 05hys IRg�����e "ctrl/typ,. DTYPEl/typ,.f�lE� Rs! IRge 05hys IRg�����e "ctrl/typ,.f"ctrl/typ,.f" PLEX_a) TH #de 05hys IRg�����e "ctrl/typ,.T" #dtyp,.f" PLEX_a) TH #de 05hys IRg�����e "ctrl/typ,.t�lEmaxinys,max�lE� Rs! IRge 05hys IRg�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRge 05hys IRg����,,,,,,,---max,phys------dvax_loop,physTEGER, 0�-31,tMPI_INTEGphysntrol fil, fail,d!', ---ginWRITE(errmsg,'(5A,I5,2A)')i'm! clerssE! isor ::-[_: '_(((((h#A(INd- ! issEN urrghrivax(1: _DTYM( urrghrivax) ::-tTRph#A(INd- ! issEN' from(#A(INd: '_(selp_ (1: _DTYM( elp_ ) h#A(INd- ! issEN' out'R :: '_(i'R :-(:) ::-INTEGER_c)gsaaaa=>lh#A(INd- ! issEN' ofTntro: '_(se-control fil(1:l k,-c)---giax,phys,mis,tttx,t�l100hys,mis,-te -FD#A(errmsg,ys,max,phys,mis,t�lEmTEGER, 0�-21,tMPI_INTEGphysntrol fil, fail,d!', ---ginWRITE(errmsg,'(A,I5,2A)')i'm! clerssE! is'R :: '_(i'R :-(:) :h#A(INd- &NTEGER_c)gsaaaa=>l' ofTntro: '_(se-control fil(1:l k,-c)---giax,phys,mis,tttx,t�l100hys,mis,-te -FD#A(errmsg,ys,max,phys,mis,t�lEmTEGER, 0�-11,tMPI_INTEGphys-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhys,Closinil,(max,pchys,m! issEND---------------------------------ginys,max,phys,9999 mONTIETUR DD&elp, disabCLOSE(!UnitD&elp, disabl,_ct(ig6b.(OR.NE 05hysse-controlidatorshys,mssE! slE�åop(caM er,-t0, 'R :)hys,mRETUR DD&elp, disabl,_ct Zsa=>lCALL() ysLOGICAL, M _iefault_funcsF'R ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Ar-debug--��� L�EcsIF--debug� caM er,mis,t�lEmax,t�lhys,m! Locals,m! issEND- GICAL D- --��� L�EcsIF--deb',alidr s,m!,lude "ctrl/typ,.f" #de�lE� Rs! IRgesIF--deF--de�����e "ctrl/typ,.f" #defi�lE� Rs! IRgesIF--deF--de�����e "ctrl/typ,.TYPElLOGICAL_a) TH #desIF--deF--de�����e "ctrl/typ,. DTYPEltTRp1D_a) TH #dsIF--deF--de�����e "ctrl/typ,.f"YPElCOMPLEX_a) TH #desIF--deF--de�����e "ctrl/typ,.TDTYPEltCOMPLEX_a) TH sIF--deF--de�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRgesIF--deF--de�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRgesIF--deF--de����lLONGINT_a) TH #de#include "ctrl/typ,.f�lE� Rs! IRgesIF--deF--de�����e "ctrl/typ,.f" #del/typ,.f�lE� Rs! IRgesIF--deF--de�����e "ctrl/typ,.ctrl/typ,.f" ICAL_a) TH #desIF--deF--de�����e "ctrl/typ,. DTYPEl/typ,.f�lE� Rs! IRgesIF--deF--de�����e "ctrl/typ,.f"ctrl/typ,.f" PLEX_a) TH #desIF--deF--de�����e "ctrl/typ,.TDTYPEtyp,.f" PLEX_a) TH #desIF--deF--de�����e "ctrl/typ,.t�lEmaxinys,max�lE� Rs! IRgesIF--deF--de�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRgesIF--deF--de����ETUR DD&elp, disct(ig6b.(OR.NE --��� L�EcsIF--debD---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER nmaxF'R :)hys,! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Ar-debug-�EcsIF--debug� caM er,mis,t�lEmax,t�lhys,m! Locals,m! issEND- GICAL D- -�EcsIF--debmINTEGER :: vax,alidr s,m!,lude "ctrl/typ,.f" #de�lE� Rs! IRgeF--deb�����e "ctrl/typ,.f" #defi�lE� Rs! IRgeF--deb�����e "ctrl/typ,.TYPElLOGICAL_a) TH #deF--deb�����e "ctrl/typ,. DTYPEltTRp1D_a) TH #dF--deb����! �e "ctrl/typ,.TDTYPEl! �e "ctrlPEltCOMPL! �ICAL_a) TH #deF--deb�����e "ctrlD-----) TH #de#include "ctrl/typ,.f�lE� Rs! IRgeF--deb�����e "ctrl/typ,.f" #del/typ,.f�lE� Rs! IRgeF--deb�����e "ctrl/typ,.ctrl/typ,.f" ICAL_a) TH #deF--deb�����e "ctrl/typ,. DTYPEyp,.f" ICAL_a) TH #deF--deb����! �e "ctrl/typ,.TDTYPEyp,.f" ! �e "ctrlPEltCOMPL! �ICAL_a) TH #deF--deb�����untorsD-----ETUR DD&elp, disct(ig6b.(OR.NE -�EcsIF--deblidatorshys,mssE! slE�åop(caM er,-t0, 'R :)hys,mRETUR DD&elp, disabl,_ct Zsa=>lCALL() ysLOGICAL, M _i-------------------'R ! issEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lhys,m! Ar-debug--����� L�EcsIF--debug� caM er,mis,t�lEmax,t�lhys,m! Locals,m! issEND- GICAL D- --����� L�EcsIF--debmINTEGER :: vax,alidr s,m!,NUEhysm, max,lude "ctrl/typ,.f" #de�lE� Rs! IRge�� L�Ece�����e "ctrl/typ,.f" #defi�lE� Rs! IRge�� L�Ece�����e "ctrl/typ,.TYPElLOGICAL_a) TH #de�� L�Ece�����e "ctrl/typ,. DTYPEltTRp1D_a) TH #d�� L�Ece�����e "ctrl/typ,.f"YPElCOMPLEX_a) TH #de�� L�Ece�����e "ctrl/typ,.TDTYPEltCOMPLEX_a) TH �� L�Ece�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRge�� L�Ece�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRge�� L�Ece����lLONGINT_a) TH #de#include "ctrl/typ,.f�lE� Rs! IRge�� L�Ece�����e "ctrl/typ,.f" #del/typ,.f�lE� Rs! IRge�� L�Ece�����e "ctrl/typ,.ctrl/typ,.f" ICAL_a) TH #de�� L�Ece�����e "ctrl/typ,. DTYPEl/typ,.f�lE� Rs! IRge�� L�Ece�����e "ctrl/typ,.f"ctrl/typ,.f" PLEX_a) TH #de�� L�Ece�����e "ctrl/typ,.TDTYPEtyp,.f" PLEX_a) TH #de�� L�Ece�����e "ctrl/typ,.t�lEmaxinys,max�lE� Rs! IRge�� L�Ece�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRge�� L�Ece����ETUR DD&elp, disct(ig6b.(OR.NE --����� L�EcsIF--debD---------------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER S POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER FALSEeND----EmaxTurns ofTd5dl', DD 05hinge ,_ggCTER(LEN=(EcsD-)cedure ,_ct(ig6b.(OR.NE FALSEeND---- FALSEeNk,-ctEmaxTurns ofT------! issEN 05hinge ,_ggse-coLEN=(EcsD-)cedure ,_ct(ig6b.(OR.NE FALSEeNk,-ct se ok,-cl fil( fil, EmaxS--spse_cmd----! issEN file ,_ggER GICA = y-1 cl! sp s,m fil EmaxN __(se_cmd----! issE ACTER(OGICAL =m fil ,_ct(ig6b.(OR.NE se ok,-cl fil---------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER Set------------------g(usEND-- ::-erunn! isRs! E).E POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER adi--��( ly elp_ )lEmaxDebuggse_arbupcescefulsF'R :)hy. First --�� replacespse_cactuactEmax--------hys,mis,s ! ispse_csupplie,Fhys,ms. Mn be d :)nylEmax,imespsom! cremis,aout buildtidatfake----------liste ,_ggER GICA = y-1 cl! sp s,m---lEmaxA--------#A(INdpsombe app-----, idatliste ,_ggER GICA = y-1 cl! s, OPis,tAL fo2hys,mIEmaxOacefu p_ f app---e ,_ggER ::-tCOMPLEX_c) TH_a)gs_i =temp_aCAL INTER, DIMEN----(:) :::-tCOMPLEX_c) TH_a)gs_i =temp_lCAL INTER, DI s,m!nc INTER, DI s,mlGphysntINSiss! ) A!ncnco1 INTF (PRES y-1elp_ ) A!nc=2 INTF (RK'exiASSOCIATED(-��� L�E) -------'P_(svaLOCATE(-��� L�E(1:di),t�lEmax,vaLOCATE(-��� L�E (1:di),t�lEmax,vaLOCATE(-��� L�E (1:di),t�lEmax,RsCHARACT D-)cedure ,_ggEdurt�lEmax,c D-D-----��� L�E).E validriabc .LT. RsCHARACTER+A!nc---------'P_(sT.EvaLOCATE(temp_a(1:bc + di),)---'P_(sT.EvaLOCATE(temp_l(1:bc + di),)---'P_(sT.Etemp_a(1:l) = ��� L�E(1:l)---'P_(sT.Etemp_l(1:l) = ��� L�E (1:l)---'P_(sT.ED%vaLOCATE(-��� L�E).E validT.ED%vaLOCATE(-��� L�E ).E validT.ED%vaLOCATE(-��� L�E )ys,m!!!!ax,vaLOCATE(-��� L�E (1:(l+di),)---'P_(sT.EICAL, AL temp_a---'P_(sT.EICAL, AL temp_l---'P_(sT.EICAL, D-)cedure ,_ggggg---max,phys----ax,physLL() y=sLL() y+ 1.E vaRsCHARACTER=dRsCHARACTER+A1.E vaRsCHARAC(RsCHARACTE A ---lsT.EICAL, (RsCHARACTE D- ( l,_x,riabl,c,m! is2---------'P_(sLL() y=sLL() y+ 1.E va vaRsCHARACTER=dRsCHARACTER+A1.E va vaRsCHARAC(RsCHARACTE A hys,mINTEG,miICAL, (RsCHARACTE D- (elp_ )lphys----ax,phct(ig6b.(OR.NE �di--��.E POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER METER Look-ul', DD-lssEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #defineg6b.(OR.NE racefully ully,-s)gcess elp_ A(err)lEmaxReturns idatorp_ fsupplie,F! ispse_c, DD fully_e ,_ggER GICA = y-1 cl! sp s,m, DD&EmaxF DD #A(INdp(eg. _'-f'_--r _'--, DD'_)e ,_gg ax,t�lhys,m! LocalEvariabs,ms)gcesstEmaxTr_ fonms)gcess. False if _fune is no-s)g),n DD -r idatorp_ fistEmaxnotfsupplie,e ,_ggER GICA = y-1ys,m! , OPis,tAL fo2hys,mIEmaxTdatorp_ f__(#upplie,Ff-r idatn DD ( acter #A(INd)e ,_gg ax,t�lhys,m! , OPis,tAL fo2errlEmaxReturns ) if _futn DD wasfsupplie,F! isout atorp_ . INTER, DI s,m!,NUEh:-valu,h LOGICAL s,m D- racefullymINTEGER :: s,m vax,alidr s,m! issEND-s)gcess D-)cedure ,_ggTF (PRES y-1err))merr D-)cedure ,_ggt_r'RsCHARACTERult valu disabl,_vaDCOMPLERsCHARACTE#A(INd- t_r'RsCHARAC(i)(1:RsCHARACT (i),Rult vully---------'P_(sT.Es)gcess ! ) A(INd- t_r'RK'exi-��� L�E (i),RLL() y=sLL() y- 1.E validddd-��� L�E (i) ! ) A(INd- t_r'PRES y-1elp_ ) A-------'P_(sT.E coriabl+1 .GexiRsCHARACTE allT.E validatolidatos)gcess D-)cedure ,_gg-'P_(sT.E coriabPRES y-1err))merr D-) A(INd- ntrol ! il, fail,dwarnINdSIZE(lidatoooooooWRITE (-vax,*) "F DD ", ully,-" requirespMn --------."SIZE(lidatoooooooax,phys,mis,tttx,t�l100hys,mis,-te -FD#A(-vax,y& issE-te -FD#ifdes����s,max,phys,mis,t�lEmax,,,,,,,Edurt�lEmax,,,,,,,,,,elp_ f= RsCHARAC(i+1) ,_gg-'P_(sT.E coriabRK'exi-��� L�E (i+1),RLL() y=sLL() y- 1.E validddddddddd-��� L�E (i+1) D-) A(INd- ys,max,phys,mis,t----ax,phys,mis,t disabl,_valid---max,phys------,phct(ig6b.(OR.NE racefully---------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER Get----x--un-lssEND---------------------------------ginys,max,phys,mis,t�lEmax,t�lE�å #de idr FUNmis,t----_--un-()lEmaxReturns idatnumb __(tT!tryou ,mis,s f-un,e ,_gg---_--un-y=sLL() ,phct(iFUNmis,t----_--un----------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER Look-ul'----g(after -�� , DD- havembe rssEEma).E POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER ys,mis,tttT!tryou,-s)gcess elp_ )lEmaxReturns a(tT!tryou ,mis,,tMP_tT!tryou_. INTER, DI ax,t�lh cl! sp s,mtT!tryoulEmaxI---x __(se_ctT!tryou ,mis,, 1 base,e ,_gg ax,t�lhys,m! Ls,ms)gcesstEmaxTr_ fonms)gcess. False if _fune is no-tT!tryou F! ispse_tEmaxsupplie,Fi---xe ,_ggER GICA = y-1 c,m! Ls,mhys,mIEmaxTdatorp_ f__(se_ctT!tryou ,mis, ( acter #A(INd)e ,_ggr s,m!& jSIZE(j-co ids)gcess D-)cedure ,_ggDCOMPLERsCHARACTE#A(INd- t_r'RK'exi-��� L�E (i),RallT.E validatoj-coj-+ 1.E validdddt_r'tT!tryoutult vj allT.E validatolidorp_ f f= RsCHARAC(i) ,_gg-'P_(sT.Es)gcess D-) A(INd- disabl,_valid ,t----ax,phys,mi---max,phys------,phct(ig6b.(OR.NE racef---lsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER A--------.TRUE..E POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER a--_.TRUE( fil, EmaxD "ctrspMn ---------.TRUEe ,_ggER GICA = y-1 cl! sp s,m fil EmaxGTRUEm fil ,_ggER ::-tCOMPLEX_c) TH_a)gs__i =temp_g INTER, DI :::-tCOMPLEX_c) TH_a)gs__i =temp_s INTER, DI :::-tCOMPLEX_c) TH_a)gs__i =temp_m ,_gg :::-tCOMPLEX_c) TH_a)gs__i =temp_c ,_gg :::-tCOMPLEX_c) TH_a)gs__i =temp_a---'P.TRUE. ys=P.TRUE. ys+o1 INTF (RK'exiASSOCIATED(.TRUE.) -------'P_(svaLOCATE(.TRUE.(0:di),t�lEmax,vaLOCATE(.TRUE (0:di),t�lEmax,vaLOCATE(.TRUE maxT (0:di),t�lEmax,vaLOCATE(.TRUE (0:di),t�lEmax,vaLOCATE(.TRUE s,tt0:di),t�lEmEdurNTF (.TRUE. y+1 .GexiD----.TRUE.) -------'P_(svaLOCATE(temp_gt0:(D----.TRUE.)+di),)---'P_(svaLOCATE(temp_st0:(D----.TRUE.)+di),)---'P_(svaLOCATE(temp_mt0:(D----.TRUE.)+di),)---'P_(svaLOCATE(temp_ct0:(D----.TRUE.)+di),)---'P_(svaLOCATE(temp_at0:(D----.TRUE.)+di),)---'P_(stemp_gt0:D----.TRUE.) =P.TRUE.t0:D----.TRUE.) ---'P_(stemp_.t0:D----.TRUE.) =P.TRUE (0:D----.TRUE.) ---'P_(stemp_mt0:D----.TRUE.) =P.TRUE maxT (0:D----.TRUE.) ---'P_(stemp_ct0:D----.TRUE.) =P.TRUE (0:D----.TRUE.) ---'P_(stemp_at0:D----.TRUE.) =P.TRUE s,tt0:D----.TRUE.) ---'P_(sD%vaLOCATE(.TRUE.),alid_(sD%vaLOCATE(.TRUE ),alid_(sD%vaLOCATE(.TRUE maxT ),alid_(sD%vaLOCATE(.TRUE ),alid_(sD%vaLOCATE(.TRUE l,_x,-'P.TRUE. ::AL temp_gl,_x,-'P.TRUE ::AL temp_sl,_x,-'P.TRUE maxT ::AL temp_ml,_x,-'P.TRUE :AL temp_cl,_x,-'P.TRUE ly AL temp_a---'P---max,phys.TRUE.t.TRUE. ysp =m fil ,_gg.TRUE (.TRUE. ysp D-------.TRUE maxT (.TRUE. ysp D-------.TRUE (.TRUE. yspD-)false. ,-'P.TRUE ly(.TRUE. ysp D-)false. ,-'PTF (.TRUE. yRult va .AND. ys,mis,ttt .OR.gse-coLEN=(Ec) -------'P_(s.TRUE s,tt0spD-)tr_ . IN----ax,phct(ig6b.(OR.NE �--_.TRUElsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER H5dl'#A(INdpbrssk.E POINTER, DIMEN----(:) ::-group_has_arg a=>lCALL() ysINTEGER brsskND---(h,, w, pr "cx, unit, skip_first--deb),alidhys,-- ER GICA = y-1 cl! speciht,alidr : = y-1 cl! speciw ER GICA = y-1 cl! specipr "cx,alidr : = y-1 cl! speciunit ,_gg OPis,tAL = y-1 cl! speciskip_first--deb,alidhyvars INTER, DIpecis------gggTER, DIpecibrssk.E ggTER, DIpecinex---gggTER, DIpeciend INTER, DIpeciskip ,_gg s,m, INTF (RK'exiPRES y-1skip_first--deb) -------'P_(sfl D-) AEdurt�lEmax,fl D-skip_first--deb,alid---max,phys#Aartnco1 physbrssknco1 physnex- nco1 physend D- (ht),alidhy-----loop,physDCOWHILE ult va .LT. end,t�lEmax,csbrsskn<s#Aartn+ wn<snex---ggghysDCOWHILE unex- .LT. end .AND. nex- .LT. lt va+w,t�lEmax,,,,c race nex- bl ,or new 'R :)hys,m skipnco1 physggghysDCOWHILE unex- .LT. end .AND. htunex-:nex-:C-----' ''---'P_(sT.E coriabnex- .LT. end allT.E validatolidatokphystunex-:nex-+1) ult v'\n''CallT.E validatolidatolidhy-----brssk.E gggggggggggggggggskipnco3.E gggggggggggggggggbrssknconex- - 1.E validddddddddd ysnex- conex- + 2.E validddddddddd ys issE!234.E validddddddddd----ax,phys,mis,tddd----ax,phys,mis,tdddnex- conex- + 1.E validddd------SIZE(lidatobrssknconex- s,mis,tdddnex- conex- + 1.E valid------SIZE(lid!r-(1, 'R :)!234 tokphyfl'CallT.E validatofl D-)cedure ,_ggggg-durt�lEmax,,,,WRITE(unit,'(A)',advance='no''Cpr "cx,alidddd----ax,phys,miWRITE (unit,'(A)') htult va:brssk,t�lEmax,csitterat:)hys,m #Aartncobrsskn+iskip ,_ggatobrssknconex- s,mi------,phct(ig6b.(OR.NE brsskND---lsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER P(1, -------------D---lsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETEg6b.(OR.NE (1, oD----EmaxP(1, s usages,misrmaryout idat#Aandard outpute ,_ggr s,m!& j, k,mlGphysER eciscratch INTF (se-coLEN=(Ec)CallT.E validWRITE (*,'(A)') "UsageciprogL {se-c-OGIC} [oacefus] [s,--]" AEdurt�lEmax,WRITE (*,'(A)') "UsageciprogL [oacefus] [s,--]" AE---ax,physDCOk=0,.TRUE. y#A(INd- t_r'RK'exi.TRUE s,ttk) CYCLrt�lEmax,WRITE (*,'(/A)') .TRUE.tk,t�lEmax,t_r' ,m! issECallT.E validatokphys,mis,ttt 'CallT.E validatolidWRITE (*,'(A,/A,/A)') & 'ggCTER P(1, thisgCTER messages----,ttt.',& 'ggggggggggggggggggshortnn DD : -h',& 'gggggggggggggggggg-loNdpn DD : --CTER'.E validatolidWRITE (*,*) ""SIZE(lidato----ax,phys,mis,tTF (se-coLEN=(Ec)CallT.E validatolidWRITE (*,'(A,/A)') & 'ggmd----! issEN P(1, sampl_cmd----! issEN----,ttt.',& 'gggggggggggggggggg-loNdpn DD : -- (1, -se-c'.E validatolidWRITE (*,*) ""SIZE(lidato----ax,phys,mi----ax,phys,mi.TRUE loop:---OMPLE.TRUE (k,t�lEmax,,,,c m, max,lude "ctrl/typ,.f" #dee "ctrlPE,.f" #de�lE� Rs! IRgeCTER�����e "ctrl/typ,.f" #define DTYPElCO #defi�lE� Rs! IRgeCTER�����e "ctrl/typ,.TYPElLOGe "ctrlPElYPElLOGICAL_a) TH #deCTER�����e "ctrl/typ,. DTYPElte "ctrlPE DTYPEltTRp1D_a) TH #dCTER�����e "ctrl/typ,.f" #define DTYPElCOMPLEX #define htCOMPLCTER�����e "ctrl/typ,.T" #define DTYPEltCOMPLEX #define htDCCTER�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRgeCTER�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRgeCTER�����lEmax,,,,c GINT_a) TH #deD-----) TH #de#include "ctrl/typ,.fe "ctrlPE,.f" #de�lE� Rs! IRgeCTER�����e "ctrl/typ,.f" #del/typ,.fe "ctrlPECO #defi�lE� Rs! IRgeCTER�����e "ctrl/typ,.TYPElLl/typ,.fe "ctrlPElYPElLOGICAL_a) TH #deCTER�����e "ctrl/typ,. DTYPEl/typ,.fe "ctrlPE DTYPEltTRp1D_a) TH #dCTER�����e "ctrl/typ,.f" #del/typ,.fe "ctrlPECOMPLEX #define htCOMPLCTER�����e "ctrl/typ,.T" #dl/typ,.fe "ctrlPEltCOMPLEX #define htDCCTER�����e "ctrl/typ,.t�lEmaxinys,max�lE� Rs! IRgeCTER�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRgeCTER�����untorsD-----phys,mi------O.TRUE loop s,mi------,phct(ig6b.(OR.NE (1, oD----sT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER P(1, sampl_cmd----! issElsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETEg6b.(OR.NE (1, ok,-ctEmaxP(1, s a sampl_cmd----! issEN #Aandard outpute ,_ggr s,m!& j, k,mlGphysER eciscratch IN() ysIN s,m! --deb,alidTF (.TRUE. yRult v-1)CallT.E validWRITE (*,*) "No'----ghavembe e "ctrd..."SIZE(lid disabl,_va----ax,physWRITE (*,'(A)') "#-----------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMMMMMMM",physWRITE (*,'(A)') "#TEgampl_cmd----! issENf-r lient",physWRITE (*,'(A)') "#",physWRITE (*,'(A)') "#TEEdiFGOT--setcefusmbelow",physWRITE (*,'(A)') "#",physWRITE (*,'(A)') "#-----------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMMMMMMM",physDCOk=0,.TRUE. y#A(INd- t_r'RK'exi.TRUE (k) CYCLrt�lEmax,WRITE (*,'(/A)') "#-----------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMMMMMMM",physax,WRITE (*,'(2A)') "#TE", .TRUE.tk,(1: _DTYM(.TRUE.tk,)) ,physax,e__l--- loop:---OMPLE.TRUE (k,t�lEmax,,,,c m, max,lude "ctrl/typ,.f" #dee "ctrlPE,.f" #de�lE� Rs! IRgese-coe__l---�����e "ctrl/typ,.f" #define DTYPElCO #defi�lE� Rs! IRgese-coe__l---�����e "ctrl/typ,.TYPElLOGe "ctrlPElYPElLOGICAL_a) TH #dese-coe__l---�����e "ctrl/typ,. DTYPElte "ctrlPE DTYPEltTRp1D_a) TH #dse-coe__l---�����e "ctrl/typ,.f" #define DTYPElCOMPLEX #define htCOMPLse-coe__l---�����e "ctrl/typ,.T" #define DTYPEltCOMPLEX #define htDCse-coe__l---�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRgese-coe__l---�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRgese-coe__l---�����lEmax,,,,c GINT_a) TH #deD-----) TH #de#include "ctrl/typ,.fe "ctrlPE,.f" #de�lE� Rs! IRgese-coe__l---�����e "ctrl/typ,.f" #del/typ,.fe "ctrlPECO #defi�lE� Rs! IRgese-coe__l---�����e "ctrl/typ,.TYPElLl/typ,.fe "ctrlPElYPElLOGICAL_a) TH #dese-coe__l---�����e "ctrl/typ,. DTYPEl/typ,.fe "ctrlPE DTYPEltTRp1D_a) TH #dse-coe__l---�����e "ctrl/typ,.f" #del/typ,.fe "ctrlPECOMPLEX #define htCOMPLse-coe__l---�����e "ctrl/typ,.T" #dl/typ,.fe "ctrlPEltCOMPLEX #define htDCse-coe__l---�����e "ctrl/typ,.t�lEmaxinys,max�lE� Rs! IRgese-coe__l---�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRgese-coe__l---�����untorsD-----phys,mi------Oe__l--- loop ,physax,WRITE (*,'(A)') "#-----------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMMMMMMM",,physax,vax_loop:---OMPLE.TRUE (k,t�lEmax,,,,c m, max,lude "ctrl/typ,.f" #de�lE� Rs! IRgese-c�����e "ctrl/typ,.f" #defi�lE� Rs! IRge IRg�����e "ctrl/typ,.TYPElLOGICAL_a) TH #dese-c�����e "ctrl/typ,. DTYPEltTRp1D_a) TH #dse-c�����e "ctrl/typ,.f"MPLEX #define htCOMPLse-c�����e "ctrl/typ,.T" #define DTYPEltCOMPLEX #define htDCse-c�����e "ctrl/typ,.t�lEmax,t�lE� Rs! IRgese-c�����e "ctrl/typ,. t�lEmax,t�lE� Rs! IRgese-c�����lEmax,,,,c GINT_a) TH #deD-----) TH #de#include "ctrl/typ,.f�lE� Rs! IRgese-c�����e "ctrl/typ,.f" #del/typ,.f�lE� Rs! IRgese-c�����e "ctrl/typ,.ctrl/typ,.f" ICAL_a) TH #dese-c�����e "ctrl/typ,. DTYPEl/typ,.f�lE� Rs! IRgese-c�����e "ctrl/typ,.f"ctrl/typ,.f" PLEX_a) TH #dese-c�����e "ctrl/typ,.T" #dl/typ,.fe "ctrlPEltCOMPLEX #define htDCse-c�����e "ctrl/typ,.t�lEmaxinys,max�lE� Rs! IRgese-c�����e "ctrl/typ,. t�lEmaxinys,max�lE� Rs! IRgese-c�����untorsD-----phys,mi------Ovax_loop, s,mi------,phct(ig6b.(OR.NE (1, ok,-ctsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER DebugtsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMER ig6b.(OR.NE ump_e "ctrsER EmaxDebuggse_asF'R :)hy. P(1, s a _iefactrd'----.ER iINTER, DIpeciiER iINWRITE (*,'(//A)') "DUMPOMP DEF.NEDsD-GS"ER iINWRITE (*,'(//A/)') "Integers: "ER iIN--OMPLEr �! �e "ctrl/typ,.,.f" #d! �ICAL_a) TH #de ump����! �untors/typ,ER iIN------,R iINWRITE (*,'(//A/)') "Reals: "ER iIN--OMPLERE �! �e "ctrl/typ,.RE d! �ICAL_a) TH #de ump����! �untors/typ,ER iIN------,R iINWRITE (*,'(//A/)') "C s: "ER iIN--OMPLEER �! �e "ctrl/typ,.ER �! �e "ctrlltCOMPL! �ICAL_a) TH #de ump����! �untorsltCOMPL! �untors/typ,ER iIN------,R iINWRITE (*,'(//A/)') "Logicals: "ER iIN--OMPLE �! �e "ctrl/typ,.f"MPLEX ! �e "ctrlBOO d! �ICAL_a) TH #de ump����! �untorsBOO d! �untors/typ,ER iIN------,R ict(ig6b.(OR.NE ump_e "ctrsE ig6b.(OR.NE ump_s,-- EmaxDebuggse_asF'R :)hy. P(1, s a _isupplie,F-----------------e ,_ggr s,m!,NUEhWRITE (*,'(//A/)') 'DUMPOMP ys,mANDsD-GS' iIN--OMPLERsCHARACTE#A(INd- WRITE (*,*) ' ly : '_(ssCHARAC(i)(1:RsCHARACT (i),#A(INd- t_r'-��� L�E (i),RallT.E validatoWRITE (*,*) ' '.E valid-durt�lEmax,,,,WRITE (*,*) 'notf '.E valid---max,phys------,phct(ig6b.(OR.NE ump_s,-- sT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMETER Adders - bl c ,or l_funwisElsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAME ,,c m, max,lude "ctrl/typ,.f" #dee "ctrlPE,.f" #de�lE� Rs! IRgeadder������e "ctrl/typ,.f" #define DTYPElCO #defi�lE� Rs! IRgeadder������e "ctrl/typ,.TYPElLOGe "ctrlPElYPElLOGICAL_a) TH #deadder������e "ctrl/typ,. DTYPElte "ctrlPE DTYPEltTRp1D_a) TH #dadder������e "ctrl/typ,.f" #define DTYPElCOMPLEX #define htCOMPLadder������e "ctrl/typ,.T" #define DTYPEltCOMPLEX #define htDCadder������e "ctrl/typ,.t�lEmax,tine DTYPEt�lEmax,t�lE� Rs! IRgeadder������e "ctrl/typ,. t�lEmax,tine DTYPE t�lEmax,t�lE� Rs! IRgeadder�����,,c GINT_a) TH #deD------) TH #de#include "ctrl/typ,.fe "ctrlPE,.f" #de�lE� Rs! IRgeadder������e "ctrl/typ,.f" #del/typ,.fe "ctrlPECO #defi�lE� Rs! IRgeadder������e "ctrl/typ,.TYPElLl/typ,.fe "ctrlPElYPElLOGICAL_a) TH #deadder������e "ctrl/typ,. DTYPEl/typ,.fe "ctrlPE DTYPEltTRp1D_a) TH #dadder������e "ctrl/typ,.f" #del/typ,.fe "ctrlPECOMPLEX #define htCOMPLadder������e "ctrl/typ,.T" #dl/typ,.fe "ctrlPEltCOMPLEX #define htDCadder������e "ctrl/typ,.t�lEmaxl/typ,.fe "ctrlPEt�lEmax,t�lE� Rs! IRgeadder������e "ctrl/typ,. t�lEmaxl/typ,.fe "ctrlPE t�lEmax,t�lE� Rs! IRgeadder������untorsD-----lsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETER My own upp_nmasmEmaxYAYEmalsT------------------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEg6b.(OR.NE Upp_nCasm(#A(INdE! ,g� caM er,mlEmICIT NONEGphysER GICA = y-1 c,m! ecis-(INdSIZE(r = y-1 cl! speci! ,alidr Emax,t�lhys,m! s,m! issEND-hys,mis,t�lEmax,ts,m!&jsEND-hys,mis,t�lEmax,ts,m!1,i2,i3,iaddsEND-r funco idi1 D-IAER ('a') - 1.E vai2 D-IAER ('z') + 1.E vai3 D-IAER ('A''---'Piadd-cor3 - i1 - 1.E vaDCOMPLE! ,aliddddj D-IAER (s-(INd(i:i:,#A(INd- t_r'j.Gexi1.AND.j.LT.i2---------'P_(sT.Es-(INd(i:i:ncoyR (j+iadd,t�lEmax,---ax,phys-----SIZE( disabl,_ct(ig6b.(OR.NE Upp_nCasm ct(iMODULE moduEeNk,-ct����������������������������������������������������������������������������lib -1.2.1/src/ moduEeNtree_done.f�����������������������������������������������������������������644����1752����1753��������4734�11616003524��20310� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lEmax,---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeNtree_done lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E lEmax,--------------------------------------------------------------------------ETEmax,- xD "ctr types lEmax,--------------------------------------------------------------------------Efe "ctrlPElYPElL_PRECITH_a 1.fe "ctrlPE DTYPE_PRECITH_a 2E lEmax,MODULE moduEeNtree_done lEmax,-!! ThisgmoduEeasF'videspse_ lEmax,-!! TRUtctr t! FGdetermctrs wheOTa treeNisgdone.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfacesps idatTRUtctr(E).E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE tree_done lEmax,lEmax,MODULE PROCEDURE tree_done_sl,_x,-'PEmax,MODULE PROCEDURE tree_done_dl,_x,-'PEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(se_validat-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! tree/ tree_done�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! tree/ tree_done�����untorsPEKI-- .,-'PEm---mMODULE moduEeNtree_done ������������������������������������lib -1.2.1/src/ moduEeNwrite.f���������������������������������������������������������������������644����1752����1753��������4003�11616003524��17463� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������alidat---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeNwrite lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E lEmax,MODULE moduEeNwrite lEmax,-!! ThisgmoduEeasF'videspse_ Utclity writetTRUtctr.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps idatwritetTRUtctr.E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE write lEmax,lEmax,MODULE PROCEDURE write lEmax,lEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(se_validat-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .f�lE� Rs! io/ write�����,,,lEm---mMODULE moduEeNwrite �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/ moduEeNtopo.f����������������������������������������������������������������������644����1752����1753��������3574�11616003524��17326� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������alidat---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeNtopo lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E lEmax,MODULE moduEeNtopo lEmax,-!! ThisgmoduEeamd--ains a _iusEr-e -FN=(EtTRUtctrs lEmax,-!! nee---, creatu andtmanagesPPMNtopologies.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xPPMNmoduEes---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,USE moduEeNmktopo lEmax,ax,USE moduEeNtopo_-�EcsINUEhEmax,USE moduEeNmesh_e "ctrINUEhEmax,USE moduEeNm, me_domain lEmax,ax,USE moduEeNtopo_get .,-'PEm---mMODULE moduEeNtopo ������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/ moduEeNloadbal.f�������������������������������������������������������������������644����1752����1753�������11221�11616003524��17727� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������P_(sT.---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeNloadbal lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E Efe "ctrlPElYPElL_PRECITH_a 1.fe "ctrlPE DTYPE_PRECITH_a 2E lEmax,MODULE moduEeNloadbal lEmax,-!! ThisgmoduEeamd--ains a _iTRUtctrs nee---,f-r lEmax,-!! dynamic load balancinge ,_ggx,-!! lEmax,-!! Currentlyn_nly(se_cSOR (stop,tMPrise) meisodNisgpF'vided asgse_ lEmax,-!! heuristic, escematu idattime wheOTidatdomain nee-spsombe lEmax,-!! Te--compose,e ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps load balancr inquirytTRUtctr.E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE loadbal_inquire lEmax,lEmax,MODULE PROCEDURE loadbal_inq_sl,_x,-'PEmax,MODULE PROCEDURE loadbal_inq_dl,_x,-'PEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps sF'R ss-r spee- escemat-r lEmax,dT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE escematu_sF'Rspee-l,_x,-'PEmax,MODULE PROCEDURE esc_sF'Rspee-_sl,_x,-'PEmax,MODULE PROCEDURE esc_sF'Rspee-_dl,_x,-'PEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps cost inquirytTRUtctr.E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE ge okost lEmax,lEmax,MODULE PROCEDURE ge okost_sl,_x,-'PEmax,MODULE PROCEDURE ge okost_dl,_x,-'PEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps --compostryoutcost up�EcetTRUtctr.E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE se o--compokost lEmax,lEmax,MODULE PROCEDURE se o-kost_sl,_x,-'PEmax,MODULE PROCEDURE se o-kost_dl,_x,-'PEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps sF'R ss-r spee- setcer lEmax,dT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE se osF'R_spee-l,_x,-'PEmax,MODULE PROCEDURE se osF'R_spee-_sl,_x,-'PEmax,MODULE PROCEDURE se osF'R_spee-_dl,_x,-'PEm---maCOMPFACE ,_x,-'PEm---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(se_validat-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! loadbal/ loadbal_inquire�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! loadbal/ loadbal_inquire�����untorsPEKI-- .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! loadbal/ escematu_sF'R_spee-�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! loadbal/ escematu_sF'R_spee-�����untorsPEKI-- .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! loadbal/ ge okost�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! loadbal/ ge okost�����untorsPEKI-- .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! loadbal/ se o--compokost�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! loadbal/ se o--compokost�����untorsPEKI-- .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! loadbal/ se osF'R_spee-�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! loadbal/ se osF'R_spee-�����untorsPEKI-- .,-'PEm---mMODULE moduEeNloadbal �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/ moduEeN--py_emage_subs.f�����������������������������������������������������������644����1752����1753��������4756�11616003524��21520� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������alidat---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeN--py_emage_subs lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E INx, lEmax,--------------------------------------------------------------------------ETEmax,- xD "ctr types lEmax,--------------------------------------------------------------------------Efe "ctrlPElYPElL_PRECITH_a 1.fe "ctrlPE DTYPE_PRECITH_a 2E lEmax,MODULE moduEeN--py_emage_subs lEmax,-!! ThisgmoduEeasF'videspse_ --compostryoutTRUtctrs.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps periodic emageF--pynTRUtctr.E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE --py_emage_subs lEmax,lEmax,MODULE PROCEDURE --py_emgsubs_sl,_x,-'PEmax,MODULE PROCEDURE --py_emgsubs_dl,_x,-'PEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(m---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! topo/ --py_emage_subs.f���untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! topo/ --py_emage_subs.f���untorsPEKI-- .,-'PEm---mMODULE moduEeN--py_emage_subs ������������������lib -1.2.1/src/ moduEeNtree_boxcut.f���������������������������������������������������������������644����1752����1753��������4743�11616003525��20670� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������P_(sT.---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeNtree_boxcut lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E lEmax,--------------------------------------------------------------------------ETEmax,- xD "ctr types lEmax,--------------------------------------------------------------------------Efe "ctrlPElYPElL_PRECITH_a 1.fe "ctrlPE DTYPE_PRECITH_a 2E lEmax,MODULE moduEeNtree_boxcut lEmax,-!! ThisgmoduEeasF'videspse_ TRUtctr t! F lEmax,-!! subdividespsree boxrs.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfacesps idatTRUtctr(E).E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE tree_boxcut lEmax,lEmax,MODULE PROCEDURE tree_boxcut_sl,_x,-'PEmax,MODULE PROCEDURE tree_boxcut_dl,_x,-'PEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! tree/ tree_boxcut.f���untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! tree/ tree_boxcut.f���untorsPEKI-- .,-'PEm---mMODULE moduEeNtree_boxcut �����������������������������lib -1.2.1/src/ moduEeN"ctalize.f������������������������������������������������������������������644����1752����1753��������4045�11616003524��20140� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������P_(sT.---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeN"ctalize lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E INx, lEmax,MODULE moduEeN"ctalize lEmax,-!! ThisgmoduEeasF'videspse_ "ctalizaryoutTRUtctr e -FN=(Etfrom outside---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps p "ctalize lEmax,sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE "ctalize lEmax,sT. x,MODULE PROCEDURE "ctalize lEmax,sT.---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(m---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .f�lE� Rs! "ctalize�����,,,lEm---mMODULE moduEeN"ctalize �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/ moduEeN -Foc.f���������������������������������������������������������������������644����1752����1753�������27165�11616003524��17441� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������P_(sT.---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeN -Foc lEmax,--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E lEmax,--------------------------------------------------------------------------ETEmax,- xD "ctr types lEmax,--------------------------------------------------------------------------Efe "ctrlPElYPElL_PRECITH_a 1.fe "ctrlPE DTYPE_PRECITH_a 2.fe "ctrlPE,.f" # 3.fe "ctrlPECOMPLEX 4Efe "ctrlPElYPElL_PRECITH_aEt�lEmax 5.fe "ctrlPE DTYPE_PRECITH_aEt�lEmax 6.fe "ctrlPECO #de 7E lEmax,MODULE moduEeN -Foc lEmax,-!! ThisgmoduEeasF'videspa _iPPMN -FocaryoutTRUtctrs. ThesEtTRUtctrsN -Fow lEmax,-!! f-r -Focaryou,mre -Focaryou,mgrowse_aandtshrinkse_a__(one-ps fivr- lEmax,-!! dimensyou - /typ,s.NOTa _iintrinsic ,ara typese ,_ggx,-!! lEmax,-!! WheOTextendse_ase_cPPMNcore -r numericaltTRUtctrsNthesEtTRUtctrsN*mu#A* lEmax,-!! be usEd.cPPMNclie, s may(sakeAadvpntageF__(se_seAfunctyou -ities.-INUEhEmax,USE moduEeN,ara, ONLY: ksed_sse_le, ksed_double,&INU& ksed_int64 ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xWork /typ,s.f-r re -Focaryou.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmRE ( ksed_sse_le) EmDIMENTH_a(:ICAPOaCOMPts,mwork_1ds => NULL()INUEhEmRE ( ksed_double) EmDIMENTH_a(:ICAPOaCOMPts,mwork_1dd => NULL()INUEhEmt�lEmax( ksed_sse_le)EmDIMENTH_a(:ICAPOaCOMPts,mwork_1dsc => NULL()INUEhEmt�lEmax( ksed_double)EmDIMENTH_a(:ICAPOaCOMPts,mwork_1ddc => NULL()INUEhEm,.f" # EmDIMENTH_a(:ICAPOaCOMPts,mwork_1di => NULL()INUEhEm,.f" #( ksed_int64) EmDIMENTH_a(:ICAPOaCOMPts,mwork_1dli => NULL()INUEhEmCOMPLEX EmDIMENTH_a(:ICAPOaCOMPts,mwork_1dl => NULL()IINUEhEmRE ( ksed_sse_le) EmDIMENTH_a(:,:ICAPOaCOMPts,mwork_2ds => NULL()INUEhEmRE ( ksed_double) EmDIMENTH_a(:,:ICAPOaCOMPts,mwork_2dd => NULL()INUEhEmt�lEmax( ksed_sse_le)EmDIMENTH_a(:,:ICAPOaCOMPts,mwork_2dsc => NULL()INUEhEmt�lEmax( ksed_double)EmDIMENTH_a(:,:ICAPOaCOMPts,mwork_2ddc => NULL()INUEhEm,.f" # EmDIMENTH_a(:,:ICAPOaCOMPts,mwork_2di => NULL()INUEhEm,.f" #( ksed_int64) EmDIMENTH_a(:,:ICAPOaCOMPts,mwork_2dli => NULL()INUEhEmCOMPLEX EmDIMENTH_a(:,:ICAPOaCOMPts,mwork_2dl => NULL()IINUEhEmRE ( ksed_sse_le) EDIMENTH_a(:,:,:ICPOaCOMPts,mwork_3ds => NULL()INUEhEmRE ( ksed_double) EDIMENTH_a(:,:,:ICPOaCOMPts,mwork_3dd => NULL()INUEhEmt�lEmax( ksed_sse_le)EDIMENTH_a(:,:,:ICPOaCOMPts,mwork_3dsc => NULL()INUEhEmt�lEmax( ksed_double)EDIMENTH_a(:,:,:ICPOaCOMPts,mwork_3ddc => NULL()INUEhEm,.f" # EDIMENTH_a(:,:,:ICPOaCOMPts,mwork_3di => NULL()INUEhEm,.f" #( ksed_int64) EDIMENTH_a(:,:,:ICPOaCOMPts,mwork_3dli => NULL()INUEhEmCOMPLEX EDIMENTH_a(:,:,:ICPOaCOMPts,mwork_3dl => NULL()IINUEhEmRE ( ksed_sse_le) EDIMENTH_a(:,:,:,:ICPOaCOMPts,mwork_4ds => NULL()INUEhEmRE ( ksed_double) EDIMENTH_a(:,:,:,:ICPOaCOMPts,mwork_4dd => NULL()INUEhEmt�lEmax( ksed_sse_le)EDIMENTH_a(:,:,:,:ICPOaCOMPts,mwork_4dsc => NULL()INUEhEmt�lEmax( ksed_double)EDIMENTH_a(:,:,:,:ICPOaCOMPts,mwork_4ddc => NULL()INUEhEm,.f" # EDIMENTH_a(:,:,:,:ICPOaCOMPts,mwork_4di => NULL()INUEhEm,.f" #( ksed_int64) EDIMENTH_a(:,:,:,:ICPOaCOMPts,mwork_4dli => NULL()INUEhEmCOMPLEX EDIMENTH_a(:,:,:,:ICPOaCOMPts,mwork_4dl => NULL()IINUEhEmRE ( ksed_sse_le) EDIMENTH_a(:,:,:,:,:ICPOaCOMP::work_5ds => NULL()INUEhEmRE ( ksed_double) EDIMENTH_a(:,:,:,:,:ICPOaCOMP::work_5dd => NULL()INUEhEmt�lEmax( ksed_sse_le)EDIMENTH_a(:,:,:,:,:ICPOaCOMP::work_5dsc => NULL()INUEhEmt�lEmax( ksed_double)EDIMENTH_a(:,:,:,:,:ICPOaCOMP::work_5ddc => NULL()INUEhEm,.f" # EDIMENTH_a(:,:,:,:,:ICPOaCOMP::work_5di => NULL()INUEhEm,.f" #( ksed_int64) EDIMENTH_a(:,:,:,:,:ICPOaCOMP::work_5dli => NULL()INUEhEmCOMPLEX EDIMENTH_a(:,:,:,:,:ICPOaCOMP::work_5dl => NULL()IINUEhEmPRIVATEts,mwork_1ds,work_1dd,work_1dsc,work_1ddc,work_1di,work_1dlINUEhEmPRIVATEts,mwork_2ds,work_2dd,work_2dsc,work_2ddc,work_2di,work_2dlINUEhEmPRIVATEts,mwork_3ds,work_3dd,work_3dsc,work_3ddc,work_3di,work_3dlINUEhEmPRIVATEts,mwork_4ds,work_4dd,work_4dsc,work_4ddc,work_4di,work_4dlINUEhEmPRIVATEts,mwork_5ds,work_5dd,work_5dsc,work_5ddc,work_5di,work_5dlINUEhEmPRIVATEts,mwork_1dli,work_2dli,work_3dli,work_4dli,work_5dli ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfacesps -FocaryoutTRUtctrs lEmax,sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE -Foc lEmax,,,,,,,MODULE PROCEDURE -Foc_1d_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_1d_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_1d_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_1d_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_1d_i lEmax,,,,,,,MODULE PROCEDURE -Foc_1d_li lEmax,,,,,,,MODULE PROCEDURE -Foc_1d_l lEmax,,,,,,,MODULE PROCEDURE -Foc_1dl_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_1dl_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_1dl_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_1dl_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_1dl_i lEmax,,,,,,,MODULE PROCEDURE -Foc_1dl_li lEmax,,,,,,,MODULE PROCEDURE -Foc_1dl_l lEmax,,,,,,,MODULE PROCEDURE -Foc_2d_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_2d_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_2d_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_2d_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_2d_i lEmax,,,,,,,MODULE PROCEDURE -Foc_2d_li lEmax,,,,,,,MODULE PROCEDURE -Foc_2d_l lEmax,,,,,,,MODULE PROCEDURE -Foc_2dl_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_2dl_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_2dl_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_2dl_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_2dl_i lEmax,,,,,,,MODULE PROCEDURE -Foc_2dl_li lEmax,,,,,,,MODULE PROCEDURE -Foc_2dl_l lEmax,,,,,,,MODULE PROCEDURE -Foc_3d_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_3d_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_3d_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_3d_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_3d_i lEmax,,,,,,,MODULE PROCEDURE -Foc_3d_li lEmax,,,,,,,MODULE PROCEDURE -Foc_3d_l lEmax,,,,,,,MODULE PROCEDURE -Foc_3dl_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_3dl_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_3dl_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_3dl_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_3dl_i lEmax,,,,,,,MODULE PROCEDURE -Foc_3dl_li lEmax,,,,,,,MODULE PROCEDURE -Foc_3dl_l lEmax,,,,,,,MODULE PROCEDURE -Foc_4d_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_4d_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_4d_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_4d_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_4d_i lEmax,,,,,,,MODULE PROCEDURE -Foc_4d_li lEmax,,,,,,,MODULE PROCEDURE -Foc_4d_l lEmax,,,,,,,MODULE PROCEDURE -Foc_4dl_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_4dl_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_4dl_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_4dl_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_4dl_i lEmax,,,,,,,MODULE PROCEDURE -Foc_4dl_li lEmax,,,,,,,MODULE PROCEDURE -Foc_4dl_l lEmax,,,,,,,MODULE PROCEDURE -Foc_5d_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_5d_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_5d_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_5d_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_5d_i lEmax,,,,,,,MODULE PROCEDURE -Foc_5d_li lEmax,,,,,,,MODULE PROCEDURE -Foc_5d_l lEmax,,,,,,,MODULE PROCEDURE -Foc_5dl_sl,_x,-'PEmax,MODULE PROCEDURE -Foc_5dl_-l,_x,-'PEmax,MODULE PROCEDURE -Foc_5dl_sc lEmax,,,,,,,MODULE PROCEDURE -Foc_5dl_dc lEmax,,,,,,,MODULE PROCEDURE -Foc_5dl_i lEmax,,,,,,,MODULE PROCEDURE -Foc_5dl_li lEmax,,,,,,,MODULE PROCEDURE -Foc_5dl_l lEmax,,,,,,,MODULE PROCEDURE -Foc_topo lEmax,ax,---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .fe "ctrlPEKI--mPElYPElL_PRECITH_a,t�lE� Rs! -Foc/ -Foc_1-������lE� Rs! -Foc/ -Foc_2-������lE� Rs! -Foc/ -Foc_3-������lE� Rs! -Foc/ -Foc_4-������lE� Rs! -Foc/ -Foc_5-������lE� Rs! -Foc/ -Foc_1dl������lE� Rs! -Foc/ -Foc_2-l������lE� Rs! -Foc/ -Foc_3-l������lE� Rs! -Foc/ -Foc_4-l������lE� Rs! -Foc/ -Foc_5-l�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_a,t�lE� Rs! -Foc/ -Foc_1-������lE� Rs! -Foc/ -Foc_2-������lE� Rs! -Foc/ -Foc_3-������lE� Rs! -Foc/ -Foc_4-������lE� Rs! -Foc/ -Foc_5-������lE� Rs! -Foc/ -Foc_1dl������lE� Rs! -Foc/ -Foc_2-l������lE� Rs! -Foc/ -Foc_3-l������lE� Rs! -Foc/ -Foc_4-l������lE� Rs! -Foc/ -Foc_5-l�����untorsPEKI-- .fe "ctrlPEKI--mPElYPElL_PRECITH_aEt�lEmax,t�lE� Rs! -Foc/ -Foc_1-������lE� Rs! -Foc/ -Foc_2-������lE� Rs! -Foc/ -Foc_3-������lE� Rs! -Foc/ -Foc_4-������lE� Rs! -Foc/ -Foc_5-������lE� Rs! -Foc/ -Foc_1dl������lE� Rs! -Foc/ -Foc_2-l������lE� Rs! -Foc/ -Foc_3-l������lE� Rs! -Foc/ -Foc_4-l������lE� Rs! -Foc/ -Foc_5-l�����untorsPEKI-- .fe "ctrlPEKI--mPE DTYPE_PRECITH_aEt�lEmax,t�lE� Rs! -Foc/ -Foc_1-������lE� Rs! -Foc/ -Foc_2-������lE� Rs! -Foc/ -Foc_3-������lE� Rs! -Foc/ -Foc_4-������lE� Rs! -Foc/ -Foc_5-������lE� Rs! -Foc/ -Foc_1dl������lE� Rs! -Foc/ -Foc_2-l������lE� Rs! -Foc/ -Foc_3-l������lE� Rs! -Foc/ -Foc_4-l������lE� Rs! -Foc/ -Foc_5-l�����untorsPEKI-- .fe "ctrlPEKI--mPE,.f" #,t�lE� Rs! -Foc/ -Foc_1-������lE� Rs! -Foc/ -Foc_2-������lE� Rs! -Foc/ -Foc_3-������lE� Rs! -Foc/ -Foc_4-������lE� Rs! -Foc/ -Foc_5-������lE� Rs! -Foc/ -Foc_1dl������lE� Rs! -Foc/ -Foc_2-l������lE� Rs! -Foc/ -Foc_3-l������lE� Rs! -Foc/ -Foc_4-l������lE� Rs! -Foc/ -Foc_5-l�����untorsPEKI-- .fe "ctrlPEKI--mPECO #de,t�lE� Rs! -Foc/ -Foc_1-������lE� Rs! -Foc/ -Foc_2-������lE� Rs! -Foc/ -Foc_3-������lE� Rs! -Foc/ -Foc_4-������lE� Rs! -Foc/ -Foc_5-������lE� Rs! -Foc/ -Foc_1dl������lE� Rs! -Foc/ -Foc_2-l������lE� Rs! -Foc/ -Foc_3-l������lE� Rs! -Foc/ -Foc_4-l������lE� Rs! -Foc/ -Foc_5-l�����untorsPEKI-- .fe "ctrlPEKI--mPECOMPLEX,t�lE� Rs! -Foc/ -Foc_1-������lE� Rs! -Foc/ -Foc_2-������lE� Rs! -Foc/ -Foc_3-������lE� Rs! -Foc/ -Foc_4-������lE� Rs! -Foc/ -Foc_5-������lE� Rs! -Foc/ -Foc_1dl������lE� Rs! -Foc/ -Foc_2-l������lE� Rs! -Foc/ -Foc_3-l������lE� Rs! -Foc/ -Foc_4-l������lE� Rs! -Foc/ -Foc_5-l�����untorsPEKI-- .f�lE� Rs! -Foc/ -Foc_topo.f" .f�lE� Rs! -Foc/ -Foc_arg-�Ecs�����,,,lEm---mMODULE moduEeN -Foc �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/ moduEeNUtcl_collapse_list.f��������������������������������������������������������644����1752����1753��������4123�11616003523��22225� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������P_(sT.---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeNUtcl_collapse_list P_(sT.--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E lEmax,MODULE moduEeNUtcl_collapse_list P_(sT.-!! ThisgmoduEeasF'videspse_ UtclitytTRUtctrs.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xD "ctr interfaceps se_ list inversyoutTRUtctr.E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,tCOMPFACE Utcl_collapse_list P_(sT.lEmax,MODULE PROCEDURE Utcl_collapse_list P_(sT.lEm---maCOMPFACE ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x�lE� Rs!OT--sour_(---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,DD&eAINS .f�lE� Rs! Utcl/ Utcl_collapse_list�����,,,lEm---mMODULE moduEeNUtcl_collapse_list ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/ moduEeN,ara.f����������������������������������������������������������������������644����1752����1753�������25464�11616003524��17260� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������P_(sT.---*- f90 -*------------ginys,max,phys,mis,t�lEmax,t�lE� RsLOGICAL, PARAMMETEmax,- ModuEelEmax,ts moduEeN,ara P_(sT.--------------------------------------------------------------------------ETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E lEmax,MODULE moduEeN,ara P_(sT.-!!xD clares glob - ,ara types andtvariN=(Ese ,_ggx,-!! lEmax,-!! [NOTE] lEmax,-!! Most __(se_cd claredtvariN=(Es.NOTseisgmoduEeassouldgnotibe acR sse-l,_x,-'-!! directlynby(se_cPPMNclie, cd veloper,(se_y are usEd intern -Fy.NOTse_l,_x,-'-!! library.---'P_(sT.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xModuEes lEmax,sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,USE moduEeNtypedef ---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xGlob - TYPEs lEmax,sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTI---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xbuffersAf-r communicaryou---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,RE ( ksed_double),DIMENTH_a(:ICPOaCOMPts,m sendbufferd => NULL()INUEhEm,-'-!! sendxbufferAf-r particsEs INUEhEmax,RE ( ksed_double),DIMENTH_a(:ICPOaCOMPts,m recvbufferd => NULL()INUEhEm,-'-!! recvxbufferAf-r particsEs INUEhEmax,RE ( ksed_sse_le)EDIMENTH_a(:ICPOaCOMPts,m sendbuffers => NULL()INUEhEm,-'-!! sendxbufferAf-r particsEsINUEhEmax,RE ( ksed_sse_le)EDIMENTH_a(:ICPOaCOMPts,m recvbuffers => NULL()INUEhEm,-'-!! recvxbufferAf-r particsEs INUEhEmax,,.f" # ,DIMENTH_a(:,:ICPOaCOMPts,m ghosthack => NULL()INUEhEm,-'-!! invert map __(ghostAf-r symmetry INUEhEmax,,.f" # EDIMENTH_a(:ICPOaCOMPts,m psendbuffer => NULL()INUEhEm,-'-!! pointerps particsEs ! isNOTse_csendxbufferINUEhEm,-'-!!INUEhEm,-'-!! Inttermsn__(particsE *not*Tse_cactu - postryoutNOTse_cbufferINUEhEm,-',.f" # EDIMENTH_a(:ICPOaCOMPts,m precvbuffer => NULL()INUEhEm,-'-!! pointerps particsEs ! isNOTse_crecvxbufferINUEhEm,-'-!!INUEhEm,-'-!! Inttermsn__(particsE *not*Tse_cactu - postryoutNOTse_cbufferIINUEhEm,-',.f" # s,mm nsendbufferINUEhEm,-'-!! se_csizeF__(se_ sendxbufferA(notise_catyp, but se_cnumberAoft�lEmax,-'-!! usEd eleme, s)INUEhEm,-'-!!INUEhEm,-'-!! Inttermsn__(entriEs.NOTse_cbuffer *not*Tse_cnumberAof particsEs INUEhEmax,,.f" # s,mm nrecvbufferINUEhEm,-'-!! se_csizeF__(se_ recvxbufferA(notise_catyp, but se_cnumberAoft�lEmax,-'-!! usEd eleme, s)INUEhEm,-'-!!INUEhEm,-'-!! Inttermsn__(entriEs.NOTse_cbuffer *not*Tse_cnumberAof particsEs INUEhEmax,,.f" # s,mm sendbufsize lEmax,sT.-!! se_cactu - sizeF__(se_ sendxbufferAatyp,INUEhEmax,,.f" # s,mm recvbufsize lEmax,sT.-!! se_cactu - sizeF__(se_ receivrxbufferAatyp,INUEhEmax,,.f" # s,mm buffer se lEmax,sT.-!! se_ctot - numberAof particsEgiseldsgpackEd inINUEhEm,-'-!! se_csendxbuffer, ie. xp, vpNisgtwo sets INUEhEmax,,.f" # , DIMENTH_a(:ICPOaCOMPts,m buffer2partn=> NULL()INUEhEm,-'-!! UsEd f-r se_corigctal on-sF'R ss-r particsEgIDs.NOTse_cortor NOTwhichETEmax,,-'-!! se_y are NOTse_csendbuffer. UsEd s push addityou - particsEETEmax,,-'-!! ,ara oOTse_cbuffer NOTse_ccorrectcortor.INUEhEmax,,.f" # , DIMENTH_a(:ICPOaCOMPts,m bufferNtypen=> NULL()INUEhEm,-'-!! types __(se_cdara oOTse_csendbufferINUEhEm,-',.f" # , DIMENTH_a(:ICPOaCOMPts,m bufferNdimn=> NULL()INUEhEm,-'-!! dimensyous __(se_corigctal on-sF'R ss-r particsEg/typ,s. INUEhEmax,RE ( ksed_sse_le)EDIMENTH_a(:ICPOaCOMP:: ghost_offsetsn=> NULL()INUEhEm,-'-!! ghostAoffsetINUEhEm,-'-!!INUEhEm,-'-!! ghostAparticsEs may(havema sparyal offset comparedts se_ir re -INUEhEm,-'-!! particsEg- w_cneedts store seisgoffset inttermsn__(se_cbuffer NdINUEhEm,-'-!! intortor s be a=(Ets push/send/pop ghostAcoortctatEs.NOTse_cINUEhEm,-'-!! ghost ge andtghost put mappse_; seisgisgneede,F!heOTusse_ Verle lEmax,sT.-!! lists: here nothse_ isgremapprd'-ndAf-r symmetry w_cneedtbothts INUEhEm,-'-!! put se_cparticsEgiorcespetc. andtio ge se_ UpdaredtparticsEgINUEhEm,-'-!! postryou; f-r se_casymmetric case w_cdognotiput se_ciorcespback bu lEmax,sT.-!! w_cneedts ge se_ Updaredtpostryousn__(se_cghostA- NOT ge tse_ INUEhEm,-'-!! ghostsA- becauseAacnew mappse_ isgNOT neede,Fbut simplygreusse_INUEhEm,-'-!! se_cold mappse_ push/send/poppse_ase_cUpdaredtcoortctatEs.INUEhEm,-'-!! Te_coffsetsnare stored asgse_cpdara NOTse_cpsendbuffer, i.e.,INUEhEm,-'-!! ` ghost_offset(ibuffer+0) = xp_offset(1,)` +INUEhEm,-'-!! ` ghost_offset(ibuffer+1) = xp_offset(2,)` +INUEhEm,-'-!! ` ghost_offset(ibuffer+2) = xp_offset(3,)`INUEhEmax,RE ( ksed_double),DIMENTH_a(:ICPOaCOMP:: ghost_offsetd => NULL()INUEhEm,-'-!! ghostAoffset (double precison)INUEhEm,-'-!!INUEhEm,-'-!! ghostAparticsEs may(havema sparyal offset comparedts se_ir re -INUEhEm,-'-!! particsEg- w_cneedts store seisgoffset inttermsn__(se_cbuffer NdINUEhEm,-'-!! intortor s be a=(Ets push/send/pop ghostAcoortctatEs.NOTse_cINUEhEm,-'-!! ghost ge andtghost put mappse_; seisgisgneede,F!heOTusse_ Verle lEmax,sT.-!! lists: here nothse_ isgremapprd'-ndAf-r symmetry w_cneedtbothts INUEhEm,-'-!! put se_cparticsEgiorcespetc. andtio ge se_ UpdaredtparticsEgINUEhEm,-'-!! postryou; f-r se_casymmetric case w_cdognotiput se_ciorcespback bu lEmax,sT.-!! w_cneedts ge se_ Updaredtpostryousn__(se_cghostA- NOT ge tse_ INUEhEm,-'-!! ghostsA- becauseAacnew mappse_ isgNOT neede,Fbut simplygreusse_INUEhEm,-'-!! se_cold mappse_ push/send/poppse_ase_cUpdaredtcoortctatEs.INUEhEm,-'-!! Te_coffsetsnare stored asgse_cpdara NOTse_cpsendbuffer, i.e.,INUEhEm,-'-!! ` ghost_offset(ibuffer+0) = xp_offset(1,)` +INUEhEm,-'-!! ` ghost_offset(ibuffer+1) = xp_offset(2,)` +INUEhEm,-'-!! ` ghost_offset(ibuffer+2) = xp_offset(3,)`I---'P_(sT.-I---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xmappse_---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,,.f" # s,m mapNtypenINUEhEmax,,.f" # s,m nsendlist P_(sT.lEm,.f" # s,m nrecvlist P_(sT.lEm,.f" #EmDIMENTH_a(:ICAPOaCOMPts,m isendlist => NULL()INUEhEm,-',.f" #EmDIMENTH_a(:ICAPOaCOMPts,m irecvlist => NULL()IINUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xPrecisyou---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,,.f" # :: ksedINUEhEm,-'-!! Precisyou---'P_(sT.,.f" # :: mpi ksedINUEhEm,-'-!! MPI Precisyou-INUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xDimensyou -ity---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,,.f" # :: dimINUEhEm,-'-!! Dimensyou -ity-INUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- Topologies lEmax,sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,TYPE( ptrNt_topo)EmDIMENTH_a(:ICAPOaCOMPts,m topon=> NULL()INUEhEm,-'-!! te_cPPMNtopologiesAatyp,IINUEhEmax,,.f" # :: next_avail_topo lEmax,ax,-!! IDn__(se_cnext availa=(Ets pology s be usEd by lEmax,ax,-!! topoN -Foc.INUEhEm,-'-!!INUEhEm,-'-!! At iniryalizaryoutseisgisgset s p param_untorinEd +INUEhEm,-'-!! IfGi--points ! isNOT(1,SIZE( topo))tseisgslotiisg(re)usEd s INUEhEm,-'-!! store seecnew s pology, ifGi--isg> SIZE( topo) seeOTse_cp topoINUEhEm,-'-!! atyp, mu#A be extendedINUEhEm,-'INUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xDebuggse_---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,,.f" # :: debug = 0INUEhEm,-'-!! ate w_cNOTDebuggse_gmode?-INUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xHasgp inir beeOTe -Fed?INUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,COMPLEX s,m iniryalizEd = .FALSE.INUEhEm,-'-!!xHasgp inir beeOTe -Fed?IINUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xpar -FDlcvariN=(Es---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,,.f" # :: nsF'RINUEhEmax,,.f" # :: rankINUEhEmax,,.f" # :: commINUEhEmax,- relaryvemspeedsn__(se_csF'R ss-rsg(f-r load balancse_)INUEhEm,-'RE ( ksed_double),DIMENTH_a(:ICPOaCOMPts,m sF'R_speed => NULL()IINUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xNumericalttolerance. Differencespsm -FDr seautseisgate cousitoredINUEhEm,-'- xzero.---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,RE ( ksed_double) :: myepsdINUEhEmax,RE ( ksed_sse_le) :: myepssIINUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xCoustants (computE(.NOTp inir).E validT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,RE ( ksed_double) :: pi dINUEhEmax,RE ( ksed_sse_le) :: pi sIINUEhEmsT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xI/O Unirs---'P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,,.f" # s,m stdout = 6INUEhEmax,,.f" # s,m stderr = 0INUEhEm,-',.f" # s,m logissEN= -1INUEhEm,-'INUEhEm---mMODULE moduEeN,ara ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/test/����������������������������������������������������������������������������������755����1752����1753�������������11616003524��14723� 5����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/test/RE DME����������������������������������������������������������������������������644����1752����1753��������0212�11616003524��15576� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Te_ciortran code here servesAasAa unir test framework Te_cmakeissENwi _inotiwork.NOTseisgdirector, but ssouldgbe also usEd asAa tamplatu ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/test/p test.f������������������������������������������������������������������������644����1752����1753�������11671�11616003524��16733� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Test Case ,ts p test_CASE P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------Eprogram p test_CASE INuseA moduEeNcore INuseA moduEeNtypedef INuseA moduEeNmktopoINUEhuseA moduEeNinirINUEhuseA moduEeN"ctalize INUEhimplici--none .f�lE� Rs! ../../ derinE.h����ftorsPEMPI INx,INCLUDE 'mpif.h' #endsf ---'Pinteger, parametunAAAAAAAAAAAAAAs,mdebug = 0INUEhinteger, parametunAAAAAAAAAAAAAAs,mMK = ksed_doubleINUEhre -(mk),parametunAAAAAAAAAAAAAAs,mpi = 3.1415926535897931NmkINUEhinteger s,mndsm,nspecINUEhinteger s,mdecompINUEhinteger s,massigINUEhinteger s,mtolexpINUEhre -(MK) s,mtolINUEhinteger s,minfoINUEhinteger s,mtopoid,meshNdINUEhinteger, parametunAAAAAAAAAAAAAs,mngrid = 513INUEhinteger, parametunAAAAAAAAAAAAAs,mnpgrid = 1025INUEhre -(MK),dimensyou(:,:ICpointerps,mxp,wpINUEhre -(MK),dimensyou(: ICpointerps,mmin_phys,max_phys,h,p_hINUEhinteger, dimensyou(: ICpointerps,mghostsize lEmainteger s,mi,j,ai,aj,p_iINUEhinteger, dimensyou(6) s,mbcdef INre -(MK),dimensyou(: ICpointerps,mcost P_(sinteger, dimensyou(:,:ICpointerps,mi#Aart,n,ara P_(sinteger, dimensyou(: ICpointerps,mnmINUEhre -(MK),dimensyou(:,:ICpointerps,mminsub,maxsub P_(sinteger, dimensyou(: ICpointerps,msub2sF'RINUEhinteger s,mnp,mpINUEhinteger, parametunAAAAAAAAAAAAAAs,mkernDlc= p param_rmsh_kernDl_mp4INUEhre -(MK),dimensyou(:,:,:,: IC pointerps,miseld_wp,- 2d miseld_up(ldn,i,j,isub)t�lEm!re -(MK),dimensyou(:,:,:,:,:ICApointerps,miseld_up,- 3d miseld_up(ldn,i,j,k,isub)t�lEmre -(MK),dimensyou(: ICpointerps,miseld_xt�lEmtype( t_topo)EmpointerpAAAAAAs,mtopoINUEhre -(MK) s,mmaxm3INUEhinteger, parametunAAAAAAAAAAAAAAs,mnmom = 10 P_(sinteger, dimensyou(2,nmom)AAAAAAs,malphat�lEmre -(MK),dimensyou(nmom)AAAAAAAAs,mf mome, s, p mome, st�lEmre -(MK),dimensyou(2) s,msigma,mut�lEm!================t�lEm!gsetupt�lEm!================t�lEmtol = 10.0Nmk*epsiloN(1.0Nmk)t�lEmtolexp = int(log10(epsiloN(1.0Nmk)))t�lEmndimn= 2t�lEmnspec = 1 ---'P -Focatu(min_phys(ndim),max_phys(ndim),ghostsize(ndim),&INUU& nm(ndim),h(ndim),p_h(ndim),iseld_x(ndim),#Aat=info)IINUEhdo i=1,ndimINUEhEm,-min_phys(i) = 0.0NmkINUEhEm,-max_phys(i) = 1.0NmkINUEhEm,-ghostsize(i) = 2t�lEmenddoINUEhbcdef(1:6)N= -1m!gBOUNDARY,DD&DITH_a,t�lEmnullify(xp)t�lEmnullify(wp)t���ftorsPEMPI INe -F MPI_Inir(info)I#endsf ---'Pe -F p inir(ndim,MK,tolexp,0,debug,info,99)IINUEh-----------------t�lEm!gcre te particsEsINUEh-----------------t�lEmnp = npgrid**2t�lEmmp = 0I---'P -Focatu(xp(ndim,np),wp(nspec,np),#Aat=info)I--'Pxp = 0.0NmkINUEhwp = 0.0NmkII---'P -Focatu(nm(ndim),#Aat=info)I--'Pdo i=1,ndimINUEhEm,-nm(i) = ngridt�lEmenddoIINUEh-----------------t�lEm!gmake s pologyINUEh-----------------tt�lEmtopoid = 0INUEhmeshNdN= -1I---'Pe -F p mktopo(topoid,meshNd,xp,np,decomp,assig,min_phys,max_phys,bcdef, &INUUU& ghostsize,cost,i#Aart,n,ara,nm,info)IINUEh-----------------t�lEm!gsetuphmesh ,ara P_(s-----------------tt P_(sprint *, 'rinishe,Finiryalizaryou't�lEm!================t�lEm!gbodyt�lEm!================t P_(s----------------------------t�lEm!gc -F TRUtctrsNt be testedINUEh----------------------------tINUEh-----------------t�lEm!gtest RUtpu lEma-----------------tt t�lEm!================t�lEm!gteardown...t�lEm!================t�lEmprint *, 'csEanse_gup' 8000 coutctueI---'Pe -F p "ctalize(info)I���ftorsPEMPI INe -F MPI_Fctalize(info)I#endsf INI--'Pde -Focatu(xp,wp,iseld_wp,min_phys,max_phys,ghostsize,nm)t P_(sprint *, 'done.' endxprogram p test_CASE �����������������������������������������������������������������������lib -1.2.1/src/test/MakeissE��������������������������������������������������������������������������644����1752����1753��������045��11616003524��16362� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TESTINC=-I../../../�lE� Rs!-L../../../lib -l sour_(s=$(wildEard *.f) Aargets=$(patsubst %.f,%,$(sour_(s))t new ,mcsEanP -F -F : $(Aargets)t $(Aargets) : $(sour_(s) $(CPP) -P $@.f >sPE$@.f $(FC) $(OPTS)sPE$@.f $(TESTINC) $(LDFLAGS) $(LIBS) -o $@ rmsPE$@.f ./$@ csEanP: rms-f $(Aargets)t������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/map/�����������������������������������������������������������������������������������755����1752����1753�������������11616003524��14521� 5����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/map/ mapNpart_ghost put.f�����������������������������������������������������������644����1752����1753�������33746�11616003524��21460� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- SubTRUtctr ,ts mapNpart_ghost put P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E INx,SUBR(ORINE mapNpart_ghost put(topoid,info)I--'P .-!! ThisgTRUtctr putspback ghostAparticsE values/propertirsNt se_l,_x,-'-!! correspondsNdpre - particsEs. Thisgisgvery usEND- NOTse_ccase oft�lEmax!!! symmetric interacryousnasgse_re seecghostAparticsEs are also updarede ,_ggx,-!! lEmax,-!! [IMPORT NT] I--'P .-!! ThisgTRUtctr p deonlynbeTe -Fed aftunAghostAparticsEs havembeeOl,_x,-'-!! cre tedTusse_ seec` mapNpart_ghost get` (+push/send/pop sequence)I--'P .-!! TRUtctre ,_ggx,-!! lEmax,-!! [WD-NING] lEmax,-!! I--isg deerror s e -F ` mapNpart_pop`.NOTse_l,_x,-'-!! push-send-pop sequencen__(a `mapNpart_ghost put` e -F. Instead, you l,_x,-'-!! *mu#A* e -F ` mapNpart_ghost pop`.f-r poppse_ase_l,_x,-'-!! propertirsNpushedTons se_ put bufferse ,_ggx,-!! lEmax,-!! [TIP] I--'P .-!! Ifxyou needts do altern tse_ ghost-ge andtghost-put sequencesI--'P .-!! you may(wpntts useA` mapNpart_store` andt` mapNpart_load` s INUEhEm-!! store andtload .-inintern -xbuffersAf-r ghost ge andtspare yourselft�lEmax!!! .-in(costly) e -F s ` mapNpart_ghost get`. Postryousnp debeNpushedt�lEmax!!! usse_ seec` mapNpart_ghost push` TRUtctre ,_ggx,-!! I--'P .-!! [NOTE] lEmax,-!! .Impleme, aryoutNotesI--'P .-!! ======================================================================I--'P .-!! ThisgTRUtctr swaps se_csendxandtreceivrxlistsn__(se_I--'P .-!! mappse_ TRUtctr toP -Fowcsendse_ back se_cvalue/,ara P_(sT.-!!xcomputE(.oOTse_cghostAparticsEs. Te_cTRUtctr mu#A be P_(sT.-!!xc -Fed aftunA` mapNpart_send` andtssouldgbe fo-Fowedt�lEmax!!! by(a ` mapNpart_push`,A` mapNpart_send` andt` mapNpart_pop`.t�lEmax!!! . ge e ,_ggx,-!! lEmax,-!! Thisgimpleme, aryoutonlyn -Fows *one*cghostAput FGa P_(sT.-!!xtime; ToP -Fowcmultiple ghostsAwe havems passt�lEmax!!! .-in Usor_hack s se_ ghost pop OR s e-pynse_I--'P .-!! Usorpassed atyp, s se_ intern -Fy.stored ghosthackI--'P .-!! Usod (andt*not*Tpassed)Fby(se_cghost pop()I--'P .-!! ======================================================================I--'P .--------------------------------------------------------------------------E--'P .- xModuEes I--'P .--------------------------------------------------------------------------E--'P .USE moduEeNtypedef --'P .USE moduEeN,ara P_(sT.USE moduEeN -Foc P_(sT.USE moduEeNsubstart P_(sT.USE moduEeNsubstop P_(sT.USE moduEeNerror P_(sT.USE moduEeNwrite P_(sT.USE moduEeN-�Ecs_NdINUEhEmUSE moduEeNUtcl_commlacINUEhEmIMPLICIT NONE P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- ThisgTRUtctr isgALLsinteger, excep se_ timse_ variN=(E t0ETEmax,- Win ick double asgse_cprecisyou -xnopre - re sou f-r se FG P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,.f" #EmL AMET # s,mMK = ksed_doubleINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Argume, sEmax, P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,.f" #Em,.f"NT(INax,) s,mtopoid lEmax,-!! T pology IDETEmax,,.f" #Em,.f"NT( (OR) s,minfoINUEhx,-!! Return #Aatus, 0.oOTsucR ssINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- LocaltvariN=(Es. P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,.f" #EmDIMENTH_a(2) s,mlduETEmax,TYPE( t_topo)EmPOaCOMPts,mtopon=> NULL()INUEhEm,.f" # s,mi,j,kINUEhEm,.f" # s,milacINUEhEmyR RACOMP( char) s,mmes_---'P_(COMPLEX s,mvalid lEmax,RE (MK) s,mt0INUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Extern -s. P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMEINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- IniryaliseAETEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,CALLssubstart(' mapNpart_ghost put',t0,info)IIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- C�Ecs atgume, s P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F ( debug .GT. 0) THEN CALLs-�Ecs ,F (info .NE. 0) GOTO 9999 ENDIFIINUEhT.topon=> p topo(topoid)%tIINUEhT.- ifGse_re isgsti _isom_cdara left.NOTse_cbuffer,F!/tOTse_cUsorETEmax,,F ( buffer se .GT. 0) THEN info = error_!/tOse_---'P_(sTCALLs error( err mapNincomp,' mapNpart_ghost put', &INUUUU& 'Buffer wasgnotiempty. Possible lossn__(dara!',__LINE__,info)I--'P .ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEm! misrstAc�Ecs i_(se_coptimaltcommunicaryou protocol isgknownINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEm,F (.NOT.topo%isoptimizEd) THEN -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m - i_(not,mdetermctr iA before c -Fse_gmapNpart_ghost put P_(sT. -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m CALLs Utcl_commlac(topoid,info)I--'P .x,,F ( debug .GT. 1) THEN DO i=1,topo%nneighsF'RINUEhEmax,,,,,,,,WRITE(mes_,'(A,I4)') 'havemneighbor: ', topo%ineighsF'R(i)INUEhEmax,,,,,,,,CALLs write( rank,' mapNpart_ghost put',mes_,info)I--'P .x,'P .ENDDO DO i=1,topo%ncommseqINUEhEmax,,,,,,,,WRITE(mes_,'(A,I4)') 'communicare: ', topo%icommseq(i)INUEhEmax,,,,,,,,CALLs write( rank,' mapNpart_ghost put',mes_,info)I--'P .x,'P .ENDDO ENDIFI ENDIFIIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Savemse_cmapmtype f-r se_csubsequent c -Fs. P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax, mapNtypen= p param_mapNghost put INUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Findtidatrequired sizeF__(se_ ghosthack atyp,: se_ctot - numberAof ETEmax,- particsEs sendxtimes(se_ ncommseqINUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,j = 0INUEhEmDO k=1,topo%ncommseqINUEhEmax,j = MAX(j,( psendbuffer(k+1) -m psendbuffer(k)))t�lEm .ENDDO P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- The 2ndtleadse_ dimensyouNisgplusn_tr toPcarchP -F ghostsA-) P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,ldu(1) = j + 2t�lEmx,ldu(2) = topo%ncommseq + 1 P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- A-Focatuise_catyp, P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,ilacn= p param_ -Foc_growETEmax,CALLsp -Foc( ghosthack,ldu,ilac,info)I--'P .,F (info.NE.0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNpart_ghost put', &INUUUU& ' -Focatyoutof ghosthack failed',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- nowcstore seecdara NOT ghosthack() P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,i = 0INUEhEmDO k=1, nsendlist P_(sT.lEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- xStore seecnumberAof particsEs sendxt se_ k-th sF'RINUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax, ghosthack(1,k)n= p psendbuffer(k+1) -m psendbuffer(k)'INUEhEmsT.DO j=1, ghosthack(1,k)I--'P .x,'P .-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m max,- xIncreme, Tse_ccounterI--'P .x,'P .-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m max,i = i + 1 P_(sT.x,'P .-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m max,- xstore seecidF__(se_ articsEs sendxt se_ k-th sF'RINUEhEmax,P .-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m max, ghosthack(j+2,k)n= p buffer2part(i) mENDDO ENDDO P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- nowcstore seecdara NOT ghosthack() P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,DO k=1, nsendlist + 1 NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,!x, ghosthack(2,k)nstores(se_ ointerps se_cisrstAparticsE receivrd'INUEhEmax,!x,from se_ k-th sF'RINUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax, ghosthack(2,k)n= p precvbuffer(k)' ENDDO P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Prepare we FGs send:ETEmax,- we havems sendxte_cghostAback :-)nso cousequryvempiecen__(,ara P_(sT.- xstartie_ FGNpartn+ 1 andtendse_ FGMpart;(se_ ointerps se_cisrstETEmax,- particsE wasgstored NOT precvbuffer(k)'andtnowcNOT ghosthack(2,k).ETEmax,- Te_cbuffer2partnisgeasy asgse_cdara Ns cousequryve P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,i = -1INUEhEmDO k=1, nsendlist P_(sT.lEmi = MAX(i, ghosthack(2,k+1))t�lEm .ENDDO �lEm .ldu(1) = iETEmax,CALLsp -Foc( buffer2part,ldu,ilac,info)I--'P .DO k=1, nsendlist P_(sT.lEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,- x psendbuffer(k)'stores(se_ ointerps se_cisrstAparticsE receivrd'INUEhEmax,!x,from se_ k-th sF'RINUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax, psendbuffer(k)'=, ghosthack(2,k)nINUEhEmsT.DO j= ghosthack(2,k), ghosthack(2,k+1)-1INUEhEm,-' p buffer2part(j)'=,j mENDDO ENDDOnINUEhEm psendbuffer( nsendlist+1) = ghosthack(2, nsendlist+1) P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Prepare we FGs receivr:ETEmax,- WENwi _irecievemse_cfuncryoucvaluePcarrie,Fby(se_cghostsA- se_s_cghostsETEmax,- are RE articsEs outourcsF'R ss-rnso weassouldgNOT pop se_m asgusua-INUEhEm- xNotice se_ push ,oesgnoticare (aftunA -F i--isgjustApackse_ sese_sAf-r P_(sT.- xsendse_),mnei_funA,oesgse_csendx(i--isgjustAsendse_ se_cbuffer __(and INx,- receivse_ _tr)A- se_ pop cares -nso muchPse FGw_cneedta speci - popINUEhEm- xNow.NOTse_cfu-F versyou,(se_ ghosthack ssouldgbe passed back outETEmax,- s se_cUsor (ORgbe giveOTa 3rd NOdexp! ispannintern -x'pset'(entry).ETEmax,- so ei_funAwe pass .-in Usor_hack s se_ ghost pop OR we e-pynse_I--'P .- Usorpassed atyp, s se_ intern -Fy.stored ghosthack UsodI--'P .- (andtNOT passed)Fby(se_cghost pop() ... let Us seep!t�lEmax! msT.DO it�lEmax! msT. x, ghosthack() = Usorpassed() P_(sT.- mENDDO - F-r se_ctimegbese_ we assumegONEgset __(ghostAandtstore seisgatyp, inINUEhEm- x moduEeN,ara. Thisgpiecen__(,ara-wi _ibe usEd directlynby(se_cINUEhEm- xghost pop TRUtctr P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MME P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- flip se_csendxandtreceivrxlists P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,DO k=1, nrecvlist P_(sT.lEmj =m irecvlist(k)I--'P .x,' irecvlist(k) =m isendlist(k)I--'P .x,' isendlist(k)'=,j ENDDO P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Return P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMET9999,DD&TINUE P_(sT.CALLssubstop(' mapNpart_ghost put',t0,info)IP_(sT.RETURN DD&TAINS SUBR(ORINE -�Ecs m,F (.NOT.m iniryalizEd) THEN info = error_error P_(sT.........CALLs error( err noinir,' mapNpart_ghost put', &INUUUU& 'Please e -F p inircisrst!',__LINE__,info)I--'P .........GOTO 8888I--'P .....ENDIFIP_(sT. m,F (topoid .EQ. p param_topoNuntorinEd) THEN info = error_error P_(sT.........CALLs error( err no_topo,' mapNpart_ghost put', &INUUUU& 'ThisgTRUtctr needsnats pology torinEd s po',__LINE__,info)I--'P .........GOTO 8888I--'P .....ENDIFIP_(sT. m,F (topoid .NE. p param_topoNuntorinEd) THEN CALLs -�Ecs_topoid(topoid,valid,info)I--'P .......,F (.NOT.mvalid) THEN info = error_error P_(sT.........'TCALLs error( err tgume, ,' mapNpart_ghost put', &INUUUU& 'topoid out __(range',__LINE__,info)I--'P ...........GOTO 8888I--'P .......ENDIFIP_(sT. ENDIFIP8888 ,DD&TINUE P_(sT.---mSUBR(ORINE -�Ecs ---mSUBR(ORINE mapNpart_ghost put ��������������������������lib -1.2.1/src/map/ mapNiseld_ghost put.f����������������������������������������������������������644����1752����1753�������32314�11616003524��21563� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- SubTRUtctr ,ts mapNiseld_ghost put P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E INx,SUBR(ORINE mapNiseld_ghost put(topoid,meshNd,ghostsize,info)I--'P .-!! ThisgTRUtctr sends se_cvalues __(ghostAmesh pointsI--'P .-!! back s se_ircorigct intortor s add se_irccout(Ibutyouts se_l,_x,-'-!! correspondsNdpre - mesh pointe ,_ggx,-!! lEmax,-!! [IMPORT NT] lEmax,-!! ` mapNiseld_ghost inir` mu#A notibeTe -Fed anymore. ThisgTRUtctrl,_x,-'-!! c�EcssF!hetunhxte_cghostAmappse_s havembeeO iniryalizEd alre dy(and INx,-!! i_(not,(se_ TRUtctr isge -Fed by(se_clibrarye ,_ggx,-!! lEmax,-!! [NOTE] lEmax,-!! Te_cisrstApartn__(se_csend/recvxlistsncoutains se_con-sF'R ss-r ,ara.EINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- InE� Rss P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMEINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- ModuEesINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,USE moduEeN,ara P_(sT.USE moduEeN,ara_mesh P_(sT.USE moduEeNtypedef --'P .USE moduEeNsubstart P_(sT.USE moduEeNsubstop P_(sT.USE moduEeNerror P_(sT.USE moduEeN -Foc P_(sT.USE moduEeN-�Ecs_NdINUEhEmIMPLICIT NONE P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Atgume, s P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,.f" # Em,.f"NT(INax,) s,mtopoid lEmax,-!! T pology IDETEmax,,.f" # Em,.f"NT(INax,) s,mmeshNdINUEhx,-!! Mesh IDETEmax,,.f" #EmDIMENTH_a(:I Em,.f"NT(INax,) s,mghostsize lEmax,-!! SizeF__(se_ ghostAlayer Nncnumbers __(grid points inP -Ftspace lEmax,-!! dimensyous (1... dim).t�lEmax,.f" # Em,.f"NT( (OR) s,minfoINUEhx,-!! Returns #Aatus, 0.upoOTsucR ssINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- LocaltvariN=(Es P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,.f" #EmDIMENTH_a(3) s,mlduETEmax,,.f" # s,mi,j,lb,ub P_(sx,,.f" # s,milac,ibuffer,pdimINUEhEm,.f" # s,mnsendlist,nrecvlist P_(sT.RE ( ksed_double) s,mt0INUEhT.COMPLEX s,mvalid lEmax,TYPE( t_topo)EmPOaCOMPt s,mtopon=> NULL()INUEhEmTYPE( t_equi_mesh)EmPOaCOMPt s,mmeshn=> NULL()INUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Extern -s P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMEINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- IniryaliseINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,CALLssubstart(' mapNiseld_ghost put',t0,info)IP_(sT.pdimn= dimIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- C�Ecs atgume, s P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F ( debug .GT. 0) THEN CALLs-�Ecs ,F (info .NE. 0) GOTO 9999 ENDIFIINUEhT.topon=> p topo(topoid)%tINUEhT.meshn=> topo%mesh(meshNd)IIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- C�Ecs ifcghostAmappse_s havembeeO iniralizEd, i_(no do sotnow. P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F (.NOT.mmesh%ghost iniryalizEd) THEN CALLs mapNiseld_ghost inir(topoid,meshNd,ghostsize,info)I--'P . ,F (info .NE. 0) THEN info = error_error P_(sT.......CALLs error( err tgume, ,' mapNiseld_ghost put', &INUUUU& 'CouldgnotiiniryalizEcghostAmappse_s',__LINE__,info)I--'P ......GOTO 9999 ENDIFI ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Savemse_cmapmtype f-r se_csubsequent c -Fs.(usEd s gset pop sype)INUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax, mapNtypen= p param_mapNghost put INUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Reset se_cbuffer sizeFcounters P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax, nsendbuffer = 0INUEhEm nrecvbuffer = 0IINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- NumberAof meshnbFocksNt be sent/recvd isgreverse,from se_ get P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,nrecvlist = mesh%ghost nsendETEmax,nsendlist = mesh%ghost nrecv P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- A-Focatuimemor, f-r se_cglob - mesh sendlists P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,ilacn n= p param_ -Foc_fit P_(sT.ldu(1) = nsendlist P_(sT.CALLsp -Foc( mesh isendfromsub,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'sour_(csendxsubxlistpPPM_MESH_ISENDFROMSUB',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.ldu(1) = pdimINUEhEmldu(2) = nsendlist P_(sT.CALLsp -Foc( mesh isendblk#Aart,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'sendxbFockxstartxlistpPPM_MESH_ISENDBLKSTART',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.CALLsp -Foc( mesh isendblk#ize,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'sendxbFockxsizeFlistpPPM_MESH_ISENDBLKSIZE',__LINE__,info)I--'P .....GOTO 9999 ENDIFI P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- A-Focatuimemor, f-r se_cglob - mesh receivrxlists P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,ilacn n= p param_ -Foc_fit P_(sT.ldu(1) = nrecvlist P_(sT.CALLsp -Foc( mesh irecvtosub,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'destinatyoutrecvxsubxlistpPPM_MESH_IRECVTOSUB',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.ldu(1) = pdimINUEhEmldu(2) = nrecvlist P_(sT.CALLsp -Foc( mesh irecvblk#Aart,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'recvxbFockxstartxlistpPPM_MESH_IRECVBLKSTART',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.CALLsp -Foc( mesh irecvblk#ize,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'recvxbFockxsizeFlistpPPM_MESH_IRECVBLKSIZE',__LINE__,info)I--'P .....GOTO 9999 ENDIFI P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- A-Focatuimemor, f-r se_cglob - send/recvxlists P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,ldu(1) = topo%ncommseqINUEhEmCALLsp -Foc( isendlist,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'glob - send(rankFlistpPPM_ISENDLIST',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.CALLsp -Foc( irecvlist,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'glob - recvxrankFlistpPPM_IRECVLIST',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.ldu(1) = topo%ncommseq + 1 NUEhEmCALLsp -Foc( psendbuffer,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'glob - sendxbuffer ointerpPPM_PSENDBUFFER',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.CALLsp -Foc( precvbuffer,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_ghost put', &INUUUU& 'glob - recvxbuffer ointerpPPM_PRECVBUFFER',__LINE__,info)I--'P .....GOTO 9999 ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Reset se_cnumberAof buffer entriEs P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,p buffer se = 0IINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Build(se_clistsnf-r p mapNiseld_push, pop andt_sendxt CREATEcghostETEmax,- meshpoints oOTse_cs pology topoid lEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax, psendbuffer(1) = 1ETEmax, precvbuffer(1) = 1ETEmax, nsendlist = topo%ncommseqINUEhEm nrecvlist = nsendlistETEmax,ibuffer = 0INUEhEmDO i=1,topo%ncommseqINUEhEmax,ibuffer = i + 1 NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,!x,Store seecsF'R ss-r ! ispwhich we wi _isend/recv NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax, isendlist(i) = topo%icommseq(i)INUEhEmax, irecvlist(i) = topo%icommseq(i)I NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,!x,Store seecmeshnbFock(range f-r seisgpF'R ss-r interacryou NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax, psendbuffer(ibuffer)=mesh%ghost recvblk(ibuffer)INUEhEmax, precvbuffer(ibuffer)=mesh%ghost blk(ibuffer)I NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,!x,Store seectorintryousn__(se_ meshnbFocksNt be sent NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,lbn= p psendbuffer(i)INUEhEmax,ubn= p psendbuffer(ibuffer)INUEhEmax,DO j=lb,ub-1INUEhEm,-' mesh isendblk#Aart(1:pdim,j)'=,,,,,&INUUUU& mesh%ghost recvblk#Aart(1:pdim,j)INUEhEm,-' mesh isendblk#ize(1:pdim,j)'=,,,,,,&INUUUU& mesh%ghost recvblk#ize(1:pdim,j)INUEhEm,-' mesh isendfromsub(j)=mesh%ghost recvtosub(j)INUEhEm,-'ENDDO P_(sT.ax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,!x,Store seectorintryousn__(se_ meshnbFocksNt be receivrd NUEhEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,lbn= p precvbuffer(i)INUEhEmax,ubn= p precvbuffer(ibuffer)INUEhEmax,DO j=lb,ub-1INUEhEm,-' mesh irecvblk#Aart(1:pdim,j)'=,,,,,&INUUUU& mesh%ghost blk#Aart(1:pdim,j)INUEhEm,-' mesh irecvblk#ize(1:pdim,j)'=,,,,,,&INUUUU& mesh%ghost blk#ize(1:pdim,j)INUEhEm,-' mesh irecvtosub(j) = mesh%ghost fromsub(j)INUEhEm,-'ENDDO hEm,-'ENDDO P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Return P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMET9999,DD&TINUE P_(sT.CALLssubstop(' mapNiseld_ghost put',t0,info)IP_(sT.RETURN DD&TAINS SUBR(ORINE -�Ecs m CALLs -�Ecs_topoid(topoid,valid,info)I--'P .....,F (.NOT.mvalid) THEN info = error_error P_(sT.........CALLs error( err tgume, ,' mapNiseld_ghost put', &INUUUU& 'topoid out __(range',__LINE__,info)I--'P .........GOTO 8888I--'P .....ENDIFIP_(sT. mCALLs -�Ecs_meshNd(topoid,meshNd,valid,info)I--'P .....,F (.NOT.mvalid) THEN info = error_error P_(sT.........CALLs error( err tgume, ,' mapNiseld_ghost put', &INUUUU& 'meshNdNout __(range',__LINE__,info)I--'P .........GOTO 8888I--'P .....ENDIFIP8888 , ,DD&TINUE P_(sT.---mSUBR(ORINE -�Ecs ---mSUBR(ORINE mapNiseld_ghost put ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/map/ mapNiseld_pop_2d.f�������������������������������������������������������������644����1752����1753������545724�11616003524��20750� 0����������������������������������������������������������������������������������������������������u#Aar ��lEardon�������������������������lEardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- SubTRUtctr ,ts p mapNiseld_pop_2d P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Copyrigh, ( ) 2010 CS,.fab (ETH ZurichICAMOSAICxGTRUEm(ETH ZurichICAETEmax,- Center f-r Fluid Dynamics (DTU,t�lEmax!t�lEmax!t�lEmax! ThisgissENisgpartn__(se_cPar -FDlcParticsENMesh Library (PPM).t�lEmax!t�lEmax! PPMNisgfree software: you p deredis-(IbutENi--in,/-r modifyt�lEmax! i--untor idattermsn__(se_cGNU Lessor Gener - Public LicenseAETEmax,- asgpublishe,Fby(se_cFree Software F-un,aryou,-ei_funAETEmax,- versyout3n__(se_cLicense,,or (at your lacefu)-iny latunAETEmax,- versyou.t�lEmax!t�lEmax! PPMNisgdis-(IbutE(.NOTse_chopeF!! FGi--wi _ibe usEND-,t�lEmax! but WITH(OR ANY WD---NTY;F! isout eveOT.-inimplie,F!/typnty oft�lEmax! MERyR NTABILITY,or FITNESS FOR AAL TICULAR PURPOSE. Seepse_t�lEmax! GNU Gener - Public LicenseAf-r more details.t�lEmax!t�lEmax! You ssouldghavemreceivrd'-F--pyn__(se_cGNU Gener - Public LicenseETEmax,- andtidatGNU Lessor Gener - Public LicenseAaloNdp! ispPPM. Ifxnot,t�lEmax! seep<http://www.gnu.org/licenses/>.t�lEmax!t�lEmax! Par -FDlcParticsENMesh Library (PPM)t�lEmax! ETH ZurichETEmax,- CH-8092 Zurich, S! izerland INx,--------------------------------------------------------------------------E #ifINx,__DIM ==,__SFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a SUBR(ORINE p mapNiseld_pop_2d_sca_s(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& ghostsize,info,mask,popsype)I#elifIN__KI--m==,__DOUBLE_PRECITH_a SUBR(ORINE p mapNiseld_pop_2d_sca_d(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& ghostsize,info,mask,popsype)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX SUBR(ORINE p mapNiseld_pop_2d_sca_sc(Aarget_topoid,Aarget_meshNd,f,ara,&INUUUU& ghostsize,info,mask,popsype)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX SUBR(ORINE p mapNiseld_pop_2d_sca_dc(Aarget_topoid,Aarget_meshNd,f,ara,&INUUUU& ghostsize,info,mask,popsype)I#elifIN__KI--m==,__,.f" # SUBR(ORINE p mapNiseld_pop_2d_sca_i(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& ghostsize,info,mask,popsype)I#elifIN__KI--m==,__COMPLEX SUBR(ORINE p mapNiseld_pop_2d_sca_l(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& ghostsize,info,mask,popsype)I#endifI#elifIN__DIM ==,__VFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a SUBR(ORINE p mapNiseld_pop_2d_vec_s(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& lda,ghostsize,info,mask,popsype)I#elifIN__KI--m==,__DOUBLE_PRECITH_a SUBR(ORINE p mapNiseld_pop_2d_vec_d(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& lda,ghostsize,info,mask,popsype)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX SUBR(ORINE p mapNiseld_pop_2d_vec_sc(Aarget_topoid,Aarget_meshNd,f,ara,&INUUUU& lda,ghostsize,info,mask,popsype)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX SUBR(ORINE p mapNiseld_pop_2d_vec_dc(Aarget_topoid,Aarget_meshNd,f,ara,&INUUUU& lda,ghostsize,info,mask,popsype)I#elifIN__KI--m==,__,.f" # SUBR(ORINE p mapNiseld_pop_2d_vec_i(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& lda,ghostsize,info,mask,popsype)I#elifIN__KI--m==,__COMPLEX SUBR(ORINE p mapNiseld_pop_2d_vec_l(Aarget_topoid,Aarget_meshNd,f,ara, &INUUUU& lda,ghostsize,info,mask,popsype)I#endifI#endifI -!! ThisgTRUtctr pops se_clist buffer f-r 2D meshn,ara P_(sT.-!!I -!! [NOTE] lEmax,-!! Te_con-sF'R ss-r ,araNisgNOTse_cfsrstApartn__(se_cbuffer lEmax,-!! Re -Focatesgse_cf,aragatyp, if needed. Te_cUsor ,oesgnotineed lEmax,-!! toPcare about itsxsize. Ifxwe wpntts change seisgs improve P_(sT.-!!xc -Fability from C, atgume, c�EcssFssouldgbe added f-r se_ P_(sT.-!!xSIZEn__(f,ara. IfTse_cca-F s invert_list isgs o sFowce_re, seis P_(sT.-!!xcouldgbe d_tr by topo_store andtstored f-r eachPs pologye ,_ggx,-!! At se_cexpenseA__(som_cextraimemor,e ,_ggx,-!! lEmax,-!! [WD-NING] lEmax,-!! DIM isgse_cdimensyouN__(se_c`f,ara`gatyp, andtnot se_cspace lEmax,-!! dimemsyouN` dim`! lEmax,--------------------------------------------------------------------------ElEmax,- InE� Rss P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMEINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- ModuEesINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,USE moduEeN,ara P_(sT.USE moduEeN,ara_mesh P_(sT.USE moduEeNtypedef --'P .USE moduEeNsubstart P_(sT.USE moduEeNsubstop P_(sT.USE moduEeNerror P_(sT.USE moduEeN -Foc P_(sT.USE moduEeNwrite P_(sT.USE moduEeN-�Ecs_NdINUEhEmUSE moduEeNUtcl_invert_listINUEhEmIMPLICIT NONE #ifINx,__KI--m==,__SINGLE_PRECITH_a |N__KI--m==,__SINGLE_PRECITH_a_COMPLEX ,.f" #EmL AMET # s,mMK = ksed_sse_leI#elseETEmax,,.f" #EmL AMET # s,mMK = ksed_doubleI#endifI -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Atgume, s P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MME#ifINx__DIM ==,__SFIELD #ifINx__KI--m==,__,.f" # ,.f" # EmDIMENTH_a(:_a(:I EmPOaCOMPt s,mf,araI#elifI__KI--m==,__COMPLEX COMPLEX EmDIMENTH_a(:_a(:I EmPOaCOMPt s,mf,araI#elifI__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX COMPLEX(MK)EmDIMENTH_a(:_a(:IEmPOaCOMPt s,mf,araI#elseETEmax,RE (MK)EmDIMENTH_a(:_a(:I EmPOaCOMPt s,mf,araI#endifI#elifI__DIM ==,__VFIELD #ifINx__KI--m==,__,.f" # ,.f" # EmDIMENTH_a(:_a(:(:I EmPOaCOMPt s,mf,araI#elifI__KI--m==,__COMPLEX COMPLEX EmDIMENTH_a(:_a(:(:I EmPOaCOMPt s,mf,araI#elifI__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX COMPLEX(MK)EmDIMENTH_a(:_a(:(:IEmPOaCOMPt s,mf,araI#elseETEmax,RE (MK)EmDIMENTH_a(:_a(:(:I EmPOaCOMPt s,mf,araI#endifI#endifI -!! Fseld ,ara.E -!!I -!! 1st iOdex,mlda +I -!! 2nd-3th iOdex,mmeshn(i,j)'relaryvems istart-1n__(se_csub.t�lEmax!!! (i.e. (i,j)=(1,1) correspondsms istart) +I -!! 4th: isub.1...nsublist ( -Ftsubs oOTseisgpF'R ss-r).E -!!I -!! F-r sca-ar fselds,Tse_cfsrstANOdexpisgomittE(.(se_co_funsFssiftI -!! accordsNdly).ETEmax,COMPLEXEmDIMENTH_a(:_a(:IEm mPOaCOMP, OPTH_aEX s,mmaskI -!! Logicaltmask.E -!!I -!! Only(se_ meshnnoRss f-r which seisgisg.TRUE.-wi _ibeI -!! mapped. Ifxnot giveO,P -Ftpoints are mapped.E -!!I -!! 1st-2ndtiOdex,mmeshn(i,j)' +I -!! 3rd: isub.t�lEmax,.f" # , OPTH_aEX s,mpopsypeE#ifINx__DIM ==,__VFIELD �lEmax,.f" # , ,.f"NT(INax,) s,mlda lEmax,-!! Te_cleadse_ dimensyouN__(se_cf,ara.E -!!mlda=1 f-r se_ccaseA__(sca-ar ,araI#endifI�lEmax,.f" # , ,.f"NT(INax,) s,mAarget_topoid lEmax,-!! T pology IDn__(,estinatyouI�lEmax,.f" # , ,.f"NT(INax,) s,mAarget_meshNdINUEhx,-!! Mesh IDn__(,estinatyouI�lEmax,.f" #EmDIMENTH_a(:I , ,.f"NT(INax,) s,mghostsize lEmax,-!! SizeF__(se_ ghostAlayer (NOTmesh points)gNOTeachPdimensyou.t�lEmax,.f" # , ,.f"NT( (OR) s,minfoINUEhx,-!! Returns #Aatus, 0.upoOTsucR ssINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- LocaltvariN=(Es P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,.f" #EmDIMENTH_a(3) s,mmofsETEmax,,.f" #EmDIMENTH_a(4) s,mldu,ldlt�lEmax,.f" # s,mi,j,k,ibuffer,M,ara,isub,bdim,jsub,edimINUEhEm,.f" # s,milac,totopo,xhi,yhi,xlo,ylo,imesh,jmesh P_(sT.,.f" # s,mbsype,idomINUEhEmRE (MK) s,mt0INUEhT.COMPLEX s,mldo P_(sT.,.f" # s,mrsypeE yR RACOMP(LEN= -�ar) s,mmes_-#ifINx__DIM ==,__SFIELD TEmax,,.f" #EmL AMET # s,mlda = 1E#endifI�lEmaxTYPE( t_topo)lEmaxEmPOaCOMPt s,mAarget_topon=> NULL()INUEhEmTYPE( t_equi_mesh)EmPOaCOMPt s,mAarget_meshn=> NULL()INUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Extern -s P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMEINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- IniryaliseINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,CALLssubstart(' mapNiseld_pop_2d',t0,info)IIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- C�Ecs atgume, s P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F ( debug .GT. 0) THEN CALLs-�Ecs ,F (info .NE. 0) GOTO 9999 ENDIFIINUEhT.! skip if buffer emptyETEmax,,F ( buffer se .LT. 1) THEN info = error_notice ,F ( debug .GT. 1) THEN CALLs error( err buffer empt,' mapNiseld_pop', &INUUUU& 'Buffer isgempty: skippse_mpop!',__LINE__,info)I--'P ...ENDIFIP_(sT. GOTO 9999 ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- set se_clocalt ointers s se_ s pology andtmesh P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,Aarget_topon=> topo(target_topoid)%tINUEhT.Aarget_meshn=> target_topo%mesh(Aarget_meshNd)I NUEhEm,F ( debug .GT. 0) THEN ,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,!x,now, i_(NOTdebug moRs,s-�Ecstidatrest P_(sT.lEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTINUEhEmax,CALLs-�Ecs_two ENDIFIIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- C�Ecs we FGksedAof pop isgneeded (replacen_r add)INUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F ( mapNtypen.EQ. p param_mapNintr) THEN info = error_error P_(sT...CALLs error( err tgume, ,' mapNiseld_pop_2d', &INUUUU& 'mapNiseld_pop p dnotibeTe -Fed aftunAghost inir',__LINE__,info)I--'P ...CALLs error( err tgume, ,' mapNiseld_pop_2d', &INUUUU& 'ghost inir mu#A notibeTe -Fed directlynby(se_cUsor',__LINE__,info)I--'P ...GOTO 9999 ELSE ,F (PRES"NT(popsype)) THEN rtypen= popsypeE ELSE max,,F ( mapNtypen.EQ. p param_mapNghost put) THEN rtypen= p param_pop_add ELSE max, rtypen= p param_pop_replace ENDIFIP_(sT. mENDIFI ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- C�Ecstidattidatrequired dimensyouNfitsxse_cdimensyouN__(se_cbuffer lEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,bdimn= buffer dim( buffer se ) #ifINx__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ! f-r complex,Tse_ceffecryvemdimensyouNis halfgse_cdara dimensyou edimn= bdim/2I#elseETEmax,edimn= bdimI#endifI�lEmax,F ( debug .GT. 1) THEN WRITE(mesg,'(2(A,I3))') 'bdim=',edim,' lda=',lda lEmax,,,,,CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P .ENDIFI#ifINx__DIM ==,__VFIELD �lEmax,F (edim.NE.lda) THEN info = error_error P_(sT....CALLs error( err wrong_dim,' mapNiseld_pop_2d', &INUUUU& 'leadse_ dimensyouNLDANisgNOTerror',__LINE__,info)I--'P ....GOTO 9999 ENDIFI#elifI__DIM ==,__SFIELD �lEmax,F (edim.NE.1) THEN info = error_error P_(sT....CALLs error( err wrong_dim,' mapNiseld_pop_2d', &INUUUU& 'buffer ,oesgnoticoutain 1d ,ara!',__LINE__,info)I--'P ....GOTO 9999 ENDIFI#endifIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- C�Ecstidattidatrequired typenisgNde, icalts se_ sypen__(se_cbuffer lEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,btypen= p buffer type( buffer se ) #ifINx,__KI--m==,__SINGLE_PRECITH_a ,F (btype.NE. ksed_sse_le) THEN info = error_error P_(sT....CALLs error( err wrong_prec,' mapNiseld_pop_2d', &INUUUU& 'tryse_ so pop agnon-sse_le into sse_le ',__LINE__,info)I--'P ....GOTO 9999 ENDIFI#elifIN__KI--m==,__DOUBLE_PRECITH_a ,F (btype.NE. ksed_double) THEN info = error_error P_(sT....CALLs error( err wrong_prec,' mapNiseld_pop_2d', &INUUUU& 'tryse_ so pop agnon-double into double ',__LINE__,info)I--'P ....GOTO 9999 ENDIFI#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX ,F (btype.NE. ksed_sse_le) THEN info = error_error P_(sT....CALLs error( err wrong_prec,' mapNiseld_pop_2d', &INUUUU& 'tryse_ so pop agnon-sse_le-complex into sse_le-complex',&INUUUU& __LINE__,info)I--'P ....GOTO 9999 ENDIFI#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ,F (btype.NE. ksed_double) THEN info = error_error P_(sT....CALLs error( err wrong_prec,' mapNiseld_pop_2d', &INUUUU& 'tryse_ so pop agnon-double-complex into double-complex',&INUUUU& __LINE__,info)I--'P ....GOTO 9999 ENDIFI#elifIN__KI--m==,__,.f" # ,F (btype.NE. integer) THEN info = error_error P_(sT....CALLs error( err wrong_prec,' mapNiseld_pop_2d', &INUUUU& 'tryse_ so pop agnon-integer into integer ',__LINE__,info)I--'P ....GOTO 9999 ENDIFI#elifIN__KI--m==,__COMPLEX ,F (btype.NE. logical) THEN info = error_error P_(sT....CALLs error( err wrong_prec,' mapNiseld_pop_2d', &INUUUU& 'tryse_ so pop agnon-logical into logical ',__LINE__,info)I--'P .ENDIFI#endifIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Detunmctr sizeF__(fseld ,aragatyp, neededINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,xhi = 0INUEhEmyhi = 0INUEhEmDO i=1,target_topo%nsublist lEmax,,,,,idom = target_topo%isublist(i)INUEhEmax,m,F (target_mesh%nnoRss(1,idom).GT.xhi) THEN xhi = target_mesh%nnoRss(1,idom)IP_(sT. mENDIFI ax,m,F (target_mesh%nnoRss(2,idom).GT.yhi) THEN yhi = target_mesh%nnoRss(2,idom)IP_(sT. mENDIFI ENDDO P_(sT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Re -Focategatyp, if neededINUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F (( mapNtypen.EQ. p param_mapNghost get) .OR. &INUUUU& ( mapNtypen.EQ. p param_mapNghost put) .OR. &INUUUU& (rtypen.EQ. p param_pop_add)) THEN -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mON - Preservemold fselds if seisgisgto receivrxghostsn_r s add - cout(Ibutyous -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mON ilacn= p param_ -Foc_fit_preserve ELSE ilacn= p param_ -Foc_fitI--'P .ENDIFI#ifINx__DIM ==,__VFIELD �lEmaxldu(1) = edimINUEhEmldu(2) = xhi+ghostsize(1)INUEhEmldu(3) = yhi+ghostsize(2)INUEhEmldu(4) = target_topo%nsublist lEmax,ldl(1) = 1ETEmax,ldl(2) = 1-ghostsize(1)INUEhEmldl(3) = 1-ghostsize(2)INUEhEmldl(4) = 1E#elifI__DIM ==,__SFIELD �lEmaxldu(1) = xhi+ghostsize(1)INUEhEmldu(2) = yhi+ghostsize(2)INUEhEmldu(3) = target_topo%nsublist lEmax,ldl(1) = 1-ghostsize(1)INUEhEmldl(2) = 1-ghostsize(2)INUEhEmldl(3) = 1I#endifI�lEmaxCALLsp -Foc(f,ara,ldl,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_pop_2d', &INUUUU& 'new ,aragFDATA',__LINE__,info)I--'P .....GOTO 9999 ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Build(se_cinversexsubxlistps fsedAlocaltsubxiOdeices basEd ou - glob - ones (se_cglob - ones are communicated)INUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,ilacn n= p param_ -Foc_fit P_(sT.ldu(1) = target_topo%nsublist lEmax,CALLsp -Foc(sublist,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_fara-INUEhEm,-'TCALLs error( err -Foc,' mapNiseld_pop_2d', &INUUUU& 'temporary subxlistpSUBLIST',__LINE__,info)I--'P .....GOTO 9999 ENDIFIP_(sT.! Wr needts c-pynit into a tempxlist, ssece directlynusse_IP_(sT.! isublist(:, iseld_topoid) asgan atgume, s invert_list isIP_(sT.! notipossible ssece se_catgume, needsnt be amPOaCOMP.t�lEmaxsublist(1:target_topo%nsublist)'=,,,,,&INUUUU& target_topo%isublist(1:target_topo%nsublist) lEmax,CALLsp Utcl_invert_list(sublist,invsublist,info)I--'P .ilacn n= p param_de -Foc P_(sT.CALLsp -Foc(sublist,ldu,ilac,info)I--'P .,F (info .NE. 0) THEN info = error_error P_(sT.....CALLs error( err de -Foc,' mapNiseld_pop_2d', &INUUUU& 'temporary subxlistpSUBLIST',__LINE__,info)I--'P .ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Detunmctr se_cnumberAof ,aragpoints t be receivrd NUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,M,ara = 0IN!-'P .,F (PRES"NT(mask)) THEN - DO i=1, nrecvlist P- -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m P- - access meshnbFocksNbeloNdse_ so se_ci-thgpF'R ss-r in se_ P- - recvlist P- -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 m P- DO j=p precvbuffer(i),p precvbuffer(i+1)-1IN- -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999IN- - Detunmctr mesh range in localtsubxcoordsNatesIN- -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999IN- jsub = mesh irecvtosub(j)IN- isub = invsublist(jsub)IN- mofs(1) = p_mesh%i#Aart(1,jsub)-1IN- mofs(2) = p_mesh%i#Aart(2,jsub)-1IN- xlo = mesh irecvblk#Aart(1,j)-mofs(1)IN- ylo = mesh irecvblk#Aart(2,j)-mofs(2)IN- xhi = xlo+ mesh irecvblk#ize(1,j)-1IN- yhi = ylo+ mesh irecvblk#ize(2,j)-1IN- -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999IN- - Countgpoints f-r which maskgisgtrueIN- -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999IN- DO jmesh=ylo,yhiIN- DO imesh=xlo,xhiIN- .,F (mask(1,imesh,jmesh,isub)) M,ara = M,ara + 1 N- ENDDO h! ENDDO h! ENDDO h! ENDDO h! ELSE DO i=1, nrecvlist P -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - access meshnbFocksNbeloNdse_ so se_ci-thgpF'R ss-r in se_ P - recvlist P -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON DO j=p precvbuffer(i),p precvbuffer(i+1)-1INNNNNNNNNNNNNNN-------------------------------ginys,max,phys,mis,t�lEmax,t�lh999INNNNNNNNNNNNNNN-..Get se_cnumberAof mesh points in seisgbFockINNNNNNNNNNNNNNN-------------------------------ginys,max,phys,mis,t�lEmax,t�lh999INNNNNNNNNNNNNNNM,ara = M,ara + ( mesh irecvblk#ize(1,j)*NNNNNNNNN&INUUUU& mesh irecvblk#ize(2,j))I--'P .......ENDDO hEm,-' ENDDO h! ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- IfTse_renisgnothse_ so be sentxwe are d_trINUEhEm-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F (M,ara .EQ. 0) THEN ,F ( debug .GT. 0) THEN ,,,,,,CALLs write( rank,' mapNiseld_pop_2d',NNN&INUUUU& 'Te_renisgno ,aragt be receivrd',info)I--'P .....ENDIFI ax,mGOTO 9999 ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Decreme, seecsointerpinto idatreceivrxbuffer lEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F ( debug .GT. 1) THEN WRITE(mesg,'(2(A,I9))') ' nrecvbuffer = ', nrecvbuffer,NNN&INUUUU& ' / M,ara*bdimn= ',M,ara*bdim P_(sT.....CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P .ENDIFI--'P . nrecvbuffer = nrecvbuffer - M,ara*bdimIINUEhT.ibuffer = nrecvbufferETEmax,,F ( debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'ibuffer = ',ibufferETEmax,....CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P .ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Decreme, seecsointerpinto idatsendxbuffer to alFowcreusr byETEmax,- multiple sequentialt ush-send-pop pycles.t�lEmax!------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,M,ara = 0INNNNNNDO i=1, nsendlistETEmax,max!------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTETEmax,max! access meshnbFocksNbeloNdse_ so se_ci-thgpF'R ss-r in se_ P - sendlistETEmax,max!------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONTETEmax,maxDO j=p psendbuffer(i),p psendbuffer(i+1)-1INNNNNNNNNNNN-------------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - Get se_cnumberAof mesh points in seisgbFockINNNNNNNNNNNN-------------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON M,ara = M,ara + ( mesh isendblk#ize(1,j)*NNNNNNNNN&INUUUU& mesh isendblk#ize(2,j))I--'P ....ENDDO hEm,-'ENDDO nsendbuffer = nsendbuffer - buffer dim( buffer se )*M,araIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Debug output NUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F ( debug .GT. 0) THEN ,,,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,CALLs write( rank,' mapNiseld_pop_2d',NNNNN&INUUUU& 'Replacse_ curre, fseld values',info)I--'P .....ELSEIF(rtypen.EQ. p param_pop_add) THEN ,,,,,,CALLs write( rank,' mapNiseld_pop_2d',NNNNN&INUUUU& 'Addse_ so curre, fseld values',info)I--'P .....ENDIFI ENDIFIINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,- Loop ovor idatreceivrd'meshnbFocksINUEhT.-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,-------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,-axDOUBLE PRECITH_a -------------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 mONT-MMETEmax,,F ( ksedA.EQ. p ksed_double) THEN DO i=1, nrecvlist P -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - Access meshnbFocksNbeloNdse_ so se_ci-thgpF'R ss-r in se_ P - recvlist P -------------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON DO j=p precvbuffer(i),p precvbuffer(i+1)-1INNNNNNNNNNNNNNN----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - Get se_csub ID f-r seisgmeshnbFockINNNNNNNNNNNNNNN----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON jsub = mesh irecvtosub(j)INNNNNNNNNNNNNNN----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - Translatu to localtsubxID f-r storse_ se_cdaraINNNNNNNNNNNNNNN----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON isub = invsublist(jsub)INNNNNNNNNNNNNNN----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - Mesh offset f-r seisgsubINNNNNNNNNNNNNNN----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON mofs(1) = target_mesh%i#Aart(1,jsub)-1IN mofs(2) = target_mesh%i#Aart(2,jsub)-1IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - Get b-un,ariEsAof mesh bFock(t be receivrd in localtsub - coordsNatesIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON xlo = mesh irecvblk#Aart(1,j)-mofs(1)INNNNNNNNNNNNNNNylo = mesh irecvblk#Aart(2,j)-mofs(2)IN xhi = xlo+ mesh irecvblk#ize(1,j)-1INNNNNNNNNNNNNNNyhi = ylo+ mesh irecvblk#ize(2,j)-1INNNNNNNNNNNNNNN,F ( debug .GT. 1) THEN WRITE(mesg,'(A,2I4)') '#Aart: ',NNNNNNNNNNNNN&INUUUU& mesh irecvblk#Aart(1,j), mesh irecvblk#Aart(2,j) CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P . WRITE(mesg,'(A,2I4)') '#ize: ',NNNNNNNNNNNNN&INUUUU& mesh irecvblk#ize(1,j), mesh irecvblk#ize(2,j) CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P . WRITE(mesg,'(A,2I4)') 'mesh offset: ',mofs(1),mofs(2)IN CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P . WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiIN CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P . WRITE(mesg,'(A,2I4)') 'ylo,Nyhi: ',ylo,yhiIN CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I--'P . WRITE(mesg,'(A,I1)') 'buffer ,im: ',edim P_(sT..... CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I#ifINx__DIM ==,__VFIELD �lEmax WRITE(mesg,'(A,2I4)') 'SIZE(f,ara): ',SIZE(f,ara,2), &INUUUU& SIZE(f,ara,3)IN CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I#elifI__DIM ==,__SFIELD �lEmax WRITE(mesg,'(A,2I4)') 'SIZE(f,ara): ',SIZE(f,ara,1), &INUUUU& SIZE(f,ara,2)IN CALLs write( rank,' mapNiseld_pop_2d',mesg,info)I#endifI�lEmaxxxxxxxxxxENDIFI#ifINx__DIM ==,__VFIELD �lEmaxxxxxxxxxx----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON - W isout mask: Thisgwi _ivectorsze x----------------------------ginys,max,phys,mis,t�lEmax,t�lh999-ON ,F (.NOT.PRES"NT(mask)) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=1INNNNNNNNNNNNNNN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ,F (edimA.EQ. 1) THEN ,,,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=2I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edimA.EQ. 2) THEN ,,,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=3I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edimA.EQ. 3) THEN ,,,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(2,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(3,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(3,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=4I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edimA.EQ. 4) THEN ,,,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(2,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(3,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(3,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(4,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(4,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=5I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edimA.EQ. 5) THEN ,,,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)ITEmax, ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(2,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(3,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(3,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(4,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(4,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(5,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(5,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(5,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(5,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)ITEmax, ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(5,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(5,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(5,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(5,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(1,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(2,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(3,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(4,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(5,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(5,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(5,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(5,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(5,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - F-r edim.GT.5 the vect-r length will be edim !!I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSE max, ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNNNNNNNNNNNDO k=1,edimI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(k,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(k,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,,,, NNDO k=1,edimI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDDO hEm,-' ENDIF ! rtype ENDIF ! lda'=,... ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! With mask: This will not vect-rize so no need to unro-F ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSE max, DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,IF (mask(imesh,jmesh,isub)) THEN DO k=1,edimI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifITEmax, ,F (rtypen.EQ. p param_pop_replace) THEN #ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(k,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(k,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ELSEIF (rtypen.EQ. p param_pop_add) THEN #ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,&INUUUU& f,ara(k,imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDIFIN ENDDO hEm,-' ELSE max, ----------------------------ginys,max,phys,mis,t�lEma max, - If ldo.EQ..FALSE. skip this point max, ----------------------------ginys,max,phys,mis,t�lEma #ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + (edim*2)I#elseETEmax, ibuffer = ibuffer + edimI#endifI ENDIF ! mask.EQ..TRUE. ENDDO hEm,-' ENDDO hEm,-' ENDIF ! PRESENT(mask)I#elifI__DIMm==,__SFIELD hEm,-' IF (.NOT.PRESENT(mask)) THEN ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=, recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& , recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFIN ELSE ! PRESENT(mask)IhEm,-' DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,IF (mask(imesh,jmesh,isub)) THEN #ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifITEmax, ,F (rtypen.EQ. p param_pop_replace) THEN #ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=, recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ELSEIF (rtypen.EQ. p param_pop_add) THEN #ifINx,__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& , RE ( recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& , , recvbufferd(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& , CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+&INUUUU& , CMPLX( recvbufferd(ibuffer-1), &INUUUU& recvbufferd(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,f,ara(imesh,jmesh,isub)+,&INUUUU& INT(p recvbufferd(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbufferd(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_double- myepsd)) THEN f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDIFIN ELSE max, ----------------------------ginys,max,phys,mis,t�lEma max, - If ldo.EQ..FALSE. skip this point max, ----------------------------ginys,max,phys,mis,t�lEma #ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifITEmax, ENDIF ! mask.EQ..TRUE. ENDDO hEm,-' ENDDO hEm,-' ENDIF ! PRESENT(mask)I#endifITEmax, ENDDOm,-' ! p precvbuffer ax, ENDDOm,-' ! p nrecvlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - SINGLE PRECITH_a ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma ELSE DO i=1,p nrecvlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, - Access mesh blocks belongse_ to the i-th processor in the - recvlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, DO j=p precvbuffer(i),p precvbuffer(i+1)-1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the sub ID for this mesh blockI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 jsub =, mesh_irecvtosub(j)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Translate to local sub ID for st-rie_ the ,araIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 isub =,invsublist(jsub)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Mesh offset for this subIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 mofs(1)'=,target mesh%istart(1,jsub)-1I mofs(2)'=,target mesh%istart(2,jsub)-1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get boundaries of mesh block to be received in local sub ! coordinatesI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 xlo =, mesh_irecvblkstart(1,j)-mofs(1) ylo =, mesh_irecvblkstart(2,j)-mofs(2) xhi =,xlo+ mesh_irecvblksize(1,j)-1I yhi =,ylo+ mesh_irecvblksize(2,j)-1I IF ( debug .GT. 1) THEN WRITE(mesg,'(A,2I4)') 'start: ', &INUUUU& mesh_irecvblkstart(1,j), mesh_irecvblkstart(2,j) LEXL write( rank,' map_field_pop_2d',mesg,info) WRITE(mesg,'(A,2I4)') 'size: ', &INUUUU& mesh_irecvblksize(1,j), mesh_irecvblksize(2,j) LEXL write( rank,' map_field_pop_2d',mesg,info) WRITE(mesg,'(A,2I4)') 'mesh offset: ',mofs(1),mofs(2) LEXL write( rank,' map_field_pop_2d',mesg,info) WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiINNNNNNNNNNNNNNNNNNNLEXL write( rank,' map_field_pop_2d',mesg,info) WRITE(mesg,'(A,2I4)') 'ylo, yhi: ',ylo,yhiINNNNNNNNNNNNNNNNNNNLEXL write( rank,' map_field_pop_2d',mesg,info) WRITE(mesg,'(A,I1)') 'buffer dim: ',edimINNNNNNNNNNNNNNNNNNNLEXL write( rank,' map_field_pop_2d',mesg,info) #ifINx__DIMm==,__VFIELD hEm,-' WRITE(mesg,'(A,2I4)') 'SIZE(f,ara): ',SIZE(f,ara,2), &INUUUU& SIZE(f,ara,3) LEXL write( rank,' map_field_pop_2d',mesg,info) #elifI__DIMm==,__SFIELD hEm,-' WRITE(mesg,'(A,2I4)') 'SIZE(f,ara): ',SIZE(f,ara,1), &INUUUU& SIZE(f,ara,2) LEXL write( rank,' map_field_pop_2d',mesg,info) #endifITEmax, ENDIFI#ifINx__DIMm==,__VFIELD hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Without mask: This will vect-rize hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (.NOT.PRESENT(mask)) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 IF (edim .EQ. 1) THEN ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'= &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,, &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=2I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edim .EQ. 2) THEN ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'= &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,, &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=3I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edim .EQ. 3) THEN ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(3,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(3,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'= &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,, &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(3,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(3,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=4I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edim .EQ. 4) THEN ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(3,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(3,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(4,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(4,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'= &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,, &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(3,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(3,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(4,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(4,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - Unro-Fed f-r edim=5I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSEIF (edim .EQ. 5) THEN ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)ITEmax, ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, ,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(1,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(2,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(3,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(3,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(4,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(4,imesh,jmesh,isub)'=,.FALSE. ENDIFI ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(5,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(5,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)ITEmax, ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(5,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(5,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I ibuffer = ibuffer + 2I f,ara(5,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(5,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(1,imesh,jmesh,isub)'=,,, &INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I ibuffer = ibuffer + 2I ax,mmmmmmmmm f,ara(5,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(5,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(1,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(2,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(3,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(4,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I f,ara(5,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(5,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(1,imesh,jmesh,isub)'= &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(1,imesh,jmesh,isub)'=,,,, &INUUUU& (f,ara(1,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(2,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(2,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(3,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(3,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(3,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(4,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(4,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(4,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFIN ibuffer = ibuffer + 1I IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(5,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(5,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(5,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(5,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFI ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - F-r edim.GT.5 the vect-r length will be edim !!I ax,mmmmmmmmm----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ELSE max, ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNNNNNNNNNNNDO k=1,edimI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(k,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(k,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,,,,DO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,,,, NNDO k=1,edimI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(k,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(k,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDDO hEm,-' ENDIF ! rtype ENDIF ! lda'=,... ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! With mask: This will not vect-rize so no need to unro-F ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSE max, DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,IF (mask(imesh,jmesh,isub)) THEN DO k=1,edimI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifITEmax, ,F (rtypen.EQ. p param_pop_replace) THEN #ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(k,imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(k,imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ELSEIF (rtypen.EQ. p param_pop_add) THEN #ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(k,imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(k,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(k,imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(k,imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDIFIN ENDDO hEm,-' ELSE max, ----------------------------ginys,max,phys,mis,t�lEma max, - If ldo.EQ..FALSE. skip this point max, ----------------------------ginys,max,phys,mis,t�lEma #ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + (edim*2)I#elseETEmax, ibuffer = ibuffer + edimI#endifI ENDIF ! mask.EQ..TRUE. ENDDO hEm,-' ENDDO hEm,-' ENDIF ! PRESENT(mask)I#elifI__DIMm==,__SFIELD hEm,-' IF (.NOT.PRESENT(mask)) THEN ,F (rtypen.EQ. p param_pop_replace) THEN ,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ELSEIF (rtypen.EQ. p param_pop_add) THEN ,,,,,,,,,,,,,DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNN,,,DO imesh=xlo,xhiI#ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifI#ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDIFIN ELSE ! IF PRESENT(mask)IhEm,-' DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,IF (mask(imesh,jmesh,isub)) THEN #ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifITEmax, ,F (rtypen.EQ. p param_pop_replace) THEN #ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,,,,,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(imesh,jmesh,isub)'=,.TRUE. ELSE max, f,ara(imesh,jmesh,isub)'=,.FALSE. ENDIFI#endifI ELSEIF (rtypen.EQ. p param_pop_add) THEN #ifINx,__KI--m==,__DOUBLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& RE ( recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__SINGLE_PRECITH_a f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& recvbuffers(ibuffer)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_sse_le)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& CMPLX( recvbuffers(ibuffer-1), &INUUUU& recvbuffers(ibuffer),p ksed_double)I#elifIN__KI--m==,__,.f" # f,ara(imesh,jmesh,isub)'=,,,,&INUUUU& f,ara(imesh,jmesh,isub)'+,&INUUUU& INT(p recvbuffers(ibuffer))I#elifIN__KI--m==,__COMPLEX IF ( recvbuffers(ibuffer) .GT. ,,,,&INUUUU& (1.0_p ksed_sse_le- myepss)) THEN f,ara(imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.TRUE.)IN ELSE max, f,ara(imesh,jmesh,isub)'=,,,,,,,,&INUUUU& (f,ara(imesh,jmesh,isub)'.AND.,.FALSE.)IN ENDIFI#endifI ENDIFIN ELSE max, ----------------------------ginys,max,phys,mis,t�lEma max, - If ldo.EQ..FALSE. skip this point max, ----------------------------ginys,max,phys,mis,t�lEma #ifINx,__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ibuffer = ibuffer + 2I#elseETEmax, ibuffer = ibuffer + 1I#endifITEmax, ENDIF ! mask.EQ..TRUE. ENDDO hEm,-' ENDDO hEm,-' ENDIF ! PRESENT(mask)I#endifITEmax, ENDDOm,-' ! p precvbuffer ax, ENDDOm,-' ! p nrecvlist ENDIF ! p ksed ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Decrement the set counter ax, ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma p buffer_set = p buffer_set - 1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Deallocate the receive buffer ifIall sets have been poped ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma IF ( buffer_set .LT. 1) THEN iopt = p param_dealloc IF ( ksedn.EQ. p ksed_sse_le) THEN LEXL p alloc( recvbuffers,ldu,iopt,info)IN ELSE max,LEXL p alloc( recvbufferd,ldu,iopt,info)IN ENDIFIN IF (info .NE. 0) THEN info = p error error max,LEXL p error(p err alloc,' map_field_pop_2d', max,&INUUUU& 'receive buffer PPM_RECVBUFFER',__CINE__,info)IN ENDIFIN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Deallocate inverse sub list ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma iopt = p param_dealloc LEXL p alloc(invsublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err dealloc,' map_field_pop_2d', max,&INUUUU& 'inverse sub list INVSUBLIST',__CINE__,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Return ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma 9999 CONTINUE LEXL substop(' map_field_pop_2d',t0,info)IN RETURN CONTAINS SUBROUTINE check LEXL p check_meshid(target_topoid,target_meshid,ldo,info)IN IF ( buffer_set .LT. 1) THEN info = p error noticeETEmax, LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'buffer is empty. Cannot pop.',__CINE__,info)IN GOTO 8888IN ENDIFIN IF (.NOT. ldo) THEN info = p error error max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'destination meshid out of range',__CINE__,info)IN GOTO 8888IN ENDIFI#ifINx__DIMm==,__VFIELD hEm,-' IF (lda'.LT. 1) THEN info = p error error max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'lda'must be >0 for vect-r ,ara',__CINE__,info)IN GOTO 8888IN ENDIFI#elifI__DIMm==,__SFIELD hEm,-' IF (lda'.NE. 1) THEN info = p error error max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'lda'must be =1 for scalar ,ara',__CINE__,info)IN GOTO 8888IN ENDIFI#endifITEmax, IF (SIZE(ghostsize,1) .LT. 2) THEN info = p error error max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'ghostsize'must be given for all dimensions',__CINE__,info)IN GOTO 8888IN ENDIFIN IF ((ghostsize(1) .LT. 0) .OR. (ghostsize(2) .LT. 0)) THEN info = p error error max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'ghostsize'must be >=0 in all dimensions',__CINE__,info)IN GOTO 8888IN ENDIFIN IF (PRESENT(poptype)) THEN IF ((poptype'.NE. p param_pop_replace) .AND.,UUUU&INUUUU& (poptype'.NE. p param_pop_add)) THEN info = p error error max,max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'Unknown pop type'specified',__CINE__,info)IN GOTO 8888IN ENDIFIN ENDIFIN8888,max,LONTINUE END SUBROUTINE check SUBROUTINE check_twoIN IF (PRESENT(mask)) THEN xhi = 0 yhi = 0 DO i=1,target_topo%nsublist isub = target_topo%isublist(i)IN IF (target_mesh%nnodes(1,isub).GT.xhi) THEN xhi = target_mesh%nnodes(1,isub) hEm,-' ENDIFIN IF (target_mesh%nnodes(2,isub).GT.yhi) THEN yhi = target_mesh%nnodes(2,isub) hEm,-' ENDIFIN ENDDO hEm,-' IF (SIZE(mask,1) .LT. xhi) THEN info = p error error max,max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'x dimension of mask does not match mesh',__CINE__,info)IN GOTO 7777IN ENDIFIN IF (SIZE(mask,2) .LT. yhi) THEN info = p error error max,max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'y dimension of mask does not match mesh',__CINE__,info)IN GOTO 7777IN ENDIFIN IF (SIZE(mask,3) .LT. target_topo%nsublist) THEN info = p error error max,max,LEXL p error(p err argument,' map_field_pop_2d', m&INUUUU& 'mask dara for some subs is missse_',__CINE__,info)IN GOTO 7777IN ENDIFIN ENDIFIN7777,max,LONTINUE END SUBROUTINE check_twoI#ifINx,__DIMm==,__SFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a END SUBROUTINE map_field_pop_2d_sca_sI#elifIN__KI--m==,__DOUBLE_PRECITH_a END SUBROUTINE map_field_pop_2d_sca_dI#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_pop_2d_sca_scI#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_pop_2d_sca_dcI#elifIN__KI--m==,__,.f" # END SUBROUTINE map_field_pop_2d_sca_iI#elifIN__KI--m==,__COMPLEX END SUBROUTINE map_field_pop_2d_sca_lI#endifII#elifIN__DIMm==,__VFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a END SUBROUTINE map_field_pop_2d_vec_sI#elifIN__KI--m==,__DOUBLE_PRECITH_a END SUBROUTINE map_field_pop_2d_vec_dI#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_pop_2d_vec_scI#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_pop_2d_vec_dcI#elifIN__KI--m==,__,.f" # END SUBROUTINE map_field_pop_2d_vec_iI#elifIN__KI--m==,__COMPLEX END SUBROUTINE map_field_pop_2d_vec_lI#endifI#endifI��������������������������������������������lib -1.2.1/src/map/ map_field_push_2d.f��������������������������������������������������������0000644�0001752�0001753�00000250453�11616003524�021121� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Subroutine : map_field_push_2d ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribute it and/or modifyIN ! it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either - version 3 of the License, or (at your option) any later - version.IN !IN ! PPM is distributed in the hope that it will be useful,IN ! but WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theIN ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public License - and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH Zurich - CH-8092 Zurich, Switzerland ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma I#ifINx,__DIMm==,__SFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a SUBROUTINE map_field_push_2d_sca_s(topoid,meshid,f,ara,info,mask)I#elifIN__KI--m==,__DOUBLE_PRECITH_a SUBROUTINE map_field_push_2d_sca_d(topoid,meshid,f,ara,info,mask)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX SUBROUTINE map_field_push_2d_sca_sc(topoid,meshid,f,ara,info,mask)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX SUBROUTINE map_field_push_2d_sca_dc(topoid,meshid,f,ara,info,mask)I#elifIN__KI--m==,__,.f" # SUBROUTINE map_field_push_2d_sca_i(topoid,meshid,f,ara,info,mask)I#elifIN__KI--m==,__COMPLEX SUBROUTINE map_field_push_2d_sca_l(topoid,meshid,f,ara,info,mask)I#endifI#elifIN__DIMm==,__VFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a SUBROUTINE map_field_push_2d_vec_s(topoid,meshid,f,ara,lda,info,mask)I#elifIN__KI--m==,__DOUBLE_PRECITH_a SUBROUTINE map_field_push_2d_vec_d(topoid,meshid,f,ara,lda,info,mask)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX SUBROUTINE map_field_push_2d_vec_sc(topoid,meshid,f,ara,lda,info,mask)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX SUBROUTINE map_field_push_2d_vec_dc(topoid,meshid,f,ara,lda,info,mask)I#elifIN__KI--m==,__,.f" # SUBROUTINE map_field_push_2d_vec_i(topoid,meshid,f,ara,lda,info,mask)I#elifIN__KI--m==,__COMPLEX SUBROUTINE map_field_push_2d_vec_l(topoid,meshid,f,ara,lda,info,mask)I -!! This routine pushes field dara onto the send buffer for 2D meshes.IN !!!I -!! [NOTE]I -!! ======================================================================I -!! The on-process-r ,ara is stored in the first part of the buffer ax, !!!I -!! If the call to invert_list is too slow here, thisI -!! could be done by topo_store and stored for each -!! topology. At the expense of some extra memory.IN !!!I -!! The f,ara arrays are passed as `PO,.f"R` and notI -!! `,.f"NT(IN)` even though they are not changed or ax, !!! reallocated inside this routine. The reason is that ax, !!! LBOU--mcan be non-standard (i.e. != 1) ifIwe have ax, !!! ghost layers and the correct LBOU--mis only passed ax, !!! along with the array ifIthe latter is given theIN !!! PO,.f"R attribute.IN !!!I -!! When N,ara is determined,Ithe mask is notI -!! considered. This could lead to a too largeI -!! sendbuffer being allocated inIthe last push and -!! could be optimized later.I -!! ======================================================================I -!!I -!! [WARNING]I -!! DIMmis the dimension of the f,ara array and not the spaceI -!! dimension dim!I#endifI#endifI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - IncludesI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - ModulesI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma USE module_,ara USE module_,ara_mesh USE module_typedef USE module_substart USE module_substop USE module_error USE module_alloc USE module_write USE module_check_id USE module_util_invert_list IMPLICIT NONE #ifINx,__KI--m==,__SINGLE_PRECITH_a |N__KI--m==,__SINGLE_PRECITH_a_COMPLEX ,.f" #, PARAMEf"R :: MK = p ksed_sse_leI#elseETEmax,,.f" #, PARAMEf"R :: MK = p ksed_doubleI#endifI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - ArgumentsI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma #ifINx__DIMm==,__SFIELD #ifINx__KI--m==,__,.f" # ,.f" # , DIMENTH_a(:,:,:) , PO,.f"R :: f,araI#elifI__KI--m==,__COMPLEX COMPLEX , DIMENTH_a(:,:,:) , PO,.f"R :: f,araI#elifI__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX COMPLEX(MK), DIMENTH_a(:,:,:), PO,.f"R :: f,araI#elseETEmax,RE (MK), DIMENTH_a(:,:,:) , PO,.f"R :: f,araI#endifII#elifI__DIMm==,__VFIELD #ifINx__KI--m==,__,.f" # ,.f" # , DIMENTH_a(:,:,:,:) , PO,.f"R :: f,araI#elifI__KI--m==,__COMPLEX COMPLEX , DIMENTH_a(:,:,:,:) , PO,.f"R :: f,araI#elifI__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX COMPLEX(MK), DIMENTH_a(:,:,:,:), PO,.f"R :: f,araI#elseETEmax,RE (MK), DIMENTH_a(:,:,:,:) , PO,.f"R :: f,araI#endifI#endifI -!! Field dara.IN !!!I -!! 1st index: lda'''''''''''''''''''''''''''''''''''''''''''''''''''''''+I -!! 2nd-3th index: mesh (i,j) relative to istart-1 of the sub I -!! (i.e. (i,j)=(1,1) corresponds to istart)'''''''''''''''''''''''''''''+I -!! 4th: isub 1...nsublist (all subs on this process-r).IN !!!I -!! For scalar fields, the first indexmis omitted (the others shiftI -!! accordse_ly).IN COMPLEX, DIMENTH_a(:,:,:), PO,.f"R, OPTH_aEX :: mask ax, !!! Logical mask.IN !!!I -!! Only the mesh nodes for which this is .TRUE. will beI -!! mapped. If not given, all points are mapped.IN !!!I -!! 1st-2nd index: mesh (i,j) '''''''''''''''''''''''''''''''''''''''''''+I -!! 3rd: isub.I#ifINx__DIMm==,__VFIELD hEm,-',.f" # , ,.f"NT(IN ) :: ldaI -!! The leading dimension of the f,ara.I -!! lda=1 for the case of scalar ,araI#endifI ,.f" # , ,.f"NT(IN ) :: topoidI -!! Topology ID of sourceI ,.f" # , ,.f"NT(IN ) :: meshidI -!! Mesh ID of sourceI ,.f" # , ,.f"NT( OUT) :: infoI -!! Returns status, 0 upon successI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Local variablesI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma ,.f" #, DIMENTH_a(2) '':: ldu,mofsI ,.f" # :: i,j,k,ibuffer,isub,imesh,jmesh,jsubI ,.f" # :: iopt,N,ara,xlo,xhi,ylo,yhi,ldbI RE (MK) :: t0IN COMPLEX :: ldoI CHARACf"R(LEN=p char) :: mesg #ifINx__DIMm==,__SFIELD ,.f" #, PARAMEf"R :: lda'=,1I#endifITEmax,TYPE(p t_topo), max, PO,.f"R :: topo => NULL()ITEmax,TYPE(p t_equi_mesh), PO,.f"R :: mesh => NULL()ITEmax,----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - ExternalsI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - InitialiseI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma LEXL substart(' map_field_push_2d',t0,info)I I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Check argumentsI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma ,F ( debug .GT. 0) THEN LEXL check IF (info .NE. 0) GOTO 9999 ENDIFI topo => p topo(topoid)%tI mesh => topo%mesh(meshid)ITEmax,----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Count number of ,ara points to be sent ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma N,ara = 0 DO i=1,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�l - access mesh blocks belonging to the i-th process-r in theIN - sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�l DO j=p psendbuffer(i),p psendbuffer(i+1)-1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, - Get the number of mesh points in this block ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, N,ara = N,ara + ( mesh_isendblksize(1,j)* &INUUUU& mesh_isendblksize(2,j))IN ENDDO hEm,-'ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - If there is nothing to be sentIwe are doneI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma ,F (N,ara .EQ. 0) THEN ,F ( debug .GT. 0) THEN LEXL p write( rank,' map_field_push_2d', &INUUUU& 'There is no ,ara to be sent',info)IN ENDIFIN GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Increment the buffer set ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma p buffer_set = p buffer_set + 1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Allocate memory for the buffer dimension and type ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma iopt = p param_alloc_grow preserve ax, ldu(1) = p buffer_set LEXL p alloc( buffer_dim,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faraF LEXL p error(p err alloc,' map_field_push_2d', x,&INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__CINE__,info)IN GOTO 9999 ENDIFI LEXL p alloc( buffer_type,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faraF LEXL p error(p err alloc,' map_field_push_2d', x,&INUUUU& 'buffer types PPM_BUFFER_TYPE',__CINE__,info)IN GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - A complex number is treated as two reals. Cannot change ldaI - because it is ,.f"NT(IN)I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma #ifINx__KI--m==,__SINGLE_PRECITH_a_COMPLEX |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX ldb = 2*ldaI#elseETEmax,ldb = ldaI#endifII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Store the dimension and type ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma buffer_dim( buffer_set) = ldbI#ifINx,__KI--m==,__SINGLE_PRECITH_a |N__KI--m==,__SINGLE_PRECITH_a_COMPLEX buffer_type( buffer_set) = p ksed_sse_leI#elifI__KI--m==,__DOUBLE_PRECITH_a |N__KI--m==,__DOUBLE_PRECITH_a_COMPLEX buffer_type( buffer_set) = p ksed_doubleI#elifI__KI--m==,__,.f" # buffer_type( buffer_set) = p integerI#elifI__KI--m==,__COMPLEX buffer_type( buffer_set) = p logicalI#endifII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - Build the inverse sub list to fsednlocal sub indeices based on - global ones (the global ones are communicated)ITEmax,----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma iopt = p param_alloc_fitETEmax,ldu(1) = topo%nsublist LEXL p alloc(sublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faraF LEXL p error(p err alloc,' map_field_push_2d', &INUUUU& 'temporary sub list SUBLIST',__CINE__,info)IN GOTO 9999 ENDIFI ! We need to copy it into a temp list, ssece directly usse_I ! p isublist(:,p field_topoid) as an argument to invert_list isI ! not possible ssece the argument needs to be a PO,.f"R.I sublist(1:topo%nsublist) =,,,,,&INUUUU& topo%isublist(1:topo%nsublist) LEXL p util_invert_list(sublist,invsublist,info)IN iopt = p param_dealloc LEXL p alloc(sublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err dealloc,' map_field_push_2d', x,&INUUUU& 'temporary sub list SUBLIST',__CINE__,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - loop over the process-rs inIthe p isendlist()ITEmax,----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma ibuffer = p nsendbuffer ax, !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma - DOUBLE PRECITH_a BUFFERI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�lEma ,F ( ksed.EQ.p ksed_double) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�l - (Re)allocate memory for the buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,t�l iopt = p param_alloc_grow preserve ax, x,ldu(1) = p nsendbuffer + ldb*N,ara LEXL p alloc(p sendbufferd,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faraF LEXL p error(p err alloc,' map_field_push_2d', x,&INUUUU& 'global send buffer PPM_SENDBUFFERD',__CINE__,info)IN GOTO 9999 ENDIFI DO i=1,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, - access mesh blocks belonging to the i-th process-r in theIN - sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, DO j=p psendbuffer(i),p psendbuffer(i+1)-1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Get the sub ID for this mesh block ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 jsub = mesh_isendfromsub(j)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Translate tonlocal sub ID for storing the dara ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 isub = invsublist(jsub) hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Mesh offset for this subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 mofs(1) = mesh%istart(1,jsub)-1 mofs(2) = mesh%istart(2,jsub)-1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Get boundaries of mesh block to be sentIonnlocal sub - coordseates ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 xlo = mesh_isendblkstart(1,j)-mofs(1) ylo = mesh_isendblkstart(2,j)-mofs(2) xhi = xlo+ mesh_isendblksize(1,j)-1 yhi = ylo+ mesh_isendblksize(2,j)-1 ,F ( debug .GT. 1) THEN WRITE(mesg,'(A,2I4)') 'start: ', x,,,,,,,,,&INUUUU& mesh_isendblkstart(1,j), mesh_isendblkstart(2,j) LEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'size: ', x,,,,,,,,,&INUUUU& mesh_isendblksize(1,j), mesh_isendblksize(2,j) LEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'mesh offset: ',mofs(1),mofs(2) LEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiINNNNNNNNNNNNNNNNNNNLEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'ylo, yhi: ',ylo,yhiINNNNNNNNNNNNNNNNNNNLEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,I1)') 'buffer dim: ',ldaI NNNNNNNNNNNNNLEXL p write( rank,' map_field_push_2d',mesg,info)IN ENDIFIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Loop over all mesh points of this block and append dara - to send buffer. ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - ldo'=,.TRUE. - IF (PRESENT(mask)) THEN - IF (.NOT.mask(1,imesh,jmesh,isub)) ldo'=,.FALSE. ! ENDIFIN - IF (ldo) THEN #ifINx,__DIMm==,__VFIELD hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=1 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (lda'.EQ. 1) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__SINGLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I#elifIN__KI--m==,__,.f" # p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=2 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 2) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__SINGLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I#elifIN__KI--m==,__,.f" # p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFIN ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=3 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 3) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__SINGLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(3,imesh,jmesh,isub)), &INUUUU& p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(3,imesh,jmesh,isub))I#elifIN__KI--m==,__,.f" # p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFIN ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFIN ibuffer = ibuffer + 1I IF (f,ara(3,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=4 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 4) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__SINGLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(3,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(4,imesh,jmesh,isub)), &INUUUU& p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(3,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(4,imesh,jmesh,isub))I#elifIN__KI--m==,__,.f" # p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFIN ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFIN ibuffer = ibuffer + 1I IF (f,ara(3,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(4,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=5 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 5) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__SINGLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(5,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(3,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(4,imesh,jmesh,isub)), &INUUUU& p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(5,imesh,jmesh,isub)), &INUUUU& p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(3,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(4,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(5,imesh,jmesh,isub))I#elifIN__KI--m==,__,.f" # p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFIN ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFIN ibuffer = ibuffer + 1I IF (f,ara(3,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(4,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(5,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - For lda.GT.5 vector length is ldaI NNNNNNNNN----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSE hEm,-' DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,DO k=1,ldaI NNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I#ifINx,__KI--m==,__SINGLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(k,imesh,jmesh,isub)), &INUUUU& p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(k,imesh,jmesh,isub))I#elifIN__KI--m==,__,.f" # p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__COMPLEX IF (f,ara(k,imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDDO hEm,-' ENDIFI#elifIN__DIMm==,__SFIELD hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Scalar version hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I#ifINx,__KI--m==,__SINGLE_PRECITH_a p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a p sendbufferd(ibuffer) =,f,ara(imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_double)INNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(imesh,jmesh,isub)), &INUUUU& p ksed_double)I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_double)INNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I p sendbufferd(ibuffer) =,AIMAG(f,ara(imesh,jmesh,isub))I#elifIN__KI--m==,__,.f" # p sendbufferd(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_double)I#elifIN__KI--m==,__COMPLEX IF (f,ara(imesh,jmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_p ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_p ksed_doubleI ENDIFI#endifI ENDDO hEm,-' ENDDO #endifI ENDDO ! i=1,p nsendlist ENDDO ! psendbuffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - SINGLE PRECITH_a BUFFER ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999 - (Re)allocate memory for the buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999 iopt = param_alloc_grow_preserveI ldu(1) = p nsendbuffer + ldb*N,araI LEXL p alloc(p sendbuffers,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error_faral LEXL p error(p err alloc,' map_field_push_2d', &INUUUU& 'global send buffer PPM_SENDBUFFERS',__CINE__,info)IN GOTO 9999 ENDIFI DO i=1,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, - access mesh blocks belonging to the i-th processor in the - sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is, DO j= psendbuffer(i),p psendbuffer(i+1)-1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Get the sub ID for this mesh block ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 jsub = mesh_isendfromsub(j) ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Translate to local sub ID for storing the ,araI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 isub = invsublist(jsub)I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Mesh offset for this subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 mofs(1) = mesh%istart(1,jsub)-1 mofs(2) = mesh%istart(2,jsub)-1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Get boundaries of mesh block to be sent on local sub - coordinates ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 xlo = mesh_isendblkstart(1,j)-mofs(1) ylo = mesh_isendblkstart(2,j)-mofs(2) xhi = xlo+ mesh_isendblksize(1,j)-1 yhi = ylo+ mesh_isendblksize(2,j)-1 IF ( debug .GT. 1) THEN WRITE(mesg,'(A,2I4)') 'start: ', &INUUUU& mesh_isendblkstart(1,j), mesh_isendblkstart(2,j) LEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'size: ', &INUUUU& mesh_isendblksize(1,j), mesh_isendblksize(2,j) LEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'mesh offset: ',mofs(1),mofs(2) LEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiINNNNNNNNNNNNNNNNNNNLEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'ylo, yhi: ',ylo,yhiINNNNNNNNNNNNNNNNNNNLEXL p write( rank,' map_field_push_2d',mesg,info)IN WRITE(mesg,'(A,I1)') 'buffer dim: ',ldaI NNNNNNNNNNNNNLEXL p write( rank,' map_field_push_2d',mesg,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Loop over all mesh points of this block and append ,araI - to send buffer.I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - ldo = .TRUE.I - IF (PRESENT(mask)) THEN ! IF (.NOT.mask(1,imesh,jmesh,isub)) ldo = .FALSE.I - ENDIFI - IF (ldo) THEN #ifINx,__DIMm==,__VFIELD hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (lda'.EQ. 1) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__DOUBLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__SINGLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_single)I#elifIN__KI--m==,__,.f" # p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=2 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 2) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__DOUBLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__SINGLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_single)I#elifIN__KI--m==,__,.f" # p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=3 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 3) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__DOUBLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__SINGLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(3,imesh,jmesh,isub))I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(3,imesh,jmesh,isub)), &INUUUU& p ksed_single)I#elifIN__KI--m==,__,.f" # p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(3,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=4 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 4) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__DOUBLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__SINGLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(3,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(4,imesh,jmesh,isub))I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(3,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(4,imesh,jmesh,isub)), &INUUUU& p ksed_single)I#elifIN__KI--m==,__,.f" # p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(3,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(4,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Unrolled for lda=5 hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (lda'.EQ. 5) THEN DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,ibuffer = ibuffer + 1I#ifINx,__KI--m==,__DOUBLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__SINGLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(1,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(2,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(3,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(4,imesh,jmesh,isub)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(5,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(1,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(2,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(3,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(4,imesh,jmesh,isub))I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(5,imesh,jmesh,isub))I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(1,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(2,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(3,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(4,imesh,jmesh,isub)), &INUUUU& p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(5,imesh,jmesh,isub)), &INUUUU& p ksed_single)I#elifIN__KI--m==,__,.f" # p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(1,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(2,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(3,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(4,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(5,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__COMPLEX IF (f,ara(1,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(2,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(3,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(4,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI ibuffer = ibuffer + 1I IF (f,ara(5,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - For lda.GT.5 the vector length is lda !! hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSE max, DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNN,,,DO k=1,ldaI NNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I#ifINx,__KI--m==,__DOUBLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__SINGLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& f,ara(k,imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& AIMAG(f,ara(k,imesh,jmesh,isub))I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(k,imesh,jmesh,isub)), &INUUUU& p ksed_single)I#elifIN__KI--m==,__,.f" # p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(k,imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__COMPLEX IF (f,ara(k,imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI#endifI ENDDO hEm,-' ENDDO hEm,-' ENDDO hEm,-' ENDIFI#elifIN__DIMm==,__SFIELD hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Serial version hEm,-' ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO jmesh=ylo,yhiINNNNNNNNNNNNNNNNNNDO imesh=xlo,xhiINNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I#ifINx,__KI--m==,__DOUBLE_PRECITH_a p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__SINGLE_PRECITH_a p sendbuffers(ibuffer) =,f,ara(imesh,jmesh,isub)I#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_single)INNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,AIMAG(f,ara(imesh,jmesh,isub))I#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_single)INNNNNNNNNNNNNNNNNNNNNibuffer = ibuffer + 1I p sendbuffers(ibuffer) =,,,,&INUUUU& RE (AIMAG(f,ara(imesh,jmesh,isub)),p ksed_single)I#elifIN__KI--m==,__,.f" # p sendbuffers(ibuffer) =,,,,&INUUUU& RE (f,ara(imesh,jmesh,isub),p ksed_single)I#elifIN__KI--m==,__COMPLEX IF (f,ara(imesh,jmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_p ksed_singleI ELSE max, p sendbuffers(ibuffer) =,0.0_p ksed_singleI ENDIFI#endifI ENDDO hEm,-' ENDDO #endifI ENDDO ! p psendbuffer ENDDO ! i=1,p nsendlist ENDIFm,-' ! p ksedI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Update the buffer ,ara count ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 p nsendbuffer = ibufferI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Deallocate inverse sub list ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 iopt = para dealloc LEXL p alloc(invsublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_push_2d', &INUUUU& 'inverse sub list INVSUBLIST',__CINE__,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Return ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 9999 CONTINUE LEXL substop(' map_field_push_2d',t0,info)IN RETURN CONTAINS SUBROUTINE check LEXL p check meshid(topoid,meshid,ldo,info)IN IF (.NOT. ldo) THEN m,-' info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'source meshid out of range',__CINE__,info)IN GOTO 8888IN ENDIFI xhi = 0I yhi = 0I DO i=1,p topo(topoid)%t%nsublist m,-' isub = topo(topoid)%t%isublist(i)IN IF ( topo(topoid)%t%mesh(meshid)%nnodes(1,isub).GT.xhi) THEN xhi = topo(topoid)%t%mesh(meshid)%nnodes(1,isub) ENDIFI IF ( topo(topoid)%t%mesh(meshid)%nnodes(2,isub).GT.yhi) THEN yhi = topo(topoid)%t%mesh(meshid)%nnodes(2,isub) ENDIFI ENDDO #ifINx__DIMm==,__VFIELD hEm,-' IF (lda'.LT. 1) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'lda'must be >=1 for vector ,ara',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,4)'.LT. p topo(topoid)%t%nsublist) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'field ,ara for some subs is missing',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,1)'.LT. lda) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'leading dimension of ,ara does not match lda',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,2)'.LT. xhi) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'x dimension of field ,ara does not match mesh',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,3)'.LT. yhi) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'y dimension of field ,ara does not match mesh',__CINE__,info)IN GOTO 8888IN ENDIFI#elifI__DIMm==,__SFIELD hEm,-' IF (lda'.NE. 1) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'lda'must be =1 for scalar ,ara',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,3)'.LT. p topo(topoid)%t%nsublist) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'field ,ara for some subs is missing',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,1)'.LT. xhi) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'x dimension of field ,ara does not match mesh',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,2)'.LT. yhi) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'y dimension of field ,ara does not match mesh',__CINE__,info)IN GOTO 8888IN ENDIFI#endifI IF (PRESENT(mask)) THEN IF (SIZE(mask,1)'.LT. xhi) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'x dimension of mask does not match mesh',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(mask,2)'.LT. yhi) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'y dimension of mask does not match mesh',__CINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(mask,3)'.LT. p topo(topoid)%t%nsublist) THEN info = error error LEXL p error(p err argument,' map_field_push_2d', &INUUUU& 'mask dara for some subs is missing',__CINE__,info)IN GOTO 8888IN ENDIFI ENDIFI 8888 LONTINUE END SUBROUTINE check #ifINx,__DIMm==,__SFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a END SUBROUTINE map_field_push_2d_sca_sI#elifIN__KI--m==,__DOUBLE_PRECITH_a END SUBROUTINE map_field_push_2d_sca_dI#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_push_2d_sca_scI#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_push_2d_sca_dcI#elifIN__KI--m==,__,.f" # END SUBROUTINE map_field_push_2d_sca_iI#elifIN__KI--m==,__COMPLEX END SUBROUTINE map_field_push_2d_sca_lI#endifII#elifIN__DIMm==,__VFIELD #ifINx,__KI--m==,__SINGLE_PRECITH_a END SUBROUTINE map_field_push_2d_vec_sI#elifIN__KI--m==,__DOUBLE_PRECITH_a END SUBROUTINE map_field_push_2d_vec_dI#elifIN__KI--m==,__SINGLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_push_2d_vec_scI#elifIN__KI--m==,__DOUBLE_PRECITH_a_COMPLEX END SUBROUTINE map_field_push_2d_vec_dcI#elifIN__KI--m==,__,.f" # END SUBROUTINE map_field_push_2d_vec_iI#elifIN__KI--m==,__COMPLEX END SUBROUTINE map_field_push_2d_vec_lI#endifI#endifI���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/map/ghost map_symmetry_bc_lx.inc���������������������������������������������������0000644�0001752�0001753�00000003414�11616003524�022317� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - (Re)allocate memory for the symmetry ghosts. ----------------------------ginys,max,phys,mis,t�lEmax,t�lh iopt = para alloc_grow_preserveI ldu(1) = dimI ldu(2) = 2*nghostplus LEXL p alloc(xt,ldu,iopt,info) LEXL p alloc(xt_offset,ldu,iopt,info) IF (info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_part_ghost get', &I 'xt',__CINE__,info)IN GOTO 9999 ENDIFI I ldu(1) = ldu(2) LEXL p alloc(ighost,ldu,iopt,info) IF (info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_part_ghost get', &I 'ighost',__CINE__,info)IN GOTO 9999 ENDIFI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - symmetry ghosts in the x-direction. ----------------------------ginys,max,phys,mis,t�lEmax,t�lh k = nghostplus I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - those at the west boundary. - No '=' in the inequality checking. ----------------------------ginys,max,phys,mis,t�lEmax,t�lh xminf = min_phys(1) xmini = min_phys(1) + ghostsize DO i =,1, nghostplus IF ( xt(1,i) > xminf .AND.xt(1,i) < xmini ) THEN k = k + 1I ighost(k) = ighost(i)IN xt(1,k) = 2.0_MK*xminf - xt(1,i)IN xt(2,k) = xt(2,i)IN xt_offset(1,k) = -2.0_MK*(xt(1,i)-xminf)IN xt_offset(2,k) = xt_offset(2,i)IN IF ( dimm==,3 ) THEN xt(3,k) = xt(3,i)IN xt_offset(3,k) = xt_offset(3,i)IN END IFI END IFI END DO hEI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - update the ghost counter. ----------------------------ginys,max,phys,mis,t�lEmax,t�lhh nghostplus = k ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/map/ map_field_send alltoall.f��������������������������������������������������0000644�0001752�0001753�00000103241�11616003524�022362� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Subroutine : map_field_send alltoall ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribute it and/or modifyIN ! it under the terms of the GNU Lesser General Public License IN ! as published by the Free Software Foundation, either IN ! version,3 of the License, or (at your option) any later IN ! version.IN !IN ! PPM is distributed in the hope that it will be useful,IN ! but WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theIN ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseIN ! and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH Zurich - CH-8092 Zurich, Switzerland ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 SUBROUTINE map_field_send alltoall(info)IN !!! This routine performs the actual send/recv of theIN !!! mesh blocks and all pushed ,ara.IN !!!IN !!! [WARNING]IN !!! This routine has not been tested, reviewed, or checked. CommentsIN !!! and documentation are wrong. This routine might kill your cat or !!! worse.IN !!!IN !!! [NOTE]IN !!! The first part of the buffer contains the on-processor ,ara.IN !!!IN !!! [NOTE]IN !!! Using global communication (AllToAll)IN !!! could possibly speed-up this routine on very large architectures.I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Modules ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 USE module_,ara USE module_,ara mesh USE module_substart USE module_substop USE module_error USE module_alloc USE module_write IMPLICIT NONE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Includes ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 #ifdefI__MPI INCLUDE 'mpif.h'I#endifII integer, para eter :: MK = ksed_double ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Arguments ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ,.f" # , ,.f"NT( OUT) :: infoIN !!! Return status, 0 upon success ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Local variables ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ,.f" #, DIMENTH_a(3) :: ldl,ldu ,.f" # :: i,j,k,ibuffer,jbuffer,bdim,offs ,.f" # :: iopt,tag1,N,ara,msend,mrecv,allsend,allrecv CHARACTER(p char) :: mesg RE ( ksed_double) :: t0 #ifdefI__MPI INf" #, DIMENTH_a(MPI_STATUS_SIZE) :: commstatI#endifI ----------------------------ginys,max,phys,mis,t�lEmax - AllToAll Communication stuffI ----------------------------ginys,max,phys,mis,t�lEmax ,.f" # :: kbuffer INf" #, DIMENTH_a(:), POINf"R :: irecvoff => NULL() INf" #, DIMENTH_a(:), POINf"R :: isendoffglobal => NULL() INf" #, DIMENTH_a(:), POINf"R :: irecvoffglobal => NULL() INf" #, DIMENTH_a(:), POINf"R :: nsendglobal => NULL() INf" #, DIMENTH_a(:), POINf"R :: nrecvglobal => NULL() RE ( ksed_double), DIMENTH_a(:), POINf"R :: isendd => NULL() RE ( ksed_double), DIMENTH_a(:), POINf"R :: irecvd => NULL() RE ( ksed_single), DIMENTH_a(:), POINf"R :: isends => NULL() RE ( ksed_single), DIMENTH_a(:), POINf"R :: irecvs => NULL() LOMPLEX :: rflag RE ( ksed_double) :: nonblock_time0, nonblock_timer, nonblock_timeout ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Externals ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Initialise ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 LEXL substart(' map_field_send alltoall',t0,info)IIN ! skip if the buffer is emptyIN IF ( buffer_set'.LT. 1) THEN IF ( debug .GT. 1) THEN LEXL p write( rank,' map_field_send alltoall', &INUUUU& 'Buffer is empty: skipping send!',info)IN ENDIFI GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - AllocateI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 iopt = para alloc_fit ldu(1) = nsendlist LEXL p alloc(nsend,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'send counter NSEND',__CINE__,info)IN GOTO 9999 ENDIFI LEXL p alloc(psend,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'particle send counter PSEND',__CINE__,info)IN GOTO 9999 ENDIFI ldu(1) = nrecvlist LEXL p alloc(nrecv,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'receive counter NRECV',__CINE__,info)IN GOTO 9999 ENDIFI LEXL p alloc(precv,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'particle receive counter PRECV',__CINE__,info)IN GOTO 9999 ENDIFI ldu(1) = nrecvlist ldu(2) = buffer_set'I LEXL p alloc(pp,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'work buffer PP',__CINE__,info)IN GOTO 9999 ENDIFI ldu(1) = nsendlist ldu(2) = buffer_set'I LEXL p alloc(qq,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'work buffer QQ',__CINE__,info)IN GOTO 9999 ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Count the size of the buffer that will not be sendI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 N,ara = 0I IF ( dim'.LT. 3) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - access mesh blocks belonging to the 1st processor ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 DO j= psendbuffer(1), psendbuffer(2)-1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999isI - Get the number of mesh points in this blockI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999isI N,ara = N,ara + ( mesh_isendblksize(1,j)* &INUUUU& mesh_isendblksize(2,j))IN ENDDO hEm,-'ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - access mesh blocks belonging to the 1st processor ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 DO j= psendbuffer(1), psendbuffer(2)-1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999isI - Get the number of mesh points in this blockI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999isI N,ara = N,ara + ( mesh_isendblksize(1,j)* &INUUUU& mesh_isendblksize(2,j)* mesh_isendblksize(3,j))IN ENDDO hEm,-'ENDIFI ibuffer = 0I DO j=1,p buffer_setIN bdim = buffer_dim(j)IN ibuffer = ibuffer + bdim*N,ara ENDDO II ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Initialize the buffer counters ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 nrecvbuffer = ibufferI nsend(1) = ibufferI nrecv(1) = ibufferI psend(1) = N,ara precv(1) = N,ara mrecv = -1I msend = -1II ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Count the size of the buffers that will be sent ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 DO k=2,p nsendlist nsend(k) = 0I psend(k) = 0I N,ara = 0 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Number of mesh points to be sent off to the k-th processor in - the sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 IF ( dim'.LT. 3) THEN DO i= psendbuffer(k), psendbuffer(k+1)-1I N,ara = N,ara + ( mesh_isendblksize(1,i)* &INUUUU& mesh_isendblksize(2,i))I ENDDO hEm,-' ELSE max,DO i= psendbuffer(k), psendbuffer(k+1)-1I N,ara = N,ara + ( mesh_isendblksize(1,i)* &INUUUU& mesh_isendblksize(2,i)* mesh_isendblksize(3,i))I ENDDO hEm,-' ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Store the number of mesh points in psendI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 psend(k) = N,ara I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Store the size of the ,ara to be sent ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 DO j=1,p buffer_setIN nsend(k) = nsend(k) + ( buffer_dim(j)*N,ara)IN ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Find the maximum buffer length (for the allocate)I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 msend = MAX(msend,nsend(k))IN IF ( debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'msend = ',msend LEXL p write( rank,' map_field_send alltoall',mesg,info)IN ENDIFI ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Count the size of the buffers that will be received - (For meshes we know this a priori. This is different from - particles)I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 DO k=2,p nrecvlist nrecv(k) = 0I precv(k) = 0I N,ara = 0 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Number of mesh points to be received from the k-th processor in - the recvlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 IF ( dim'.LT. 3) THEN DO i= precvbuffer(k), precvbuffer(k+1)-1I N,ara = N,ara + ( mesh_irecvblksize(1,i)* &INUUUU& mesh_irecvblksize(2,i))I ENDDO hEm,-' ELSE max,DO i= precvbuffer(k), precvbuffer(k+1)-1I N,ara = N,ara + ( mesh_irecvblksize(1,i)* &INUUUU& mesh_irecvblksize(2,i)* mesh_irecvblksize(3,i))I ENDDO hEm,-' ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Store the number of mesh points in precv ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 precv(k) = N,ara I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Store the size of the ,ara to be received ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 DO j=1,p buffer_setIN nrecv(k) = nrecv(k) + ( buffer_dim(j)*N,ara)IN ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Find the maximum buffer length (for the allocate)I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 mrecv = MAX(mrecv,nrecv(k))IN IF ( debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'mrecv = ',mrecv LEXL p write( rank,' map_field_send alltoall',mesg,info)IN ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 - Increment the total receive buffer count ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,99 p nrecvbuffer = p nrecvbuffer + nrecv(k) IN IF ( debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'p nrecvbuffer = ',p nrecvbuffer LEXL p write( rank,' map_field_send alltoall',mesg,info)IN ENDIFI ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Allocate the memory for the copy of the particle buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 iopt = para alloc_grow ldu(1) = nrecvbuffer IF ( ksed.EQ. ksed_double) THEN LEXL p alloc(pp recvbufferd,ldu,iopt,info)IN ELSE LEXL p alloc(pp recvbuffers,ldu,iopt,info)IN ENDIFm IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'global receive buffer PPM_RECVBUFFER',__CINE__,info)IN GOTO 9999 ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Allocate memory for the smaller send and receive bufferI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - only allocate if there actually is anything to be sent/recvd with - other processors. Otherwise mrecv and msend would both still be -1I ! (as initialized above) and the alloc would throw a FATAL. This was - Bug ID 000012. IF ( nrecvlist .GT. 1) THEN iopt = para alloc_grow ldu(1) = MAX(mrecv,1)IN IF ( ksed.EQ. ksed_double) THEN LEXL p alloc(recvd,ldu,iopt,info)IN ELSE maxLEXL p alloc(recvs,ldu,iopt,info)IN ENDIF IN IF (info .NE. 0) THEN info = error faral maxLEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'local receive buffer RECV',__CINE__,info)IN GOTO 9999 ENDIF ENDIFII IF ( nsendlist .GT. 1) THEN ldu(1) = MAX(msend,1)IN IF ( ksed.EQ. ksed_double) THEN LEXL p alloc(sendd,ldu,iopt,info)IN ELSE maxLEXL p alloc(sends,ldu,iopt,info)IN ENDIF IN IF (info .NE. 0) THEN info = error faral maxLEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'local send buffer SEND',__CINE__,info)IN GOTO 9999 ENDIF ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Sum of all mesh points that will be sent and receivedI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 allsend = SUM(psend(1: nsendlist))IN allrecv = SUM(precv(1: nrecvlist)) I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Compute the pointer to the position of the ,ara in the main send - buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ,F ( debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'p buffer_set=',p buffer_setIN LEXL p write( rank,' map_field_send alltoall',mesg,info)IN ENDIF bdim = 0I offs = 0I DO k=1,p buffer_setIN offs = offs + allsend*bdimI qq(1,k) = offs + 1I bdim = buffer_dim(k)IN DO j=2,p nsendlist qq(j,k) = qq(j-1,k) + psend(j-1)*bdimI ,F ( debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'qq(j,k)=',qq(j,k) LEXL p write( rank,' map_field_send alltoall',mesg,info)IN ENDIFI ENDDO hEm,-'ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Compute the pointer to the position of the ,ara in the main receive - buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 bdim = 0I offs = 0I DO k=1,p buffer_setIN offs = offs + allrecv*bdimI pp(1,k) = offs + 1I bdim = buffer_dim(k)IN DO j=2,p nrecvlist pp(j,k) = pp(j-1,k) + precv(j-1)*bdimI ,F ( debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'pp(j,k)=',p (j,k) LEXL p write( rank,' map_field_send alltoall',mesg,info)IN WRITE(mesg,'(A,I9,A,I4)') 'precv(j-1)=',precv(j-1),', bdim=',bdimI LEXL p write( rank,' map_field_send alltoall',mesg,info)IN ENDIFI ENDDO hEm,-'ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - First copy the on processor ,ara - which is in the first bufferI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 IF ( ksed.EQ. ksed_double) THEN DO k=1,p buffer_setIN ibuffer = pp(1,k) - 1I jbuffer = qq(1,k) - 1I DO j=1,psend(1)* buffer_dim(k)IN ibuffer = ibuffer + 1I jbuffer = jbuffer + 1I pp recvbufferd(ibuffer) =,pp sendbufferd(jbuffer)IN ENDDO I ENDDO I ELSE DO k=1,p buffer_setIN ibuffer = pp(1,k) - 1I jbuffer = qq(1,k) - 1I DO j=1,psend(1)* buffer_dim(k)IN ibuffer = ibuffer + 1I jbuffer = jbuffer + 1I pp recvbuffers(ibuffer) =,pp sendbuffers(jbuffer)IN ENDDO I ENDDO I ENDIF II ----------------------------ginys,max,phys,mis,t�lEmax - Allocate buffers for all-to-all communicationI ----------------------------ginys,max,phys,mis,t�lEmax iopt = para alloc_fitIN ldu(1) = nsendlist LEXL p alloc(irecvoff,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUU& 'irecvoff array',__CINE__,info)IN GOTO 9999 ENDIFI iopt = para alloc_fitIN ldl(1) = 0IN ldu(1) = nproc-1I LEXL p alloc(isendoffglobal,ldl,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUU& 'isendoffglobal array',__CINE__,info)IN GOTO 9999 ENDIFI iopt = para alloc_fitIN ldl(1) = 0IN ldu(1) = nproc-1I LEXL p alloc(irecvoffglobal,ldl,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUU& 'irecvoffglobal array',__CINE__,info)IN GOTO 9999 ENDIFI iopt = para alloc_fitIN ldl(1) = 0IN ldu(1) = nproc-1I LEXL p alloc(nsendglobal,ldl,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUU& 'nsendglobal array',__CINE__,info)IN GOTO 9999 ENDIFI iopt = para alloc_fitIN ldl(1) = 0IN ldu(1) = nproc-1I LEXL p alloc(nrecvglobal,ldl,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUU& 'nrecvglobal array',__CINE__,info)IN GOTO 9999 ENDIFI II IF( ksed.EQ. ksed_double) THEN iopt = para alloc_fitIN ldu(1) = SUM(nsend(2: nsendlist))IN LEXL p alloc(isendd,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUUUUU& 'isendd array',__CINE__,info)IN GOTO 9999 ENDIFI iopt = para alloc_fitIN ldu(1) = SUM(nrecv(2: nsendlist))IN LEXL p alloc(irecvd,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUUUUU& 'irecvd array',__CINE__,info)IN GOTO 9999 ENDIFI ELSE iopt = para alloc_fitIN ldu(1) = SUM(nsend(2: nsendlist))IN LEXL p alloc(isends,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUUUUU& 'isends array',__CINE__,info)IN GOTO 9999 ENDIFI iopt = para alloc_fitIN ldu(1) = SUM(nrecv(2: nsendlist))IN LEXL p alloc(irecvs,ldu,iopt,info)IN IF(info.NE.0) THEN info = error faral LEXL p error(p err alloc,' map_field_send alltoall', &INUUUUUUUUUUUUUUUU& 'irecvs array',__CINE__,info)IN GOTO 9999 ENDIFI END IFI I ----------------------------ginys,max,phys,mis,t�lEmax - loop over cpus in isendlist, skip the first guy which is the local - processor, put the stuff in one (bigish) send buffer and store the - sedexI ----------------------------ginys,max,phys,mis,t�lEmax IF ( ksed.EQ. ksed_double) THEN isendoffglobal = 0I irecvoffglobal = 0I nsendglobal = 0I nrecvglobal = 0I I kbuffer = 0I DO k=2,p nsendlist IF( send(k).GT.0) THEN isendoffglobal( isendlist(k)) = kbuffer nsendglobal( isendlist(k)) = nsend(k)IN END IFI ----------------------------ginys,max,phys,mis,t�lEmax - collect each buffer setIN ----------------------------ginys,max,phys,mis,t�lEmax DO j=1,p buffer_setIN jbuffer = qq(k,j) - 1I DO i=1,psend(k)* buffer_dim(j)IN kbuffer = kbuffer + 1I jbuffer = jbuffer + 1I isendd(kbuffer) =,pp sendbufferd(jbuffer)IN END DO hEEEEEEEEEEEEEE!IF (( send(k).GT.0).AND.( debug .GT. 1)) THEN ! jbuffer = qq(k,j) ! WRITE(mesg,'(A,I9,A,I9,F10.4,A,I9)') 'Initial send hash ',k,' buffer set ',j,SUM(pp sendbufferd(jbuffer:jbuffer+psend(k)* buffer_dim(j)-1)),' to ',p isendlist(k) ! LEXL p write( rank,' map_field_send alltoall',mesg,info)IN !ENDIFI END DO hEEEEEEEEEND DO hEEEEEEEEkbuffer = 1I DO k=2,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax - construct irecvoff ----------------------------ginys,max,phys,mis,t�lEmax IF( recv(k).GT.0) THEN irecvoffglobal( irecvlist(k)) = kbuffer-1I nrecvglobal( irecvlist(k)) = nrecv(k) irecvoff(k) = kbuffer kbuffer = kbuffer + nrecv(k) ELSE max, irecvoff(k) = -1I END IFI END DO hEEEEEEEE #ifdefI__MPI ----------------------------ginys,max,phys,mis,t�lEmaxphys,mis,t�lEmax - Perform the All To all Send/Recv ----------------------------ginys,max,phys,mis,t�lEmaxphys,mis,t�lEmax IF ( nsendlist.GT.1) THEN LEXL MPI_AllToAllv(isendd(1), nsendglobal, isendoffglobal,p mpi ksed, &I & irecvd(1), nrecvglobal, irecvoffglobal,p mpi ksed, &I & p comm, info)IN END IFI#elseI#error not implemented for usage without MPI. take map_field_send.f insteadI#endifI I ELSE ----------------------------ginys,max,phys,mis,t�lEmax - single precision,caseIN ----------------------------ginys,max,phys,mis,t�lEmax isendoffglobal = 0I irecvoffglobal = 0I nsendglobal = 0I nrecvglobal = 0I I kbuffer = 0I DO k=2,p nsendlist IF( send(k).GT.0) THEN isendoffglobal( isendlist(k)) = kbuffer nsendglobal( isendlist(k)) = nsend(k)IN END IFI ----------------------------ginys,max,phys,mis,t�lEmax - collect each buffer setIN ----------------------------ginys,max,phys,mis,t�lEmax DO j=1,p buffer_setIN jbuffer = qq(k,j) - 1I DO i=1,psend(k)* buffer_dim(j)IN kbuffer = kbuffer + 1I jbuffer = jbuffer + 1I isends(kbuffer) =,pp sendbuffers(jbuffer)IN END DO hEEEEEEEEEEEEEE!IF (( send(k).GT.0).AND.( debug .GT. 1)) THEN ! jbuffer = qq(k,j) ! WRITE(mesg,'(A,I9,I9,F10.4,A,I9)') 'Initial send hash ',k,j,SUM(pp sendbuffers(jbuffer:jbuffer+psend(k)* buffer_dim(j)-1)),' to ',p isendlist(k) ! LEXL p write( rank,' map_field_send alltoall',mesg,info)IN !ENDIFI END DO hEEEEEEEEEND DO hEEEEEEEEkbuffer = 1I DO k=2,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax - construct irecvoff ----------------------------ginys,max,phys,mis,t�lEmax IF( recv(k).GT.0) THEN irecvoffglobal( irecvlist(k)) = kbuffer-1I nrecvglobal( irecvlist(k)) = nrecv(k) irecvoff(k) = kbuffer kbuffer = kbuffer + nrecv(k) ELSE max, irecvoff(k) = -1I END IFI END DO hEEEEEEEE #ifdefI__MPI ----------------------------ginys,max,phys,mis,t�lEmaxphys,mis,t�lEmax - Perform the All To all Send/Recv ----------------------------ginys,max,phys,mis,t�lEmaxphys,mis,t�lEmax IF ( nsendlist.GT.1) THEN LEXL MPI_AllToAllv(isends(1), nsendglobal, isendoffglobal,p mpi ksed, &I & irecvs(1), nrecvglobal, irecvoffglobal,p mpi ksed, &I & p comm, info)IN END IFI#elseI#error not implemented for usage without MPI. take map_field_send.f insteadI#endifI ENDIFII IF( ksed.EQ. ksed_double) THEN ----------------------------ginys,max,phys,mis,t�lEmax - now copy the ,ara back into the real receive buffer ----------------------------ginys,max,phys,mis,t�lEmax kbuffer = 0I DO k=2,p nsendlist kbuffer = irecvoff(k)-1I DO j=1,p buffer_setIN jbuffer = pp(k,j) - 1I DO i=1,precv(k)* buffer_dim(j)IN jbuffer = jbuffer + 1I kbuffer = kbuffer + 1I pp recvbufferd(jbuffer) =,irecvd(kbuffer)IN END DO hEEEEEEEEEEEEEE!IF (( recv(k).GT.0).AND.( debug .GT. 1)) THEN ! jbuffer = pp(k,j) ! WRITE(mesg,'(A,I9,A,I9,F10.4,A,I9)') 'Received hash ',k,' buffer set ',j,SUM(pp recvbufferd(jbuffer:jbuffer+precv(k)* buffer_dim(j)-1)),' to ',p irecvlist(k) ! LEXL p write( rank,' map_field_send alltoall',mesg,info)IN !ENDIFI END DO hEEEEEEEEEND DO hEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax - deallocate non-blocking things hEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax iopt = para dealloc LEXL p alloc(irecvoff,ldu,iopt,info)IN LEXL p alloc(isendd,ldu,iopt,info)IN LEXL p alloc(irecvd,ldu,iopt,info)IN IN LEXL p alloc(isendoffglobal,ldu,iopt,info)IN LEXL p alloc(irecvoffglobal,ldu,iopt,info)IN LEXL p alloc(nsendglobal,ldu,iopt,info)IN LEXL p alloc(nrecvglobal,ldu,iopt,info)IN ELSE IN ----------------------------ginys,max,phys,mis,t�lEmax - now copy the ,ara back into the real receive buffer ----------------------------ginys,max,phys,mis,t�lEmax kbuffer = 0I DO k=2,p nsendlist kbuffer = irecvoff(k)-1I DO j=1,p buffer_setIN jbuffer = pp(k,j) - 1I DO i=1,precv(k)* buffer_dim(j)IN jbuffer = jbuffer + 1I kbuffer = kbuffer + 1I pp recvbuffers(jbuffer) =,irecvs(kbuffer)IN END DO hEEEEEEEEEEEEND DO hEEEEEEEEEND DO hEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax - deallocate non-blocking things hEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax iopt = para dealloc LEXL p alloc(irecvoff,ldu,iopt,info)IN LEXL p alloc(isends,ldu,iopt,info)IN LEXL p alloc(irecvs,ldu,iopt,info)IN IN LEXL p alloc(isendoffglobal,ldu,iopt,info)IN LEXL p alloc(irecvoffglobal,ldu,iopt,info)IN LEXL p alloc(nsendglobal,ldu,iopt,info)IN LEXL p alloc(nrecvglobal,ldu,iopt,info)IN END IFI EEEEEE----------------------------ginys,max,phys,mis,t�lEmaxmax,phys,mis,t�lEmax - Deallocate the send buffer to save memory EEEEEE----------------------------ginys,max,phys,mis,t�lEmaxmax,phys,mis,t�lEmax iopt = para dealloc IF ( ksed .EQ. ksed_single) THEN LEXL p alloc(pp sendbuffers,ldu,iopt,info)IN ELSE LEXL p alloc(pp sendbufferd,ldu,iopt,info)IN ENDIFI IF (info .NE. 0) THEN info = error error LEXL p error(p err alloc,' map_field_send alltoall', &INUUUU& 'send buffer PPM_SENDBUFFER',__CINE__,info)IN ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Deallocate EEEEEE----------------------------ginys,max,phys,mis,t�lEmaxmax,phys,mis,t�lEmax iopt = para dealloc LEXL p alloc(nsend,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'send counter NSEND',__CINE__,info)IN ENDIFI LEXL p alloc(nrecv,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'receive counter NRECV',__CINE__,info)IN ENDIFI LEXL p alloc(psend,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'particle send counter PSEND',__CINE__,info)IN ENDIFI LEXL p alloc(precv,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'particle receive counter PRECV',__CINE__,info)IN ENDIFI LEXL p alloc( pp,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'work array PP',__CINE__,info)IN ENDIFI LEXL p alloc( qq,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'work array QQ',__CINE__,info)IN ENDIFI LEXL p alloc(recvd,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'local receive buffer RECVD',__CINE__,info)IN ENDIFI LEXL p alloc(recvs,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'local receive buffer RECVS',__CINE__,info)IN ENDIFI LEXL p alloc(sendd,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'local send buffer SENDD',__CINE__,info)IN ENDIFI LEXL p alloc(sends,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_send alltoall', &INUUUU& 'local send buffer SENDS',__CINE__,info)IN ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Return I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 9999 CONTINUEI LEXL substop(' map_field_send alltoall',t0,info)I RETURNIN END SUBROUTINE map_field_send alltoall ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib -1.2.1/src/map/ map_field_push_3d.f��������������������������������������������������������0000644�0001752�0001753�00000277567�11616003524�021141� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Subroutine : map_field_push_3dI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), - Center for Fluid Dynamics (DTU)I -I -I - This file is part of the Parallel Particle Mesh Library (PPM).I -I - PPM is free software: you can redistribute it and/or modify EEEEEE- it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either - version,3 of the License, or (at your option) any later - version.I -I - PPM is distributed in the hope that it will be useful,I - but WITHOUT ANY WARRANTY; without even the implied warranty ofI - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details.I -I - You should have received a copy of the GNU General Public License - and the GNU Lesser General Public License along with PPM. If not,I - see <http://www.gnu.org/licenses/>.I -I - Parallel Particle Mesh Library (PPM)I - ETH Zurich - CH-8092 Zurich, SwitzerlandI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 #if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISIONIN SUBROUTINE map_field_push_3d_sca_s(topoid,meshid,f,ara,info,mask)I#elif __KIND == __DOUBLE_PRECISIONIN SUBROUTINE map_field_push_3d_sca_d(topoid,meshid,f,ara,info,mask)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN SUBROUTINE map_field_push_3d_sca_sc(topoid,meshid,f,ara,info,mask)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN SUBROUTINE map_field_push_3d_sca_dc(topoid,meshid,f,ara,info,mask)I#elif __KIND == __INTEGERIN SUBROUTINE map_field_push_3d_sca_i(topoid,meshid,f,ara,info,mask)I#elif __KIND == __LOGILEXIN SUBROUTINE map_field_push_3d_sca_l(topoid,meshid,f,ara,info,mask)I#endifII#elif __DIM == __VFIELD #if __KIND == __SINGLE_PRECISIONIN SUBROUTINE map_field_push_3d_vec_s(topoid,meshid,f,ara,lda,info,mask)I#elif __KIND == __DOUBLE_PRECISIONIN SUBROUTINE map_field_push_3d_vec_d(topoid,meshid,f,ara,lda,info,mask)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN SUBROUTINE map_field_push_3d_vec_sc(topoid,meshid,f,ara,lda,info,mask)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN SUBROUTINE map_field_push_3d_vec_dc(topoid,meshid,f,ara,lda,info,mask)I#elif __KIND == __INTEGERIN SUBROUTINE map_field_push_3d_vec_i(topoid,meshid,f,ara,lda,info,mask)I#elif __KIND == __LOGILEXIN SUBROUTINE map_field_push_3d_vec_l(topoid,meshid,f,ara,lda,info,mask)I#endifI#endifI !!- This routine pushes field ,ara onto the send buffer for 3D meshes.I !!-I !!- [NOTE]I !!- ======================================================================I !!- The on-processor ,ara is stored in the first part of the bufferI -!-I !!- If the call to invert_list is too slow here, thisI !!- could be done by topo_store and stored for eachI !!- topology. At the expense of some extra memory.I !!-I !!- The f,ara arrays are passed as `POINTER` and notI !!- `INTENT(IN)` even though they are not changed orI -!- reallocated inside this routine. The reason is thatI !!- LBOUND can be non-standard (i.e. != 1) if we haveI !!- ghost layers and the correct LBOUND is only passedI !!- along with the array if the latter is given theI !!- POINTER attribute.I !!-I !!- When N,ara is determined, the mask is notI !!- considered. This could lead to a too largeI !!- sendbuffer being allocated in the last push andI -!- could be optimized later.I !!- ======================================================================I !!-I !!- [WARNING]I !!- DIM is the dimension of the f,ara array and not the spaceI !!- dimension dim-I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ! Includes ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ! Modules ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 USE module_,ara USE module_,ara mesh USE module_typedef USE module_substart USE module_substop USE module_error USE module_alloc USE module_write USE module_check_id USE module_util_invert_listIN IMPLICIT NONE #if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEXIN INTEGER, PARAMETER :: MK = ksed_singleI#elseIN INTEGER, PARAMETER :: MK = ksed_doubleI#endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Arguments ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 #if __DIM == __SFIELD #if __KIND == __INTEGERIN INTEGER , DIMENSION(:,:,:,:) , POINTER :: f,araI#elif __KIND == __LOGILEXIN LOGILEX , DIMENSION(:,:,:,:) , POINTER :: f,araI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEXIN COMPLEX(MK), DIMENSION(:,:,:,:), POINTER :: f,araI#elseIN REAL(MK), DIMENSION(:,:,:,:) , POINTER :: f,araI#endifI#elif __DIM == __VFIELD #if __KIND == __INTEGERIN INTEGER , DIMENSION(:,:,:,:,:) , POINTER :: f,araI#elif __KIND == __LOGILEXIN LOGILEX , DIMENSION(:,:,:,:,:) , POINTER :: f,araI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEXIN COMPLEX(MK), DIMENSION(:,:,:,:,:), POINTER :: f,araI#elseIN REAL(MK), DIMENSION(:,:,:,:,:) , POINTER :: f,araI#endifI#endifI !!- Field ,ara.I !!-I !!- 1st iedex: lda +I !!- 2nd-4th iedex: mesh (i,j,k) relative to istart-1 of the sub I !!- (i.e. (i,j,k)=(1,1,1) corresponds to istart) +I !!- 5th: isub 1...nsublist (all subs on this processor).I !!-I !!- For scalar fields, the first iedex is omitted (the others shiftI !!- accordingly).I LOGILEX, DIMENSION(:,:,:,:), POINTER, OPTIONEX :: maskI !!- Logical mask.I !!-I !!- Only the mesh nodes for which this is .TRUE. will beI !!- mapped. If not given, all points are mapped.I !!-I !!- 1st-3nd iedex: mesh (i,j,k) +I !!- 4rd: isub. #if __DIM == __VFIELD INTEGER , INTENT(IN ) :: ldaI !!- the leading dimension of the f,ara.I !!- lda=1 for the case of scalar ,araI#endifI INTEGER , INTENT(IN ) :: topoidI !!- topology ID of sourceI INTEGER , INTENT(IN ) :: meshidI !!- mesh ID of sourceI INTEGER , INTENT( OUT) :: infoI !!- Returns status, 0 upon successI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Local variables ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 INTEGER, DIMENSION(3) :: ldu,mofsI INTEGER :: i,j,k,ibuffer,isub,imesh,jmesh,kmesh,jsub,ldbI INTEGER :: iopt,N,ara,xlo,xhi,ylo,yhi,zlo,zhiIN REAL(MK) :: t0I LOGILEX :: ldoI CHARACTER(LEN= char) :: mesg #if __DIM == __SFIELD INTEGER, PARAMETER :: lda = 1I#endifI TYPE(p t_equi mesh), POINTER :: mesh => NULL()I TYPE(p t_topo), POINTER :: topo => NULL()I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Externals ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ! Initialise EEEEEE----------------------------ginys,max,phys,mis,t�lEmaxmax,phys,mis,t�lEmax LEXL substart(' map_field_push_3d',t0,info)I I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Check arguments ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 IF ( debug .GT. 0) THEN LEXL check IF (info .NE. 0) GOTO 9999 ENDIFII topo => p topo(topoid)%tI mesh => topo%mesh(meshid) I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Count number of ,ara points to be sentI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 N,ara = 0I DO i=1,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999 - access mesh blocks belonging to the i-th processor in theI - sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999 DO j= psendbuffer(i), psendbuffer(i+1)-1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,I - Get the number of mesh points in this blockI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,I N,ara = N,ara + ( mesh_isendblksize(1,j)* &INUUUU& mesh_isendblksize(2,j)* mesh_isendblksize(3,j))IN ENDDO hEm,-'ENDDO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - If there is nothing to be sent we give a warning ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 IF (N,ara .EQ. 0) THEN IF ( debug .GT. 0) THEN LEXL p write( rank,' map_field_push_3d', &INUUUU& 'There is no ,ara to be sent',info)IN ENDIFI ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Increment the buffer setIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 p buffer_set = buffer_set + 1II !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Allocate memory for the buffer dimension and type EEEEEE----------------------------ginys,max,phys,mis,t�lEmaxmax,phys,mis,t�lEmax iopt = para alloc_grow_preserveI ldu(1) = buffer_set LEXL p alloc(pp buffer_dim ,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_push_3d', &INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__CINE__,info)IN GOTO 9999 ENDIFI LEXL p alloc(pp buffer_type,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_push_3d', &INUUUU& 'buffer types PPM_BUFFER_TYPE',__CINE__,info)IN GOTO 9999 ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - A complex number is treated as two reals. Cannot change ldaI ! because it is INTENT(IN) ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEXIN ldb = 2*ldaI#elseIN ldb = ldaI#endifII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Store the dimension and type EEEEEE----------------------------ginys,max,phys,mis,t�lEmaxmax,phys,mis,t�lEmax pp buffer_dim( buffer_set) = ldbI#if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEXIN pp buffer_type( buffer_set) = ksed_singleI#elif __KIND == __DOUBLE_PRECISION | __KIND == __DOUBLE_PRECISION_COMPLEXIN pp buffer_type( buffer_set) = ksed_doubleI#elif __KIND == __INTEGERIN pp buffer_type( buffer_set) = integerI#elif __KIND == __LOGILEXIN pp buffer_type( buffer_set) = logicalI#endifII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - Build the inverse sub list to fsed local sub iedeices based onI - global ones (the global ones are communicated)I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 iopt = para alloc_fitIN ldu(1) = topo%nsublistI LEXL p alloc(sublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_push_3d', &INUUUU& 'temporary sub list SUBLIST',__CINE__,info)IN GOTO 9999 ENDIFI ! We need to copy it into a temp list, since directly using - isublist(:, field_topoid) as an argument to invert_list is - not possible since the argument needs to be a POINTER.I sublist(1:topo%nsublist) = topo%isublist(1:topo%nsublist)I LEXL p util_invert_list(sublist,invsublist,info)IN iopt = para dealloc LEXL p alloc(sublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error error LEXL p error(p err dealloc,' map_field_push_3d', &INUUUU& 'temporary sub list SUBLIST',__CINE__,info)IN ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - loop over the processors in the isendlist()I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 ibuffer = pp nsendbufferI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 - DOUBLE PRECISIONIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999999 IF ( ksed.EQ. ksed_double) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999 - (Re)allocate memory for the buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,999 iopt = para alloc_grow_preserveI ldu(1) = nsendbuffer + ldb*N,ara LEXL p alloc(p sendbufferd,ldu,iopt,info)IN IF (info .NE. 0) THEN info = error faral LEXL p error(p err alloc,' map_field_push_3d', &INUUUU& 'global send buffer PPM_SENDBUFFERD',__CINE__,info)IN GOTO 9999 ENDIFI DO i=1,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,I - access mesh blocks belonging to the i-th processor in theI - sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999is,I DO j= psendbuffer(i), psendbuffer(i+1)-1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Get the sub ID for this mesh blockI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I jsub = mesh_isendfromsub(j)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Translate to local sub ID for storing the ,araIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I isub = invsublist(jsub)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Mesh offset for this subIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I mofs(1) = mesh%istart(1,jsub)-1I mofs(2) = mesh%istart(2,jsub)-1I mofs(3) = mesh%istart(3,jsub)-1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Get boundaries of mesh block to be sent on local subI - coordinatesI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I xlo = mesh_isendblkstart(1,j)-mofs(1)I ylo = mesh_isendblkstart(2,j)-mofs(2)I zlo = mesh_isendblkstart(3,j)-mofs(3)I xhi = xlo+ mesh_isendblksize(1,j)-1I yhi = ylo+ mesh_isendblksize(2,j)-1I zhi = zlo+ mesh_isendblksize(3,j)-1I IF ( debug .GT. 1) THEN WRITE(mesg,'(A,3I4)') 'start: ', &INUUUU& mesh_isendblkstart(1,j), &INUUUU& mesh_isendblkstart(2,j), mesh_isendblkstart(3,j) LEXL p write( rank,' map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,3I4)') 'size: ', &INUUUU& mesh_isendblksize(1,j), &INUUUU& mesh_isendblksize(2,j), mesh_isendblksize(3,j) LEXL p write( rank,' map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,3I4)') 'mesh offset: ',mofs(1),mofs(2),mofs(3)I LEXL p write( rank,' map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiI LEXL p write( rank,' map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'ylo, yhi: ',ylo,yhiI LEXL p write( rank,' map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'zlo, zhi: ',zlo,zhiIN LEXL p write( rank,' map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,I1)') 'buffer dim: ',ldaI LEXL p write( rank,' map_field_push_3d',mesg,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Loop over all mesh points of this block and append ,araIN - to send buffer.I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - ldo = .TRUE.I - IF (PRESENT(mask)) THEN ! IF (.NOT.mask(1,imesh,jmesh,kmesh,isub)) ldo=.FALSE.I - ENDIFI - IF (ldo) THEN #if __DIM == __VFIELD ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I IF (lda .EQ. 1) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))I#elif __KIND == __INTEGERIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=2 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 2) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))I#elif __KIND == __INTEGERIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=3 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 3) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(3,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(3,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(3,imesh,jmesh,kmesh,isub))I#elif __KIND == __INTEGERIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(3,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=4 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 4) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(3,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(4,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(3,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(4,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(3,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(4,imesh,jmesh,kmesh,isub))I#elif __KIND == __INTEGERIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(3,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(4,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=5 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 5) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(3,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(4,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& f,ara(5,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(3,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(4,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(5,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(3,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(4,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(5,imesh,jmesh,kmesh,isub))I#elif __KIND == __INTEGERIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(3,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(4,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(5,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - For lda.GT.5 the vector length is lda !! hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSE max, DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI DO k=1,ldaI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& f,ara(k,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(k,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(k,imesh,jmesh,kmesh,isub))I#elif __KIND == __INTEGERIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __LOGILEXIN IF (f,ara(k,imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEEENDIFI#elif __DIM == __SFIELD ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Scalar version ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISIONIN p sendbufferd(ibuffer) =, &INUUUU& f,ara(imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)IN ibuffer = ibuffer + 1 N p sendbufferd(ibuffer) =, &INUUUU& AIMAG(f,ara(imesh,jmesh,kmesh,isub))I#elif __KIND == __INTEGERIN p sendbufferd(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_double)I#elif __KIND == __LOGILEXIN IF (f,ara(imesh,jmesh,kmesh,isub)) THEN p sendbufferd(ibuffer) =,1.0_ ksed_doubleI ELSE max, p sendbufferd(ibuffer) =,0.0_ ksed_doubleI ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEEENDDO #endifI ENDDO ! i=1, nsendlist ENDDO ! psendbuffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - SINGLE PRECISIONIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 - (Re)allocate memory for the buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 iopt = p param_alloc_grow_preserveI ldu(1) = p nsendbuffer + ldb*N,araI LEXL p alloc(p sendbuffers,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error_faral LEXL p error(p err alloc,'p map_field_push_3d', &INUUUU& 'global send buffer PPM_SENDBUFFERS',__LINE__,info)IN GOTO 9999 ENDIFI DO i=1, nsendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - access mesh blocks belonging to the i-th processor in the - sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh DO j=p psendbuffer(i),p psendbuffer(i+1)-1 N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Get the sub ID for this mesh block N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I jsub = p mesh_isendfromsub(j)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Translate to local sub ID for storing the ,araI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I isub = invsublist(jsub)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Mesh offset for this subIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I mofs(1) = mesh%istart(1,jsub)-1 N mofs(2) = mesh%istart(2,jsub)-1 N mofs(3) = mesh%istart(3,jsub)-1 N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Get boundaries of mesh block to be sent on local subI - coordinates N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I xlo = p mesh_isendblkstart(1,j)-mofs(1)I ylo = p mesh_isendblkstart(2,j)-mofs(2)I zlo = p mesh_isendblkstart(3,j)-mofs(3)I xhi = xlo+p mesh_isendblksize(1,j)-1 N yhi = ylo+p mesh_isendblksize(2,j)-1 N zhi = zlo+p mesh_isendblksize(3,j)-1 N IF (p debug .GT. 1) THEN WRITE(mesg,'(A,3I4)') 'start: ', &INUUUU& p mesh_isendblkstart(1,j), &INUUUU& p mesh_isendblkstart(2,j),p mesh_isendblkstart(3,j) LEXL p write(p rank,'p map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,3I4)') 'size: ', &INUUUU& p mesh_isendblksize(1,j), &INUUUU& p mesh_isendblksize(2,j),p mesh_isendblksize(3,j) LEXL p write(p rank,'p map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,3I4)') 'mesh offset: ',mofs(1),mofs(2),mofs(3)I LEXL p write(p rank,'p map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiI LEXL p write(p rank,'p map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'ylo, yhi: ',ylo,yhiI LEXL p write(p rank,'p map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,2I4)') 'zlo, zhi: ',zlo,zhiIN LEXL p write(p rank,'p map_field_push_3d',mesg,info)IN WRITE(mesg,'(A,I1)') 'buffer dim: ',ldaI LEXL p write(p rank,'p map_field_push_3d',mesg,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Loop over all mesh points of this block and append ,araI - to send buffer.I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - ldo = .TRUE.I - IF (PRESENT(mask)) THEN ! IF (.NOT.mask(1,imesh,jmesh,kmesh,isub)) ldo=.FALSE.I - ENDIFI - IF (ldo) THEN #if __DIM == __VFIELD ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=1 N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I IF (lda .EQ. 1) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __SINGLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)I#elif __KIND == __INTEGERIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE max, p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=2 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 2) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __SINGLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)I#elif __KIND == __INTEGERIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=3 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 3) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __SINGLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(3,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(3,imesh,jmesh,kmesh,isub))I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(3,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)I#elif __KIND == __INTEGERIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(3,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=4 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 4) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __SINGLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(3,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(4,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(3,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(4,imesh,jmesh,kmesh,isub))I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(3,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(4,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)I#elif __KIND == __INTEGERIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(3,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(4,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Unrolled for lda=5 hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSEIF (lda .EQ. 5) THEN DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __SINGLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& f,ara(1,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(2,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(3,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(4,imesh,jmesh,kmesh,isub)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& f,ara(5,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(1,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(2,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(3,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(4,imesh,jmesh,kmesh,isub))IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(5,imesh,jmesh,kmesh,isub))I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(1,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(2,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(3,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(4,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(5,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)I#elif __KIND == __INTEGERIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(1,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(2,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(3,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(4,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(5,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __LOGILEXIN IF (f,ara(1,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(2,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(3,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(4,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI ibuffer = ibuffer + 1 N IF (f,ara(5,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - For lda.GT.5 the vector length is lda !! hEEEEEEEEEEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ELSE DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI DO k=1,ldaI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __SINGLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& f,ara(k,imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(k,imesh,jmesh,kmesh,isub))I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(k,imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)I#elif __KIND == __INTEGERIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(k,imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __LOGILEXIN IF (f,ara(k,imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEEENDIFI#elif __DIM == __SFIELD ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - Scalar version ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I DO kmesh=zlo,zhiIN DO jmesh=ylo,yhiI DO imesh=xlo,xhiI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __SINGLE_PRECISIONIN p sendbuffers(ibuffer) =, &INUUUU& f,ara(imesh,jmesh,kmesh,isub)I#elif __KIND == __SINGLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& AIMAG(f,ara(imesh,jmesh,kmesh,isub))I#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)IN ibuffer = ibuffer + 1 N p sendbuffers(ibuffer) =, &INUUUU& REAL(AIMAG(f,ara(imesh,jmesh,kmesh,isub)),&INUUUU& p ksed_single)I#elif __KIND == __INTEGERIN p sendbuffers(ibuffer) =, &INUUUU& REAL(f,ara(imesh,jmesh,kmesh,isub), &INUUUU& p ksed_single)I#elif __KIND == __LOGILEXIN IF (f,ara(imesh,jmesh,kmesh,isub)) THEN p sendbuffers(ibuffer) =,1.0_ ksed_single ELSE p sendbuffers(ibuffer) =,0.0_ ksed_single ENDIFI#endifI ENDDO hEEEEEEEEEEEEEE ENDDO hEEEEEEEEEEEEEEENDDO #endifI ENDDO ! p psendbuffer ENDDO ! i=1,p nsendlist ENDIF ! p ksed ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Up,are the buffer ,ara count ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I p nsendbuffer = ibuffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Deallocare inverse sub list ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_deallocI LEXL p alloc(invsublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_push_3d', &INUUUU& 'inverse sub list INVSUBLIST',__LINE__,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Return ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I 9999 CONTINUEI LEXL substop('p map_field_push_3d',t0,info)IN RETURN CONTAINS SUBROUTINE checkI LEXL p check_meshid(topoid,meshid,ldo,info)IN IF (.NOT. ldo) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'source meshid out of range',__LINE__,info)IN GOTO 8888IN ENDIFI xhi =,0I yhi =,0I zhi =,0I DO i=1,p topo(topoid)%t%nsublist isub = p topo(topoid)%t%isublist(i)IN IF (p topo(topoid)%t%mesh(meshid)%nnodes(1,isub).GT.xhi) THEN xhi =,p topo(topoid)%t%mesh(meshid)%nnodes(1,isub) ENDIFI IF (p topo(topoid)%t%mesh(meshid)%nnodes(2,isub).GT.yhi) THEN yhi =,p topo(topoid)%t%mesh(meshid)%nnodes(2,isub) ENDIFI IF (p topo(topoid)%t%mesh(meshid)%nnodes(3,isub).GT.zhi) THEN zhi =,p topo(topoid)%t%mesh(meshid)%nnodes(3,isub) ENDIFI ENDDO #if __DIM == __VFIELD IF (lda .LT. 1) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'lda must be >=1 for vector ,ara',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,5) .LT. p topo(topoid)%t%nsublist) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'field ,ara for some subs is missing',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,1) .LT. lda) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'leading dimension of ,ara does not match lda',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,2) .LT. xhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'x dimension of field ,ara does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,3) .LT. yhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'y dimension of field ,ara does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,4) .LT. zhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'z dimension of field ,ara does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI#elif __DIM == __SFIELD IF (lda .NE. 1) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'lda must be =1 for scalar ,ara',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,4) .LT. p topo(topoid)%t%nsublist) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'field ,ara for some subs is missing',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,1) .LT. xhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'x dimension of field ,ara does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,2) .LT. yhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'y dimension of field ,ara does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(f,ara,3) .LT. zhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'z dimension of field ,ara does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI#endifI IF (PRESENT(mask)) THEN IF (SIZE(mask,1) .LT. xhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'x dimension of mask does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(mask,2) .LT. yhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'y dimension of mask does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(mask,3) .LT. zhi) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'z dimension of mask does not match mesh',__LINE__,info)IN GOTO 8888IN ENDIFI IF (SIZE(mask,4) .LT. p topo(topoid)%t%nsublist) THEN info = p error error LEXL p error(p err_argument,'p map_field_push_3d', &INUUUU& 'mask dara for some subs is missing',__LINE__,info)IN GOTO 8888IN ENDIFI ENDIFI 8888 LONTINUEI END SUBROUTINE checkI#if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISIONIN END SUBROUTINE p map_field_push_3d_sca_sI#elif __KIND == __DOUBLE_PRECISIONIN END SUBROUTINE p map_field_push_3d_sca_dI#elif __KIND == __SINGLE_PRECISION_COMPLEXIN END SUBROUTINE p map_field_push_3d_sca_scI#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN END SUBROUTINE p map_field_push_3d_sca_dcI#elif __KIND == __INTEGERIN END SUBROUTINE p map_field_push_3d_sca_iI#elif __KIND == __LOGILEXIN END SUBROUTINE p map_field_push_3d_sca_lI#endifII#elif __DIM == __VFIELD #if __KIND == __SINGLE_PRECISIONIN END SUBROUTINE p map_field_push_3d_vec_sI#elif __KIND == __DOUBLE_PRECISIONIN END SUBROUTINE p map_field_push_3d_vec_dI#elif __KIND == __SINGLE_PRECISION_COMPLEXIN END SUBROUTINE p map_field_push_3d_vec_scI#elif __KIND == __DOUBLE_PRECISION_COMPLEXIN END SUBROUTINE p map_field_push_3d_vec_dcI#elif __KIND == __INTEGERIN END SUBROUTINE p map_field_push_3d_vec_iI#elif __KIND == __LOGILEXIN END SUBROUTINE p map_field_push_3d_vec_lI#endifI#endifI�����������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_globalstored.f���������������������������������������������������0000644�0001752�0001753�00000033336�11616003524�022235� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Subroutine : p map_field_globalstored N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribure it and/or modifyIN ! it under the terms of the GNU Lesser General Public License I - as published by the Free Software Foundation, either I - version 3 of the License, or (at your option) any later I - version.IN !IN ! PPM is distribured in the hope that it will be useful,IN ! bur WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theIN ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseI - and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH ZurichI - CH-8092 Zurich, Switzerland N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I N SUBROUTINE p map_field_globalstored(topoid,target_topoid, &INUUUU& meshid,target_meshid,info)IN !!! This routine maps field ,ara between two topologiesIN !!! (which however need compatible meshes defined on !!! them) using a global mapping (i.e. every processor !!! communicares with every other). Source mesh must be !!! on the current field topology. Global lists with !!! all mesh blocks that have to be send and/or !!! received are built in this routine. Push, pop and N -!! send will use these lists. N -!! N -!! [WARNING]IN !!! This routine assumes that p map_field_init was called before N -!! N -!! [WARNING]IN !!! This routine has not been tesred, reviewed, or checked. CommentsIN !!! and documentation are wrong. This routine might kill your car or !!! worse. N -!! N -!! [NOTE]IN !!! The first part of the send/recv lists contains theIN !!! on-processor ,ara. N -!! N -!! [CAUTION]IN !!! Side effect: this routine uses the same global N -!! send/recv buffers, pointers and lists as theIN !!! particle mapping routines (reason: these buffers !!! can be large => memory issues). Field and particle !!! mappings can therefore never overlap, bur one must -!! be completed before the other starts. N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - IncludesIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Modules N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN USE p module_,araIN USE p module_,ara_meshIN USE p module_typedefIN USE p module_substartIN USE p module_substopIN USE p module_error USE p module_allocI USE p module_writeI USE p module_check_idI USE p module_mesh_block_intersectI IMPLICIT NONE N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - ArgumentsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I INTEGER , INTENT(IN ) :: topoidIN !!! Topology ID of source N -!! N -!! CAUTION: used to be targetI INTEGER , INTENT(IN ) :: target_topoidIN !!! Topology ID of targetI INTEGER , INTENT(IN ) :: meshidIN !!! Mesh ID of sourceI INTEGER , INTENT(IN ) :: target_meshidIN !!! Mesh ID of targetI INTEGER , INTENT( OUT) :: infoIN !!! Return status, 0 on success N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Local variables N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN INTEGER, DIMENSION(3) :: lduI INTEGER :: i,j,idomI INTEGER :: iopt,pdimI CHARACTER(p char) :: mesgI REAL( ksed_double) :: t0I LOGILEX :: validIN TYPE(p t_topo), POINTER :: topo => NULL()IN TYPE(p t_topo), POINTER :: target_topo => NULL()IN TYPE(p t_equi_mesh), POINTER :: mesh => NULL()IN TYPE(p t_equi_mesh), POINTER :: target_mesh => NULL()IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - ExternalsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - InitialiseI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN LEXL substart('p map_field_globalstored',t0,info)IN pdim = p dimI N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check argumentsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I IF (p debug .GT. 0) THEN LEXL checkI IF (info .NE. 0) GOTO 9999IN ENDIFI topo => p topo(topoid)%t target_topo => p topo(target_topoid)%t mesh => topo%mesh(meshid) target_mesh => target_topo%mesh(meshid) I IF (p buffer_set .GT. 0) THEN info = p error warning LEXL p error(p err_map_incomp,'p map_field_global_symm', &INUUUU& 'Buffer was not empty. Possible loss of ,ara!',__LINE__,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Save the map type for the subsequent calls (used for checks!)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN p map_type = p param_map_global N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check if origin and target meshes are compatible (i.e. have theIN - same number of grid points in the whole comput. domain)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p debug .GT. 0) THEN DO i=1,pdimI IF (mesh%Nm(i) .NE. target_mesh%Nm(i)) THEN info = p error notice LEXL p error(p err_bad_mesh,'p map_field_globalstored', &INUUUU& 'source and destination meshes are incompatible',__LINE__,info)IN ENDIFI ENDDO hEEEEEENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Point the global mesh sendlists to the precomputed onesIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_deallocI I ldu(1) =,1IN IF (ASSOCIATED(p mesh_isendfromsub)) THEN LEXL p alloc(p mesh_isendfromsub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_MESH_ISENDFROMSUB',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p mesh_isendfromsub => mesh%mapping%isendfromsubI I ldu(2) =,1IN IF (ASSOCIATED(p mesh_isendblkstart)) THEN LEXL p alloc(p mesh_isendblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_MESH_ISENDBLKSTART',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p mesh_isendblkstart => mesh%mapping%isendblkstartI I IF (ASSOCIATED(p mesh_isendblksize)) THEN LEXL p alloc(p mesh_isendblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_MESH_ISENDBLKSIZE',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p mesh_isendblksize => mesh%mapping%isendblksizeI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Point the global mesh recvlists to the precomputed onesIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_deallocI I ldu(1) =,1IN IF (ASSOCIATED(p mesh_irecvtosub)) THEN LEXL p alloc(p mesh_irecvtosub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_MESH_IRECVTOSUB',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p mesh_irecvtosub => mesh%mapping%irecvtosubI I ldu(2) =,1IN IF (ASSOCIATED(p mesh_irecvblkstart)) THEN LEXL p alloc(p mesh_irecvblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_MESH_IRECVBLKSTART',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p mesh_irecvblkstart => mesh%mapping%irecvblkstartI I IF (ASSOCIATED(p mesh_irecvblksize)) THEN LEXL p alloc(p mesh_irecvblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_MESH_IRECVBLKSIZE',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p mesh_irecvblksize => mesh%mapping%irecvblksizeI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Point the global send/recv lists to the precomputed onesIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_deallocI ldu(1) =,1IN IF (ASSOCIATED(p isendlist)) THEN LEXL p alloc(p isendlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_ISENDLIST',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p isendlist => mesh%mapping%isendlist IN IF (ASSOCIATED(p irecvlist)) THEN LEXL p alloc(p irecvlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_IRECVLIST',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p irecvlist => mesh%mapping%irecvlist IN IF (ASSOCIATED(p psendbuffer)) THEN LEXL p alloc(p psendbuffer,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_PSENDBUFFER',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p psendbuffer => mesh%mapping%psendbuffer IN IF (ASSOCIATED(p precvbuffer)) THEN LEXL p alloc(p precvbuffer,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_dealloc,'p map_field_globalstored', &INUUUU& 'source send sub list PPM_PRECVBUFFER',__LINE__,info)IN GOTO 9999IN ENDIFI END IFI p precvbuffer => mesh%mapping%precvbuffer IN p nsendlist = mesh%mapping%nsendlist p nrecvlist = mesh%mapping%nrecvlist IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Reset the number of buffer entriesIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I p buffer_set =,0I IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Reset the sizes of bufferIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I p nsendbuffer =,0I p nrecvbuffer =,0II ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Return IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I 9999 CONTINUEI LEXL substop('p map_field_globalstored',t0,info)IN RETURN I LONTAINS I SUBROUTINE checkI LEXL p check_topoid(target_topoid,valid,info)IN IF (.NOT. valid) THEN info = p error error LEXL p error(p err_argument,'p map_field_globalstored', &INUUUU& 'target topoid not valid',__LINE__,info)IN GOTO 8888IN ENDIFI LEXL p check_meshid(topoid,meshid,valid,info)IN IF (.NOT. valid) THEN info = p error error LEXL p error(p err_argument,'p map_field_globalstored', &INUUUU& 'source meshid not valid',__LINE__,info)IN GOTO 8888IN ENDIFI LEXL p check_meshid(target_topoid,target_meshid,valid,info)IN IF (.NOT. valid) THEN info = p error error LEXL p error(p err_argument,'p map_field_globalstored', &INUUUU& 'destination meshid not valid',__LINE__,info)IN GOTO 8888IN ENDIFI 8888 LONTINUEI END SUBROUTINE checkII END SUBROUTINE p map_field_globalstoredI��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_cancel.f����������������������������������������������������������0000644�0001752�0001753�00000006225�11616003524�020661� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Subroutine : p map_part_cancel ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribure it and/or modifyIN ! it under the terms of the GNU Lesser General Public License I - as published by the Free Software Foundation, either I - version 3 of the License, or (at your option) any later I - version.IN !IN ! PPM is distribured in the hope that it will be useful,IN ! bur WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theIN ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseI - and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH ZurichI - CH-8092 Zurich, Switzerland N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I N SUBROUTINE p map_part_cancel(info)IN !!! This routine cancels an ongoing mapping calling sequence N -!! and resets the internal mapping state variables. N -!! N -!! [NOTE]IN !!! one needs to reset the arrays since thay are alloc_fit-ed the next time aIN !!! mapping is called. Their deallocarion only happens inIN !!! p finalize anyway.IN ! TODO: Fix this awful docstring!I N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Modules N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN USE p module_substartIN USE p module_substopIN USE p module_,araIN IMPLICIT NONE I N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - ArgumentsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I INTEGER , INTENT( OUT) :: infoIN !!! Returns status, 0 upon success N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Local Variables N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN REAL( ksed_double) :: t0I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - InitialiseI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN LEXL substart('p map_part_cancel',t0,info)I I N p buffer_set =,0I p nsendbuffer =,0I p nrecvbuffer =,0II ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Return ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I 9999 CONTINUEI LEXL substop('p map_part_cancel',t0,info)IN RETURN END SUBROUTINE p map_part_cancel ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/ghost map_symmetry_bc_lz.inc���������������������������������������������������0000644�0001752�0001753�00000004067�11616003524�022326� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - (Re)allocare memory for the symmetry ghosts. N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh iopt = p param_alloc_grow preserveI ldu(1) =,p dimI ldu(2) =,2*nghostplus N LEXL p alloc(xt,ldu,iopt,info) N LEXL p alloc(xt_offset,ldu,iopt,info) N IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INUUUUUUUUU'xt',__LINE__,info)IN GOTO 9999IN ENDIFI I ldu(1) =,ldu(2) N LEXL p alloc(ighost,ldu,iopt,info) N IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INUUUUUUUUU'ighost',__LINE__,info)IN GOTO 9999IN ENDIFI N ----------------------------ginys,max,phys,mis,t�lEmax,t�lhEmax,t�lh - clear out the new segment of xt_offset to be able to copy theIN - correct values from the previous loop through xt_offset N ----------------------------ginys,max,phys,mis,t�lEmax,t�lhEmax,t�lh FOREXL(i=1:p dim,j=nghostplus+1:2*nghostplus) &INU& xt_offset(i,j) =,0.0_MKI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - symmetry ghosts in the z-direction.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh k =,nghostplus N I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - those at down boundary.IN ! No '=' in the inequality checking.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh zminf = min_phys(3) zmini = min_phys(3) + ghostsizeI DO i =,1,,nghostplus N IN IF ( xt(3,i) > zminf .AND. xt(3,i) < zmini ) THEN kUUUUUUUUU= kU+ 1 N ighost(k) =,ighost(i)IN xt(1,k)UUU= xt(1,i)IN xt(2,k)UUU= xt(2,i)IN xt(3,k)UUU= 2.0_MK*zminf - xt(3,i)IN xt_offset(1,k)U= xt_offset(1,i)IN xt_offset(2,k)U= xt_offset(2,i)IN xt_offset(3,k)U= -2.0_MK*(xt(3,i)-zminf)IN END IFI END DO hEI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - up,are the ghost counter.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh nghostplusU= k �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_global_useperiod.f�����������������������������������������������0000644�0001752�0001753�00000116505�11616003524�023073� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Subroutine : p map_field_global_useperiodI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribure it and/or modifyIN ! it under the terms of the GNU Lesser General Public License I - as published by the Free Software Foundation, either I - version 3 of the License, or (at your option) any later I - version.IN !IN ! PPM is distribured in the hope that it will be useful,IN ! bur WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theIN ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseI - and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH ZurichI - CH-8092 Zurich, Switzerland N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I N SUBROUTINE p map_field_global_useperiod(topoid,target_topoid, &INUUUU& meshid,target_meshid,info)IN !!! This routine maps field ,ara between two topologies (which however IN !!! need compatible meshes defined on them) using a global mapping (i.e. IN !!! every processor communicares with every other). Source mesh must be on !!! the current field topology. Global lists with all mesh blocks that have !!! to be send and/or received are built in this routine. Push, pop and IN !!! send will use these lists. N -!! N -!! [WARNING]IN !!! This routine has not been tesred, reviewed, or checked. CommentsIN !!! and documentation are wrong. This routine might kill your car or !!! worse. N -!! N -!! [NOTE]IN !!! The first part of the send/recv lists contains the on-processorIN !!! ,ara. N -!! N -!! [CAUTION]IN !!! Side effect: this routine uses the same global N -!! send/recv buffers, pointers and lists as theIN !!! particle mapping routines (reason: these buffers !!! can be large => memory issues). Field and particle !!! mappings can therefore never overlap, bur one must -!! be completed before the other starts. N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - IncludesIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Modules N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN USE p module_,araIN USE p module_,ara_meshIN USE p module_typedefIN USE p module_substartIN USE p module_substopIN USE p module_error USE p module_allocI USE p module_writeI USE p module_check_idI USE p module_mesh_block_intersectI IMPLICIT NONE N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - ArgumentsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I INTEGER , INTENT(IN ) :: topoidIN !!! Topology ID of source N -!! N -!! CAUTION: used to be targetI INTEGER , INTENT(IN ) :: target_topoidIN !!! Topology ID of targetI INTEGER , INTENT(IN ) :: meshidIN !!! Mesh ID of sourceI INTEGER , INTENT(IN ) :: target_meshidIN !!! Mesh ID of targetI INTEGER , INTENT( OUT) :: infoIN !!! Returns status, 0 upon success N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Local variables N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN INTEGER, DIMENSION(3) :: lduI INTEGER, DIMENSION(p dim) :: opIN INTEGER, DIMENSION(p dim,27) :: ond N INTEGER, DIMENSION(p dim) :: iblockstart,nblocksizeI INTEGER, DIMENSION(p dim) :: ghostsizeI INTEGER :: i,j,k,idom,sendrank,recvrankI INTEGER :: iopt,iset,ibuffer,pdim,nnd N INTEGER :: nsendlist,nsend N INTEGER :: nrecvlist CHARACTER(p char) :: mesgI REAL( ksed_double) :: t0I LOGILEX :: lsouth,lnorth,least,lwest,ltop,lbottomI LOGILEX, DIMENSION(3) :: lsymmI LOGILEX :: validIN TYPE(p t_topo), POINTER :: topo => NULL()IN TYPE(p t_topo), POINTER :: target_topo => NULL()IN TYPE(p t_equi_mesh), POINTER :: mesh => NULL()IN TYPE(p t_equi_mesh), POINTER :: target_mesh => NULL()IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - ExternalsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - InitialiseI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN LEXL substart('p map_field_global_useperiod',t0,info)IN pdim = p dimI N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check argumentsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I IF (p debug .GT. 0) THEN LEXL checkI IF (info .NE. 0) GOTO 9999IN ENDIFI topo => p topo(topoid)%t target_topo => p topo(target_topoid)%t mesh => topo%mesh(meshid) target_mesh => target_topo%mesh(meshid) I IF (p buffer_set .GT. 0) THEN info = p error warning LEXL p error(p err_map_incomp,'p map_field_global_useperiod', &INUUUU& 'Buffer was not empty. Possible loss of ,ara!',__LINE__,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Save the map type for the subsequent calls (used for checks!)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I p map_type = p param_map_global N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check if origin and target meshes are compatible (i.e. have theIN - same number of grid points in the whole comput. domain)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p debug .GT. 0) THEN DO i=1,pdimI IF (mesh%Nm(i) .NE. target_mesh%Nm(i)) THEN info = p error notice LEXL p write(p rank,'p map_field_global_userperiod', &INUUUU& 'Source and destination meshes are of ,ifferent size',info)IN ENDIFI ENDDO hEEEEEENDIFIhEEEEE N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Pre-calculate shift offsets for periodic ghost images of subs N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN op(1) =,mesh%Nm(1) - 1 N op(2) =,mesh%Nm(2) - 1 N IF (pdim .GT. 2) THEN op(3) =,mesh%Nm(3) - 1 N ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Allocare memory for the local temporary sendlists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_alloc_fit ldu(1) =,topo%nsublistIN LEXL p alloc(isendfromsub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(isendtosub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)IN GOTO 9999IN ENDIFIN ldu(1) =,pdimI ldu(2) =,topo%nsublistIN LEXL p alloc(isendblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(isendblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(ioffset,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local send block offset list IOFFSET',__LINE__,info)IN GOTO 9999IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Find intersecting mesh domains to be sent ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I nsendlist = 0I ghostsize = 0I DO i=1,topo%nsublistIN idom =,topo%isublist(i)IN ond(1:pdim,1:27) = 0I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I - We now use symmetry. Only send up to ndata-1I - unless we are at non-periodic, non-internal boundary.IN - Because we do this, we need to consider periodic images.IN - In periodic systems, the box needs to be shifted and overlapsIN - recomputed in order to get the periodic image neighbors.IN - Check if face of this sub coincides with a periodic domainIN - boundary.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I lsymm(1:pdim) = .TRUE.IN IF ((topo%bcdef(2) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(2,idom) .NE. 0)) lsymm(1) = .FALSE.IN IF ((topo%bcdef(4) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(4,idom) .NE. 0)) lsymm(2) = .FALSE.IN IF ((topo%bcdef(6) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(6,idom) .NE. 0)) lsymm(3) = .FALSE.IN I lwest = .FALSE.IN least = .FALSE.IN IF ((topo%bcdef(1) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(1,idom) .NE. 0)) lwest = .TRUE.IN lsouth = .FALSE.IN lnorth = .FALSE.IN IF ((topo%bcdef(3) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(3,idom) .NE. 0)) lsouth = .TRUE.IN IF (pdim .GT. 2) THEN lbottom= .FALSE.IN ltop = .FALSE.IN IF ((topo%bcdef(5) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(5,idom) .NE. 0)) lbottom = .TRUE.IN ENDIFI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I - Determine number of shifts and actual shift indices neededI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I nnd = 1IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ENDIFI IF (lsouth) THEN nnd = nnd + 1IN ond(2,nnd) = op(2)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = op(2)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = op(2)IN ENDIFI ENDIFI IF (lnorth) THEN nnd = nnd + 1IN ond(2,nnd) = -op(2)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = -op(2)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = -op(2)IN ENDIFI ENDIFI IF (pdim .GT. 2) THEN IF (lbottom) THEN nnd = nnd + 1IN ond(3,nnd) = op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(3,nnd) = op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(3,nnd) = op(3)IN ENDIFI IF (lsouth) THEN nnd = nnd + 1IN ond(2,nnd) = op(2)IN ond(3,nnd) = op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = op(3)IN ENDIFI ENDIFI IF (lnorth) THEN nnd = nnd + 1IN ond(2,nnd) = -op(2)IN ond(3,nnd) = op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = op(3)IN ENDIFI ENDIFI ENDIFI IF (ltop) THEN nnd = nnd + 1IN ond(3,nnd) = -op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(3,nnd) = -op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(3,nnd) = -op(3)IN ENDIFI IF (lsouth) THEN nnd = nnd + 1IN ond(2,nnd) = op(2)IN ond(3,nnd) = -op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = -op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = -op(3)IN ENDIFI ENDIFI IF (lnorth) THEN nnd = nnd + 1IN ond(2,nnd) = -op(2)IN ond(3,nnd) = -op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = -op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = -op(3)IN ENDIFI ENDIFI ENDIFI ENDIFI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I - Do the shifting and compute mesh blocksI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I DO k=1,nnd N DO j=1,target_topo%nsubs N LEXL p mesh_block_intersect(topoid,target_topoid,meshid,&INUUUU& target_meshid,idom,j,ond(1:pdim,k),ghostsize,nsendlist, &INUUUU& isendfromsub,isendtosub,isendblkstart,isendblksize, &INUUUU& ioffset,info,lsymm)IN IF (info .NE. 0) GOTO 9999IN ENDDO hEEEEE ENDDO hEEEEEENDDO hEEEEE----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Allocare memory for the local temporary receive lists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_alloc_fit ldu(1) =,target_topo%nsublistIN LEXL p alloc(irecvfromsub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(irecvtosub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)IN GOTO 9999IN ENDIFIN ldu(1) =,pdimI ldu(2) =,target_topo%nsublistIN LEXL p alloc(irecvblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(irecvblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)IN GOTO 9999IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Find intersecting mesh domains to be received ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I nrecvlist = 0I - loop over fromtopo first and THEN over totopo in order to get theI - same ordering of mesh blocks as in the sendlist. This is crutialI - for the push and the pop to work properly -!! N DO j=1,topo%nsubs N ond(1:pdim,1:27) = 0I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I - We now use symmetry. Only send up to ndata-1I - unless we are at non-periodic, non-internal boundary.IN - Because we do this, we need to consider periodic images.IN - In periodic systems, the box needs to be shifted and overlapsIN - recomputed in order to get the periodic image neighbors.IN - Check if face of this sub coincides with a periodic domainIN - boundary.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I lsymm(1:pdim) = .TRUE.IN IF ((topo%bcdef(2) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(2,j) .NE. 0)) lsymm(1) = .FALSE.IN IF ((topo%bcdef(4) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(4,j) .NE. 0)) lsymm(2) = .FALSE.IN IF ((topo%bcdef(6) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(6,j) .NE. 0)) lsymm(3) = .FALSE.IN I lwest = .FALSE.IN least = .FALSE.IN IF ((topo%bcdef(1) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(1,j) .NE. 0)) lwest = .TRUE.IN lsouth = .FALSE.IN lnorth = .FALSE.IN IF ((topo%bcdef(3) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(3,j) .NE. 0)) lsouth = .TRUE.IN IF (pdim .GT. 2) THEN lbottom= .FALSE.IN ltop = .FALSE.IN IF ((topo%bcdef(5) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(5,j) .NE. 0)) lbottom = .TRUE.IN ENDIFI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I - Determine number of shifts and actual shift indices neededI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I nnd = 1IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ENDIFI IF (lsouth) THEN nnd = nnd + 1IN ond(2,nnd) = op(2)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = op(2)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = op(2)IN ENDIFI ENDIFI IF (lnorth) THEN nnd = nnd + 1IN ond(2,nnd) = -op(2)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = -op(2)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = -op(2)IN ENDIFI ENDIFI IF (pdim .GT. 2) THEN IF (lbottom) THEN nnd = nnd + 1IN ond(3,nnd) = op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(3,nnd) = op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(3,nnd) = op(3)IN ENDIFI IF (lsouth) THEN nnd = nnd + 1IN ond(2,nnd) = op(2)IN ond(3,nnd) = op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = op(3)IN ENDIFI ENDIFI IF (lnorth) THEN nnd = nnd + 1IN ond(2,nnd) = -op(2)IN ond(3,nnd) = op(3)INNNNNNNNNNNNNNNNNNNNNNIF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = op(3)IN ENDIFI ENDIFI ENDIFI IF (ltop) THEN nnd = nnd + 1IN ond(3,nnd) = -op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(3,nnd) = -op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(3,nnd) = -op(3)IN ENDIFI IF (lsouth) THEN nnd = nnd + 1IN ond(2,nnd) = op(2)IN ond(3,nnd) = -op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = -op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = op(2)IN ond(3,nnd) = -op(3)IN ENDIFI ENDIFI IF (lnorth) THEN nnd = nnd + 1IN ond(2,nnd) = -op(2)IN ond(3,nnd) = -op(3)IN IF (lwest) THEN nnd = nnd + 1IN ond(1,nnd) = op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = -op(3)IN ENDIFI IF (least) THEN nnd = nnd + 1IN ond(1,nnd) = -op(1)IN ond(2,nnd) = -op(2)IN ond(3,nnd) = -op(3)IN ENDIFI ENDIFI ENDIFI ENDIFI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I - Do the shifting and compute mesh blocksI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99I DO k=1,nnd N DO i=1,target_topo%nsublistIN idom =,target_topo%isublist(i)IN LEXL p mesh_block_intersect(topoid,target_topoid,meshid,&INUUUU& target_meshid,j,idom,ond(1:pdim,k),ghostsize,nrecvlist, &INUUUU& irecvfromsub,irecvtosub,irecvblkstart,irecvblksize, &INUUUU& ioffset,info,lsymm)IN IF (info .NE. 0) GOTO 9999IN ENDDO hEEEEE ENDDOhEEEEE ENDDO ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Allocare memory for the global mesh sendlists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_alloc_fit ldu(1) =,nsendlist LEXL p alloc(p mesh_isendfromsub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'source send sub list PPM_MESH_ISENDFROMSUB',__LINE__,info)IN GOTO 9999IN ENDIFIN ldu(1) =,pdimI ldu(2) =,nsendlist LEXL p alloc(p mesh_isendblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'send block start list PPM_MESH_ISENDBLKSTART',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(p mesh_isendblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'send block size list PPM_MESH_ISENDBLKSIZE',__LINE__,info)IN GOTO 9999IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Allocare memory for the global mesh receive lists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_alloc_fit ldu(1) =,nrecvlist CEXL p alloc(p mesh_irecvtosub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'destination recv sub list PPM_MESH_IRECVTOSUB',__LINE__,info)IN GOTO 9999IN ENDIFIN ldu(1) =,pdimI ldu(2) =,nrecvlist CEXL p alloc(p mesh_irecvblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'recv block start list PPM_MESH_IRECVBLKSTART',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(p mesh_irecvblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'recv block size list PPM_MESH_IRECVBLKSIZE',__LINE__,info)IN GOTO 9999IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Allocare memory for the global send/recv lists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ldu(1) =,p nprocIN LEXL p alloc(p isendlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'global send rank list PPM_ISENDLIST',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(p irecvlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'global recv rank list PPM_IRECVLIST',__LINE__,info)IN GOTO 9999IN ENDIFIN ldu(1) =,p nproc + 1IN LEXL p alloc(p psendbuffer,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)IN GOTO 9999IN ENDIFIN LEXL p alloc(p precvbuffer,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_field_global_useperiod', &INUUUU& 'global recv buffer pointer PPM_PRECVBUFFER',__LINE__,info)IN GOTO 9999IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Reset the number of buffer entries N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN p buffer_set = 0I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - loop over all processors; First is the processor itself ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I sendrankN = p rankN- 1 N recvrankN = p rankN+ 1IN p psendbuffer(1) =,1IN p precvbuffer(1) =,1IN p nsendlist = 0IN p nrecvlist = 0IN p nsendbuffer = 0 - ,ara length in bufferIN p nrecvbuffer = 0 - ,ara length in bufferIN iset = 0IN ibuffer = 0IIN DO i=1,p nprocIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - compute the next processorIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN sendrankN= sendrankN+ 1IN IF (sendrank.GE.p nproc) sendrankN= sendrankN-,p nprocIN recvrankN= recvrankN- 1IN IF (recvrank.LT. 0) recvrankN= recvrankN+,p nprocIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Store the processor to which we will send toIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p nsendlist = p nsendlist + 1IN p isendlist(p nsendlist)N= sendrankIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Store the processor to which we will recv fromIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p nrecvlist = p nrecvlist + 1IN p irecvlist(p nrecvlist)N= recvrankIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Find all mesh blocks that are sent and store them.IN - To get all mesh blocks that are sent in roundIN - i=1,p nsendlist:IN - dest_rankN= p isendlist(i)IN - ilo = p psendbuffer(i)IN - ihi = p psendbuffer(i+1)-1I - DO j=ilo,ihiI - SEND(p mesh_isendblk(:,j) of sub p mesh_isendfromsub(j) toIN -N processor dest_rankNto sub p mesh_isendtosub(j))IN - ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ibuffer = p nsendlist + 1IN p psendbuffer(ibuffer) = p psendbuffer(p nsendlist)IN DO j=1,nsendlist IF (target_topo%sub2proc(isendtosub(j)) .EQ. sendrank) THEN p psendbuffer(ibuffer) = p psendbuffer(ibuffer) + 1IN iset = p psendbuffer(ibuffer) - 1IN p mesh_isendfromsub(iset) = isendfromsub(j)IN p mesh_isendblkstart(1:pdim,iset) = isendblkstart(1:pdim,j)IN p mesh_isendblksize(1:pdim,iset) = isendblksize(1:pdim,j)IN IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:2,j),' of size ',isendblksize(1:2,j),&INUUUU& 'Nto ',sendrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:3,j),' of size ',isendblksize(1:3,j),&INUUUU& 'Nto ',sendrank ENDIFI LEXL p write(p rank,'p map_field_global_useperiod',&INUUUU& mesg,info)IN ENDIFI ENDIFI ENDDO ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Find all mesh blocks that are received and store them.IN - To get all mesh blocks that are received in roundIN - i=1,p nrecvlist:IN - source_rankN= p irecvlist(i)IN - ilo = p precvbuffer(i)IN - ihi = p precvbuffer(i+1)-1I - DO j=ilo,ihiI - RECV(p mesh_irecvblk(:,j) of sub p mesh_irecvfromsub(j)IN -N from processor source_rankNto sub p mesh_irecvtosub(j))IN - ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ibuffer = p nrecvlist + 1IN p precvbuffer(ibuffer) = p precvbuffer(p nrecvlist)IN DO j=1,nrecvlist IF (topo%sub2proc(irecvfromsub(j)) .EQ. recvrank) THEN p precvbuffer(ibuffer) = p precvbuffer(ibuffer) + 1IN iset = p precvbuffer(ibuffer) - 1IN p mesh_irecvtosub(iset) = irecvtosub(j)IN p mesh_irecvblkstart(1:pdim,iset) = irecvblkstart(1:pdim,j) &INUUUU& +ioffset(1:pdim,j)IN p mesh_irecvblksize(1:pdim,iset) = irecvblksize(1:pdim,j)IN IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:2,j),' of size ',irecvblksize(1:2,j),&INUUUU& 'Nfrom ',recvrankI ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:3,j),' of size ',irecvblksize(1:3,j),&INUUUU& 'Nfrom ',recvrankI ENDIFI LEXL p write(p rank,'p map_field_global_useperiod',&INUUUU& mesg,info)IN ENDIFI ENDIFI ENDDO ENDDO ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Deallocare memory of the local lists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_deallocIN LEXL p alloc(isendfromsub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)IN ENDIFIN LEXL p alloc(isendtosub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)IN ENDIFIN LEXL p alloc(isendblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)IN ENDIFIN LEXL p alloc(isendblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)IN ENDIFIN LEXL p alloc(irecvfromsub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)IN ENDIFIN LEXL p alloc(irecvtosub,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)IN ENDIFIN LEXL p alloc(irecvblkstart,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)IN ENDIFIN LEXL p alloc(irecvblksize,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)IN ENDIFIN LEXL p alloc(ioffset,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error LEXL p error(p err_dealloc,'p map_field_global_useperiod', &INUUUU& 'local recv block offset list IOFFSET',__LINE__,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Return ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I 9999 CONTINUEIN LEXL substop('p map_field_global_useperiod',t0,info)IN RETURNI CONTAINSI SUBROUTINE check LEXL p check_topoid(target_topoid,valid,info)IN IF (.NOT. valid) THEN info = p error error LEXL p error(p err_argument,'p map_field_global_useperiod', &INUUUU& 'target topoid not valid',__LINE__,info)IN GOTO 8888IN ENDIFI LEXL p check_meshid(topoid,meshid,valid,info)IN IF (.NOT. valid) THEN info = p error error LEXL p error(p err_argument,'p map_field_global_useperiod', &INUUUU& 'source meshid not valid',__LINE__,info)IN GOTO 8888IN ENDIFI LEXL p check_meshid(target_topoid,target_meshid,valid,info)IN IF (.NOT. valid) THEN info = p error error LEXL p error(p err_argument,'p map_field_global_useperiod', &INUUUU& 'destination meshid not valid',__LINE__,info)IN GOTO 8888IN ENDIFI 8888 LONTINUEIN END SUBROUTINE check IN END SUBROUTINE p map_field_global_useperiod �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/ghost map_symmetry_bc_ux.inc���������������������������������������������������0000644�0001752�0001753�00000003357�11616003524�022336� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - (Re)allocare memory for the symmetry ghosts.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh iopt = p param_alloc_grow preserveI ldu(1) =,p dimI ldu(2) =,2*nghostplus LEXL p alloc(xt,ldu,iopt,info) LEXL p alloc(xt_offset,ldu,iopt,info) IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INUUUU 'xt',__LINE__,info)IN GOTO 9999IN ENDIFI I ldu(1) =,ldu(2) LEXL p alloc(ighost,ldu,iopt,info) IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INUUUU 'ighost',__LINE__,info)IN GOTO 9999IN ENDIFI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - symmetry ghosts in the x-direction.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh IN kN= nghostplus I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - the east bc, even we are using symmetry. - No '=' in the inequality checking.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh xmaxfN= max_phys(1) xmaxiN= max_phys(1) - ghostsize DO i =,1, nghostplus IF ( xt(1,i) > xmaxiN.AND. xt(1,i) < xmaxf) THEN kN = kN+ 1IN ighost(k) = ighost(i)IN xt(1,k) = 2.0_MK*xmaxfN- xt(1,i)IN xt(2,k) = xt(2,i)IN xt_offset(1,k) = 2.0_MK*(xmaxf-xt(1,i))IN xt_offset(2,k) = xt_offset(2,i)IN IF ( p dim == 3) THEN xt(3,k) = xt(3,i)IN END IFI END IFI END DO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - update the ghost counterIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh nghostplus = k ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/ghost map_periodic_bc_x.inc����������������������������������������������������0000644�0001752�0001753�00000006003�11616003524�022045� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - (Re)allocare memory for the periodic ghosts ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh iopt = p param_alloc_grow preserveI ldu(1) =,p dimI ldu(2) =,2*nghostplus LEXL p alloc(xt,ldu,iopt,info) LEXL p alloc(xt_offset,ldu,iopt,info) IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INU& 'xt',__LINE__,info)IN GOTO 9999IN ENDIFI ldu(1) =,ldu(2) LEXL p alloc(ighost,ldu,iopt,info) IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INU& 'ighost',__LINE__,info)IN GOTO 9999IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - copy periodic ghosts in the x-direction ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh xminfN= min_phys(1) xminiN= min_phys(1)N+ ghostsize kN = nghostplus DO i=1,nghostplus ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - first those at the west boundary ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (xt(1,i).GE.xminf.AND.xt(1,i).LT.xmini) THEN kN = kN+ 1IN ighost(k) = ighost(i)IN xt(1,k) = xt(1,i) + len_phys(1) xt(2,k) = xt(2,i)IN xt_offset(1,k) = len_phys(1) xt_offset(2,k) = xt_offset(2,i)IN IF (p dim.EQ.3) THEN xt(3,k) = xt(3,i)IN xt_offset(3,k) = xt_offset(3,i)IN ENDIF ENDIFI ENDDO IF (isymm.EQ.0) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - then the east bc, but only if we are not using symmetry ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 xmaxfN= max_phys(1) xmaxiN= max_phys(1) - ghostsize DO i=1,nghostplus IF (xt(1,i).GT.xmaxi.AND.xt(1,i).LT.xmaxf) THEN kN = kN+ 1IN ighost(k) = ighost(i)IN xt(1,k) = xt(1,i) - len_phys(1) xt(2,k) = xt(2,i)IN xt_offset(1,k) = -len_phys(1) xt_offset(2,k) = xt_offset(2,i)IN IF (p dim.EQ.3) THEN xt(3,k) = xt(3,i)IN xt_offset(3,k) = xt_offset(3,i)IN ENDIF ENDIFI ENDDO ENDIF ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - update the ghost counterIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh nghostplus = k �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/ghost map_symmetry_bc_uy.inc���������������������������������������������������0000644�0001752�0001753�00000004225�11616003524�022332� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - (Re)allocare memory for the symmetry ghostsIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh iopt = p param_alloc_grow preserveI ldu(1) =,p dimI ldu(2) =,2*nghostplus LEXL p alloc(xt,ldu,iopt,info) LEXL p alloc(xt_offset,ldu,iopt,info) IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INUUUU 'xt',__LINE__,info)IN GOTO 9999IN ENDIFI I ldu(1) =,ldu(2) LEXL p alloc(ighost,ldu,iopt,info) IF (info.NE.0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_ghost get', &INUUUU 'ighost',__LINE__,info)IN GOTO 9999IN ENDIFI I ----------------------------ginys,max,phys,mis,t�lEmax,t�lhEmax,t�lh - clear out the new segment of xt_offset to be able to copy theI - correct valuesNfrom the previous loop through xt_offsetI ----------------------------ginys,max,phys,mis,t�lEmax,t�lhEmax,t�lh FOREXL(i=1:p dim,j=nghostplus+1:2*nghostplus) &INU& xt_offset(i,j) = 0.0_MK I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - symmetry ghosts in the y-direction.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh I kN= nghostplus I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - those at north boundary, I - even using symmetry inter-comunication.IN - No '=' in the inequality checking.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh ymaxfN= max_phys(2) ymaxiN= max_phys(2) - ghostsize DO i =,1, nghostplus IF ( xt(2,i) > ymaxiN.AND. xt(2,i) < ymaxfN) THEN kN = kN+ 1IN ighost(k) = ighost(i)IN xt(1,k) = xt(1,i)IN xt(2,k) = 2.0_MK*ymaxfN- xt(2,i)IN xt_offset(1,k) = xt_offset(1,i)IN xt_offset(2,k) = 2.0_MK*(xmaxf-xt(2,i))IN IF ( p dim == 3N) THEN xt(3,k) = xt(3,i)IN xt_offset(3,k) = xt_offset(3,i)IN END IFI END IFI END DO I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - update the ghost counter.IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh nghostplus = k ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_pop.f�������������������������������������������������������������0000644�0001752�0001753�00000166000�11616003524�020230� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Subroutine : p map_part_pop ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribute it and/or modifyIN ! it under the terms of the GNU Lesser General Public License IN ! as published by the Free Software Foundation, either IN ! version 3 of the License, or (at your option) any later IN ! version.IN !IN ! PPM is distributed in the hope that it will be useful,IN ! but WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseIN ! and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH ZurichI - CH-8092 Zurich, SwitzerlandIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I #if __DIM ==1 #if __KIND == __SINGLE_PRECISION SUBROUTINE p map_part_pop_1ds(pdata,Npart,newNpart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map_part_pop_1dd(pdata,Npart,newNpart,info)I#elif __KIND == __SINGLE_PRECISION_COMPLEX SUBROUTINE p map_part_pop_1dsc(pdata,Npart,newNpart,info)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX SUBROUTINE p map_part_pop_1ddc(pdata,Npart,newNpart,info)I#elif __KIND == __INTEGER SUBROUTINE p map_part_pop_1di(pdata,Npart,newNpart,info)I#elif __KIND == __LOGICAL SUBROUTINE p map_part_pop_1dl(pdata,Npart,newNpart,info)I#endif I#elif __DIM == 2 #if __KIND == __SINGLE_PRECISION SUBROUTINE p map_part_pop_2ds(pdata,lda,Npart,newNpart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map_part_pop_2dd(pdata,lda,Npart,newNpart,info)I#elif __KIND == __SINGLE_PRECISION_COMPLEX SUBROUTINE p map_part_pop_2dsc(pdata,lda,Npart,newNpart,info)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX SUBROUTINE p map_part_pop_2ddc(pdata,lda,Npart,newNpart,info)I#elif __KIND == __INTEGER SUBROUTINE p map_part_pop_2di(pdata,lda,Npart,newNpart,info)I#elif __KIND == __LOGICAL SUBROUTINE p map_part_pop_2dl(pdata,lda,Npart,newNpart,info)I#endifI#endifIN -!! This routine pops the contents of the receive buffer.IN -!!IN -!! [NOTE]IN -!! The first part of the buffer contains the on processorIN -!! data. The packing could be performed more efficiently.IN -!!IN -!! [NOTE]IN -!! Maybe remove the `lda`Nfrom the argument list (sinceIN -!! it is only used to check against p buffer_dimI -!! anyway) and check size(pdata,1) againstI -!! p buffer_dim. _(does the size(,) stuffI -!! also work if the array was allocared in a C client?)_IN -!!IN -!! [WARNING]IN -!! DIM is the dimension of the pdata array and not the spaceIN -!! dimension p dim!IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Includes N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Modules IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN USE p module_dataIN USE p module_substartIN USE p module_substop USE p module_error USE p module_allocIN USE p module_writeIN IMPLICIT NONE #if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEX INTEGER, PARAMETER :: MK = p kind_singleI#elseIN INTEGER, PARAMETER :: MK = p kind_doubleI#endifIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Arguments IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I#if __DIM == 1I#if __KIND == __INTEGER INTEGER , DIMENSION(: ), POINTER :: pdataI#elif __KIND == __LOGICAL LOGICAL , DIMENSION(: ), POINTER :: pdataI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX COMPLEX(MK), DIMENSION(: ), POINTER :: pdataI#elseIN REAL(MK), DIMENSION(: ), POINTER :: pdataI#endifII#elif __DIM == 2 #if __KIND == __INTEGER INTEGER , DIMENSION(:,:), POINTER :: pdataI#elif __KIND == __LOGICAL LOGICAL , DIMENSION(:,:), POINTER :: pdataI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX COMPLEX(MK), DIMENSION(:,:), POINTER :: pdataI#elseIN REAL(MK), DIMENSION(:,:), POINTER :: pdataI#endifI#endifIN -!! Particle data to be popped.IN -!! Can be either 1D or 2D array.I#if __DIM == 2 INTEGER , INTENT(IN ) :: ldaIN -!! The leading dimension of pdata.I#endifIN INTEGER , INTENT(IN ) :: NpartIN -!! The old number of particles (on the processor)IN INTEGER , INTENT(IN ) :: newNpartIN -!! The new number of particles (on the processor)IN INTEGER , INTENT( OUT) :: infoIN -!! Returns status, 0 upon successIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Local variables IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN INTEGER, DIMENSION(2) :: lduIN INTEGER :: k,ipart,bdim,ibuffer,btypeIN INTEGER :: iopt,edim,istartI#if __DIM == 1IN INTEGER, PARAMETER :: lda =,1I#endifIN CHARACTER(p char) :: mesgIN REAL(MK) :: t0IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Externals IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Initialise IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN LEXL substart('p map_part_pop',t0,info)IIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check argumentsIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p debug .GT. 0) THEN LEXL check IF (info .NE. 0) GOTO 9999IN ENDIFI - skip if the buffer is emptyIN IF (p buffer_set .LT. 1) THEN info = p error notice IF (p debug .GT. 1) THEN LEXL p error(p err_buffer_empt,'p map_part_pop', &INUUUU& 'Buffer is empty: skipping pop!',__LINE__,info)IN ENDIFI GOTO 9999IN ENDIFI IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check that the required dimension fits the dimension of the bufferIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN bdim = p buffer_dim(p buffer_set) #if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ! for complex, the effective dimension is half the data dimension edim = bdim/2I#elseIN edim = bdimI#endifIN IF (p debug .GT. 1) THEN WRITE(mesg,'(2(A,I3))') 'bdim=',edim,' lda=',ldaIN LEXL p write(p rank,'p map_part_pop',mesg,info)IN ENDIFI#if __DIM == 2 IF (edim.NE.lda) THEN info = p error error LEXL p error(p err_wrong dim,'p map_part_pop', &INUUUU& 'leading dimension LDA is in error',__LINE__,info)IN GOTO 9999IN ENDIF I#elif __DIM == 1 IF (edim.NE.1) THEN info = p error error LEXL p error(p err_wrong dim,'p map_part_pop', &INUUUU& 'buffer does not contain 1d data!',__LINE__,info)IN GOTO 9999IN ENDIF I#endifII !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check that the required type is identical to the type of the bufferIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN btype = p buffer_type(p buffer_set) #if __KIND == __SINGLE_PRECISION IF (btype.NE.p kind_single) THEN info = p error error LEXL p error(p err_wrong prec,'p map_part_pop', &INUUUU& 'trying to pop a non-single into single ',__LINE__,info)IN GOTO 9999IN ENDIFI#elif __KIND == __DOUBLE_PRECISION IF (btype.NE.p kind_double) THEN info = p error error LEXL p error(p err_wrong prec,'p map_part_pop', &INUUUU& 'trying to pop a non-double into double ',__LINE__,info)IN GOTO 9999IN ENDIFI#elif __KIND == __SINGLE_PRECISION_COMPLEX IF (btype.NE.p kind_single) THEN info = p error error LEXL p error(p err_wrong prec,'p map_part_pop', &INUUUU& 'trying to pop a non-single-complex into single-complex', &INUUUU& __LINE__,info)IN GOTO 9999IN ENDIFI#elif __KIND == __DOUBLE_PRECISION_COMPLEX IF (btype.NE.p kind_double) THEN info = p error error LEXL p error(p err_wrong prec,'p map_part_pop', &INUUUU& 'trying to pop a non-double-complex into double-complex', &INUUUU& __LINE__,info)IN GOTO 9999IN ENDIFI#elif __KIND == __INTEGER IF (btype.NE.p integer) THEN info = p error error LEXL p error(p err_wrong prec,'p map_part_pop', &INUUUU& 'trying to pop a non-integer into integer ',__LINE__,info)IN GOTO 9999IN ENDIFI#elif __KIND == __LOGICAL IF (btype.NE.p logical) THEN info = p error error LEXL p error(p err_wrong prec,'p map_part_pop', &INUUUU& 'trying to pop a non-logical into logical ',__LINE__,info)IN ENDIFI#endifIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - (Re)allocare the particle data (if necessary)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN iopt = p param_alloc_grow preserveI#if __DIM == 2 IN ldu(1) =,edimI ldu(2) =,newNpartI#elif __DIM == 1 ldu(1) =,newNpartI#endifIN CEXL p alloc(pdata,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error faral LEXL p error(p err_alloc,'p map_part_pop', &INUUUU& 'particle data PDATA',__LINE__,info)IN GOTO 9999IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Decrement the pointer into the receive bufferIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p debug .GT. 1) THEN WRITE(mesg,'(2(A,I9))') 'p nrecvbuffer = ',p nrecvbuffer, &INUUUU& 'newNpart*bdim = ',newNpart*bdimIN LEXL p write(p rank,'p map_part_pop',mesg,info)IN ENDIFIN IF (p map_type.EQ.p param_map_ghost get) THEN p nrecvbuffer = p nrecvbuffer - (newNpart - Npart)*bdim IN ELSE p nrecvbuffer = p nrecvbuffer - newNpart*bdim IN ENDIF I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - Decrement the pointer into the send buffer to allow reuse byIN ! multiple sequential push-send-pop cycles. ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I p nsendbuffer = p nsendbuffer - p buffer_dim(p buffer_set)* &INUUUU& (p psendbuffer(p nsendlist+1)-1)I ibuffer = p nrecvbuffer IN IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'ibuffer = ',ibufferIN LEXL p write(p rank,'p map_part_pop',mesg,info)IN ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - compute the start of the loop: when ghosts are popped, we need to addI - them at the end of the current particle list, otherwise we overwrite I - the current particle listIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p map_type.EQ.p param_map_ghost get) THEN istart = Npart + 1IN ELSE istart = 1IN ENDIF I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - loop over the processors in the p isendlist() IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I#ifdef __MPI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I - DOUBLE PRECISION BUFFER ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p kind.EQ.p kind_double) THEN #if __DIM == 2 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 - Unrolled version of edim=1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 IF (edim .EQ. 1) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled version of edim=2 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 2) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(2,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled version of edim=3 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 3) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(2,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(3,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(3,ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(3,ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled version of edim=4 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 4) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(2,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(3,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(4,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(3,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(4,ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(3,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(4,ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled version of edim=5 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 5) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(2,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(3,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(4,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 1I pdata(5,ipart) = REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(3,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(4,ipart) = p recvbufferd(ibuffer)IN ibuffer = ibuffer + 1I pdata(5,ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(5,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(5,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(3,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(4,ipart) = INT(p recvbufferd(ibuffer))IN ibuffer = ibuffer + 1I pdata(5,ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(5,ipart) = .TRUE. ELSE pdata(5,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - For edim.GT.5 the vector length will be edim !!IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ELSE DO ipart=istart,newNpartI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(k,ipart) = REAL(p recvbufferd(ibuffer), &INUUUU& p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(k,ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(k,ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(k,ipart) = .TRUE. ELSE pdata(k,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ENDDO hEEEEE ENDIFI#elif __DIM == 1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Scalar version ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(ipart) = REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(ipart) = .TRUE. ELSE pdata(ipart) = .FALSE. ENDIF I#endifI ENDDO #endifIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - SINGLE PRECISION BUFFER ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN ELSE #if __DIM == 2 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 - Unrolled verion for edim=1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 IF (edim .EQ. 1) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled verion for edim=2 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 2) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(1,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled verion for edim=3 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 3) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(3,ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(2,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(3,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(3,ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled verion for edim=4 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 4) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(3,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(4,ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(2,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(3,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(4,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(3,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(4,ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Unrolled verion for edim=5 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999 ELSEIF (edim .EQ. 5) THEN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(1,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(2,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(3,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(4,ipart) = p recvbuffers(ibuffer)IN ibuffer = ibuffer + 1I pdata(5,ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(2,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(3,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(4,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 1I pdata(5,ipart) = REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)IN ibuffer = ibuffer + 2I pdata(5,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(2,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(3,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(4,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)IN ibuffer = ibuffer + 2I pdata(5,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(2,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(3,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(4,ipart) = INT(p recvbuffers(ibuffer))IN ibuffer = ibuffer + 1I pdata(5,ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF IN ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(5,ipart) = .TRUE. ELSE pdata(5,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - For edim.GT.5 the vector length will be edim !!IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ELSE DO ipart=istart,newNpartI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(k,ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(k,ipart) = REAL(p recvbuffers(ibuffer), &INUUUU& p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(k,ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(k,ipart) = .TRUE. ELSE pdata(k,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ENDDO hEEEEE ENDIFI#elif __DIM == 1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Scalar version ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(ipart) = REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(ipart) = .TRUE. ELSE pdata(ipart) = .FALSE. ENDIF I#endifI ENDDO #endifIN ENDIF ! p kind ! finish MPII#elseIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - DOUBLE PRECISION BUFFER ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p kind.EQ.p kind_double) THEN #if __DIM == 2 DO ipart=istart,newNpartI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(k,ipart) = REAL(p recvbufferd(ibuffer), &INUUUU& p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(k,ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(k,ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(k,ipart) = .TRUE. ELSE pdata(k,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ENDDO #elif __DIM == 1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Scalar version ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(ipart) = REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(ipart) = p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(ipart) = INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(ipart) = .TRUE. ELSE pdata(ipart) = .FALSE. ENDIF I#endifI ENDDO #endifIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - SINGLE PRECISION BUFFER ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN ELSE #if __DIM == 2 DO ipart=istart,newNpartI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(k,ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(k,ipart) = REAL(p recvbuffers(ibuffer), &INUUUU& p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(k,ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(k,ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(k,ipart) = .TRUE. ELSE pdata(k,ipart) = .FALSE. ENDIF I#endifI ENDDO hEEEEE ENDDO #elif __DIM == 1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Scalar version ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO ipart=istart,newNpartI#if __KIND == __SINGLE_PRECISION_COMPLEX | \IN __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION pdata(ipart) = p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(ipart) = REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(ipart) = CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(ipart) = INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(ipart) = .TRUE. ELSE pdata(ipart) = .FALSE. ENDIF I#endifI ENDDO #endifIN ENDIF ! p kind ! finish non-MPII#endif !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Decrement the set counter !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p buffer_set = p buffer_set - 1 !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Deallocate the receive buffer if all sets have been poped !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN IF (p buffer_set .LT. 1) THEN iopt = p param_dealloc IF (p kind .EQ. p kind_single) THEN CALL p alloc(p recvbuffers,ldu,iopt,info)IN ELSE CALL p alloc(p recvbufferd,ldu,iopt,info)IN ENDIFI IF (info .NE. 0) THEN info = p error error CALL p error(p err alloc,'p map part_pop', &INUUUU& 'receive buffer PPM_RECVBUFFER',__LINE__,info)IN ENDIFI ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Return !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN9999 CONTINUE CALL substop('p map part_pop',t0,info)IN RETURN CONTAINS SUBROUTINE checkI IF (Npart .LT. 0) THEN info = p error error CALL p error(p err argument,'p map part_pop', &INUUUU& 'Npart must be >=0',__LINE__,info)IN GOTO 8888IN ENDIFI IF (newNpart .LT. 0) THEN info = p error error CALL p error(p err argument,'p map part_pop', &INUUUU& 'newNpart must be >=0',__LINE__,info)IN GOTO 8888IN ENDIFI#if __DIM == 2 IF (lda .LT. 1) THEN info = p error error CALL p error(p err argument,'p map part_pop', &INUUUU& 'lda must be >0 for vector data',__LINE__,info)IN GOTO 8888IN ENDIFI#elif __DIM == 1 IF (lda .NE. 1) THEN info = p error error CALL p error(p err argument,'p map part_pop', &INUUUU& 'lda must be =1 for scalar data',__LINE__,info)IN GOTO 8888IN ENDIFI#endifIN8888 CONTINUE END SUBROUTINE checkI #if __DIM == 1I#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part_pop_1dsI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part_pop_1ddI#elif __KIND == __SINGLE_PRECISION_COMPLEX END SUBROUTINE p map part_pop_1dscI#elif __KIND == __DOUBLE_PRECISION_COMPLEX END SUBROUTINE p map part_pop_1ddcI#elif __KIND == __INTEGER END SUBROUTINE p map part_pop_1diI#elif __KIND == __LOGICAL END SUBROUTINE p map part_pop_1dlI#endifI #elif __DIM == 2I#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part_pop_2dsI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part_pop_2ddI#elif __KIND == __SINGLE_PRECISION_COMPLEX END SUBROUTINE p map part_pop_2dscI#elif __KIND == __DOUBLE_PRECISION_COMPLEX END SUBROUTINE p map part_pop_2ddcI#elif __KIND == __INTEGER END SUBROUTINE p map part_pop_2diI#elif __KIND == __LOGICAL END SUBROUTINE p map part_pop_2dlI#endifI#endifIlibp -1.2.1/src/map/p map part_get_sub.f���������������������������������������������������������0000644�0001752�0001753�00000071646�11616003524�021075� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Subroutine :N p map part_get_sub !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), IN - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribute it and/or modifyIN ! it under the terms of the GNU Lesser General Public License IN - as published by the Free Software Foundation, either IN - version 3 of the License, or (at your option) any later IN - version.IN !IN ! PPM is distributed in the hope that it will be useful,IN ! but WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theIN ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseIN - and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH ZurichIN - CH-8092 Zurich, Switzerland !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99II#if __KIND == __SINGLE_PRECISION SUBROUTINE p map part_get_sub_s(topoid,isublist,nsublist,xp,Npart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map part_get_sub_d(topoid,isublist,nsublist,xp,Npart,info)I !!! This routine maps (retrieves) the particles on the sub domains and !!! topology listed in the input list. !!! !!! [WARNING] !!! this routine was NOT tested in serial !I#endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Modules !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN USE p module_dataIN USE p module_substartI USE p module_substopI USE p module_error USE p module_alloc USE p module_check_id IMPLICIT NONEI#if __KIND == __SINGLE_PRECISION | __KIND_AUX == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_singleI#elseIN INTEGER, PARAMETER :: MK = p kind_double #endifIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Includes !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99I#ifdef __MPIIN INCLUDE 'mpif.h' #endifIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Arguments !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN REAL(MK), DIMENSION(:,:), INTENT(IN ) :: xp !!! Particle coordinatesIN INTEGER , DIMENSION(:) , INTENT(IN ) :: isublist !!! List of sub domain in topologyIN INTEGER , INTENT(IN ) :: nsublist !!! Length of list(:)IN INTEGER , INTENT(IN ) :: NpartI !!! Number of particlesIN INTEGER , INTENT(IN ) :: topoidI !!! Topology IDIN INTEGER , INTENT( OUT) :: infoI !!! Returns 0 upon successIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Local variables !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN INTEGER, DIMENSION(3) :: lduIN INTEGER :: i,j,k,isubIN INTEGER :: nsublist1,nsublist2,nghost INTEGER :: nghostplusIN INTEGER :: ipart,sendrank,recvrankIN INTEGER :: iopt,iset,ibufferIN INTEGER :: tag1,tag2IN INTEGER, DIMENSION(:), POINTER :: bcdef => NULL()IN REAL(MK), DIMENSION(:,:), POINTER :: min_sub => NULL()IN REAL(MK), DIMENSION(:,:), POINTER :: max_sub => NULL()IN REAL(MK) :: t0IN LOGICAL :: validI#ifdef __MPIIN INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status #endifIN TYPE(p t_topo) , POINTER :: topo => NULL()IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Externals !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - InitialiseIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN CALL substart('p map part_get_sub',t0,info)IN bcdef => topo%bcdef(:)IIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Check arguments !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999 ENDIFI topo => p topo(topoid)%tIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Now if we have only one processor skip the restIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p nproc.EQ.1) THEN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Moreover, if we are not using MPI we can skip the rest of the sourceIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I#ifdef __MPIIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Checking precision and pointing tree data to correct variables !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99I#if __KIND == __SINGLE_PRECISION min_sub => topo%min_subs max_sub => topo%max_subsI#elseIN min_sub => topo%min_subd max_sub => topo%max_subdI#endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Save the map type for the subsequent calls ! this mapping is a ghost get mapping: the (real) particle on the ! processor is NOT touched by this mapping - the ghosts are justIN - added to the end of the particle list !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p map type = p param_map ghost_getI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for the pointers to the particles that will be sendIN - and received from and to a processor. The p recvbuffer is NOT usedIN - in this routine, but initialized from the precv() array in the routine ! p map part_send().IN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN ldu(1) = p nproc + 1I iopt = p param_alloc_growIN CALL p alloc(p psendbuffer,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)IN GOTO 9999 ENDIFI ldu(1) = NpartI CALL p alloc(p buffer2part,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'buffer-to-particles map PPM_BUFFER2PART',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Store the number of buffer entries (this is the first)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN p buffer_set = 1I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for the field registers that holds the dimension and ! type of the dataIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN ldu(1) = p buffer_setI CALL p alloc(p buffer_dim ,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__LINE__,info)IN GOTO 9999 ENDIFI CALL p alloc(p buffer_type,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'buffer types PPM_BUFFER_TYPE',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Store the dimension and typeIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN p buffer_dim(p buffer_set) = p dimI#if __KIND == __SINGLE_PRECISIONIN p buffer_type(p buffer_set) = p kind_singleI#elseIN p buffer_type(p buffer_set) = p kind_double #endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - (Re)allocate memory for the buffer (need not save the contents of theIN - buffer since this is a global map).IN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN ldu(1) = p dim*NpartI IF (p kind.EQ.p kind_double) THEN CALL p alloc(p sendbufferd,ldu,iopt,info)IN ELSE CALL p alloc(p sendbuffers,ldu,iopt,info)IN ENDIFI IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for the sendlist !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p nsendlist = p nprocIN p nrecvlist = p nprocIN ldu(1) = p nsendlistI CALL p alloc(p isendlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'send list PPM_ISENDLIST',__LINE__,info)IN GOTO 9999 ENDIFI CALL p alloc(p irecvlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'receive list PPM_IRECVLIST',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Before we start, copy the isublist into a temporary arrayIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN ldu(1) = nsublist iopt = p param_alloc_fitI CALL p alloc(ilist1,ldu,iopt,info)IN CALL p alloc(ilist2,ldu,iopt,info)IN CALL p alloc(ilist3,ldu,iopt,info)IN CALL p alloc(ilist4,ldu,iopt,info)IN ilist1 = isublist nlist1 = nsublist tag1 = 100 tag2 = 200 !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Initialize the buffers !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN sendrankN = p rankN- 1I recvrankN = p rankN+ 1I p psendbuffer(1) = 1I p nsendlist = 0I p nrecvlist = 0I iset = 0I ibuffer = 0I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Since we skip the local processor entirely, increment the pointers onceIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN sendrankN = sendrankN+ 1I recvrankN = recvrankN- 1I p nsendlist = p nsendlist + 1I p isendlist(p nsendlist) = sendrankI p nrecvlist = p nrecvlist + 1I p irecvlist(p nrecvlist) = recvrankI p psendbuffer(2) = p psendbuffer(1)I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Loop over all processors but skip the processor itselfIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN DO i=2,p nprocIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - compute the next processorIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN sendrankN= sendrankN+ 1I IF (sendrank.GT.p nproc-1) sendrankN= sendrankN- p nprocIN recvrankN= recvrankN- 1I IF (recvrank.LT. 0) recvrankN= recvrankN+ p nprocIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Store the processor to which we will send toIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p nsendlist = p nsendlist + 1I p isendlist(p nsendlist) = sendrankIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Store the processor to which we will recv fromIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p nrecvlist = p nrecvlist + 1I p irecvlist(p nrecvlist) = recvrankIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Loop over the entire list of subs that we need on topoidI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN nlist2 = 0I nlist3 = 0I DO j=1,nlist1IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN - Check if they belong to the processor from where we will receiveIN - dataIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN IF (topo%sub2proc(ilist1(j)).EQ.recvrank) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - If yes, then store it in the local receive list (ilist3)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 nlist3 = nlist3 + 1I ilist3(nlist3) = ilist1(j)I ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - otherwise store the sub in the second list to be swapped laterIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 nlist2 = nlist2 + 1I ilist2(nlist2) = ilist1(j)I ENDIFI ENDDO IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Swap the listsIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ilist1 = ilist2I nlist1 = nlist2 IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Now send the list of data we need to the recvrankNprocessor and - receive the request from the sendrankNprocessor for data we have - to provide. Notice: the first part of the envelope is the SEND partI - so we send to the recvlist what we needIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN CALL MPI_SendRecv(nlist3,1,MPI_INTEGER,recvrank,tag1, &INUUUU& nlist4,1,MPI_INTEGER,sendrank,tag1, &INUUUU& p comm,status,info)IIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Reallocate if needed the (partial) list (ilist4) of subs that weIN - have and should send to sendrankI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN iopt = p param_alloc_growIN ldu(1) = nlist4 CALL p alloc(ilist4,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'allocation of ilist4 failed',__LINE__,info)IN GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - and receive the dataIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN CALL MPI_SendRecv(ilist3,nlist3,MPI_INTEGER,recvrank,tag2, &INUUUU& ilist4,nlist4,MPI_INTEGER,sendrank,tag2, &INUUUU& p comm,status,info)IIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Reallocate to make sure we have enough memory in the ! p buffer2part and p sendbuffers/d; we can at most send all our ! particles, so we increment the buffer with NpartI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN iopt = p param_alloc_grow_preserve ldu(1) = ibuffer + Npart*p dimI IF (p kind.EQ.p kind_double) THEN CALL p alloc(p sendbufferd,ldu,iopt,info)IN ELSE CALL p alloc(p sendbuffers,ldu,iopt,info)IN ENDIFI IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)IN GOTO 9999 ENDIFI ldu(1) = iset + NpartI CALL p alloc(p buffer2part,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_get_sub', &INUUUU& 'buffer2particles map PPM_BUFFER2PART',__LINE__,info)IN GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Now we know what to do, and loop over our subs in the ilist4 toIN - extract the particles ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO j=1,nlist4IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN - Get the sub idIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN isub = ilist4(j)I IF (p dim.EQ.2) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Loop over the particles in 2D ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO k=1,NpartI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - and check if they are inside the subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I IF (xp(1,k).GE.min_sub(1,isub).AND. &INUUUU& xp(1,k).LE.max_sub(1,isub).AND. &INUUUU& xp(2,k).GE.min_sub(2,isub).AND. &INUUUU& xp(2,k).LE.max_sub(2,isub)) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�l - In the non-periodic case, allow particles that are - exactly ON an upper EXTERNAL boundary. ----------------------------ginys,max,phys,mis,t�lEmax,t�l IF((xp(1,k).LT.max_sub(1,isub) .OR. &INUUUU& (topo%subs_bc(2,isub).EQ.1 .AND. &INUUUU& bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,k).LT.max_sub(2,isub) .OR. &INUUUU& (topo%subs_bc(4,isub).EQ.1 .AND. &INUUUU& bcdef(4).NE. p param_bcdef_periodic))) THEN ----------------------------ginys,max,phys,mis,t�lEmax, - If yes, then store them ----------------------------ginys,max,phys,mis,t�lEmax, iset = iset + 1 ----------------------------ginys,max,phys,mis,t�lEmax, - store the ID of the particles ----------------------------ginys,max,phys,mis,t�lEmax, p buffer2part(iset) = k ----------------------------ginys,max,phys,mis,t�lEmax, - store the particle ----------------------------ginys,max,phys,mis,t�lEmax, IF (p kind.EQ.p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = &INUUUU& REAL(xp(1,k),p kind_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = &INUUUU& REAL(xp(2,k),p kind_double)I#elseIN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(1,k)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(2,k)I#endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(1,k)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(2,k)I#elseIN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = &INUUUU& REAL(xp(1,k),p kind_single)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = &INUUUU& REAL(xp(2,k),p kind_single)I#endifI ENDIFI ENDIF ! for inside/outside ENDIF ! for inside/outside ENDDO ! end loop over 2D particles ELSE ! else of 2d versus 3d ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Loop over the particles in 3D ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO k=1,NpartI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - and check if they are inside the subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I IF (xp(1,k).GE.min_sub(1,isub).AND. &INUUUU& xp(1,k).LE.max_sub(1,isub).AND. &INUUUU& xp(2,k).GE.min_sub(2,isub).AND. &INUUUU& xp(2,k).LE.max_sub(2,isub).AND. &INUUUU& xp(3,k).GE.min_sub(3,isub).AND. &INUUUU& xp(3,k).LE.max_sub(3,isub)) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh99 - In the non-periodic case, allow particles that are - exactly ON an upper EXTERNAL boundary. ----------------------------ginys,max,phys,mis,t�lEmax,t�lh99 IF((xp(1,k).LT.max_sub(1,isub) .OR. &INUUUU& (topo%subs_bc(2,isub).EQ.1 .AND. &INUUUU& bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,k).LT.max_sub(2,isub) .OR. &INUUUU& (topo%subs_bc(4,isub).EQ.1 .AND. &INUUUU& bcdef(4).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(3,k).LT.max_sub(3,isub) .OR. &INUUUU& (topo%subs_bc(6,isub).EQ.1 .AND. &INUUUU& bcdef(6).NE. p param_bcdef_periodic)) ) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - If yes, then store them ----------------------------ginys,max,phys,mis,t�lEmax,t�lh iset = iset + 1 ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - store the ID of the particles ----------------------------ginys,max,phys,mis,t�lEmax,t�lh p buffer2part(iset) = k ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - store the particle ----------------------------ginys,max,phys,mis,t�lEmax,t�lh IF (p kind.EQ.p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(1,k),p kind_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(2,k),p kind_double)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(3,k),p kind_double)I#elseIN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(1,k)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(2,k)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(3,k)I#endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(1,k)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(2,k)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(3,k)I#elseIN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(1,k),p kind_single)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(2,k),p kind_single)IN ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(3,k),p kind_single)I#endifI ENDIFI ENDIFI ENDIFI ENDDO ! end loop over particles ENDIF ! endif of 2d/3d ENDDO ! end loop over ilist4: the list of subs to sendIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Update the buffer pointer (ie the current iset ... or the number ofIN - particle we will send to the k-th entry in the icommseq list ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p psendbuffer(i+1) = iset + 1I ENDDO ! end loop over nprocIIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Store the current size of the bufferIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p nsendbuffer = ibuffer !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Deallocate the memory for the listsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN iopt = p param_dealloc CALL p alloc(ilist1,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error error CALL p error(p err dealloc,'p map part_get_sub', &INUUUU& 'ilist1',__LINE__,info)IN ENDIFI CALL p alloc(ilist2,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error error CALL p error(p err dealloc,'p map part_get_sub', &INUUUU& 'ilist2',__LINE__,info)IN ENDIFI CALL p alloc(ilist3,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error error CALL p error(p err dealloc,'p map part_get_sub', &INUUUU& 'ilist3',__LINE__,info)IN ENDIFI CALL p alloc(ilist4,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error error CALL p error(p err dealloc,'p map part_get_sub', &INUUUU& 'ilist4',__LINE__,info)IN ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Moreover, if we are not using MPI we can skip the rest of the sourceIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I#endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Return !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN9999 CONTINUE CALL substop('p map part_get_sub',t0,info)IN RETURN CONTAINS SUBROUTINE checkI IF (.NOT. p initialized) THEN info = p error error CALL p error(p err p noinit,'p map part_get_sub', &INUUUU& 'Please call p init first!',__LINE__,info)IN GOTO 8888IN ENDIFI IF (topoid .GT. 0) THEN CALL p check_topoid(topoid,valid,info)IN IF (.NOT. valid) THEN info = p error error CALL p error(p err argument,'p map part_get_sub', &INUUUU& 'Invalid topology ID as to_topo specified!',__LINE__,info)IN GOTO 8888IN ENDIFI ENDIFI 8888 CONTINUE END SUBROUTINE checkI#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part_get_sub_sI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part_get_sub_dI#endifI������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map part_ghost_get.f�������������������������������������������������������0000644�0001752�0001753�00000211313�11616003524�021413� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Subroutine :N p map part_ghost_getI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), IN - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribute it and/or modifyIN ! it under the terms of the GNU Lesser General Public License IN - as published by the Free Software Foundation, either IN - version 3 of the License, or (at your option) any later IN - version.IN !IN ! PPM is distributed in the hope that it will be useful,IN ! but WITHOUT ANY WARRANTY; without even the implied warranty ofIN ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theIN ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseIN - and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH ZurichIN - CH-8092 Zurich, Switzerland !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99II#if __KIND == __SINGLE_PRECISION SUBROUTINE p map part_ghost_get_s(topoid,xp,lda,Npart,isymm, &INUUUU& ghostsize,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map part_ghost_get_d(topoid,xp,lda,Npart,isymm, &INUUUU& ghostsize,info)I#endif !!! This routine maps/adds the ghost particles on the current topology. !!! This routine is similar to the partial mapping routine !!! (`p map part_partial`) in the sense that the ghost particles are !!! assumed to be located on neighbouring processors only, and thus only !!! require a nearest neighbour communication. !!! !!! [WARNING] !!! It is an error to specify a topology ID to which the particles are not !!! currently mapped !!! !!! [NOTE] !!! ============================================================== !!! This routine SHOULD be efficient - since it will be !!! called frequently. One way of improving (?) theIN !!! performance is to use the cell lists to find theIN !!! potential ghosts. !!! !!! This routine should be split in several routines! !!! !!! The ghosts are found in three steps: !!! !!! 1. consider ghosts within the local processorIN !!! 2. consider ghosts on neighbouring processorsIN !!! 3. consider ghosts on periodic images of neighbouringIN !!! processorsIN !!!IN !!! Comments: !!! !!! 1. Local ghost particles come in two types: ghost particles thatIN !!! exist because two sub domains touch, and ghosts across aIN !!! periodic boundary. The first is automatically handled !!! by the particles - and no copy or/and send is !!! required. The second ghosts could be handled duringIN !!! the calculation of the interactions, but this would !!! require a check for periodicity and no explicitIN !!! ghosts from the processor itself. However, it seems !!! more natural to have ghosts - irrespectively of their !!! origin, so ghosts from periodicity (on the sameIN !!! processor) are copied here. !!! 2. is standard procedureIN !!! 3. is handled by copying particles that are adjacent toIN !!! faces on a physical boundary to their image position. !!! !!! Now, item 2. and 3. can be treated within the same logic !!! whereas 1. require a bit of thought: to keep the sourceIN -!! compact, we could loop over all processors includingIN !!! the local one and check for ghosts - the problem withIN !!! this procedure is, that we check for ghosts by comparingIN !!! the location of particles within the extended subs !!! boundaries (and not their true ghost layer - which !!! would result in more IFs than necessary). However, !!! because of this, looping over the processor itselfIN -!! would find ghosts that are not really ghost - the only !!! ghosts that should be found in this step are those dueIN -!! to periodicity. The solution is to store the ghosts as !!! ighost() with nghost denoting the total number ofIN !!! ghosts (excluding those due to periodicity) and !!! nghostplus the total number of ghosts. During the loop !!! over the processor itself we therefore only need to !!! loop from nghost+1,nghostplus. !!! ============================================================== I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Modules !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN USE p module_typedefIN USE p module_dataIN USE p module_substartIN USE p module_substop USE p module_error USE p module_alloc USE p module_write USE p module_check_idIN USE p module_util commoptI IMPLICIT NONE #if __KIND == __SINGLE_PRECISION | __KIND_AUX == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_singleI#elseIN INTEGER, PARAMETER :: MK = p kind_double #endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Arguments I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN INTEGER , INTENT(IN ) :: topoid !!! ID of current topology REAL(MK), DIMENSION(:,:), INTENT(IN ) :: xp !!! The position of the particles REAL(MK) , INTENT(IN ) :: ghostsize !!! The size of the ghost layerIN INTEGER , INTENT(IN ) :: ldaIN !!! Leading dimension of xp INTEGER , INTENT(IN ) :: NpartI !!! The number of particles (on the local processor) INTEGER , INTENT(IN ) :: isymm !!! Indicator for the use of symmetry !!! !!! * isymm > 0 use symmetry !!! * isymm = 0 do not use symmetry INTEGER , INTENT( OUT) :: info !!! Return status, 0 on successI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Local variables I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN INTEGER, DIMENSION(3) :: ldu INTEGER :: i,j,k,isub INTEGER :: nlist1,nlist2,nghost,nghostplus INTEGER :: ipart,sendrank,recvrankI INTEGER :: iopt,iset,ibufferIN REAL(MK), DIMENSION(:,:), POINTER :: xt => NULL()IN ! position of potential ghostsIN REAL(MK), DIMENSION(:,:), POINTER :: xt_offset => NULL()IN ! offset of pot. ghostsIN REAL(MK) :: xminf,yminf,zminf ! full domainIN REAL(MK) :: xmaxf,ymaxf,zmaxf ! full domainIN REAL(MK) :: xmini,ymini,zmini ! inner domainIN REAL(MK) :: xmaxi,ymaxi,zmaxi ! inner domainIN REAL(MK), DIMENSION(p dim) :: min_physIN REAL(MK), DIMENSION(p dim) :: max_physIN REAL(MK), DIMENSION(p dim) :: len_physIN REAL(MK) :: t0 INTEGER :: nbc,npbc,nsbc LOGICAL, DIMENSION(2*p dim) :: lextraIN INTEGER, DIMENSION(2*p dim) :: ibc LOGICAL :: valid CHARACTER(p char) :: mesgIN ! number of periodic directions: between 0 and p dimI TYPE(p t_topo),POINTER :: topo => NULL()IN REAL(MK) :: epsI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Externals I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Initialise IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN CALL substart('p map part_ghost_get',t0,info)II !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Check argumentsI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN IF (p debug .GT. 1) THEN CALL checkI IF (info .NE. 0) GOTO 9999 ENDIFI topo => p topo(topoid)%t #if __KIND == __DOUBLE_PRECISION eps = p myepsdI#elseIN eps = p myepssI#endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Count Boundary conditionsI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN npbc = 0I nsbc = 0I nbc = 0I ibc(:) = 0I lextra(:) = .FALSE.IN I DO i=1,2*p dimI SELECT CASE (topo%bcdef(i))IN CASE (p param_bcdef_periodic)IN npbc = npbc + 1I ibc(i) = p param_bcdef_periodicIN CASE (p param_bcdef_symmetry)IN nsbc = nsbc + 1I lextra(i) = .TRUE.IN ibc(i) = p param_bcdef_symmetry CASE (p param_bcdef_antisymmetry)IN nsbc = nsbc + 1I lextra(i) = .TRUE.IN ibc(i) = p param_bcdef_symmetry CASE (p param_bcdef_neumann)IN nsbc = nsbc + 1I lextra(i) = .TRUE.IN ibc(i) = p param_bcdef_symmetry CASE (p param_bcdef_dirichlet)IN nsbc = nsbc + 1I lextra(i) = .TRUE.IN ibc(i) = p param_bcdef_symmetry END SELECT ENDDOI nbc = npbc + nsbc IN - if there is still some data left in the buffer, warn the userIN IF (p buffer_set .GT. 0) THEN info = p error warningIN CALL p error(p err map incomp,'p map part_ghost_get', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)IN ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - first check if the optimal communication protocol is known !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (.NOT.topo%isoptimized) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN - if not: determine it ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN CALL p util commopt(topoid,info)IN IF (p debug .GT. 1) THEN DO i=1,topo%nneighprocIN WRITE(mesg,'(A,I4)') 'have neighbor: ', topo%ineighproc(i)IN CALL p write(p rank,'p map part_ghost_get',mesg,info)IN ENDDOI DO i=1,topo%ncommseqIN WRITE(mesg,'(A,I4)') 'communicate: ', topo%icommseq(i)IN CALL p write(p rank,'p map part_ghost_get',mesg,info)IN ENDDOI ENDIFI ENDIFI ! for now here, but this can be done betterIN ! TODO: kepp this consistant throughout simulationIN p sendbufsize = 0I IF (p kind.EQ.p kind_double) THEN IF (ASSOCIATED(p sendbufferd)) THEN p sendbufsize = SIZE(p sendbufferd) ENDIFI ELSE IF (ASSOCIATED(p sendbuffers)) THEN p sendbufsize = SIZE(p sendbuffers) ENDIFI ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Compute the size of the computational box on this topology ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I#if __KIND == __DOUBLE_PRECISION min_phys(:) = topo%min_physd(:) max_phys(:) = topo%max_physd(:) #elseIN min_phys(:) = topo%min_physs(:) max_phys(:) = topo%max_physs(:) #endifI len_phys(:) = max_phys(:) - min_phys(:)IIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Save the map type for the subsequent calls I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p map type = p param_map ghost_getIIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for the list of particle on the local processor thatIN ! may be ghosts on other processorsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN iopt = p param_alloc_growIN ldu(1) = NpartI IF ((Npart.NE.prev_allocsize) .OR. &INUUUUUUUUU(.NOT.ASSOCIATED(ilist1))) THEN CALL p alloc(ilist1,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'list1',__LINE__,info)IN GOTO 9999 ENDIFI CALL p alloc(ilist2,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'list2',__LINE__,info)IN GOTO 9999 ENDIFI CALL p alloc(ighost,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'ighost',__LINE__,info)IN GOTO 9999 ENDIFI ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for their positionsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN ldu(1) = p dimI ldu(2) = NpartI CALL p alloc(xt,ldu,iopt,info)IN CALL p alloc(xt_offset,ldu,iopt,info)IN IF (info.NE.0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'xt',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - List ilist1() holds the particles we are currently considering IN - List ilist2() holds the particles that have not yet been associated IN - with a sub, and ghost() holds the ghostsIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN DO i=1,NpartI ilist1(i) = i ENDDOI nlist1 = NpartI nlist2 = 0I nghost = 0I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Fill the list with particles that are within the reach of the ghostIN - regions of other subs. We do that by looping over the subs belongingIN ! to this processor and checking if the particles are well within theIN ! sub. If this is the case, the particle will never be a ghost IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN DO k=1,topo%nsublist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Initialize the second list counter to zeroIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN nlist2 = 0I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Get the (global) id of the subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN isub = topo%isublist(k)IIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Store the full extend of the sub in ?minf and ?maxfIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999I#if __KIND == __DOUBLE_PRECISION xminf = topo%min_subd(1,isub) xmaxf = topo%max_subd(1,isub) yminf = topo%min_subd(2,isub) ymaxf = topo%max_subd(2,isub) IF (p dim.EQ.3) THEN zminf = topo%min_subd(3,isub) zmaxf = topo%max_subd(3,isub) ENDIF I#elseIN xminf = topo%min_subs(1,isub) xmaxf = topo%max_subs(1,isub) yminf = topo%min_subs(2,isub) ymaxf = topo%max_subs(2,isub) IF (p dim.EQ.3) THEN zminf = topo%min_subs(3,isub) zmaxf = topo%max_subs(3,isub) ENDIFI#endifI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Compute the size of the inner region ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (isymm.GT.0) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN - if we use symmetry the upper/right part of our sub will have IN - ghosts and therefore the particle at the upper/right part of the IN - sub cannot be ghosts on other processors. Thus the ghosts must IN - be found at the lower/left of the subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN xmini = xminf + ghostsize xmaxi = xmaxfI ymini = yminf + ghostsize ymaxi = ymaxfIN IF (p dim.EQ.3) THEN zmini = zminf + ghostsize zmaxi = zmaxfIN ENDIF I ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN - if we do not use symmetry, the particles along the entire IN - boundary of the sub will be ghosts on other processorsIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN xmini = xminf + ghostsize xmaxi = xmaxf - ghostsize ymini = yminf + ghostsize ymaxi = ymaxf - ghostsize IF (p dim.EQ.3) THEN zmini = zminf + ghostsize zmaxi = zmaxf - ghostsize ENDIF I ENDIF I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - loop over the remaining particles ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (p dim.EQ.2) THEN DO j=1,nlist1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - get the particle indexI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = ilist1(j)I I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - check if the particles belongs to this subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (xp(1,ipart).GE.xminf.AND.xp(1,ipart).LT.xmaxf.AND. &INUUUU& xp(2,ipart).GE.yminf.AND.xp(2,ipart).LT.ymaxf) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - if yes, check if the particles are in the ghost layer I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I IF (xp(1,ipart).LT.xmini.OR.xp(1,ipart).GT.xmaxi.OR. &INUUUU& xp(2,ipart).LT.ymini.OR.xp(2,ipart).GT.ymaxi) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - if yes the particle will be a ghost somewhere ----------------------------ginys,max,phys,mis,t�lEmax,t�lh nghost = nghost + 1 ighost(nghost) = ipartI xt(1,nghost) = xp(1,ipart)I xt(2,nghost) = xp(2,ipart)I xt_offset(1,nghost) = 0.0_MKI xt_offset(2,nghost) = 0.0_MKI ENDIFI ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - If not on this sub we need to consider it further ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI ENDDOI ELSE DO j=1,nlist1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - get the particle indexI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = ilist1(j)I I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - check if the particles belongs to this subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (xp(1,ipart).GE.xminf.AND.xp(1,ipart).LT.xmaxf.AND. &INUUUU& xp(2,ipart).GE.yminf.AND.xp(2,ipart).LT.ymaxf.AND. &INUUUU& xp(3,ipart).GE.zminf.AND.xp(3,ipart).LT.zmaxf) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - if yes, check if the particles is in the ghost layer I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I IF (xp(1,ipart).LT.xmini.OR.xp(1,ipart).GT.xmaxi.OR. &INUUUU& xp(2,ipart).LT.ymini.OR.xp(2,ipart).GT.ymaxi.OR. &INUUUU& xp(3,ipart).LT.zmini.OR.xp(3,ipart).GT.zmaxi) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - if yes the particle will be a ghost somewhere ----------------------------ginys,max,phys,mis,t�lEmax,t�lh nghost = nghost + 1 ighost(nghost) = ipartI xt(1,nghost) = xp(1,ipart)I xt(2,nghost) = xp(2,ipart)I xt(3,nghost) = xp(3,ipart)I xt_offset(1,nghost) = 0.0_MKI xt_offset(2,nghost) = 0.0_MKI xt_offset(3,nghost) = 0.0_MKI ENDIFI ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - If not on this sub we need to consider it further ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI ENDDOI ENDIF I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - swap the lists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO j=1,nlist2I ilist1(j) = ilist2(j)I ENDDOI nlist1 = nlist2I ENDDO ! end of subs on local processorII !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - At the end the nlist2 should be zeroIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN IF (nlist2.NE.0) THEN info = p error fatal CALL p error(p err part_unass,'p map part_ghost_get', &INUUUU& 'nlist2 > 0',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Initialize the total number of ghosts incl. those due to periodicity !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN nghostplus = nghostI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Ok, we now have a list of potential ghosts. From these we extract/addIN - their periodic images (if any). So, first we check for periodicity !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99I- iperiodic = 0I! DO k=1,p dimI- IF (topo%bcdef(2*k-1).EQ.p param_bcdef_periodic) THEN - iperiodic = iperiodic + 1I- ENDIF I! ENDDOI ! find out whether we have any non-freespace BCsIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - handle boundary conditions in xIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (ibc(1).EQ.p param_bcdef_periodic) THEN #include "ghost_map periodic_bc_x.inc" ELSEIF (ibc(1).EQ.p param_bcdef_symmetry) THEN #include "ghost_map symmetry_bc_lx.inc" ENDIF IN IF (ibc(2).EQ.p param_bcdef_symmetry) THEN #include "ghost_map symmetry_bc_ux.inc" ENDIF IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - handle boundary conditions in y !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (ibc(3).EQ.p param_bcdef_periodic) THEN #include "ghost_map periodic_bc_y.inc" ELSEIF (ibc(3).EQ.p param_bcdef_symmetry) THEN #include "ghost_map symmetry_bc_ly.inc" ENDIFIN IF (ibc(4).EQ.p param_bcdef_symmetry) THEN #include "ghost_map symmetry_bc_uy.inc" ENDIFIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - handle periodicity in z (if 3D) !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (p dim.EQ.3) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN - yes, we split the if in two, since we do not know in what order ! the compiler will check and p bcdef will only be allocated to ! four (4) in 2D ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN IF (ibc(5).EQ.p param_bcdef_periodic) THEN #include "ghost_map periodic_bc_z.inc" ELSEIF (ibc(5).EQ.p param_bcdef_symmetry) THEN #include "ghost_map symmetry_bc_lz.inc" ENDIFI IF (ibc(6).EQ.p param_bcdef_symmetry) THEN #include "ghost_map symmetry_bc_uz.inc" ENDIFI ENDIF ! of 3DI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Ok, now we have a shorter list of potential ghosts to search IN - allocate memory for the lghosts !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN iopt = p param_alloc_fit ldu(1) = nghostplus CALL p alloc(lghost,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'logical list: lghost',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for the global send/recv listsIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN ldu(1) = topo%ncommseqIN CALL p alloc(p isendlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'global send rank list PPM_ISENDLIST',__LINE__,info)IN GOTO 9999 ENDIFI CALL p alloc(p irecvlist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'global recv rank list PPM_IRECVLIST',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for the pointers to the particles that will be sendIN - and received from and to a processor. The p recvbuffer is NOT usedIN - in this routine, but initialized from the precv() array in the routineIN - p map part_send().IN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN ldu(1) = topo%ncommseq + 1I CALL p alloc(p psendbuffer,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Step 1:IN - First we find the ghosts due to periodicity on the local processor !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p psendbuffer(1) = 1IN p nsendlistN = 0I p nrecvlistN = 0I iset = 0I ibuffer = 0I k = 1I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Get the rank of the processor !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN sendrank = topo%icommseq(k) ! should be p rank !IN recvrank = sendrankIIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Store the processor to which we will send to !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p nsendlistN = p nsendlistN+ 1IN p isendlist(p nsendlist) = sendrankIIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Store the processor to which we will recv from !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p nrecvlistN = p nrecvlistN+ 1IN p irecvlist(p nrecvlist) = recvrankIIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Store the number of buffer entries (this is the first) !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p buffer_set = 1I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Allocate memory for the field registers that holds the dimension andIN - type of the dataIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN iopt = p param_alloc_fit ldu(1) = p buffer_setI CALL p alloc(p buffer_dim ,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__LINE__,info)IN GOTO 9999 ENDIFI CALL p alloc(p buffer_type,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'buffer types PPM_BUFFER_TYPE',__LINE__,info)IN GOTO 9999 ENDIFI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Store the dimension and type !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p buffer_dim(p buffer_set) = p dimI#if __KIND == __SINGLE_PRECISION p buffer_type(p buffer_set) = p kind_singleI#elseIN p buffer_type(p buffer_set) = p kind_double #endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Well we only do the stuff for real if we have periodicity !IN ! (Re)allocate memory for the send buffer. The required size of these IN - arrays is not easy to compute. The first step (step 1) require atIN ! most p nsublist(topoid)*(nghostplus - nghost)*p dim. The arraysIN - are resized further below during step 2 and 3. !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN IF (nbc.GT.0) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - We can grow or fit the arrays - a matter of taste ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN iopt = p param_alloc_growIN ldu(1) = p dim*(nghostplus - nghost)*topo%nsublist p sendbufsize = ldu(1) ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - First allocate the sendbufferIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (p kind.EQ.p kind_double) THEN CALL p alloc(p sendbufferd,ldu,iopt,info)IN CALL p alloc(p ghost_offsetd,ldu,iopt,info)IN ELSE CALL p alloc(p sendbuffers,ldu,iopt,info)IN CALL p alloc(p ghost_offsets,ldu,iopt,info)IN ENDIFI IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)IN GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - then allocate the index list: buffer2partI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ldu(1) = (nghostplus - nghost)*topo%nsublist CALL p alloc(p buffer2part,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'buffer-to-particles map PPM_BUFFER2PART',__LINE__,info)IN GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - flag all ghosts as not yet taken ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO j=1,nghostplus lghost(j) = .TRUE.IN ENDDOI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - loop over the subs on the local processor ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO j=1,topo%nsublist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - Get the global ID of the subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhIN isub = topo%isublist(j) ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - Define the extended resize of this sub ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh #if __KIND == __SINGLE_PRECISION xminf = topo%min_subs(1,isub) xmaxf = topo%max_subs(1,isub) yminf = topo%min_subs(2,isub) ymaxf = topo%max_subs(2,isub) IF (p dim.EQ.3) THEN zminf = topo%min_subs(3,isub) zmaxf = topo%max_subs(3,isub) ENDIF I#elseIN xminf = topo%min_subd(1,isub) xmaxf = topo%max_subd(1,isub) yminf = topo%min_subd(2,isub) ymaxf = topo%max_subd(2,isub) IF (p dim.EQ.3) THEN zminf = topo%min_subd(3,isub) zmaxf = topo%max_subd(3,isub) ENDIF I#endifI IF (isymm.GT.0) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - if we use symmetry ghosts will only be present at the - upper/right part of the subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 xmini = xminf xmaxi = xmaxf + ghostsize ymini = yminf ymaxi = ymaxf + ghostsize IF (p dim.EQ.3) THEN zmini = zminf zmaxi = zmaxf + ghostsize ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! If this subdomain is at the physical boundary, then we need an ! extra ghostlayer for handling the boundary conditions ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (ABS(xmini - min_phys(1)).LT. eps .AND. lextra(1)) THEN xmini = xmini - ghostsize ENDIFI IF (ABS(ymini - min_phys(2)).LT. eps .AND. lextra(3)) THEN ymini = ymini - ghostsize ENDIFI IF (p dim.EQ.3) THEN IF (ABS(zmini - min_phys(3)).LT. eps .AND. lextra(5)) THEN zmini = zmini - ghostsize ENDIFI ENDIF I ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - if we do not use symmetry, we have ghost all aroundI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 xmini = xminf - ghostsize xmaxi = xmaxf + ghostsize ymini = yminf - ghostsize ymaxi = ymaxf + ghostsize IF (p dim.EQ.3) THEN zmini = zminf - ghostsize zmaxi = zmaxf + ghostsize ENDIF I ENDIF I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - Reallocate the arrays: p sendbuffers/d and p buffer2part. IN - The required size is the current size minus the current use plus IN - the maximum increment (nghostplus-nghost).IN - We perform a grow_preserve to preserve the contents but only to IN - reallocate if an increased size is required. ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh iopt = p param_alloc_grow_preserveI IF (p kind.EQ.p kind_double) THEN IF (ASSOCIATED(p sendbufferd)) THEN ldu(1) = p sendbufsize + &INUUUU& (nghostplus - nghost - ibuffer)*p dimI ELSE ldu(1) = (nghostplus - ibuffer)*p dimI ENDIFI CALL p alloc(p sendbufferd,ldu,iopt,info)IN CALL p alloc(p ghost_offsetd,ldu,iopt,info)IN ELSE IF (ASSOCIATED(p sendbuffers)) THEN ldu(1) = p sendbufsize + &INUUUU& (nghostplus - nghost - ibuffer)*p dimI ELSE ldu(1) = (nghostplus - nghost - ibuffer)*p dim ENDIF I CALL p alloc(p sendbuffers,ldu,iopt,info)IN CALL p alloc(p ghost_offsets,ldu,iopt,info)IN ENDIFI p sendbufsize = ldu(1)N IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)IN GOTO 9999 ENDIFI IF (ASSOCIATED(p buffer2part)) THEN ldu(1) = SIZE(p buffer2part) + nghostplus - nghost - isetI ELSE ldu(1) = nghostplus - nghost - isetI ENDIF I CALL p alloc(p buffer2part,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'buffer-to-particles map PPM_BUFFER2PART',__LINE__,info)IN GOTO 9999 ENDIFI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - loop over the potential ghost particles due to periodicity ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh IF (p dim.EQ.2) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Two dimensions ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO i=nghost+1,nghostplus ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - and check if it is inside the ghost region I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I IF (xt(1,i).GT.xmini.AND.xt(1,i).LT.xmaxi.AND. &INUUUU& xt(2,i).GT.ymini.AND.xt(2,i).LT.ymaxi.AND.lghost(i)) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - mark the ghost as taken ----------------------------ginys,max,phys,mis,t�lEmax,t�lh lghost(i) = .FALSE.I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - found one - increment the buffer counter ----------------------------ginys,max,phys,mis,t�lEmax,t�lh iset = iset + 1IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - store the ID of the particles ----------------------------ginys,max,phys,mis,t�lEmax,t�lh p buffer2part(iset) = ighost(i)IN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - store the particle ----------------------------ginys,max,phys,mis,t�lEmax,t�lh IF (p kind.EQ.p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_double)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_double)I#elseIN ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(1,i)I p ghost_offsetd(ibuffer) = xt_offset(1,i)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(2,i)I p ghost_offsetd(ibuffer) = xt_offset(2,i)I#endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(1,i)I p ghost_offsets(ibuffer) = xt_offset(1,i)I ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(2,i)I p ghost_offsets(ibuffer) = xt_offset(2,i)I#elseIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_single)IIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_single)I#endifI ENDIFI ENDIF I ENDDOI ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - Three dimensions ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO i=nghost+1,nghostplus ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999 - and check if it is inside the ghost region I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I IF (xt(1,i).GT.xmini.AND.xt(1,i).LT.xmaxi.AND. &INUUUU& xt(2,i).GT.ymini.AND.xt(2,i).LT.ymaxi.AND.U& INUUUU& xt(3,i).GT.zmini.AND.xt(3,i).LT.zmaxi.AND.lghost(i)) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - mark the ghost as taken ----------------------------ginys,max,phys,mis,t�lEmax,t�lh lghost(i) = .FALSE.I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - found one - increment the buffer counter ----------------------------ginys,max,phys,mis,t�lEmax,t�lh iset = iset + 1I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - store the ID of the particles ----------------------------ginys,max,phys,mis,t�lEmax,t�lh p buffer2part(iset) = ighost(i)I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - store the particle ----------------------------ginys,max,phys,mis,t�lEmax,t�lh IF (p kind.EQ.p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_double)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_double)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(3,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(3,i), &INUUUU& p kind_double)I#elseIN ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(1,i)I p ghost_offsetd(ibuffer) = xt_offset(1,i)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(2,i)I p ghost_offsetd(ibuffer) = xt_offset(2,i)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(3,i)I p ghost_offsetd(ibuffer) = xt_offset(3,i)I#endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(1,i)I p ghost_offsets(ibuffer) = xt_offset(1,i)I ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(2,i)I p ghost_offsets(ibuffer) = xt_offset(2,i)I ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(3,i)I p ghost_offsets(ibuffer) = xt_offset(3,i)I#elseIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_single)IIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_single)IIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(3,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(3,i), &INUUUU& p kind_single)I#endifI ENDIFI ENDIF I ENDDOI ENDIF ! 2/3 dimension I ENDDO ! end of loop over subs on local processorI ENDIF ! of BC ghostsI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Update the buffer pointer (ie the current iset ... or the number ofIN - particle we will send to the k-th entry in the icommseq list !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN p psendbuffer(k+1) = iset + 1I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN - Step 2 and 3:IN - Notice the p icommseq(1,topoid) points to the local processor, andIN - we already considered this on step 1, so we now start at k = 2 !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999-99IN DO k=2,topo%ncommseqIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ! for each processor in the sendrank listNwe need to send the ghostsIN ! only once, so we flag the lghost as true initiallyIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO j=1,nghostplus lghost(j) = .TRUE.IN ENDDOI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Get the rank of the processor ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN sendrank = topo%icommseq(k)IN recvrank = sendrankIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Store the processor to which we will send to ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p nsendlistN = p nsendlistN+ 1IN p isendlist(p nsendlist) = sendrankIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Store the processor to which we will recv from ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p nrecvlistN = p nrecvlistN+ 1IN p irecvlist(p nrecvlist) = recvrankIIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - only consider non-negative sendranks ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN IF (sendrank.GE.0) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh - loop over all the subs in the current topology IN - this is a bit tedious and perhaps inefficient, but we do notIN - have the subs belonging to all processors stored for each topoidIN - sorry ! so we have to perform the calculations each time ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh DO j=1,topo%nsubs ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 - consider only those beloging to rankI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (topo%sub2proc(j).EQ.sendrank) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - Define the extended resize of this sub ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I#if __KIND == __SINGLE_PRECISION xminf = topo%min_subs(1,j)I xmaxf = topo%max_subs(1,j) yminf = topo%min_subs(2,j)I ymaxf = topo%max_subs(2,j) IF (p dim.EQ.3) THEN zminf = topo%min_subs(3,j)I zmaxf = topo%max_subs(3,j)I ENDIF I#elseIN xminf = topo%min_subd(1,j)I xmaxf = topo%max_subd(1,j) yminf = topo%min_subd(2,j)I ymaxf = topo%max_subd(2,j)I IF (p dim.EQ.3) THEN zminf = topo%min_subd(3,j)I zmaxf = topo%max_subd(3,j)I ENDIF I#endifI IF (isymm.GT.0) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - if we use symmetry ghosts will only be present at the - upper/right part of the subI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh xmini = xminf xmaxi = xmaxf + ghostsize ymini = yminf ymaxi = ymaxf + ghostsize IF (p dim.EQ.3) THEN zmini = zminf zmaxi = zmaxf + ghostsize ENDIF I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - If we are at the border of the physical domain we have - to have ghostlayers either wayI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh IF (ABS(xmini - min_phys(1)).LT.eps.AND.lextra(1)) THEN xmini = xmini - ghostsize ENDIFI IF (ABS(ymini - min_phys(2)).LT.eps.AND.lextra(3)) THEN ymini = ymini - ghostsize ENDIFI IF (p dim.EQ.3) THEN IF (ABS(zmini - min_phys(3)).LT.eps.AND.lextra(5)) THEN zmini = zmini - ghostsize ENDIFI ENDIFI ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - if we do not use symmetry, we have ghost all aroundI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh xmini = xminf - ghostsize xmaxi = xmaxf + ghostsize ymini = yminf - ghostsize ymaxi = ymaxf + ghostsize IF (p dim.EQ.3) THEN zmini = zminf - ghostsize zmaxi = zmaxf + ghostsize ENDIF I ENDIF I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - Reallocate to make sure we have enough memory in theI - p buffer2part and p sendbuffers/d ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I iopt = p param_alloc_grow_preserveI ldu(1) = ibuffer + nghostplus*p dim*10 - test 20061109I IF (p kind.EQ.p kind_double) THEN IF ((ibuffer + nghostplus*p dim).GT.p sendbufsize) THEN CALL p alloc(p sendbufferd,ldu,iopt,info)IN CALL p alloc(p ghost_offsetd,ldu,iopt,info)IN p sendbufsize = ldu(1)I ENDIFI ELSE IF ((ibuffer + nghostplus*p dim).GT.p sendbufsize) THEN CALL p alloc(p sendbuffers,ldu,iopt,info)IN CALL p alloc(p ghost_offsets,ldu,iopt,info)IN p sendbufsize = ldu(1)I ENDIFI ENDIFI IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)IN GOTO 9999 ENDIFII ldu(1) = iset + nghostplus*10 - test 20061109I IF ((iset + nghostplus).GT.SIZE(p buffer2part)) THEN CALL p alloc(p buffer2part,ldu,iopt,info)IN ENDIFI IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part_ghost_get', &INUUUU& 'buffer2particles map PPM_BUFFER2PART',__LINE__,info)IN GOTO 9999 ENDIFII ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I - loop over the potential ghost particles I ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999I IF (p dim.EQ.2) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - Two dimensions ----------------------------ginys,max,phys,mis,t�lEmax,t�lh DO i=1,nghostplus ----------------------------ginys,max,phys,mis,t�lEmax,t - and check if it is inside the ghost region I ----------------------------ginys,max,phys,mis,t�lEmax,t IF (xt(1,i).GT.xmini.AND.xt(1,i).LT.xmaxi.AND. &INUUUU& xt(2,i).GT.ymini.AND.xt(2,i).LT.ymaxi.AND.U&INUUUU& lghost(i)) THEN ----------------------------ginys,max,phys,mis,t�lEma - Mark the ghost as taken for this sendrankI ----------------------------ginys,max,phys,mis,t�lEma lghost(i) = .FALSE.I ----------------------------ginys,max,phys,mis,t�lEma - found one - increment the buffer counter ----------------------------ginys,max,phys,mis,t�lEma iset = iset + 1I ----------------------------ginys,max,phys,mis,t�lEma - store the ID of the particles ----------------------------ginys,max,phys,mis,t�lEma p buffer2part(iset) = ighost(i)I ----------------------------ginys,max,phys,mis,t�lEma - store the particle ----------------------------ginys,max,phys,mis,t�lEma IF (p kind.EQ.p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_double)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_double)I#elseIN ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(1,i)I p ghost_offsetd(ibuffer) = xt_offset(1,i)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(2,i)I p ghost_offsetd(ibuffer) = xt_offset(2,i)I#endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(1,i)I p ghost_offsets(ibuffer) = xt_offset(1,i)I ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(2,i)I p ghost_offsets(ibuffer) = xt_offset(2,i)I#elseIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_single)IIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_single)I#endifI ENDIF I ENDIF I ENDDOI ELSE ----------------------------ginys,max,phys,mis,t�lEmax,t�lh - Three dimensions ----------------------------ginys,max,phys,mis,t�lEmax,t�lh DO i=1,nghostplus ----------------------------ginys,max,phys,mis,t�lEmax,t - and check if it is inside the ghost region I ----------------------------ginys,max,phys,mis,t�lEmax,t IF (xt(1,i).GT.xmini.AND.xt(1,i).LT.xmaxi.AND. &INUUUU& xt(2,i).GT.ymini.AND.xt(2,i).LT.ymaxi.AND.U& INUUUU& xt(3,i).GT.zmini.AND.xt(3,i).LT.zmaxi.AND.U&INUUUU& lghost(i)) THEN ----------------------------ginys,max,phys,mis,t�lEma - Mark the ghost as taken for this sendrankI ----------------------------ginys,max,phys,mis,t�lEma lghost(i) = .FALSE.I ----------------------------ginys,max,phys,mis,t�lEma - found one - increment the buffer counter ----------------------------ginys,max,phys,mis,t�lEma iset = iset + 1I ----------------------------ginys,max,phys,mis,t�lEma - store the ID of the particles ----------------------------ginys,max,phys,mis,t�lEma p buffer2part(iset) = ighost(i)I ----------------------------ginys,max,phys,mis,t�lEma - store the particle ----------------------------ginys,max,phys,mis,t�lEma IF (p kind.EQ.p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_double)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_double)I ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xt(3,i), &INUUUU& p kind_double)I p ghost_offsetd(ibuffer) = REAL(xt_offset(3,i), &INUUUU& p kind_double)I#elseIN ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(1,i)I p ghost_offsetd(ibuffer) = xt_offset(1,i)IN ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(2,i)I p ghost_offsetd(ibuffer) = xt_offset(2,i)IN ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xt(3,i)I p ghost_offsetd(ibuffer) = xt_offset(3,i)I#endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(1,i)I p ghost_offsets(ibuffer) = xt_offset(1,i)I ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(2,i)I p ghost_offsets(ibuffer) = xt_offset(2,i)I ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xt(3,i)I p ghost_offsets(ibuffer) = xt_offset(3,i)I#elseIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(1,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(1,i), &INUUUU& p kind_single)IIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(2,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(2,i), &INUUUU& p kind_single)IIN ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xt(3,i), &INUUUU& p kind_single)I p ghost_offsets(ibuffer) = REAL(xt_offset(3,i), &INUUUU& p kind_single)I#endifI ENDIF I ENDIF I ENDDOI ENDIF ! 2/3 dimension I ENDIF ! only consider subs belonging to rankI ENDDO ! loop over all subs in topo ENDIF ! skipped negative ranks ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN - Update the buffer pointer (ie the current iset ... or the number ofIN - particle we will send to the k-th entry in the icommseq list ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN p psendbuffer(k+1) = iset + 1I ENDDO ! loop over all processors in commseqI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Store the current size of the buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN p nsendbuffer = ibufferI ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Deallocate the memory for the lists ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN iopt = p param_dealloc !N CALL p alloc(ilist1,ldu,iopt,info)I!N IF (info .NE. 0) THEN !N info = p error error !N CALL p error(p err dealloc,'p map part_ghost_get', &I!N & 'ilist1',__LINE__,info)I! ENDIF ! !N CALL p alloc(ilist2,ldu,iopt,info)I!N IF (info .NE. 0) THEN !N info = p error error !N CALL p error(p err dealloc,'p map part_ghost_get', &I!N & 'ilist2',__LINE__,info)I! ENDIF ! !N CALL p alloc(ighost,ldu,iopt,info)I!N IF (info .NE. 0) THEN !N info = p error error !N CALL p error(p err dealloc,'p map part_ghost_get', &I!N & 'ighost',__LINE__,info)I! ENDIF N CALL p alloc( xt,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error N CALL p error(p err dealloc,'p map part_ghost_get', &IN & 'xt',__LINE__,info)I ENDIF N CALL p alloc(xt_offset,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error N CALL p error(p err dealloc,'p map part_ghost_get', &IN & 'xt',__LINE__,info)I ENDIF N CALL p alloc(lghost,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error N CALL p error(p err dealloc,'p map part_ghost_get', &IN & 'lghost',__LINE__,info)I ENDIF N ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Return ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN9999 CONTINUE N CALL substop('p map part_ghost_get',t0,info)I RETURN CONTAINS SUBROUTINE checkI IF (.NOT. p initialized) THEN info = p error error N CALL p error(p err p noinit,'p map part_ghost_get', &INUUUU& 'Please call p init first!',__LINE__,info)IN GOTO 8888IN ENDIFI IF (topoid .EQ. p param_topo_undefined) THEN info = p error error N CALL p error(p err no_topo,'p map part_ghost_get', &INUUUU& 'This routine needs a topology defined topo',__LINE__,info)IN GOTO 8888IN ENDIFI IF (topoid .NE. p param_topo_undefined) THEN CALL p check_topoid(topoid,valid,info)IN IF (.NOT. valid) THEN info = p error error N CALL p error(p err argument,'p map part_ghost_get', &INUUUU& 'topoid out of range',__LINE__,info)IN GOTO 8888IN ENDIFI ENDIFI IF (lda .LT. 1) THEN info = p error error N CALL p error(p err argument,'p map part_ghost_get', &INUUUU& 'lda must be >0',__LINE__,info)IN GOTO 8888IN ENDIFI IF (Npart .LT. 0) THEN info = p error error N CALL p error(p err argument,'p map part_ghost_get', &INUUUU& 'Npart must be >=0',__LINE__,info)IN GOTO 8888IN ENDIFI IF (ghostsize .LT. 0.0_MK) THEN info = p error error N CALL p error(p err argument,'p map part_ghost_get', &INUUUU& 'ghostsize must be >=0.0',__LINE__,info)IN GOTO 8888IN ENDIFI 8888 CONTINUE N END SUBROUTINE checkI#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part_ghost_get_sI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part_ghost_get_dI#endifI���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map field_pop_3d.f���������������������������������������������������������0000644�0001752�0001753�00000570272�11616003524�020745� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Subroutine : p map field_pop_3d ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN - Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), IN - Center for Fluid Dynamics (DTU)IN !IN !IN ! This file is part of the Parallel Particle Mesh Library (PPM).IN !IN ! PPM is free software: you can redistribute it and/or modifyIN ! it under the terms of the GNU Lesser General Public License IN ! as published by the Free Software Foundation, either IN ! version 3 of the License, or (at your option) any later IN ! version.IN !IN ! PPM is distributed in the hope that it will be useful,IN ! but WITHOUT ANY WARRANTY; without even the implied warranty ofIN - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.IN !IN ! You should have received a copy of the GNU General Public LicenseIN ! and the GNU Lesser General Public License along with PPM. If not,IN ! see <http://www.gnu.org/licenses/>.IN !IN ! Parallel Particle Mesh Library (PPM)IN ! ETH ZurichIN - CH-8092 Zurich, SwitzerlandIN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999II#if __DIM == __SFIELDI#if __KIND == __SINGLE_PRECISION SUBROUTINE p map field_pop_3d_sca_s(target_topoid,target_meshid,fdata, &INUUUU& ghostsize,info,mask,poptype)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map field_pop_3d_sca_d(target_topoid,target_meshid,fdata, &INUUUU& ghostsize,info,mask,poptype)I#elif __KIND == __SINGLE_PRECISION_COMPLEX SUBROUTINE p map field_pop_3d_sca_sc(target_topoid,target_meshid,fdata,&INUUUU& ghostsize,info,mask,poptype)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX SUBROUTINE p map field_pop_3d_sca_dc(target_topoid,target_meshid,fdata,&INUUUU& ghostsize,info,mask,poptype)I#elif __KIND == __INTEGER SUBROUTINE p map field_pop_3d_sca_i(target_topoid,target_meshid,fdata, &INUUUU& ghostsize,info,mask,poptype)I#elif __KIND == __LOGICAL SUBROUTINE p map field_pop_3d_sca_l(target_topoid,target_meshid,fdata, &INUUUU& ghostsize,info,mask,poptype)I#endifI#elif __DIM == __VFIELDI#if __KIND == __SINGLE_PRECISION SUBROUTINE p map field_pop_3d_vec_s(target_topoid,target_meshid,fdata, &INUUUU& lda,ghostsize,info,mask,poptype)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map field_pop_3d_vec_d(target_topoid,target_meshid,fdata, &INUUUU& lda,ghostsize,info,mask,poptype)I#elif __KIND == __SINGLE_PRECISION_COMPLEX SUBROUTINE p map field_pop_3d_vec_sc(target_topoid,target_meshid,fdata,&INUUUU& lda,ghostsize,info,mask,poptype)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX SUBROUTINE p map field_pop_3d_vec_dc(target_topoid,target_meshid,fdata,&INUUUU& lda,ghostsize,info,mask,poptype)I#elif __KIND == __INTEGER SUBROUTINE p map field_pop_3d_vec_i(target_topoid,target_meshid,fdata, &INUUUU& lda,ghostsize,info,mask,poptype)I#elif __KIND == __LOGICAL SUBROUTINE p map field_pop_3d_vec_l(target_topoid,target_meshid,fdata, &INUUUU& lda,ghostsize,info,mask,poptype)I#endifI#endifI !!! This routine pops the list buffer for 3D mesh dataI !!!I !!! [NOTE]I !!! The on-processor data is in the first part of the buffer -!! Reallocates the fdata array if needed. The user does not need -!! to care about its size. If we want to change this to improveI -!! callability from C, argument checks should be added for theI !!! SIZE of fdata. If the call to invert_list is too slow here, thisI -!! could be done by topo_store and stored for each topology.I -!! At the expense of some extra memory.I !!!I !!! [WARNING]I !!! DIM is the dimension of the fdata array and not the spaceI !!! dimemsion p dim!I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Includes ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999II !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Modules ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I USE p module_dataI USE p module_data_meshI USE p module_typedefI USE p module_substartI USE p module_substopI USE p module_error N USE p module_alloc N USE p module_write N USE p module_check_idIN USE p module_util_invert_listIN IMPLICIT NONE #if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEX INTEGER, PARAMETER :: MK = p kind_singleI#elseIN INTEGER, PARAMETER :: MK = p kind_doubleI#endifI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Arguments ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I#if __DIM == __SFIELDI#if __KIND == __INTEGER INTEGER , DIMENSION(:,:,:,:) , POINTER :: fdataI#elif __KIND == __LOGICAL LOGICAL , DIMENSION(:,:,:,:) , POINTER :: fdataI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX COMPLEX(MK), DIMENSION(:,:,:,:), POINTER :: fdataI#elseIN REAL(MK), DIMENSION(:,:,:,:) , POINTER :: fdataI#endifI#elif __DIM == __VFIELDI#if __KIND == __INTEGER INTEGER , DIMENSION(:,:,:,:,:) , POINTER :: fdataI#elif __KIND == __LOGICAL LOGICAL , DIMENSION(:,:,:,:,:) , POINTER :: fdataI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX COMPLEX(MK), DIMENSION(:,:,:,:,:), POINTER :: fdataI#elseIN REAL(MK), DIMENSION(:,:,:,:,:) , POINTER :: fdataI#endifI#endifI !!! Field data.I !!!I !!! 1st index: lda +I !!! 2nd-4th index: mesh (i,j,k) relative to istart-1 of the sub I !!! (i.e. (i,j,k)=(1,1,1) corresponds to istart) +I !!! 5th: isub 1...nsublist (all subs on this processor).I !!!I !!! For scalar fields, the first index is omitted (the others shiftI !!! accordingly).I LOGICAL, DIMENSION(:,:,:,:), POINTER, OPTIONAL :: maskI !!! Logical mask.I !!!I !!! Only the mesh nodes for which this is .TRUE. will beI !!! mapped. If not given, all points are mapped.I !!!I !!! 1st-3nd index: mesh (i,j,k) +I !!! 4rd: isub. INTEGER , OPTIONAL :: poptypeI#if __DIM == __VFIELDI INTEGER , INTENT(IN ) :: ldaI !!! The leading dimension of the fdata.I -!! lda=1 for the case of scalar dataI#endifI INTEGER , INTENT(IN ) :: target_meshidI -!! Mesh ID of destinationI INTEGER , INTENT(IN ) :: target_topoidIN !!! Topology ID of destinationI INTEGER, DIMENSION(:) , INTENT(IN ) :: ghostsize !!! Number of mesh points in the ghost layer in each dimensionI INTEGER , INTENT( OUT) :: info -!! Return status, 0 on successI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Local variables ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I INTEGER, DIMENSION(3) :: mofsI INTEGER, DIMENSION(5) :: ldu,ldlI INTEGER :: i,j,k,ibuffer,Mdata,imesh,jmesh,kmesh,isubI INTEGER :: iopt,xhi,yhi,zhi,xlo,ylo,zlo,bdim,jsubI INTEGER :: btype,edim,idom REAL(MK) :: t0 LOGICAL :: ldoI INTEGER :: rtypeI CHARACTER(LEN=p char) :: mesgI#if __DIM == __SFIELDI INTEGER, PARAMETER :: lda = 1I#endifI TYPE(p t_equi_mesh), POINTER :: target_mesh => NULL()I TYPE(p t_topo), POINTER :: target_topo => NULL()II !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Externals ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999II !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! InitialiseIN !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I CALL substart('p map field_pop_3d',t0,info)III !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Check arguments ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999 ENDIF N ! warn if buffer is emptyI IF (p buffer_set .LT. 1) THEN info = p error noticeI IF (p debug .GT. 1) THEN CALL p error(p err buffer_empt,'p map field_pop', &INUUUU& 'Buffer is empty: skipping pop!',__LINE__,info)IN ENDIFI GOTO 9999 ENDIF I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! set the local pointers to the topology and meshI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I target_topo => p topo(target_topoid)%tI target_mesh => target_topo%mesh(target_meshid)II IF (p debug .GT. 0) THEN CALL check_twoI IF (info .NE. 0) GOTO 9999 ENDIF !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Check what kind of pop is needed (replace or add) ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I IF (p map type .EQ. p param_map init) THEN info = p error error N CALL p error(p err argument,'p map field_pop_3d', &IN & 'map field_pop cannot be called after ghost_init',__LINE__,info)IN CALL p error(p err argument,'p map field_pop_3d', &IN & 'ghost_init must not be called directly by the user',__LINE__,info)IN GOTO 9999 ELSE IF (PRESENT(poptype)) THEN rtype = poptypeI ELSE IF (p map type .EQ. p param_map ghost_put) THEN rtype = p param_pop_add ELSE rtype = p param_pop_replace ENDIFI ENDIFI ENDIF N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Check that the required dimension fits the dimension of the buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN bdim = p buffer_dim(p buffer_set)I#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ! for complex the effective dimension is half the data dimensionI edim = bdim/2I#elseIN edim = bdimI#endifI IF (p debug .GT. 1) THEN WRITE(mesg,'(2(A,I3))') 'bdim=',edim,' lda=',ldaI CALL p write(p rank,'p map field_pop_3d',mesg,info)I ENDIF #if __DIM == __VFIELDI IF (edim.NE.lda) THEN info = p error error N CALL p error(p err wrong_dim,'p map field_pop_3d', &IN & 'leading dimension LDA is in error',__LINE__,info)IN GOTO 9999 ENDIF #elif __DIM == __SFIELDI IF (edim.NE.1) THEN info = p error error N CALL p error(p err wrong_dim,'p map field_pop_3d', &IN & 'buffer does not contain 1d data!',__LINE__,info)IN GOTO 9999 ENDIF #endifI N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Check that the required type is identical to the type of the buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN btype = p buffer_type(p buffer_set)I#if __KIND == __SINGLE_PRECISION IF (btype.NE.p kind_single) THEN info = p error error N CALL p error(p err wrong_prec,'p map field_pop_3d', &IN & 'trying to pop a non-single into single ',__LINE__,info)IN GOTO 9999 ENDIF #elif __KIND == __DOUBLE_PRECISION IF (btype.NE.p kind_double) THEN info = p error error N CALL p error(p err wrong_prec,'p map field_pop_3d', &IN & 'trying to pop a non-double into double ',__LINE__,info)IN GOTO 9999 ENDIF #elif __KIND == __SINGLE_PRECISION_COMPLEX IF (btype.NE.p kind_single) THEN info = p error error N CALL p error(p err wrong_prec,'p map field_pop_3d', &IN & 'trying to pop a non-single-complex into single-complex',&INUUUU& __LINE__,info)IN GOTO 9999 ENDIF #elif __KIND == __DOUBLE_PRECISION_COMPLEX IF (btype.NE.p kind_double) THEN info = p error error N CALL p error(p err wrong_prec,'p map field_pop_3d', &IN & 'trying to pop a non-double-complex into double-complex',&INUUUU& __LINE__,info)IN GOTO 9999 ENDIF #elif __KIND == __INTEGER IF (btype.NE.p integer) THEN info = p error error N CALL p error(p err wrong_prec,'p map field_pop_3d', &IN & 'trying to pop a non-integer into integer ',__LINE__,info)IN GOTO 9999 ENDIF #elif __KIND == __LOGICAL IF (btype.NE.p logical) THEN info = p error error N CALL p error(p err wrong_prec,'p map field_pop_3d', &IN & 'trying to pop a non-logical into logical ',__LINE__,info)I ENDIF #endifI N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Determine size of field data array needed N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I xhi = 0 yhi = 0 zhi = 0 DO i=1,target_topo%nsublistI idom = target_topo%isublist(i)I IF (target_mesh%nnodes(1,idom).GT.xhi) THEN xhi = target_mesh%nnodes(1,idom)I ENDIFI IF (target_mesh%nnodes(2,idom).GT.yhi) THEN yhi = target_mesh%nnodes(2,idom)I ENDIFI IF (target_mesh%nnodes(3,idom).GT.zhi) THEN zhi = target_mesh%nnodes(3,idom)I ENDIFI ENDDOI N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Reallocate array if needed ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I IF ((p map type .EQ. p param_map ghost_get) .OR. &IN & (p map type .EQ. p param_map ghost_put) .OR. &IN & (rtype .EQ. p param_pop_add)) THEN ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99 - Preserve old fields if this is to receive ghosts or to add - contributions ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99 iopt = p param_alloc_fit_preserveI ELSE iopt = p param_alloc_fitI ENDIF #if __DIM == __VFIELDI ldu(1) = edimI ldu(2) = xhi+ghostsize(1)I ldu(3) = yhi+ghostsize(2)I ldu(4) = zhi+ghostsize(3)I ldu(5) = target_topo%nsublistI ldl(1) = 1I ldl(2) = 1-ghostsize(1)I ldl(3) = 1-ghostsize(2)I ldl(4) = 1-ghostsize(3)I ldl(5) = 1I#elif __DIM == __SFIELDI ldu(1) = xhi+ghostsize(1)I ldu(2) = yhi+ghostsize(2)I ldu(3) = zhi+ghostsize(3)I ldu(4) = target_topo%nsublistI ldl(1) = 1-ghostsize(1)I ldl(2) = 1-ghostsize(2)I ldl(3) = 1-ghostsize(3)I ldl(4) = 1I#endifI CALL p alloc(fdata,ldl,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field_pop_3d', &IN & 'new data FDATA',__LINE__,info)IN GOTO 9999 ENDIF N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 - Build the inverse sub list to find local sub indeices based on - global ones (the global ones are communicated) ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I iopt = p param_alloc_fitI ldu(1) = target_topo%nsublistI CALL p alloc(sublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field_pop_3d', &IN & 'temporary sub list SUBLIST',__LINE__,info)IN GOTO 9999 ENDIF ! We need to copy it into a temp list, since directly using ! p isublist(:,p field_topoid) as an argument to invert_list is ! not possible since the argument needs to be a POINTER.I sublist(1:target_topo%nsublist) = &INUUUU& target_topo%isublist(1:target_topo%nsublist)I CALL p util_invert_list(sublist,invsublist,info)IN iopt = p param_dealloc CALL p alloc(sublist,ldu,iopt,info)IN IF (info .NE. 0) THEN info = p error error N CALL p error(p err dealloc,'p map field_pop_3d', &IN & 'temporary sub list SUBLIST',__LINE__,info)IN ENDIF N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 - Determine the number of data points to be received N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 Mdata = 0 ! IF (PRESENT(mask)) THEN - DO i=1,p nrecvlistI - !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI - ! access mesh blocks belonging to the i-th processor in theI - ! recvlistI - !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI - DO j=p precvbuffer(i),p precvbuffer(i+1)-1I - !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - ! Determine mesh range in local sub coordinatesI - !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - jsub = p mesh_irecvtosub(j)I - isub = invsublist(jsub)I - mofs(1) = p_mesh%istart(1,jsub)-1I - mofs(2) = p_mesh%istart(2,jsub)-1I - mofs(3) = p_mesh%istart(3,jsub)-1I - xlo = p mesh_irecvblkstart(1,j)-mofs(1)I - ylo = p mesh_irecvblkstart(2,j)-mofs(2)I - zlo = p mesh_irecvblkstart(3,j)-mofs(3)I - xhi = xlo+p mesh_irecvblksize(1,j)-1I - yhi = ylo+p mesh_irecvblksize(2,j)-1I - zhi = zlo+p mesh_irecvblksize(3,j)-1I - !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - ! Count points for which mask is trueI - !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I - DO kmesh=zlo,zhiI - DO jmesh=ylo,yhiI - DO imesh=xlo,xhiI - IF (mask(1,imesh,jmesh,kmesh,isub)) Mdata = Mdata + 1I - ENDDOI - ENDDOI - ENDDOI - ENDDOI - ENDDOI - ELSE DO i=1,p nrecvlistI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! access mesh blocks belonging to the i-th processor in theI ! recvlistI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI DO j=p precvbuffer(i),p precvbuffer(i+1)-1I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the number of mesh points in this blockI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I Mdata = Mdata + (p mesh_irecvblksize(1,j)* &INUUUU& p mesh_irecvblksize(2,j)*p mesh_irecvblksize(3,j))IN ENDDOI ENDDOI - ENDIF N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 - If there is nothing to be sent we are done ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I IF (Mdata .EQ. 0) THEN IF (p debug .GT. 0) THEN CALL p write(p rank,'p map field_pop_3d', &INUUUU& 'There is no data to be received',info)IN ENDIFI GOTO 9999 ENDIF N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 - Decrement the pointer into the receive buffer ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999IN IF (p debug .GT. 1) THEN WRITE(mesg,'(2(A,I9))') 'p nrecvbuffer = ',p nrecvbuffer, &INUUUU& 'Mdata*bdim = ',Mdata*bdim N CALL p write(p rank,'p map field_pop_3d',mesg,info)I ENDIF p nrecvbuffer = p nrecvbuffer - Mdata*bdim IN ibuffer = p nrecvbufferIN IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'ibuffer = ',ibufferIN CALL p write(p rank,'p map field_pop_3d',mesg,info)I ENDIF N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 - Decrement the pointer into the send buffer to allow reuse by - multiple sequential push-send-pop cycles. N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 Mdata = 0 DO i=1,p nsendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN ! access mesh blocks belonging to the i-th processor in theI ! sendlist ----------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999IN DO j=p psendbuffer(i),p psendbuffer(i+1)-1I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! Get the number of mesh points in this blockI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI Mdata = Mdata + (p mesh_isendblksize(1,j)* &INUUUU& p mesh_isendblksize(2,j)*p mesh_isendblksize(3,j))IN ENDDOI ENDDOI p nsendbuffer = p nsendbuffer - p buffer_dim(p buffer_set)*Mdata N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 - Debug output N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 IF (p debug .GT. 0) THEN IF (rtype .EQ. p param_pop_replace) THEN CALL p write(p rank,'p map field_pop_3d', &INUUUU& 'Replacing current field values',info)IN ELSEIF(rtype .EQ. p param_pop_add) THEN CALL p write(p rank,'p map field_pop_3d', &INUUUU& 'Adding to current field values',info)IN ENDIFI ENDIF N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! Loop over the received mesh blocks N !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh999999I ! DOUBLE PRECISION !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lh99lh99 IF (p kind .EQ. p kind_double) THEN DO i=1,p nrecvlistI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! Access mesh blocks belonging to the i-th processor in theI ! recvlistI !---------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI DO j=p precvbuffer(i),p precvbuffer(i+1)-1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! Get the sub ID for this mesh blockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI jsub = p mesh_irecvtosub(j)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! Translate to local sub ID for storing the dataI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI isub = invsublist(jsub)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! Mesh offset for this subI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI mofs(1) = target_mesh%istart(1,jsub)-1I mofs(2) = target_mesh%istart(2,jsub)-1I mofs(3) = target_mesh%istart(3,jsub)-1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! Get boundaries of mesh block to be received in local subI ! coordinatesI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI xlo = p mesh_irecvblkstart(1,j)-mofs(1)I ylo = p mesh_irecvblkstart(2,j)-mofs(2)I zlo = p mesh_irecvblkstart(3,j)-mofs(3)I xhi = xlo+p mesh_irecvblksize(1,j)-1I yhi = ylo+p mesh_irecvblksize(2,j)-1I zhi = zlo+p mesh_irecvblksize(3,j)-1I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,3I4)') 'start: ', &INUUUU& p mesh_irecvblkstart(1,j), &INUUUU& p mesh_irecvblkstart(2,j),p mesh_irecvblkstart(3,j) CALL p write(p rank,'p map field_pop_3d',mesg,info)I WRITE(mesg,'(A,3I4)') 'size: ', &INUUUU& p mesh_irecvblksize(1,j), &INUUUU& p mesh_irecvblksize(2,j),p mesh_irecvblksize(3,j) CALL p write(p rank,'p map field_pop_3d',mesg,info)I WRITE(mesg,'(A,3I4)') 'mesh offset: ',mofs(1),mofs(2),mofs(3)I CALL p write(p rank,'p map field_pop_3d',mesg,info)I WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiI CALL p write(p rank,'p map field_pop_3d',mesg,info)I WRITE(mesg,'(A,2I4)') 'ylo, yhi: ',ylo,yhiI CALL p write(p rank,'p map field_pop_3d',mesg,info)I WRITE(mesg,'(A,2I4)') 'zlo, zhi: ',zlo,zhiI CALL p write(p rank,'p map field_pop_3d',mesg,info)I WRITE(mesg,'(A,I1)') 'buffer dim: ',edim N CALL p write(p rank,'p map field_pop_3d',mesg,info)I#if __DIM == __VFIELDI WRITE(mesg,'(A,3I4)') 'SIZE(fdata): ',SIZE(fdata,2), &INUUUU& SIZE(fdata,3),SIZE(fdata,4)I CALL p write(p rank,'p map field_pop_3d',mesg,info)I#elif __DIM == __SFIELDI WRITE(mesg,'(A,3I4)') 'SIZE(fdata): ',SIZE(fdata,1), &INUUUU& SIZE(fdata,2),SIZE(fdata,3)I CALL p write(p rank,'p map field_pop_3d',mesg,info)I#endifI ENDIF #if __DIM == __VFIELDI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI ! Without mask: This will vectorize !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999�lhI IF (.NOT.PRESENT(mask)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (edim .EQ. 1) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 2) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=3I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 3) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(2,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(3,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(3,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=4I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 4) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(2,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(3,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(3,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(4,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(4,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=5I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 5) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(2,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(3,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(3,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(4,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(4,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(5,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(5,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) N ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(5,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(5,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! For edim.GT.5 the vector length will be edim !!I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSE IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(k,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(k,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDDOI ENDIF ! rtype ENDIF ! lda = ... !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! With mask: This will not vectorize so no need to unroll !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ELSE DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI IF (mask(imesh,jmesh,kmesh,isub)) THEN DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifIN IF (rtype .EQ. p param_pop_replace) THEN #if __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(k,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(k,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ELSEIF (rtype .EQ. p param_pop_add) THEN #if __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub).AND. &INUUUU& .TRUE.)I ELSE fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub).AND. &INUUUU& .FALSE.)I ENDIF #endifI ENDIF ENDDOI ELSE !------------------------ginys,max,phys,mis,t�lEmax,t ! If ldo.EQ..FALSE. skip this point !------------------------ginys,max,phys,mis,t�lEmax,t #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + (edim*2)I#elseIN ibuffer = ibuffer + edimI#endifI ENDIF ! mask.EQ..TRUE. ENDDOI ENDDOI ENDDOI ENDIF ! PRESENT(mask)I#elif __DIM == __SFIELDI IF (.NOT.PRESENT(mask)) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIF ELSE ! PRESENT(mask)I DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI IF (mask(imesh,jmesh,kmesh,isub)) THEN #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifIN IF (rtype .EQ. p param_pop_replace) THEN #if __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ELSEIF (rtype .EQ. p param_pop_add) THEN #if __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& REAL(p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& p recvbufferd(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1),&INUUUU& p recvbufferd(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& CMPLX(p recvbufferd(ibuffer-1),&INUUUU& p recvbufferd(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub)+ &INUUUU& INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDIF ELSE !------------------------ginys,max,phys,mis,t�lEmax,t ! If ldo.EQ..FALSE. skip this point !------------------------ginys,max,phys,mis,t�lEmax,t #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifIN ENDIF ! mask.EQ..TRUE. ENDDOI ENDDOI ENDDOI ENDIF ! PRESENT(mask)I#endifIN ENDDO ! p precvbuffer ENDDO ! p nrecvlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! SINGLE PRECISION !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ELSE DO i=1,p nrecvlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l ! Access mesh blocks belonging to the i-th processor in the ! recvlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l DO j=p precvbuffer(i),p precvbuffer(i+1)-1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Get the sub ID for this mesh blockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 jsub = p mesh_irecvtosub(j)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Translate to local sub ID for storing the dataI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 isub = invsublist(jsub)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Mesh offset for this subI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 mofs(1) = target mesh%istart(1,jsub)-1I mofs(2) = target mesh%istart(2,jsub)-1I mofs(3) = target mesh%istart(3,jsub)-1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Get boundaries of mesh block to be received in local sub ! coordinatesI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 xlo = p mesh_irecvblkstart(1,j)-mofs(1) ylo = p mesh_irecvblkstart(2,j)-mofs(2) zlo = p mesh_irecvblkstart(3,j)-mofs(3) xhi = xlo+p mesh_irecvblksize(1,j)-1I yhi = ylo+p mesh_irecvblksize(2,j)-1I zhi = zlo+p mesh_irecvblksize(3,j)-1I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,3I4)') 'start: ', &INUUUU& p mesh_irecvblkstart(1,j), &INUUUU& p mesh_irecvblkstart(2,j),p mesh_irecvblkstart(3,j) CALL p write(p rank,'p map_field_pop_3d',mesg,info) WRITE(mesg,'(A,3I4)') 'size: ', &INUUUU& p mesh_irecvblksize(1,j), &INUUUU& p mesh_irecvblksize(2,j),p mesh_irecvblksize(3,j) CALL p write(p rank,'p map_field_pop_3d',mesg,info) WRITE(mesg,'(A,3I4)') 'mesh offset: ',mofs(1),mofs(2),mofs(3) CALL p write(p rank,'p map_field_pop_3d',mesg,info) WRITE(mesg,'(A,2I4)') 'xlo, xhi: ',xlo,xhiI CALL p write(p rank,'p map_field_pop_3d',mesg,info) WRITE(mesg,'(A,2I4)') 'ylo, yhi: ',ylo,yhiI CALL p write(p rank,'p map_field_pop_3d',mesg,info) WRITE(mesg,'(A,2I4)') 'zlo, zhi: ',zlo,zhiI CALL p write(p rank,'p map_field_pop_3d',mesg,info) WRITE(mesg,'(A,I1)') 'buffer dim: ',edimI CALL p write(p rank,'p map_field_pop_3d',mesg,info) #if __DIM == __VFIELDI WRITE(mesg,'(A,3I4)') 'SIZE(fdata): ',SIZE(fdata,2), &INUUUU& SIZE(fdata,3),SIZE(fdata,4) CALL p write(p rank,'p map_field_pop_3d',mesg,info) #elif __DIM == __SFIELDI WRITE(mesg,'(A,3I4)') 'SIZE(fdata): ',SIZE(fdata,1), &INUUUU& SIZE(fdata,2),SIZE(fdata,3) CALL p write(p rank,'p map_field_pop_3d',mesg,info) #endifIN ENDIF #if __DIM == __VFIELDI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Without mask: This will vectorizeI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 IF (.NOT.PRESENT(mask)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 IF (edim .EQ. 1) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 2) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=3I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 3) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(3,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(3,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=4I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 4) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(3,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(3,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(4,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(4,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for edim=5I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSEIF (edim .EQ. 5) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(1,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(2,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(3,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(3,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(4,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(4,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(5,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(5,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) N ibuffer = ibuffer + 2I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(1,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(2,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(3,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(4,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(5,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(1,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(1,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(2,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(2,imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(3,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(3,imesh,jmesh,kmesh,isub).AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub).AND..TRUE.)I ELSE fdata(4,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(4,imesh,jmesh,kmesh,isub).AND..FALSE.)I ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(5,imesh,jmesh,kmesh,isub).AND..TRUE.)I ELSE fdata(5,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(5,imesh,jmesh,kmesh,isub).AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! For edim.GT.5 the vector length will be edim !!I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ELSE IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(k,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(k,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub).AND.&INUUUU& .TRUE.)I ELSE fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub).AND.&INUUUU& .FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDDOI ENDIF ! rtype ENDIF ! lda = ... !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! With mask: This will not vectorize so no need to unroll !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ELSE DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI IF (mask(imesh,jmesh,kmesh,isub)) THEN DO k=1,edimI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifIN IF (rtype .EQ. p param_pop_replace) THEN #if __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(k,imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(k,imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ELSEIF (rtype .EQ. p param_pop_add) THEN #if __KIND == __DOUBLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& fdata(k,imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub).AND.&INUUUU& .TRUE.)I ELSE fdata(k,imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(k,imesh,jmesh,kmesh,isub).AND.&INUUUU& .FALSE.)I ENDIF #endifI ENDIF ENDDOI ELSE !------------------------ginys,max,phys,mis,t�lEmax,t ! If ldo.EQ..FALSE. skip this point !------------------------ginys,max,phys,mis,t�lEmax,t #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + (edim*2)I#elseIN ibuffer = ibuffer + edimI#endifI ENDIF ! mask.EQ..TRUE. ENDDOI ENDDOI ENDDOI ENDIF ! PRESENT(mask)I#elif __DIM == __SFIELDI IF (.NOT.PRESENT(mask)) THEN IF (rtype .EQ. p param_pop_replace) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ENDDOI ENDDOI ENDDOI ELSEIF (rtype .EQ. p param_pop_add) THEN DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI#if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifI#if __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub) .AND..TRUE.)I ELSE fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub) .AND..FALSE.)I ENDIF #endifI ENDDOI ENDDOI ENDDOI ENDIF ELSE ! IF PRESENT(mask)I DO kmesh=zlo,zhiI DO jmesh=ylo,yhiI DO imesh=xlo,xhiI IF (mask(imesh,jmesh,kmesh,isub)) THEN #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifIN IF (rtype .EQ. p param_pop_replace) THEN #if __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(imesh,jmesh,kmesh,isub) = .TRUE. ELSE fdata(imesh,jmesh,kmesh,isub) = .FALSE. ENDIF #endifI ELSEIF (rtype .EQ. p param_pop_add) THEN #if __KIND == __DOUBLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& REAL(p recvbuffers(ibuffer),p kind_double) #elif __KIND == __SINGLE_PRECISION fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& p recvbuffers(ibuffer) #elif __KIND == __SINGLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single) #elif __KIND == __DOUBLE_PRECISION_COMPLEX fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double) #elif __KIND == __INTEGER fdata(imesh,jmesh,kmesh,isub) = &INUUUU& fdata(imesh,jmesh,kmesh,isub) + &INUUUU& INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub).AND..TRUE.)I ELSE fdata(imesh,jmesh,kmesh,isub) = &INUUUU& (fdata(imesh,jmesh,kmesh,isub).AND..FALSE.)I ENDIF #endifI ENDIF ELSE !------------------------ginys,max,phys,mis,t�lEmax,t ! If ldo.EQ..FALSE. skip this point !------------------------ginys,max,phys,mis,t�lEmax,t #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseIN ibuffer = ibuffer + 1I#endifIN ENDIF ! mask.EQ..TRUE. ENDDOI ENDDOI ENDDOI ENDIF ! PRESENT(mask)I#endifIN ENDDO ! p precvbuffer ENDDO ! p nrecvlist ENDIF ! p kind !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Decrement the set counter !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = p buffer_set - 1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate the receive buffer if all sets have been poped !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p buffer_set .LT. 1) THEN iopt = p param_dealloc IF (p kind .EQ. p kind_single) THEN CALL p alloc(p recvbuffers,ldu,iopt,info)I ELSE CALL p alloc(p recvbufferd,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error error CALL p error(p err alloc,'p map_field_pop_3d', &INUUUU& 'receive buffer PPM_RECVBUFFER',__LINE__,info)I ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate inverse sub list !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(invsublist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_pop_3d', &INUUUU& 'inverse sub list INVSUBLIST',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_field_pop_3d',t0,info)I RETURN CONTAINS SUBROUTINE check CALL p check_meshid(target_topoid,target_meshid,ldo,info)I IF (p buffer_set .LT. 1) THEN CALL p write(p rank,'p map_field_pop_3d', &INUUUU& 'No field data to pop',info)I info = 0I GOTO 8888I ENDIF IF (.NOT. ldo) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'destination meshid out of range',__LINE__,info)I GOTO 8888I ENDIF #if __DIM == __VFIELDI IF (lda .LT. 1) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'lda must be >0 for vector data',__LINE__,info)I GOTO 8888I ENDIF #elif __DIM == __SFIELDI IF (lda .NE. 1) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'lda must be =1 for scalar data',__LINE__,info)I GOTO 8888I ENDIF #endifIN IF (SIZE(ghostsize,1) .LT. 3) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'ghostsize must be given for all dimensions',__LINE__,info)I GOTO 8888I ENDIF N IF ((ghostsize(1) .LT. 0) .OR. (ghostsize(2) .LT. 0) .OR. &INUUUU& (ghostsize(3) .LT. 0)) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'ghostsize must be >=0 in all dimensions',__LINE__,info)I GOTO 8888I ENDIF N IF (PRESENT(poptype)) THEN IF ((poptype .NE. p param_pop_replace) .AND.NUUUU&INUUUU& (poptype .NE. p param_pop_add)) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'Unknown pop type specified',__LINE__,info)I GOTO 8888I ENDIF N ENDIF N8888 CONTINUE END SUBROUTINE check SUBROUTINE check_two N IF (PRESENT(mask)) THEN xhi = 0I yhi = 0I zhi = 0I DO i=1,target_topo%nsublist isub = target_topo%isublist(i)I IF (target_mesh%nnodes(1,isub).GT.xhi) THEN xhi = target_mesh%nnodes(1,isub)I ENDIF IF (target_mesh%nnodes(2,isub).GT.yhi) THEN yhi = target_mesh%nnodes(2,isub)I ENDIF IF (target_mesh%nnodes(3,isub).GT.zhi) THEN zhi = target_mesh%nnodes(3,isub)I ENDIF ENDDOI IF (SIZE(mask,1) .LT. xhi) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'x dimension of mask does not match mesh',__LINE__,info)I GOTO 7777I ENDIF N IF (SIZE(mask,2) .LT. yhi) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'y dimension of mask does not match mesh',__LINE__,info)I GOTO 7777I ENDIF N IF (SIZE(mask,3) .LT. zhi) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'z dimension of mask does not match mesh',__LINE__,info)I GOTO 7777I ENDIF N IF (SIZE(mask,4) .LT. target_topo%nsublist) THEN info = p error error CALL p error(p err argument,'p map_field_pop_3d', &INUUUU& 'mask data for some subs is missing',__LINE__,info)I GOTO 7777I ENDIF N ENDIF N7777 CONTINUE END SUBROUTINE check_two #if __DIM == __SFIELDI#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map_field_pop_3d_sca_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map_field_pop_3d_sca_d #elif __KIND == __SINGLE_PRECISION_COMPLEX END SUBROUTINE p map_field_pop_3d_sca_sc #elif __KIND == __DOUBLE_PRECISION_COMPLEX END SUBROUTINE p map_field_pop_3d_sca_dc #elif __KIND == __INTEGER END SUBROUTINE p map_field_pop_3d_sca_iI#elif __KIND == __LOGICAL END SUBROUTINE p map_field_pop_3d_sca_l #endifII#elif __DIM == __VFIELDI#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map_field_pop_3d_vec_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map_field_pop_3d_vec_d #elif __KIND == __SINGLE_PRECISION_COMPLEX END SUBROUTINE p map_field_pop_3d_vec_sc #elif __KIND == __DOUBLE_PRECISION_COMPLEX END SUBROUTINE p map_field_pop_3d_vec_dc #elif __KIND == __INTEGER END SUBROUTINE p map_field_pop_3d_vec_iI#elif __KIND == __LOGICAL END SUBROUTINE p map_field_pop_3d_vec_l #endifI#endifI��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_init.f�����������������������������������������������������������0000644�0001752�0001753�00000115474�11616003524�020523� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_field_init !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modifyI ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_field_init(topoid,target_topoid,meshid, &INUUUU& target_meshid,info)I !!! This routine must be called before the p map_field_globalstoredI !!! routine.I !!!I !!! [WARNING]I !!! This routine has not been tested, reviewed, or checked. CommentsI !!! and documentation are wrong. This routine might kill your cat or !!! worse.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_mesh USE p module_typedef USE p module_substart USE p module_substop USE p module_error USE p module_alloc USE p module_write USE p module_check_id USE p module_mesh_block_intersect IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: topoidI !!! Topology ID of source !!!I !!! CAUTION: used to be target INTEGER , INTENT(IN ) :: target_topoidI !!! Topology ID of target INTEGER , INTENT(IN ) :: meshidI !!! Mesh ID of source INTEGER , INTENT(IN ) :: target_meshidI !!! Mesh ID of target INTEGER , INTENT( OUT) :: infoI !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER, DIMENSION(p dim) :: op INTEGER, DIMENSION(p dim,27) :: ond INTEGER, DIMENSION(p dim) :: iblockstart,nblocksize INTEGER, DIMENSION(p dim) :: ghostsize INTEGER :: i,j,k,idom,sendrank,recvrank INTEGER :: iopt,iset,ibuffer,pdim,nnd INTEGER :: nsendlist,nsend INTEGER :: nrecvlist CHARACTER(p char) :: mesg REAL(p kind_double) :: t0I LOGICAL :: lsouth,lnorth,least,lwest,ltop,lbottomI LOGICAL, DIMENSION(3) :: lsymmI LOGICAL :: validI TYPE(p t_topo), POINTER :: topo => NULL()I TYPE(p t_topo), POINTER :: target_topo => NULL()I TYPE(p t_equi_mesh), POINTER :: mesh => NULL()I TYPE(p t_equi_mesh), POINTER :: target_mesh => NULL()I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_field_init',t0,info)I pdim = p dimI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF topo => p topo(topoid)%t target_topo => p topo(target_topoid)%t mesh => topo%mesh(meshid) target_mesh => target_topo%mesh(meshid) IF (p buffer_set .GT. 0) THEN info = p error warning CALL p error(p err map_incomp,'p map_field_init', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Save the map type for the subsequent calls (used for checks!)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p param_map_globalI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if origin and target meshes are compatible (i.e. have theI ! same number of grid points in the whole comput. domain)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO i=1,pdim IF (mesh%Nm(i) .NE. target_mesh%Nm(i)) THEN info = p error error CALL p error(p err bad_mesh,'p map_field_init', &INUUUU& 'source and destination meshes are incompatible',__LINE__,info)I GOTO 9999 ENDIF ENDDOI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Pre-calculate shift offsets for periodic ghost images of subs !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t op(1) = mesh%Nm(1) - 1I op(2) = mesh%Nm(2) - 1I IF (pdim .GT. 2) THEN op(3) = mesh%Nm(3) - 1I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = topo%nsublist CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = topo%nsublist CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local send block offset list IOFFSET',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find intersecting mesh domains to be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nsendlist = 0I ghostsize = 0I DO i=1,topo%nsublist idom = topo%isublist(i)I ond(1:pdim,1:27) = 0I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! We now use symmetry. Only send up to ndata-1I ! unless we are at non-periodic, non-internal boundary.I ! Because we do this, we need to consider periodic images.I ! In periodic systems, the box needs to be shifted and overlapsI ! recomputed in order to get the periodic image neighbors.I ! Check if face of this sub coincides with a periodic domainI ! boundary.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI lsymm(1:pdim) = .TRUE. IF ((topo%bcdef(2) .NE. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(2,idom) .NE. 0)) lsymm(1) = .FALSE. IF ((topo%bcdef(4) .NE. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(4,idom) .NE. 0)) lsymm(2) = .FALSE. IF ((topo%bcdef(6) .NE. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(6,idom) .NE. 0)) lsymm(3) = .FALSE. I lwest = .FALSE. least = .FALSE. IF ((topo%bcdef(1) .EQ. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(1,idom) .NE. 0)) lwest = .TRUE. lsouth = .FALSE. lnorth = .FALSE. IF ((topo%bcdef(3) .EQ. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(3,idom) .NE. 0)) lsouth = .TRUE. IF (pdim .GT. 2) THEN lbottom= .FALSE. ltop = .FALSE. IF ((topo%bcdef(5) .EQ. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(5,idom) .NE. 0)) lbottom = .TRUE. ENDIF N I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Determine number of shifts and actual shift indices neededI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI nnd = 1 IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ENDIF N IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ENDIF N IF (lsouth) THEN nnd = nnd + 1 ond(2,nnd) = op(2)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = op(2)I ENDIF N IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = op(2)I ENDIF N ENDIF N IF (lnorth) THEN nnd = nnd + 1 ond(2,nnd) = -op(2)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = -op(2)I ENDIF N IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = -op(2)I ENDIF N ENDIF N IF (pdim .GT. 2) THEN IF (lbottom) THEN nnd = nnd + 1 ond(3,nnd) = op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(3,nnd) = op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(3,nnd) = op(3)I ENDIF IF (lsouth) THEN nnd = nnd + 1 ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I ENDIF ENDIF IF (lnorth) THEN nnd = nnd + 1 ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I ENDIF ENDIF ENDIF N IF (ltop) THEN nnd = nnd + 1 ond(3,nnd) = -op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(3,nnd) = -op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(3,nnd) = -op(3)I ENDIF IF (lsouth) THEN nnd = nnd + 1 ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I ENDIF ENDIF IF (lnorth) THEN nnd = nnd + 1 ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I ENDIF ENDIF ENDIF N ENDIF N I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Do the shifting and compute mesh blocksI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI DO k=1,nnd DO j=1,target_topo%nsubs CALL p mesh_block_intersect(topoid,target_topoid,meshid,&INUUUU& target_meshid,idom,j,ond(1:pdim,k),ghostsize,nsendlist, &INUUUU& isendfromsub,isendtosub,isendblkstart,isendblksize, &INUUUU& ioffset,info,lsymm)I IF (info .NE. 0) GOTO 9999 ENDDOI ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = target_topo%nsublist CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = target_topo%nsublist CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find intersecting mesh domains to be receivedI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nrecvlist = 0I ! loop over fromtopo first and THEN over totopo in order to get theI ! same ordering of mesh blocks as in the sendlist. This is crutialI ! for the push and the pop to work properly !!!I DO j=1,topo%nsubs ond(1:pdim,1:27) = 0I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! We now use symmetry. Only send up to ndata-1I ! unless we are at non-periodic, non-internal boundary.I ! Because we do this, we need to consider periodic images.I ! In periodic systems, the box needs to be shifted and overlapsI ! recomputed in order to get the periodic image neighbors.I ! Check if face of this sub coincides with a periodic domainI ! boundary.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI lsymm(1:pdim) = .TRUE. IF ((topo%bcdef(2) .NE. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(2,j) .NE. 0)) lsymm(1) = .FALSE. IF ((topo%bcdef(4) .NE. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(4,j) .NE. 0)) lsymm(2) = .FALSE. IF ((topo%bcdef(6) .NE. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(6,j) .NE. 0)) lsymm(3) = .FALSE. I lwest = .FALSE. least = .FALSE. IF ((topo%bcdef(1) .EQ. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(1,j) .NE. 0)) lwest = .TRUE. lsouth = .FALSE. lnorth = .FALSE. IF ((topo%bcdef(3) .EQ. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(3,j) .NE. 0)) lsouth = .TRUE. IF (pdim .GT. 2) THEN lbottom= .FALSE. ltop = .FALSE. IF ((topo%bcdef(5) .EQ. p param_bcdef_periodic) .AND.N&INUUUU& (topo%subs_bc(5,j) .NE. 0)) lbottom = .TRUE. ENDIF N I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Determine number of shifts and actual shift indices neededI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI nnd = 1 IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ENDIF N IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ENDIF N IF (lsouth) THEN nnd = nnd + 1 ond(2,nnd) = op(2)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = op(2)I ENDIF N IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = op(2)I ENDIF N ENDIF N IF (lnorth) THEN nnd = nnd + 1 ond(2,nnd) = -op(2)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = -op(2)I ENDIF N IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = -op(2)I ENDIF N ENDIF N IF (pdim .GT. 2) THEN IF (lbottom) THEN nnd = nnd + 1 ond(3,nnd) = op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(3,nnd) = op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(3,nnd) = op(3)I ENDIF IF (lsouth) THEN nnd = nnd + 1 ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I ENDIF ENDIF IF (lnorth) THEN nnd = nnd + 1 ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I ENDIF ENDIF ENDIF N IF (ltop) THEN nnd = nnd + 1 ond(3,nnd) = -op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(3,nnd) = -op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(3,nnd) = -op(3)I ENDIF IF (lsouth) THEN nnd = nnd + 1 ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I ENDIF ENDIF IF (lnorth) THEN nnd = nnd + 1 ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I IF (lwest) THEN nnd = nnd + 1 ond(1,nnd) = op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I ENDIF IF (least) THEN nnd = nnd + 1 ond(1,nnd) = -op(1) ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I ENDIF ENDIF ENDIF N ENDIF N I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Do the shifting and compute mesh blocksI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI DO k=1,nnd DO i=1,target_topo%nsublist idom = target_topo%isublist(i)I CALL p mesh_block_intersect(topoid,target_topoid,meshid,&INUUUU& target_meshid,j,idom,ond(1:pdim,k),ghostsize,nrecvlist, &INUUUU& irecvfromsub,irecvtosub,irecvblkstart,irecvblksize, &INUUUU& ioffset,info,lsymm)I IF (info .NE. 0) GOTO 9999 ENDDOI ENDDO ENDDOIII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow_preserveI ldu(1) = nsendlist CALL p alloc(mesh%mapping%isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'source send sub list PPM_MESH_ISENDFROMSUB',__LINE__,info)I GOTO 9999 ENDIF I ldu(1) = pdim ldu(2) = nsendlist CALL p alloc(mesh%mapping%isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'send block start list PPM_MESH_ISENDBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(mesh%mapping%isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'send block size list PPM_MESH_ISENDBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow_preserveI ldu(1) = nrecvlist CALL p alloc(mesh%mapping%irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'destination recv sub list PPM_MESH_IRECVTOSUB',__LINE__,info)I GOTO 9999 ENDIF I ldu(1) = pdim ldu(2) = nrecvlist CALL p alloc(mesh%mapping%irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'recv block start list PPM_MESH_IRECVBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(mesh%mapping%irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'recv block size list PPM_MESH_IRECVBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global send/recv lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = p nproc CALL p alloc(mesh%mapping%isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'global send rank list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(mesh%mapping%irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'global recv rank list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nproc + 1 CALL p alloc(mesh%mapping%psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(mesh%mapping%precvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_init', &INUUUU& 'global recv buffer pointer PPM_PRECVBUFFER',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Reset the number of buffer entries !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = 0II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over all processors; First is the processor itselfI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t sendrank = p rank - 1I recvrank = p rank + 1 mesh%mapping%psendbuffer(1) = 1 mesh%mapping%precvbuffer(1) = 1 mesh%mapping%nsendlist = 0 mesh%mapping%nrecvlist = 0 iset = 0 ibuffer = 0 DO i=1,p nproc !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! compute the next processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma sendrank = sendrank + 1 IF (sendrank.GE.p nproc) sendrank = sendrank - p nproc recvrank = recvrank - 1 IF (recvrank.LT. 0) recvrank = recvrank + p nproc !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the processor to which we will send to !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma mesh%mapping%nsendlist = mesh%mapping%nsendlist + 1 mesh%mapping%isendlist(mesh%mapping%nsendlist) = sendrank !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the processor to which we will recv from !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma mesh%mapping%nrecvlist = mesh%mapping%nrecvlist + 1 mesh%mapping%irecvlist(mesh%mapping%nrecvlist) = recvrank I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Find all mesh blocks that are sent and store them. ! To get all mesh blocks that are sent in round ! i=1,p nsendlist: ! dest_rank = p isendlist(i)I ! ilo = p psendbuffer(i)I ! ihi = p psendbuffer(i+1)-1I ! DO j=ilo,ihiI ! SEND(p mesh_isendblk(:,j) of sub p mesh_isendfromsub(j) to ! processor dest_rank to sub p mesh_isendtosub(j))I ! ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ibuffer = mesh%mapping%nsendlist + 1 mesh%mapping%psendbuffer(ibuffer) = &INUUUU& mesh%mapping%psendbuffer(mesh%mapping%nsendlist) DO j=1,nsendlist IF (target_topo%sub2proc(isendtosub(j)) .EQ. sendrank) THEN mesh%mapping%psendbuffer(ibuffer) = &INUUUU& mesh%mapping%psendbuffer(ibuffer) + 1 iset = mesh%mapping%psendbuffer(ibuffer) - 1 mesh%mapping%isendfromsub(iset) = isendfromsub(j) mesh%mapping%isendblkstart(1:pdim,iset)=isendblkstart(1:pdim,j) mesh%mapping%isendblksize(1:pdim,iset) =isendblksize(1:pdim,j) IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:2,j),' of size ',isendblksize(1:2,j),&INUUUU& ' to ',sendrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:3,j),' of size ',isendblksize(1:3,j),&INUUUU& ' to ',sendrank ENDIF CALL p write(p rank,'p map_field_init',mesg,info)I ENDIF ENDIF ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Find all mesh blocks that are received and store them. ! To get all mesh blocks that are received in round ! i=1,p nrecvlist: ! source_rank = p irecvlist(i)I ! ilo = p precvbuffer(i)I ! ihi = p precvbuffer(i+1)-1I ! DO j=ilo,ihiI ! RECV(p mesh_irecvblk(:,j) of sub p mesh_irecvfromsub(j) ! from processor source_rank to sub p mesh_irecvtosub(j))I ! ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ibuffer = mesh%mapping%nrecvlist + 1 mesh%mapping%precvbuffer(ibuffer) = &INUUUU& mesh%mapping%precvbuffer(mesh%mapping%nrecvlist) DO j=1,nrecvlist IF (topo%sub2proc(irecvfromsub(j)) .EQ. recvrank) THEN mesh%mapping%precvbuffer(ibuffer) = &INUUUU& mesh%mapping%precvbuffer(ibuffer) + 1 iset = mesh%mapping%precvbuffer(ibuffer) - 1 mesh%mapping%irecvtosub(iset) = irecvtosub(j) mesh%mapping%irecvblkstart(1:pdim,iset) = &INUUUU& irecvblkstart(1:pdim,j) + ioffset(1:pdim,j) mesh%mapping%irecvblksize(1:pdim,iset) = irecvblksize(1:pdim,j) IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:2,j),' of size ',irecvblksize(1:2,j),&INUUUU& ' from ',recvrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:3,j),' of size ',irecvblksize(1:3,j),&INUUUU& ' from ',recvrank ENDIF CALL p write(p rank,'p map_field_init',mesg,info)I ENDIF ENDIF ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate memory of the local lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I ENDIF CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I ENDIF CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I ENDIF CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I ENDIF CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I ENDIF CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I ENDIF CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I ENDIF CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I ENDIF CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_init', &INUUUU& 'local recv block offset list IOFFSET',__LINE__,info)I ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_field_init',t0,info)I RETURN CONTAINS SUBROUTINE check CALL p check_topoid(topoid,ltop,info)I IF (.NOT. ltop) THEN info = p error error CALL p error(p err argument,'p map_field_ghost_init', &INUUUU& 'topoid out of range',__LINE__,info)I GOTO 8888I ENDIF CALL p check_meshid(topoid,meshid,ltop,info)I IF (.NOT. ltop) THEN info = p error error CALL p error(p err argument,'p map_field_ghost_init', &INUUUU& 'meshid out of range',__LINE__,info)I GOTO 8888I ENDIF CALL p check_topoid(target_topoid,ltop,info)I IF (.NOT. ltop) THEN info = p error error CALL p error(p err argument,'p map_field_ghost_init', &INUUUU& 'topoid out of range',__LINE__,info)I GOTO 8888I ENDIF CALL p check_meshid(target_topoid,target_meshid,ltop,info)I IF (.NOT. ltop) THEN info = p error error CALL p error(p err argument,'p map_field_ghost_init', &INUUUU& 'meshid out of range',__LINE__,info)I GOTO 8888I ENDIF IF (SIZE(ghostsize,1) .LT. p dim) THEN info = p error error CALL p error(p err argument,'p map_field_ghost_init', &INUUUU& 'ghostsize must be at least of length p dim',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE check END SUBROUTINE p map_field_init ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_send.f�����������������������������������������������������������0000644�0001752�0001753�00000070633�11616003524�020506� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_field_sendI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modifyI ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, SwitzerlandI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_field_send(info)I !!! This routine performs the actual send/recv of theI !!! mesh blocks and all pushed data.I !!!I !!! [NOTE]I !!! The first part of the buffer contains the on processor data.I !!!I !!! [NOTE]I !!! Using non-blocking communication (ISend,Irecv)I !!! could possibly speed-up this routine since only aI !!! Send/Recv/SendRecv is done where needed (we know aI !!! priori how much data we are going to receive).I !!! Skipped actions could then already loop to the nextI !!! item and would not have to wait for others.I !!!I !!! [TIP]I !!! If you want to only send certain meshnodes you have to first callI !!! p map_field_push for a logical mask, then call p map_field_popI !!! and recover the new mask. First 3 (2 for 2D meshes)I !!! indices are mesh (i,j[,k]), last one is subid for all subs onI !!! the local processor. I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_mesh USE p module_substart USE p module_substopI USE p module_error USE p module_alloc USE p module_writeI IMPLICIT NONEI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPII INCLUDE 'mpif.h' #endif I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT( OUT) :: infoI !!! Return status, 0 upon successI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER :: i,j,k,ibuffer,jbuffer,bdim,offs INTEGER :: iopt,tag1,Ndata,msend,mrecv,allsend,allrecv CHARACTER(p char) :: mesgI REAL(p kind_double) :: t0 #ifdef __MPII INTEGER, DIMENSION(MPI_STATUS_SIZE) :: commstat #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_field_send',t0,info)I I ! warn if buffer is emptyI IF (p buffer_set .LT. 1) THEN info = p error notice IF (p debug .GT. 1) THEN CALL p error(p err buffer_empt,'p map_field_send', &INUUUU& 'Buffer is empty: skipping send!',__LINE__,info)I ENDIF GOTO 9999 ENDIF II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! AllocateI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit I ldu(1) = p nsendlist CALL p alloc(nsend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'send counter NSEND',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(psend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'particle send counter PSEND',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nrecvlist CALL p alloc(nrecv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'receive counter NRECV',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(precv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'particle receive counter PRECV',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nrecvlist I ldu(2) = p buffer_set CALL p alloc(pp,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'work buffer PP',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nsendlist I ldu(2) = p buffer_set CALL p alloc(qq,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'work buffer QQ',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffer that will not be sendI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t Ndata = 0 IF (p dim .LT. 3) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! access mesh blocks belonging to the 1st processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI DO j=p psendbuffer(1),p psendbuffer(2)-1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I ! Get the number of mesh points in this blockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I Ndata = Ndata + (p mesh_isendblksize(1,j)* &INUUUU& p mesh_isendblksize(2,j))I ENDDOI ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! access mesh blocks belonging to the 1st processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI DO j=p psendbuffer(1),p psendbuffer(2)-1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I ! Get the number of mesh points in this blockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I Ndata = Ndata + (p mesh_isendblksize(1,j)* &INUUUU& p mesh_isendblksize(2,j)*p mesh_isendblksize(3,j))I ENDDOI ENDIF ibuffer = 0 DO j=1,p buffer_setI bdim = p buffer_dim(j) ibuffer = ibuffer + bdim*Ndata ENDDO I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialize the buffer counters !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nrecvbuffer = ibuffer nsend(1) = ibuffer nrecv(1) = ibuffer psend(1) = Ndata precv(1) = Ndata mrecv = -1I msend = -1II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffers that will be sentI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=2,p nsendlistI nsend(k) = 0I psend(k) = 0I Ndata = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Number of mesh points to be sent off to the k-th processor inI ! the sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI IF (p dim .LT. 3) THEN DO i=p psendbuffer(k),p psendbuffer(k+1)-1I Ndata = Ndata + (p mesh_isendblksize(1,i)* &INUUUU& p mesh_isendblksize(2,i))I ENDDOI ELSE DO i=p psendbuffer(k),p psendbuffer(k+1)-1I Ndata = Ndata + (p mesh_isendblksize(1,i)* &INUUUU& p mesh_isendblksize(2,i)*p mesh_isendblksize(3,i))I ENDDOI ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Store the number of mesh points in psendI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI psend(k) = Ndata I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Store the size of the data to be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI DO j=1,p buffer_setI nsend(k) = nsend(k) + (p buffer_dim(j)*Ndata)I ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Find the maximum buffer length (for the allocate)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI msend = MAX(msend,nsend(k))I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'msend = ',msend CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffers that will be received ! (For meshes we know this a priori. This is different from ! particles)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=2,p nrecvlist nrecv(k) = 0I precv(k) = 0I Ndata = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Number of mesh points to be received from the k-th processor inI ! the recvlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI IF (p dim .LT. 3) THEN DO i=p precvbuffer(k),p precvbuffer(k+1)-1I Ndata = Ndata + (p mesh_irecvblksize(1,i)* &INUUUU& p mesh_irecvblksize(2,i))I ENDDOI ELSE DO i=p precvbuffer(k),p precvbuffer(k+1)-1I Ndata = Ndata + (p mesh_irecvblksize(1,i)* &INUUUU& p mesh_irecvblksize(2,i)*p mesh_irecvblksize(3,i))I ENDDOI ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Store the number of mesh points in precv !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI precv(k) = Ndata I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Store the size of the data to be received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI DO j=1,p buffer_setI nrecv(k) = nrecv(k) + (p buffer_dim(j)*Ndata)I ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Find the maximum buffer length (for the allocate)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI mrecv = MAX(mrecv,nrecv(k))I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'mrecv = ',mrecv CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI ! Increment the total receive buffer count !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmI p nrecvbuffer = p nrecvbuffer + nrecv(k) I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'p nrecvbuffer = ',p nrecvbuffer CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate the memory for the copy of the particle buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow ldu(1) = p nrecvbuffer IF (p kind.EQ.p kind_double) THEN CALL p alloc(pp recvbufferd,ldu,iopt,info)I ELSE CALL p alloc(pp recvbuffers,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'global receive buffer PPM_RECVBUFFER',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the smaller send and receive bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! only allocate if there actually is anything to be sent/recvd with ! other processors. Otherwise mrecv and msend would both still be -1I ! (as initialized above) and the alloc would throw a FATAL. This was ! Bug ID 000012. IF (p nrecvlist .GT. 1) THEN iopt = p param_alloc_grow ldu(1) = MAX(mrecv,1)I IF (p kind.EQ.p kind_double) THEN CALL p alloc(recvd,ldu,iopt,info)I ELSE CALL p alloc(recvs,ldu,iopt,info)I ENDIF I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'local receive buffer RECV',__LINE__,info)I GOTO 9999 ENDIF ENDIF I IF (p nsendlist .GT. 1) THEN ldu(1) = MAX(msend,1)I IF (p kind.EQ.p kind_double) THEN CALL p alloc(sendd,ldu,iopt,info)I ELSE CALL p alloc(sends,ldu,iopt,info)I ENDIF I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_field_send', &INUUUU& 'local send buffer SEND',__LINE__,info)I GOTO 9999 ENDIF ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Sum of all mesh points that will be sent and receivedI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t allsend = SUM(psend(1:p nsendlist))I allrecv = SUM(precv(1:p nrecvlist))II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the pointer to the position of the data in the main send ! buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'p buffer_set=',p buffer_setI CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF bdim = 0I offs = 0 DO k=1,p buffer_setI offs = offs + allsend*bdim qq(1,k) = offs + 1I bdim = p buffer_dim(k) DO j=2,p nsendlistI qq(j,k) = qq(j-1,k) + psend(j-1)*bdim IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'qq(j,k)=',qq(j,k) CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the pointer to the position of the data in the main receive ! buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t bdim = 0I offs = 0 DO k=1,p buffer_setI offs = offs + allrecv*bdim pp(1,k) = offs + 1I bdim = p buffer_dim(k) DO j=2,p nrecvlist pp(j,k) = pp(j-1,k) + precv(j-1)*bdim IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'pp(j,k)=',p (j,k) CALL p write(p rank,'p map_field_send',mesg,info)I WRITE(mesg,'(A,I9,A,I4)') 'precv(j-1)=',precv(j-1),', bdim=',bdim CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! First copy the on processor data - which is in the first bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p kind.EQ.p kind_double) THEN DO k=1,p buffer_setI ibuffer = pp(1,k) - 1 jbuffer = qq(1,k) - 1 DO j=1,psend(1)*p buffer_dim(k) ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 pp recvbufferd(ibuffer) = pp sendbufferd(jbuffer)I ENDDO ENDDO ELSE DO k=1,p buffer_setI ibuffer = pp(1,k) - 1 jbuffer = qq(1,k) - 1 DO j=1,psend(1)*p buffer_dim(k) ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 pp recvbuffers(ibuffer) = pp sendbuffers(jbuffer)I ENDDO ENDDO ENDIF II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over the processors in the pp isendlist(); skip the first entryI ! which is the local processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p kind.EQ.p kind_double) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! For each destination processor in the sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO k=2,p nsendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Collect each buffer setI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = qq(k,j) - 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Collect the data into the send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 DO i=1,psend(k)*p buffer_dim(j) ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 sendd(ibuffer) = pp sendbufferd(jbuffer)I ENDDO ENDDO I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Perform the actual send/recv as neededI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI#ifdef __MPII ! The following IF is needed in order to skip "dummy"I ! communication rounds where the current processor has to waitI ! (only needed in the partial mapping).I IF (p isendlist(k) .GE. 0 .AND. p irecvlist(k) .GE. 0) THEN tag1 = k IF (psend(k) .GT. 0 .AND. precv(k) .GT. 0) THEN IF (p debug .GT. 1) THEN WRITE(mesg,'(2(A,I3))') 'SendRecv to ',p isendlist(k),&INUUUU& ' from ',p irecvlist(k) CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF CALL MPI_SendRecv(sendd,nsend(k),p mpi kind, &INUUUU& p isendlist(k),tag1,recvd,nrecv(k),p mpi kind, &INUUUU& p irecvlist(k),tag1,p comm,commstat,info)I ELSEIF (psend(k) .GT. 0 .AND. precv(k) .EQ. 0) THEN IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I3)') 'Send to ',p isendlist(k) CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF CALL MPI_Send(sendd,nsend(k),p mpi kind, &INUUUU& p isendlist(k),tag1,p comm,info)I ELSEIF (psend(k) .EQ. 0 .AND. precv(k) .GT. 0) THEN IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I3)') 'Recv from ',p irecvlist(k) CALL p write(p rank,'p map_field_send',mesg,info)I ENDIF CALL MPI_Recv(recvd,nrecv(k),p mpi kind, &INUUUU& p irecvlist(k),tag1,p comm,commstat,info)I ELSE ! do nothingI ENDIF ENDIF #else recvd = sendd #endifII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Store the data back in the recv buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = pp(k,j) - 1 DO i=1,precv(k)*p buffer_dim(j) ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 pp recvbufferd(jbuffer) = recvd(ibuffer)I ENDDO ENDDO ENDDO ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! For each destination processor in the sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO k=2,p nsendlistI !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Collect each buffer setI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = qq(k,j) - 1 !------------------------ginys,max,phyis,t�lEmax,t�lh999999999t�lI ! Collect the data into the send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 DO i=1,psend(k)*p buffer_dim(j) ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 sends(ibuffer) = pp sendbuffers(jbuffer)I ENDDO ENDDO I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Perform the actual send/recv as neededI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI#ifdef __MPII ! The following IF is needed in order to skip "dummy"I ! communication rounds where the current processor has to waitI ! (only needed in the partial mapping).I IF (p isendlist(k) .GE. 0 .AND. p irecvlist(k) .GE. 0) THEN tag1 = k IF (psend(k) .GT. 0 .AND. precv(k) .GT. 0) THEN CALL MPI_SendRecv(sends,nsend(k),p mpi kind, &INUUUU& p isendlist(k),tag1,recvs,nrecv(k),p mpi kind, &INUUUU& p irecvlist(k),tag1,p comm,commstat,info)I ELSEIF (psend(k) .GT. 0 .AND. precv(k) .EQ. 0) THEN CALL MPI_Send(sends,nsend(k),p mpi kind, UUUU&INUUUU& p isendlist(k),tag1,p comm,info)I ELSEIF (psend(k) .EQ. 0 .AND. precv(k) .GT. 0) THEN CALL MPI_Recv(recvs,nrecv(k),p mpi kind, UUUU&INUUUU& p irecvlist(k),tag1,p comm,commstat,info)I ELSE ! do nothingI ENDIF ENDIF #else recvs = sends #endifII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Store the data back in the recv buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = pp(k,j) - 1 DO i=1,precv(k)*p buffer_dim(j) ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 pp recvbuffers(jbuffer) = recvs(ibuffer)I ENDDO ENDDO ENDDO ENDIF II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate the send buffer to save memoryI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc IF (p kind .EQ. p kind_single) THEN CALL p alloc(pp sendbuffers,ldu,iopt,info)I ELSE CALL p alloc(pp sendbufferd,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error error CALL p error(p err alloc,'p map_field_send', &INUUUU& 'send buffer PPM_SENDBUFFER',__LINE__,info)I ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! DeallocateI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(nsend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'send counter NSEND',__LINE__,info)I ENDIF CALL p alloc(nrecv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'receive counter NRECV',__LINE__,info)I ENDIF CALL p alloc(psend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'particle send counter PSEND',__LINE__,info)I ENDIF CALL p alloc(precv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'particle receive counter PRECV',__LINE__,info)I ENDIF CALL p alloc( pp,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'work array PP',__LINE__,info)I ENDIF CALL p alloc( qq,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'work array QQ',__LINE__,info)I ENDIF CALL p alloc(recvd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'local receive buffer RECVD',__LINE__,info)I ENDIF CALL p alloc(recvs,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'local receive buffer RECVS',__LINE__,info)I ENDIF CALL p alloc(sendd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'local send buffer SENDD',__LINE__,info)I ENDIF CALL p alloc(sends,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map_field_send', &INUUUU& 'local send buffer SENDS',__LINE__,info)I ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_field_send',t0,info)I RETURN END SUBROUTINE p map_field_send �����������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_connect_send.f���������������������������������������������������������0000644�0001752�0001753�00000044462�11616003524�021055� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_connect_sendI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modifyI ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, SwitzerlandI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_connect_send(cd,lda,Ncon,id,Npart,info)I !!! This routine sends and receives the connection data !!! according to the information stored in `p buffer2part` !!! !!! [NOTE]I !!! This routine directly sends and receives the connection data as !!! integers I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substart USE p module_substopI USE p module_error USE p module_alloc USE p module_util_invert_listI IMPLICIT NONEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPII INCLUDE 'mpif.h' #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(:,:), POINTER :: cd !!! Connection data INTEGER , INTENT(IN ) :: ldaI !!! The leading dimension of cd(:,:) INTEGER , INTENT(INOUT) :: NconI !!! Number of connections INTEGER, DIMENSION(:) , INTENT(IN ) :: id !!! Local to global particle number mapping INTEGER , INTENT(IN ) :: NpartI !!! Number of particles INTEGER , INTENT( OUT) :: infoI !!! Returns status, 0 upon successI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variablesI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER :: i,j,k,l,msend,mrecv,iopt,ipos,part,qpart,iconI REAL(p kind_double) :: t0 INTEGER :: tag,cd_size,ncons_local INTEGER :: hops #ifdef __MPII INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status #endifII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! ExternalsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_connect_send',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check argumentsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if the send buffer is emptyI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p buffer_set .LT. 1) THEN info = p error warningI CALL p error(p err buffer_empt,'p map_connect_send',UU&INUUUU& 'No mapping defined!',__LINE__,info)I GOTO 9999 ENDIF I#ifndef __MPII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! If we only have one processor there is not much to doI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t GOTO 9999 #else !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! AllocateI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p nsendlist CALL p alloc(csend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating array CSEND',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nsendlist CALL p alloc(crecv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating array CRECV',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nsendlist ldu(2) = NconI CALL p alloc(psend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating array PSEND',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = NpartI CALL p alloc(id_send,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating list ID_SEND',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialize the arrays and counterI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t id_send(:) = 0 csend(:) = 0 crecv(:) = 0 psend(:,:) = 0 msend = 0 mrecv = 0 I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Calculate how many particles will stay on this processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ipos = p psendbuffer(2) - p psendbuffer(1)II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count how many connections we have to send to the other processorsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k = 2,p nsendlistI qpart = p psendbuffer(k+1) - p psendbuffer(k) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Loop over all particles that go the k-th processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO i = ipos+1,(ipos+qpart)I part = id(p buffer2part(i))I id_send(p buffer2part(i)) = partI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Loop over all connections to find the particle partI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI DO j = 1,NconI DO l = 1,ldaI IF (part .EQ. cd(l,j)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh99 ! Count and mark this particle if it is not already ! counted and marked (this particles goes to the k-th ! processor) !------------------------ginys,max,phys,mis,t�lEmax,t�lh99 IF (psend(k,j) .EQ. 0) THEN csend(k) = csend(k) + 1 psend(k,j) = 1 !------------------------ginys,max,phys,mis,t�lEmax,t ! Mark all particles that will be send away. This ! is needed to do a faster check for orphanI ! connections !------------------------ginys,max,phys,mis,t�lEmax,t psend(1,j) = 1 ENDIF EXIT ENDIF ENDDOI ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Communicate the number of connections we have to send and to ! receive !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma tag = 100 CALL MPI_SendRecv(csend(k),1,MPI_INTEGER,p isendlist(k),tag,U&INUUUU& crecv(k),1,MPI_INTEGER,p irecvlist(k),tag,U&INUUUU& p comm,status,info)I msend = msend + csend(k) mrecv = mrecv + crecv(k)I ipos = ipos + qpart ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate the connection data array in order to hold the incomingI ! connections !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = ldaI ldu(2) = Ncon + mrecv CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating connectin array CD_LOCAL',__LINE__,info)I GOTO 9999 ENDIF cd_local(:,:) = 0 cd_local(:,1:Ncon) = cd(:,:) I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the send buffer and receive bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = MAXVAL(csend,1)*ldaI CALL p alloc(sendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating send buffer SENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF I ldu(1) = MAXVAL(crecv,1)*ldaI CALL p alloc(recvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating receive buffer RECVBUFFER',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Send and receive the connections !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t icon = 1 DO k = 2,p nsendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Fill the sendbuffer for the k-th processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ipos = 1 DO j = 1,NconI IF (psend(k,j) .EQ. 1) THEN DO i = 1,ldaI sendbuffer(ipos) = cd_local(i,j) ipos = ipos + 1 ENDDOI ENDIF ENDDOI tag = 200 CALL MPI_SendRecv(sendbuffer,csend(k)*lda,MPI_INTEGER, &INUUUU& p isendlist(k),tag,UUUUUUUUUUUUUUUUUUUUU&INUUUU& recvbuffer,crecv(k)*lda,MPI_INTEGER, &INUUUU& p irecvlist(k),tag,p comm,status,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Add the received connections to the connection data array !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (crecv(k) .NE. 0) THEN ipos = 1 DO j = 1,crecv(k)I DO i = 1,ldaI cd_local(i,Ncon+icon) = recvbuffer(ipos) ipos = ipos + 1 ENDDOI icon = icon + 1 ENDDO ENDIF ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! We now have a new number of connectionsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ncons_local = Ncon + mrecv I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! DeallocateI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(csend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'deallocating array CSEND',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(crecv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'deallocating array CRECV',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(sendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'deallocating send buffer SENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(recvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'deallocating receive buffer RECVBUFFER',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Invert list of particles that has been sent awayI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL p util_invert_list(id_send,id_inv,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'inverting id list',__LINE__,info)I GOTO 9999 ENDIF I iopt = p param_dealloc CALL p alloc(id_send,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'deallocating temporary id list ID_SEND',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find and mark all orphan connections !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t icon = 0 DO j = 1,NconI IF (psend(1,j) .EQ. 1) THEN l = 0 DO i = 1,ldaI IF ((cd_local(i,j) .GE. LBOUND(id_inv,1)) .AND. &INUUUU& (cd_local(i,j) .LE. UBOUND(id_inv,1))) THEN IF (id_inv(cd_local(i,j)) .GT. -HUGE(cd_local(i,j))) THEN l = l + 1 ENDIF ELSE l = l + 1 ENDIF ENDDOI IF (l .EQ. lda) THEN cd_local(1,j) = -1 icon = icon + 1 ENDIF ENDIF ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Mark all connections that we have more than onceI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO j = 1,ncons_local-1 IF (cd_local(1,j) .EQ. -1) CYCLEI DO k = j+1,ncons_local l = 0 DO i = 1,ldaI IF (cd_local(i,j) .EQ. cd_local(i,k)) THEN l = l + 1 ENDIF ENDDOI IF (l .EQ. lda) THEN cd_local(1,k) = -1 icon = icon + 1 ENDIF ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Prepare the final connection array !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = ldaI ldu(2) = ncons_local - iconI iopt = p param_alloc_fit CALL p alloc(cd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'allocating connection array CD',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Go through all connections and save all that are not marked !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t Ncon = 0 DO j = 1,ncons_local IF (cd_local(1,j) .NE. -1) THEN Ncon = Ncon + 1 cd(:,Ncon) = cd_local(:,j) ENDIF ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! DeallocateI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(psend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'deallocating array PSEND',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map_connect_send',UU&INUUUU& 'deallocating connection array CD_LOCAL',__LINE__,info)I GOTO 9999 ENDIF #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! ReturnI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_connect_send',t0,info)I RETURN CONTAINS SUBROUTINE check IF (Ncon .LT. 0) THEN info = p error fatal CALL p error(p err argument,'p map_connect_send',U&INUUUU& 'Number of connections must be >=0',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE check END SUBROUTINE p map_connect_sendI��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/ghost map_symmetry_bc_uz.inc���������������������������������������������������0000644�0001752�0001753�00000004160�11616003524�022331� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! (Re)allocate memory for the symmetry ghosts.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 iopt = p param_alloc_grow_preserve ldu(1) = p dim ldu(2) = 2*nghostplus CALL p alloc(xt,ldu,iopt,info) CALL p alloc(xt_offset,ldu,iopt,info) IF (info.NE.0) THEN info = p error fatal CALL p error(p err alloc,'p map_part_ghost get',U&INUUUU 'xt',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = ldu(2) CALL p alloc(ighost,ldu,iopt,info) IF (info.NE.0) THEN info = p error fatal CALL p error(p err alloc,'p map_part_ghost get',U&INUUUU 'ighost',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! clear out the new segment of xt_offset to be able to copy theI ! correct values from the previous loop through xt_offset !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI FORALL(i=1:p dim,j=nghostplus+1:2*nghostplus)U&INU& xt_offset(i,j) = 0.0_MK !------------------------ginys,max,phys,mis,t�lEmax,t�lh999I ! Symmetry ghosts in the z-direction.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999II k = nghostplus !------------------------ginys,max,phys,mis,t�lEmax,t�lh999I ! those at upper boundary, ! even using symmetry inter-communication.I ! No '=' in the inequality checking.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 zmaxf = max_phys(3) zmaxi = max_phys(3) - ghostsize DO i = 1, nghostplus I IF ( xt(3,i) > zmaxi .AND. xt(3,i) < zmaxf ) THEN kUUUU = kU+ 1 ighost(k) = ighost(i)I xt(1,k) = xt(1,i)I xt(2,k) = xt(2,i) I xt(3,k) = 2.0_MK*zmaxf - xt(3,i)I I xt_offset(1,k) = xt_offset(1,i)I xt_offset(2,k) = xt_offset(2,i)I xt_offset(3,k) = 2.0_MK*(zmaxf-xt(3,i))I END IF END DOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999I ! update the ghost counter.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 nghostplus = k ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/test/��������������������������������������������������������������������������0000755�0001752�0001753�00000000000�11616003524�015500� 5����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/test/p module_map_part.fun���������������������������������������������������0000644�0001752�0001753�00000037427�11616003524�022253� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test_suite p module_map_part #ifdef __MPII INCLUDE "mpif.h" #endifIIinteger, parameter :: debug = 0 integer, parameter :: mk = kind(1.0d0) !kind(1.0e0) real(mk),parameter :: pi = 3.1415926535897931_mk real(mk),parameter :: skin = 0._mk integer,parameter :: ndim=2 integer,parameter :: pdim=2 integer :: decomp,assig,tolexp real(mk) :: tol,min_rcp,max_rcp integer :: info,comm,rank,nproc integer :: topoid integer :: np = 100000 integer :: mp integer :: newnp real(mk),dimension(:,:),pointer :: xp => NULL() real(mk),dimension(: ),pointer :: rcp => NULL() real(mk),dimension(:,:),pointer :: wp => NULL() real(mk),dimension(: ),pointer :: min_phys => NULL() real(mk),dimension(: ),pointer :: max_phys => NULL() real(mk),dimension(: ),pointer :: h => NULL() real(mk),dimension(: ),pointer :: p_h => NULL() real(mk),dimension(: ),pointer :: len_phys => NULL() real(mk),dimension(: ),pointer :: ghostlayer => NULL() integer, dimension(: ),pointer :: ghostsize => NULL() integer :: i,j,k,sum1,sum2 integer :: p_i integer, dimension(6) :: bcdef real(mk),dimension(: ),pointer :: cost => NULL() integer, dimension(: ),pointer :: nm => NULL() integer :: seedsize integer, dimension(:),allocatable :: seed real(mk), dimension(:),allocatable :: randnb integer :: isymm = 0 logical :: lsymm = .false.,ok real(mk) :: t0,t1,t2,t3 initI use p module_typedef use p module_initI I allocate(min_phys(ndim),max_phys(ndim),len_phys(ndim),&INUUUU UU& ghostsize(ndim),ghostlayer(2*ndim),&INUUUU UU& nm(ndim),h(ndim),p_h(ndim),stat=info)I I min_phys(1:ndim) = 0.0_mk max_phys(1:ndim) = 1.0_mk len_phys(1:ndim) = max_phys-min_phys ghostsize(1:ndim) = 2 ghostlayer(1:2*ndim) = max_rcp bcdef(1:6) = p param_bcdef_periodic tol = epsilon(1.0_mk) tolexp = int(log10(epsilon(1.0_mk)))I I nullify(xp,rcp,wp) #ifdef __MPII comm = mpi comm_worldI call mpi comm_rank(comm,rank,info)I call mpi comm_size(comm,nproc,info)I#else rank = 0 nproc = 1 #endifI call p init(ndim,mk,tolexp,0,debug,info,99)I end initI finalize use p module_finalize I call p finalize(info)I deallocate(min_phys,max_phys,len_phys,ghostsize,nm)I end finalize I setup I call rando seed(size=seedsize)I allocate(seed(seedsize))I allocate(randnb((1+ndim)*np),stat=info)I do i=1,seedsize seed(i)=10+i*i*(rank+1) enddoI call rando seed(put=seed)I call rando number(randnb)I I allocate(xp(ndim,np),rcp(np),wp(pdim,np),stat=info)I end setup I teardownI I deallocate(xp,rcp,wp,stat=info)I deallocate(seed,randnb)I end teardownI test globalI ! test global mapping use p module_typedef use p module_mktopo use p module_topo_check !----------------I ! create particles !----------------II xp = 0.0_mk rcp = 0.0_mk !p_h = len_phys / real(npgrid,mk) !do j=1,npgridI ! do i=1,npgridI ! p_i = i + (j-1)*npgridI ! xp(1,p_i) = min_phys(1)+real(i-1,mk)*p_h(1) ! xp(2,p_i) = min_phys(2)+real(j-1,mk)*p_h(2) ! rcp(p_i) = min_rcp + (max_rcp-min_rcp)*randnb(p_i) ! do k=1,pdim ! wp(k,i) = rcp(i)*REAL(k,MK) ! enddoI ! enddoI !enddoI do i=1,np do j=1,ndim xp(j,i) = min_phys(j)+& len_phys(j)*randnb((ndim+1)*i-(ndim-j))I enddoI rcp(i) = min_rcp + (max_rcp-min_rcp)*randnb((ndim+1)*i-ndim) do j=1,pdim wp(j,i) = rcp(i)*REAL(j,MK) enddoI enddoI !----------------I ! make topology !----------------I decomp = p param_decomp_cuboidI !decomp = p param_decomp_xpencilI assig = p param_assign_internalI topoid = 0 I call p mktopo(topoid,xp,np,decomp,assig,min_phys,max_phys,bcdef,U&INUUUU & max_rcp,cost,info)I call p map_part_global(topoid,xp,np,info)I call p map_part_push(rcp,np,info)I call p map_part_push(wp,pdim,np,info)I call p map_part_send(np,newnp,info)I call p map_part_pop(wp,pdim,np,newnp,info)I call p map_part_pop(rcp,np,newnp,info)I call p map_part_pop(xp,ndim,np,newnp,info)I np=newnp I call p topo_check(topoid,xp,np,ok,info)I assert_true(ok)I end testI test partialI ! test partial mapping use p module_typedef use p module_mktopo use p module_topo_check !----------------I ! create particles !----------------II xp = 0.0_mk rcp = 0.0_mk do i=1,np do j=1,ndim xp(j,i) = min_phys(j)+& len_phys(j)*randnb((ndim+1)*i-(ndim-j))I enddoI rcp(i) = min_rcp + (max_rcp-min_rcp)*randnb((ndim+1)*i-ndim) do j=1,pdim wp(j,i) = rcp(i)*REAL(j,MK) enddoI enddoI !----------------I ! make topology !----------------I decomp = p param_decomp_cuboidI assig = p param_assign_internalI topoid = 0 I call p mktopo(topoid,xp,np,decomp,assig,min_phys,max_phys,bcdef,U&INUUUU & max_rcp,cost,info)I call p map_part_global(topoid,xp,np,info)I call p map_part_push(rcp,np,info)I call p map_part_push(wp,pdim,np,info)I call p map_part_send(np,newnp,info)I call p map_part_pop(wp,pdim,np,newnp,info)I call p map_part_pop(rcp,np,newnp,info)I call p map_part_pop(xp,ndim,np,newnp,info)I np=newnp I ! move all particles do i=1,np do j=1,ndim xp(j,i) = xp(j,i) + (len_phys(j)/REAL(nproc,mk))*& & randnb((ndim+1)*i-(ndim-j))I enddoI enddoI ! do local mapping call p map_part_partial(topoid,xp,np,info)I call p map_part_push(rcp,np,info)I call p map_part_push(wp,pdim,np,info)I call p map_part_send(np,newnp,info)I call p map_part_pop(wp,pdim,np,newnp,info)I call p map_part_pop(rcp,np,newnp,info)I call p map_part_pop(xp,ndim,np,newnp,info)I np=newnp I call p topo_check(topoid,xp,np,ok,info)I assert_true(ok)I end testI test ghost getI ! test ghost get and how it treats pbcI ! Ticket #32 use p module_typedef use p module_mktopo use p module_topo_check use p module_util_dbg integer :: npart = 1 integer :: newnpartI integer :: mpartI real(mk),dimension(:,:),pointer :: p => NULL() real(mk), parameter :: gl = 0.1_mk I allocate(p(ndim,npart)) p(1,1) = 0.05_mk p(2,1) = 0.05_mk bcdef(1:6) = p param_bcdef_periodic !----------------I ! make topology !----------------I decomp = p param_decomp_cuboidI !decomp = p param_decomp_xpencilI assig = p param_assign_internalI topoid = 0 I call p mktopo(topoid,p,npart,decomp,assig,min_phys,max_phys,bcdef,U&INUUUU & gl,cost,info)I call p map_part_global(topoid,p,npart,info)I call p map_part_send(npart,newnpart,info)I call p map_part_pop(p,ndim,npart,newnpart,info)I npart=newnpartII call p topo_check(topoid,p,npart,ok,info)I assert_true(ok)I !call p dbg_print_d(topoid,gl,1,1,info,p,npart)I call p map_part_ghost get(topoid,p,ndim,npart,0,gl,info)I call p map_part_send(npart,mpart,info)I call p map_part_pop(p,ndim,npart,mpart,info)I I call p topo_check(topoid,p,npart,ok,info)I assert_true(ok)I !call p dbg_print_d(topoid,gl,2,1,info,p,npart,mpart) I end testI test pbc_and map_loadI ! test ghost get map load and periodic BC use p module_typedef use p module_mktopo use p module_topo_check use p module_util_dbg integer :: npart = 8 integer :: newnpartI integer :: mpartI real(mk),dimension(:,:),pointer :: p => NULL() real(mk),dimension(:) ,pointer :: w => NULL() real(mk),dimension(2) :: check real(mk), parameter :: gl = 0.1_mk I allocate(p(ndim,npart),w(npart)) p(1,1) = 0.05_mk ! left p(2,1) = 0.5_mk p(1,2) = 0.95_mk ! right p(2,2) = 0.5_mk p(1,3) = 0.5_mk ! bottom p(2,3) = 0.05_mk p(1,4) = 0.5_mk ! topI p(2,4) = 0.95_mkI I p(1,5) = 0.05_mk ! left-bottom p(2,5) = 0.05_mk p(1,6) = 0.05_mk ! left-topI p(2,6) = 0.95_mkI p(1,7) = 0.95_mk ! right-bottom p(2,7) = 0.05_mk p(1,8) = 0.95_mk ! right-topI p(2,8) = 0.95_mk w(:) = 1.0_mk bcdef(1:6) = p param_bcdef_periodic !----------------I ! make topology !----------------I decomp = p param_decomp_cuboidI !decomp = p param_decomp_xpencilI assig = p param_assign_internalI topoid = 0 I call p mktopo(topoid,p,npart,decomp,assig,min_phys,max_phys,bcdef,U&INUUUU & gl,cost,info)I call p map_part_global(topoid,p,npart,info)I call p map_part_push(w,npart,info)I call p map_part_send(npart,newnpart,info)I call p map_part_pop(w,npart,newnpart,info)I call p map_part_pop(p,ndim,npart,newnpart,info)I npart=newnpartI call p topo_check(topoid,p,npart,ok,info)I assert_true(ok)I !call p dbg_print_d(topoid,gl,1,1,info,p,npart)I call p map_part_ghost get(topoid,p,ndim,npart,0,gl,info)I call p map_part_push(w,npart,info)I call p map_part_send(npart,mpart,info)I call p map_part_pop(w,npart,mpart,info)I call p map_part_pop(p,ndim,npart,mpart,info)I I call p topo_check(topoid,p,npart,ok,info)I assert_true(ok)I call p dbg_print_d(topoid,gl,2,1,info,p,npart,mpart) call p map_part_store(info)I call p map_part_ghost put(topoid,info)I call p map_part_push(w,npart,info)I call p map_part_send(npart,mpart,info)I call p map_part_ghost pop(w,1,npart,mpart,info)II call p map_part_load(info)I call p map_part_push(p,ndim,npart,info,.TRUE.)I call p map_part_send(npart,mpart,info)I call p map_part_pop(p,ndim,npart,mpart,info)II call p topo_check(topoid,p,npart,ok,info)I assert_true(ok)I !call p dbg_print_d(topoid,gl,3,1,info,p,npart,mpart) I assert_equal(mpart-npart,4+3*4) ! check number of ghostsI ! now go through all particles and try to find their ghosts II check(1) = 1.05_mk ! left check(2) = 0.5_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I I check(1) = -0.05_mk ! right check(2) = 0.5_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))II check(1) = 0.5_mk ! bottom check(2) = 1.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))II check(1) = 0.5_mk ! topI check(2) = -0.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I II check(1) = 1.05_mk ! left-bottom check(2) = 0.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = 0.05_mk check(2) = 1.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = 1.05_mk check(2) = 1.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))II check(1) = 1.05_mk ! left-topI check(2) = 0.95_mkI assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = 0.05_mk check(2) = -0.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = 1.05_mk check(2) = -0.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))II check(1) = -0.05_mk ! right-bottom check(2) = 0.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = 0.95_mkI check(2) = 1.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = -0.05_mk check(2) = 1.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))II check(1) = -0.05_mk ! right-topI check(2) = 0.95_mkI assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = 0.95_mkI check(2) = -0.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))I check(1) = -0.05_mk check(2) = -0.05_mk assert_true(found_ghost(p(:,npart+1:mpart),mpart-npart,check))III deallocate(w) I end testI function found_ghost(ghosts,n,cp)I real(mk),dimension(2,n),intent(in) :: ghostsI integer ,intent(in) :: nI real(mk),dimension(2) ,intent(in) :: cp logical :: found_ghost I integer :: iI integer :: foundI found_ghost = .false.I found = 0 do i=1,n if((abs(ghosts(1,i) - cp(1)).lt.tol).and.U&INUUUU & (abs(ghosts(2,i) - cp(2)).lt.tol)) thenI found = found + 1 endifI enddoI if (found.eq.1) thenI found_ghost = .true. endifI end function found_ghostI test getsymbcI ! tests symmetric boundary conditions and ghost getI use p module_typedef use p module_mktopo use p module_topo_check use p module_util_dbg integer :: npart = 1 integer :: newnpartI integer :: mpartI real(mk),dimension(:,:),pointer :: p => NULL() real(mk), parameter :: gl = 0.1_mk I allocate(p(ndim,npart)) p(1,1) = 0.05_mk p(2,1) = 0.05_mk bcdef(1:6) = p param_bcdef_symmetry !----------------I ! make topology !----------------I decomp = p param_decomp_cuboidI !decomp = p param_decomp_xpencilI assig = p param_assign_internalI topoid = 0 I call p mktopo(topoid,p,npart,decomp,assig,min_phys,max_phys,bcdef,U&INUUUU & gl,cost,info)I call p map_part_global(topoid,p,npart,info)I call p map_part_send(npart,newnpart,info)I call p map_part_pop(p,ndim,npart,newnpart,info)I npart=newnpartII call p topo_check(topoid,p,npart,ok,info)I assert_true(ok)I call p dbg_print_d(topoid,gl,1,1,info,p,npart)I call p map_part_ghost get(topoid,p,ndim,npart,0,gl,info)I call p map_part_send(npart,mpart,info)I call p map_part_pop(p,ndim,npart,mpart,info)I I call p topo_check(topoid,p,npart,ok,info)I assert_true(ok)I call p dbg_print_d(topoid,gl,2,1,info,p,npart,mpart) I end testI end test_suite �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/test/p test_map_part_ghost.f�������������������������������������������������0000644�0001752�0001753�00000015267�11616003524�022604� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������!------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Test Case : p test_map_part_ghost !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t program p test_map_part_ghost !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Test Case : ghost mappings, pushs, pops and multi-push/pops !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t use p module_typedef use p module_mktopo use p module_topo_getIuse p module_initIuse p module_finalize use p module_core implicit none #include "../../p define.h" #ifdef __MPIIINCLUDE 'mpif.h' #endifIIinteger, parameter :: debug = 0 integer, parameter :: mk = p kind_double real(mk),parameter :: pi = 3.1415926535897931_mk real(mk),parameter :: skin = 0._mk integer,parameter :: ndim=2 integer,parameter :: pdim=2 integer :: decomp,assig,tolexp real(mk) :: tol,min_rcp,max_rcp integer :: info,comm,rank integer :: topoid integer :: np = 100000 integer :: mp integer :: newnp real(mk),dimension(:,:),pointer :: xp real(mk),dimension(: ),pointer :: rcp real(mk),dimension(:,:),pointer :: wp real(mk),dimension(: ),pointer :: min_phys,max_phys,h,p_h real(mk),dimension(: ),pointer :: len_phys real(mk),dimension(: ),pointer :: ghostlayer integer, dimension(: ),pointer :: ghostsize integer :: i,j,k,sum1,sum2 integer :: p_i integer, dimension(6) :: bcdef real(mk),dimension(: ),pointer :: cost integer, dimension(: ),pointer :: nm type(p t_topo), pointer :: topo integer :: seedsize integer, dimension(:),allocatable :: seed real(mk), dimension(:),allocatable :: randnb integer :: isymm = 0 logical :: lsymm = .false.,ok real(mk) :: t0,t1,t2,t3 !----------------I! setup !----------------Itol = 10.0_mk*epsilon(1.0_mk) tolexp = int(log10(epsilon(1.0_mk)))Imin_rcp = 0.01_mk max_rcp = 0.1_mk allocate(min_phys(ndim),max_phys(ndim),len_phys(ndim),&INUUU& ghostsize(ndim),ghostlayer(2*ndim),&INUUU& nm(ndim),h(ndim),p_h(ndim),stat=info)I min_phys(1:ndim) = 0.0_mk max_phys(1:ndim) = 1.0_mk len_phys(1:ndim) = max_phys-min_phys ghostsize(1:ndim) = 2 ghostlayer(1:2*ndim) = max_rcp bcdef(1:6) = p param_bcdef_periodic nullify(xp,rcp,wp) #ifdef __MPIIcomm = mpi comm_worldIcall mpi init(info)Icall mpi comm_rank(comm,rank,info)I#else rank = 0 #endifIcall p init(ndim,mk,tolexp,0,debug,info,99)I call rando seed(size=seedsize)Iallocate(seed(seedsize))Iallocate(randnb((1+ndim)*np),stat=info)Ido i=1,seedsize seed(i)=10+i*i*(rank+1) enddoIcall rando seed(put=seed)Icall rando number(randnb)I !----------------I! create particles !----------------IIallocate(xp(ndim,np),rcp(np),wp(pdim,np),stat=info)Ixp = 0.0_mk rcp = 0.0_mk !p_h = len_phys / real(npgrid,mk) !do j=1,npgridI! do i=1,npgridI! p_i = i + (j-1)*npgridI! xp(1,p_i) = min_phys(1)+real(i-1,mk)*p_h(1) ! xp(2,p_i) = min_phys(2)+real(j-1,mk)*p_h(2) ! rcp(p_i) = min_rcp + (max_rcp-min_rcp)*randnb(p_i) ! do k=1,pdim ! wp(k,i) = rcp(i)*REAL(k,MK) ! enddoI! enddoI!enddoIdo i=1,np do j=1,ndim xp(j,i) = min_phys(j)+& len_phys(j)*randnb((ndim+1)*i-(ndim-j))I enddoI rcp(i) = min_rcp + (max_rcp-min_rcp)*randnb((ndim+1)*i-ndim) do j=1,pdim wp(j,i) = rcp(i)*REAL(j,MK) enddoIenddoI !----------------I! make topology !----------------Idecomp = p param_decomp_cuboidI!decomp = p param_decomp_xpencilIassig = p param_assign_internalI topoid = 0 Icall p mktopo(topoid,xp,np,decomp,assig,min_phys,max_phys,bcdef,U&INUUU& max_rcp,cost,info)I print *,rank,'global map:' call p map_part_global(topoid,xp,np,info)Icall p map_part_push(rcp,np,info)Icall p map_part_push(wp,pdim,np,info)Icall p map_part_send(np,newnp,info)Icall p map_part_pop(wp,pdim,np,newnp,info)Icall p map_part_pop(rcp,np,newnp,info)Icall p map_part_pop(xp,ndim,np,newnp,info)Inp=newnp print *,rank,'done' Icall p topo_check(topoid,xp,np,ok,info)Iif (.not. ok) write(*,*) '[',rank,'] topo_check failed' Icall p map_part_ghost get(topoid,xp,ndim,np,isymm,max_rcp,info)Icall p map_part_push(rcp,np,info)Icall p map_part_push(wp,pdim,np,info)Icall p map_part_send(np,mp,info)Icall p map_part_pop(wp,pdim,np,mp,info)Icall p map_part_pop(rcp,np,mp,info)Icall p map_part_pop(xp,ndim,np,mp,info)Iprint *,rank,'np: ',np,' ghosts: ',mp -np print *,rank,'done' print *,rank,'is ghost get set?',p map_type_isactive(p param_map_ghost get)Icall p dbg_print(topoid,max_rcp,1,1,info,xp,np,mp)III !compare neighbour lists obtained by the 2 different routinesI !if (rank.eq.0) thenI! write(*,'(A)') '!! --------------- !!'I! write(*,'(A)') '!! SUCCESS'I! write(*,'(2(A,I6),A)') '!! Completed test for INL with ',np,& ! ' real particles and ',mp-np,' ghosts'I! write(*,'(2(A,E10.4))') '!! Smallest cutoff was ', minval(rcp(1:np)),& ! ' and largest ',maxval(rcp(1:np))I! write(*,'(2(A,I6))') '!! Smallest nb of neigh was ',& ! minval(nvlist),' and largest ',maxval(nvlist)I! write(*,'(A)') '!! --------------- !!'I!endifII!----------------I! teardown...I!----------------I8000 continue Icall p finalize(info)I#ifdef __MPIIcall MPI finalize(info)I#endifIIdeallocate(xp,rcp,wp,min_phys,max_phys,len_phys,ghostsize,nm)I if (rank.eq.0) print *, 'done.'I end program p test_map_part_ghost �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/test/Makefile������������������������������������������������������������������0000644�0001752�0001753�00000000466�11616003524�017146� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TESTINC=-I../../../include -L../../../lib -lp sources=$(wildcard *.f) targets=$(patsubst %.f,%,$(sources))IInew : clean allIIall : $(targets)II$(targets) : $(sources) $(CPP) -P $@.f > __$@.f $(FC) $(OPTS) __$@.f $(TESTINC) $(LDFLAGS) $(LIBS) -o $@ rm -f __$@.f ./$@ clean : rm -f __* rm -f $(targets)I����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_ghost get.f������������������������������������������������������0000644�0001752�0001753�00000032563�11616003524�021540� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_field_ghost get !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_field_ghost get(topoid,meshid,ghostsize,info)I !!! This routine receives/updates the values of the ghost mesh points of !!! each sub from its corresponding neighbor subs (i.e. adds ghost !!! layers to the subs of the current topology). !!! !!! [IMPORTANT] !!! `p map_field_ghost init` must not be called anymore. This routine !!! checks whether the ghost mappings have been initialized already and !!! if not, the routine is called internally. !!! !!! [NOTE]I !!! The first part of the send/recv lists contains the on-processor data. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_mesh USE p module_substartI USE p module_substopI USE p module_errorI USE p module_allocI USE p module_check_idI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: topoid !!! Topology ID INTEGER , INTENT(IN ) :: meshid !!! Mesh ID INTEGER, DIMENSION(:) , INTENT(IN ) :: ghostsize !!! Size of the ghost layer in numbers of grid points in all space !!! dimensions (1...p dim). INTEGER , INTENT( OUT) :: info !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER :: i,j,lb,ub INTEGER :: iopt,ibuffer,pdim INTEGER :: nsendlist,nrecvlist REAL(p kind_double) :: t0 LOGICAL :: valid TYPE(p t_topo), POINTER :: topo => NULL() TYPE(p t_equi_mesh), POINTER :: mesh => NULL() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_field_ghost get',t0,info)I pdim = p dim !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF topo => p topo(topoid)%t mesh => topo%mesh(meshid) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if ghost mappings have been initalized, if no do so now. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (.NOT. mesh%ghost initialized) THEN CALL p map_field_ghost init(topoid,meshid,ghostsize,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_argument,'p map_field_ghost get', U&INUUUU& 'Could not initialize ghost mappings',__LINE__,info)I GOTO 9999 ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Save the map type for the subsequent calls (used to set pop type) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p param_map_ghost get !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Reset the buffer size counters !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendbuffer = 0 p nrecvbuffer = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Number of mesh blocks to be sent/recvd !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nsendlist = mesh%ghost nsend nrecvlist = mesh%ghost nrecv !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = nsendlist CALL p alloc(p mesh_isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'source send sub list PPM_MESH_ISENDFROMSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = nsendlist CALL p alloc(p mesh_isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'send block start list PPM_MESH_ISENDBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p mesh_isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'send block size list PPM_MESH_ISENDBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = nrecvlist CALL p alloc(p mesh_irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'destination recv sub list PPM_MESH_IRECVTOSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = nrecvlist CALL p alloc(p mesh_irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'recv block start list PPM_MESH_IRECVBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p mesh_irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'recv block size list PPM_MESH_IRECVBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global send/recv lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = topo%ncommseq CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'global send rank list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'global recv rank list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = topo%ncommseq + 1 CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p precvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost get', U U&INUUUU& 'global recv buffer pointer PPM_PRECVBUFFER',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Reset the number of buffer entries !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Build the lists for p map_field_push, _pop and _send to CREATE ghost ! meshpoints on the topology topoid !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p psendbuffer(1) = 1 p precvbuffer(1) = 1 p nsendlist = topo%ncommseq p nrecvlist = p nsendlist ibuffer = 0 DO i=1,topo%ncommseq ibuffer = i + 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the processor with which we will send/recv !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p isendlist(i) = topo%icommseq(i) p irecvlist(i) = topo%icommseq(i) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the mesh block range for this processor interaction !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p psendbuffer(ibuffer)=mesh%ghost blk(ibuffer) p precvbuffer(ibuffer)=mesh%ghost recvblk(ibuffer) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the definitions of the mesh blocks to be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma lb = p psendbuffer(i) ub = p psendbuffer(ibuffer) DO j=lb,ub-1 p mesh_isendblkstart(1:pdim,j) = mesh%ghost blkstart(1:pdim,j) p mesh_isendblksize(1:pdim,j) = mesh%ghost blksize(1:pdim,j) p mesh_isendfromsub(j) = mesh%ghost fromsub(j) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the definitions of the mesh blocks to be received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma lb = p precvbuffer(i) ub = p precvbuffer(ibuffer) DO j=lb,ub-1 p mesh_irecvblkstart(1:pdim,j) = mesh%ghost recvblkstart(1:pdim,j) p mesh_irecvblksize(1:pdim,j) = mesh%ghost recvblksize(1:pdim,j) p mesh_irecvtosub(j) = mesh%ghost recvtosub(j) ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_field_ghost get',t0,info)I RETURN CONTAINS SUBROUTINE check CALL p check_topoid(topoid,valid,info)I IF (.NOT. valid) THEN info = p error_errorI CALL p error(p err_argument,'p map_field_ghost get', U&INUUUU& 'topoid out of range',__LINE__,info)I GOTO 8888I ENDIF CALL p check_meshid(topoid,meshid,valid,info)I IF (.NOT. valid) THEN info = p error_errorI CALL p error(p err_argument,'p map_field_ghost get', U&INUUUU& 'meshid out of range',__LINE__,info)I GOTO 8888I ENDIF IF (SIZE(ghostsize,1) .LT. p dim) THEN info = p error_errorI CALL p error(p err_argument,'p map_field_ghost get', U&INUUUU& 'ghostsize must be at least of length p dim',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE check END SUBROUTINE p map_field_ghost get ���������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_eqdistrib.f�������������������������������������������������������0000644�0001752�0001753�00000053620�11616003524�021423� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_part_eqdistrib !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __KIND == __SINGLE_PRECISION SUBROUTINE p map_part_eqdistrib_s(xp,Npart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map_part_eqdistrib_d(xp,Npart,info)I#endifI !!! This routine maps the particles onto the givenI !!! processors without respect to the topology (i.e. everyI !!! processor gets as many particles as it can handle !!! according to `p proc_speed`). !!! !!! [NOTE]I !!! The first part of the buffer contains the on processorI !!! data. !!! !!! NOTE: The storing of `p map_type` is not used (yet) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substartI USE p module_substopI USE p module_errorI USE p module_allocI IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_single #else INTEGER, PARAMETER :: MK = p kind_double #endifII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPII INCLUDE 'mpif.h' #endifII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t REAL(MK), DIMENSION(:,:), INTENT(IN ) :: xpI !!! The positions of the particles INTEGER , INTENT(IN ) :: NpartI !!! The number of particles INTEGER , INTENT( OUT) :: info !!! The return status, 0 on success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER :: i,j,k,ipartI INTEGER :: iopt,iset,ibuffer,dim,totalpartI INTEGER :: ipos,max_val,max_exc,min_val,min_exc,temp_val CHARACTER(p char) :: mesg REAL(MK) :: t0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_eqdistrib',t0,info)I dim = p dim !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Save the map type for the subsequent calls (not used yet) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p param_map_global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for particle per processor lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p nproc CALL p alloc(plist des,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U&INUUUU& 'particle per processor desired list PLIST_DES',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(plist act,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U&INUUUU& 'particle per processor actual list PLIST_ACT',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(plist exc,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U&INUUUU& 'particle per processor excess list PLIST_EXC',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for particle to/from processor lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p nproc - 1 CALL p alloc(srlist1,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U&INUUUU& 'particle to/from processor list 1 SRLIST1',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(srlist2,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U&INUUUU& 'particle to/from processor list 2 SRLIST2',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find out how many particles are on each processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t plist act(:) = 0 plist des(:) = 0 plist act(p rank + 1) = NpartI #ifdef __MPII CALL MPI AllReduce(plist act,plist des,p nproc,MPI INTEGER, &INUUUU& MPI SUM,p comm,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_mpi fail,'p map_part_eqdistrib', &INUUUU& 'MPI AllReduce failed',__LINE__,info)I GOTO 9999 ENDIF #else plist des(p rank + 1) = NpartI#endifII totalpart = 0 DO j = 1,p nprocI plist act(j) = plist des(j) totalpart = totalpart + plist act(j) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Calculate the desired number of particles per processor based ! on p proc_speed and correct a possible truncation errorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ipart = 0 DO j = 1,p nprocI plist des(j) = INT(REAL(totalpart,p kind_double) * &INUUUU& p proc_speed(j - 1)) ipart = ipart + plist des(j) ENDDO IF (totalpart .NE. ipart) THEN j = 1 DO IF (j .GT. p nproc) j = 1 plist des(j) = plist des(j) + 1 ipart = ipart + 1 IF (ipart .EQ. totalpart) EXIT j = j + 1 ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Calculate the particle excess (too much or too little particles) of ! each processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO j = 1,p nprocI plist exc(j) = plist act(j) - plist des(j) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Now lets do some magic. Here we have to figure out how many particles ! have to be send to whom or received from. srlist1 contains the ! processors to send to or receive from, srlist2 contains the amount of ! particles !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ipos = 0 DOI max_exc = 1 max_val = plist exc(max_exc) min_exc = 1 min_val = plist exc(min_exc) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! First find the maximum and minimum excess in the list. The index ! of plist exc corresponds to the processor number + 1. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO j = 1,p nprocI IF (plist exc(j) .GT. max_val) THEN max_val = plist exc(j) max_exc = j ELSEIF (plist exc(j) .LT. min_val) THEN min_val = plist exc(j) min_exc = j ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! If max_exc and min_exc are equal (e.g. maximum and minimum excess ! are the same) there is nothing more to shuffle around and we are ! finished. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (max_exc .EQ. min_exc) EXIT !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Calculate how many particles can be send/received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (ABS(min_val) .LT. max_val) THEN temp_val = ABS(min_val) ELSE temp_val = max_val ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Fill the lists only if this processor has to send or receive ! something. srlist1(ipos) is the processor to send to or receive ! from. srlist2(ipos) is the number of particles to send to or ! receive from the processor in srlist1(ipos). !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (((max_exc - 1) .EQ. p rank) .OR. &INUUUU UU& ((min_exc - 1) .EQ. p rank)) THEN IF ((max_exc - 1) .EQ. p rank) THEN srlist1(ipos + 1) = min_exc - 1 ELSE srlist1(ipos + 1) = max_exc - 1 ENDIF srlist2(ipos + 1) = temp_val !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Count the entries in the srlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ipos = ipos + 1 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Update the excess list to the new situation. In the end all entries ! in plist exc should be zero. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma plist exc(max_exc) = plist exc(max_exc) - temp_val plist exc(min_exc) = plist exc(min_exc) + temp_val ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Consistency check: all entries in plist exc should be zeroI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO j = 1,p nprocI IF (plist exc(j) .NE. 0) THEN info = p error_fatal CALL p error(p err_map_incomp,'p map_part_eqdistrib', &INUUUU& 'Could not distribute all particles to processors', &INUUUU& __LINE__,info)I GOTO 9999 ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Calculate the particle excess again since it has been destroyed ! during the above caluculation and to figure out if this processor ! has to send, receive or do nothingI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO j = 1,p nprocI plist exc(j) = plist act(j) - plist des(j) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the pointer to the buffer; we only need to talk ! to (ipos + 1) processors (including this one) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = ipos + 2 CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U U&INUUUU& 'particle send buffer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fit ldu(1) = NpartI CALL p alloc(p buffer2part,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U U&INUUUU& 'buffer-to-particles map PPM_BUFFER2PART',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the number of buffer entries (this is the first) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the field registers that holds the dimension and ! type of the data !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p buffer_setI CALL p alloc(p buffer dim,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U U&INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p buffer type,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U U&INUUUU& 'buffer types PPM_BUFFER_TYPE',__LINE__,info)I GOTO 9999 ENDIF p buffer dim(p buffer_set) = dim IF (p kind .EQ. p kind_single) THEN p buffer type(p buffer_set) = p kind_single ELSE p buffer type(p buffer_set) = p kind_double ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! (Re)allocate memory for the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = dim * NpartI IF (p kind .EQ. p kind_double) THEN CALL p alloc(p sendbufferd,ldu,iopt,info)I ELSE CALL p alloc(p sendbuffers,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U U&INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendlist = ipos + 1 p nrecvlist = ipos + 1 iopt = p param_alloc_fit ldu(1) = p nsendlist CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U U&INUUUU& 'send list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nrecvlist CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_eqdistrib', U U&INUUUU& 'receive list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Fill the sendbuffer with the particles that will stay on this ! processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t pp psendbuffer(1) = 1 iset = 0 ibuffer = 0 pp isendlist(1) = p rank pp irecvlist(1) = p rank I IF (plist exc(p rank + 1) .LE. 0) THEN temp_val = NpartI ELSE temp_val = plist des(p rank + 1) ENDIF DO ipart = 1,temp_val !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the id of the particle !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p buffer2part(ipart) = ipart !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the particle !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO i = 1,dim ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISION p sendbuffers(ibuffer) = xp(i,ipart) #else p sendbufferd(ibuffer) = xp(i,ipart) #endifI ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Lets see if we have anything more to send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO j = 2,ipos + 1 pp psendbuffer(j) = temp_val + 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Only if we have to send something add it to the sendbuffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (plist exc(p rank + 1) .GT. 0) THEN DO k = 1,srlist2(j - 1) temp_val = temp_val + 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999999 ! Store the id of the particle !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999999 p buffer2part(temp_val) = temp_val !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999999 ! Store the particle !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999999 DO i = 1, dim ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISION p sendbuffers(ibuffer) = xp(i,temp_val) #else p sendbufferd(ibuffer) = xp(i,temp_val) #endifI ENDDO ENDDO ENDIF pp isendlist(j) = srlist1(j - 1) pp irecvlist(j) = srlist1(j - 1) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Everything has to go! !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t pp psendbuffer(ipos + 2) = Npart + 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the current size of the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendbuffer = ibuffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate the memory for the lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_deallocI CALL p alloc(srlist1,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_eqdistrib', U U&INUUUU& 'particle to/from processor list 1 SRLIST1',__LINE__,info)I ENDIF CALL p alloc(srlist2,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_eqdistrib', U U&INUUUU& 'particle to/from processor list 2 SRLIST2',__LINE__,info)I ENDIF CALL p alloc(plist des,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_eqdistrib', U U&INUUUU& 'particle per processor desired list PLIST_DES',__LINE__,info)I ENDIF CALL p alloc(plist act,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_eqdistrib', U U&INUUUU& 'particle per processor actual list PLIST_ACT',__LINE__,info)I ENDIF CALL p alloc(plist exc,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_eqdistrib', U U&INUUUU& 'particle per processor excess list PLIST_EXC',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_part_eqdistrib',t0,info)I RETURN CONTAINS SUBROUTINE check IF (Npart .LT. 0) THEN info = p error_errorI CALL p error(p err_argument,'p map_part_eqdistrib', U&INUUUU& 'Npart must be >=0',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE check #if __KIND == __SINGLE_PRECISION END SUBROUTINE p map_part_eqdistrib_sI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map_part_eqdistrib_d #endifI����������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_global.f���������������������������������������������������������0000644�0001752�0001753�00000062050�11616003524�021007� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_field_global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_field_global(topoid,target_topoid, &INUUUU& meshid,target_meshid,info)I !!! This routine maps field data between two topologies using a global !!! mapping (i.e. every processor communicates with every other). !!! Source mesh must be on the current field topology. Global lists !!! with all mesh blocks that have to be sent and/or received are !!! built in this routine. `p map_field_push`, `p map_field_pop` and !!! `p map_field_send` will use these lists. !!! !!! [NOTE]I !!! The first part of the send/recv lists contains on-processor data. !!! !!! [CAUTION]I !!! *Side effect*: this routine uses the *same* global send/recv buffers,I !!! pointers and lists as the particle mapping routines (reason:I !!! these buffers can be large => memory issues). Field and particle !!! mappings can therefore never overlap, but one must be completed !!! before the other starts. !!! !!! [NOTE]I !!! A map_field_partial could be constructed as follows: every processorI !!! known both `isendlist` and `irecvlist`. They could now use !!! `p util commopt` to find a good communication sequence and compress !!! the send/recv loop. Also, the loop when building the local send/recv !!! lists below would just need to go over the neighbors of a sub !!! instead of all subs. Difficulty: the order of mesh blocks in the send !!! and recv buffer could not match up any more and push/pop could fail. !!! *check this!* !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_mesh USE p module_typedef USE p module_substartI USE p module_substopI USE p module_errorI USE p module_allocI USE p module_writeI USE p module_check_id USE p module_mesh_block_intersectI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: topoid !!! Topology ID of source !!! !!! CAUTION: used to be target topo ID INTEGER , INTENT(IN ) :: target_topoid !!! Topology ID of target INTEGER , INTENT(IN ) :: meshid !!! Mesh ID of source INTEGER , INTENT(IN ) :: target_meshid !!! Mesh ID of target INTEGER , INTENT( OUT) :: info !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER, DIMENSION(p dim) :: iblockstart,nblocksize,offset INTEGER, DIMENSION(p dim) :: ghostsize INTEGER :: i,j,idom,sendrank,recvrank INTEGER :: iopt,iset,ibuffer,pdim INTEGER :: nsendlist,nsend INTEGER :: nrecvlist CHARACTER(p char) :: mesg REAL(p kind_double) :: t0 LOGICAL :: valid TYPE(p t_topo), POINTER :: topo => NULL() TYPE(p t_topo), POINTER :: target_topo => NULL() TYPE(p t_equi_mesh), POINTER :: mesh => NULL() TYPE(p t_equi_mesh), POINTER :: target_mesh => NULL() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_field_global',t0,info)I pdim = p dim !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF topo => p topo(topoid)%t target_topo => p topo(target_topoid)%t mesh => topo%mesh(meshid) target_mesh => target_topo%mesh(target_meshid) IF (p buffer_set .GT. 0) THEN info = p error_warningI CALL p error(p err_map_incomp,'p map_field_global', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Save the map type for the subsequent calls (used for checks!) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p param_map_global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if origin and target meshes are compatible (i.e. have the ! same number of grid points in the whole comput. domain) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN DO i=1,pdim IF (mesh%Nm(i) .NE. target_mesh%Nm(i)) THEN info = p error_notice CALL p write(p rank,'p map_field_global', U&INUUUU& 'Source and destination meshes are of different size',info)I ENDIF ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = topo%nsublist CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = topo%nsublist CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local send block offset list IOFFSET',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find intersecting mesh domains to be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nsendlist = 0 ghostsize = 0 offset = 0 DO i=1,topo%nsublist idom = topo%isublist(i) DO j=1,target_topo%nsubs CALL p mesh_block_intersect(topoid,target_topoid,meshid,target_meshid,&INUUUU& idom,j,offset,ghostsize,nsendlist, &INUUUU& isendfromsub,isendtosub,isendblkstart,isendblksize, &INUUUU& ioffset,info)I IF (info .NE. 0) GOTO 9999 ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = target_topo%nsublist CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = target_topo%nsublist CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find intersecting mesh domains to be received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nrecvlist = 0 ! loop over fromtopo first and THEN over totopo in order to get the ! same ordering of mesh blocks as in the sendlist. This is crucial ! for the push and the pop to work properly DO j=1,topo%nsubs DO i=1,target_topo%nsublist idom = target_topo%isublist(i) CALL p mesh_block_intersect(topoid,target_topoid,meshid,target_meshid,&INUUUU& j,idom,offset,ghostsize,nrecvlist,irecvfromsub, &INUUUU& irecvtosub,irecvblkstart,irecvblksize,ioffset,info)I IF (info .NE. 0) GOTO 9999 ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = nsendlist CALL p alloc(p mesh_isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'source send sub list PPM_MESH_ISENDFROMSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = nsendlist CALL p alloc(p mesh_isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'send block start list PPM_MESH_ISENDBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p mesh_isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'send block size list PPM_MESH_ISENDBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = nrecvlist CALL p alloc(p mesh_irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'destination recv sub list PPM_MESH_IRECVTOSUB',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = pdim ldu(2) = nrecvlist CALL p alloc(p mesh_irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'recv block start list PPM_MESH_IRECVBLKSTART',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p mesh_irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'recv block size list PPM_MESH_IRECVBLKSIZE',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global send/recv lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = p nproc CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'global send rank list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'global recv rank list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nproc + 1 CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p precvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global', U U&INUUUU& 'global recv buffer pointer PPM_PRECVBUFFER',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Reset the number of buffer entries !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over all processors; First is the processor itself !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t sendrank = p rank - 1 recvrank = p rank + 1 p psendbuffer(1) = 1 p precvbuffer(1) = 1 p nsendlist = 0 p nrecvlist = 0 p nsendbuffer = 0 ! data length in buffer p nrecvbuffer = 0 ! data length in buffer iset = 0 ibuffer = 0 DO i=1,pp nprocI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! compute the next processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma sendrank = sendrank + 1 IF (sendrank.GE.pp nproc) sendrank = sendrank - p nproc recvrank = recvrank - 1 IF (recvrank.LT. 0) recvrank = recvrank + p nproc I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the processor to which we will send toI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p nsendlist = p nsendlist + 1 pp isendlist(p nsendlist) = sendrank I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the processor to which we will recv fromI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p nrecvlist = p nrecvlist + 1 pp irecvlist(p nrecvlist) = recvrank !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Find all mesh blocks that are sent and store them. ! To get all mesh blocks that are sent in round ! i=1,pp nsendlist: ! dest_rank = pp isendlist(i) ! ilo = p psendbuffer(i) ! ihi = p psendbuffer(i+1)-1 ! DO j=ilo,ihi ! SEND(p mesh_isendblk(:,j) of sub p mesh_isendfromsub(j) toI ! processor dest_rank to sub p mesh_isendtosub(j)) ! ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ibuffer = p nsendlist + 1 pp psendbuffer(ibuffer) = pp psendbuffer(p nsendlist) DO j=1,nsendlist IF (target_topo%sub2proc(isendtosub(j)) .EQ. sendrank) THEN pp psendbuffer(ibuffer) = pp psendbuffer(ibuffer) + 1 iset = pp psendbuffer(ibuffer) - 1 p mesh_isendfromsub(iset) = isendfromsub(j) p mesh_isendblkstart(1:pdim,iset) = isendblkstart(1:pdim,j) p mesh_isendblksize(1:pdim,iset) = isendblksize(1:pdim,j) IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' sending ', U&INUUUU& isendblkstart(1:2,j),' of size ',isendblksize(1:2,j),&INUUUU& ' to ',sendrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' sending ', U&INUUUU& isendblkstart(1:3,j),' of size ',isendblksize(1:3,j),&INUUUU& ' to ',sendrank ENDIF CALL p write(p rank,'p map_field_global',mesg,info)I ENDIF ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Find all mesh blocks that are received and store them. ! To get all mesh blocks that are received in round ! i=1,pp nrecvlist: ! source_rank = pp irecvlist(i) ! ilo = p precvbuffer(i) ! ihi = p precvbuffer(i+1)-1 ! DO j=ilo,ihi ! RECV(p mesh_irecvblk(:,j) of sub p mesh_irecvfromsub(j) ! from processor source_rank to sub p mesh_irecvtosub(j)) ! ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ibuffer = p nrecvlist + 1 pp precvbuffer(ibuffer) = pp precvbuffer(p nrecvlist) DO j=1,nrecvlist IF (topo%sub2proc(irecvfromsub(j)) .EQ. recvrank) THEN pp precvbuffer(ibuffer) = pp precvbuffer(ibuffer) + 1 iset = pp precvbuffer(ibuffer) - 1 p mesh_irecvtosub(iset) = irecvtosub(j) p mesh_irecvblkstart(1:pdim,iset) = irecvblkstart(1:pdim,j) p mesh_irecvblksize(1:pdim,iset) = irecvblksize(1:pdim,j) IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' recving ', U&INUUUU& irecvblkstart(1:2,j),' of size ',irecvblksize(1:2,j),&INUUUU& ' from ',recvrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' recving ', U&INUUUU& irecvblkstart(1:3,j),' of size ',irecvblksize(1:3,j),&INUUUU& ' from ',recvrank ENDIF CALL p write(p rank,'p map_field_global',mesg,info)I ENDIF ENDIF ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate memory of the local lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_deallocI CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I ENDIF CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I ENDIF CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I ENDIF CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I ENDIF CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I ENDIF CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I ENDIF CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I ENDIF CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I ENDIF CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_field_global', U U&INUUUU& 'local recv block offset list IOFFSET',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_field_global',t0,info)I RETURN CONTAINS SUBROUTINE check CALL p check_topoid(target_topoid,valid,info)I IF (.NOT. valid) THEN info = p error_errorI CALL p error(p err_argument,'p map_field_global', &INUUUU& 'target topoid not valid',__LINE__,info)I GOTO 8888I ENDIF CALL p check_meshid(topoid,meshid,valid,info)I IF (.NOT. valid) THEN info = p error_errorI CALL p error(p err_argument,'p map_field_global', &INUUUU& 'source meshid not valid',__LINE__,info)I GOTO 8888I ENDIF CALL p check_meshid(target_topoid,target_meshid,valid,info)I IF (.NOT. valid) THEN info = p error_errorI CALL p error(p err_argument,'p map_field_global', &INUUUU& 'destination meshid not valid',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE check END SUBROUTINE p map_field_globalI����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/ghost map_symmetry_bc_ly.inc���������������������������������������������������0000644�0001752�0001753�00000004156�11616003524�022324� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! (Re)allocate memory for the symmetry ghosts !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 iopt = p param_alloc_grow preserve ldu(1) = p dim ldu(2) = 2*nghostplus CALL p alloc(xt,ldu,iopt,info) CALL p alloc(xt_offset,ldu,iopt,info) IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_ghost get', &INUUUU 'xt',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = ldu(2) CALL p alloc(ighost,ldu,iopt,info) IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_ghost get', &INUUUU 'ighost',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l ! clear out the new segment of xt_offset to be able to copy the ! correct values from the previous loop through xt_offset !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l FORALL(i=1:p dim,j=nghostplus+1:2*nghostplus) &INU& xt_offset(i,j) = 0.0_MK !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! symmetry ghosts in the y-direction. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 k = nghostplus !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! those at the south boundary. ! No '=' in the inequality checking. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 yminf = min_phys(2) ymini = min_phys(2) + ghostsize DO i = 1, nghostplus IF ( xt(2,i) > yminf .AND. xt(2,i) < ymini ) THEN k = k + 1 ighost(k) = ighost(i) xt(1,k) = xt(1,i) xt(2,k) = 2.0_MK*yminf - xt(2,i) xt_offset(1,k) = xt_offset(1,i) xt_offset(2,k) = -2.0_MK*(xt(2,i)-yminf) IF ( p dim == 3 ) THEN xt(3,k) = xt(3,i) xt_offset(3,k) = xt_offset(3,i) END IF END IF END DO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! update the ghost counter. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 nghostplus = k I������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_remap.f�����������������������������������������������������������0000644�0001752�0001753�00000013624�11616003524�020541� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_part_remap !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __KIND == __SINGLE_PRECISION SUBROUTINE p map_part_remap_s(topoid,xp,Npart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map_part_remap_d(topoid,xp,Npart,info)I#endifI !!! This routine maps the particles onto the given topology. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substartI USE p module_substopI USE p module_errorI USE p module_topo_check USE p module_check_id IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_singleI#else INTEGER, PARAMETER :: MK = p kind_doubleI#endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t REAL(MK), DIMENSION(:,:) , INTENT(IN ) :: xpI !!! The position of the particles INTEGER , INTENT(IN ) :: NpartI !!! The number of particles (on processor) INTEGER , INTENT(IN ) :: topoid !!! Topology identifier of destination topology. INTEGER , INTENT( OUT) :: info !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t LOGICAL :: topo_ok REAL(MK) :: t0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_remap',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF ! if there is still some data left in the buffer, warn the user IF (p buffer_set .GT. 0) THEN info = p error_warningI CALL p error(p err_map_incomp,'p map_part_remap', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if current topology is ok !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL p topo_check(topoid,xp,Npart,topo_ok,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! if topology is ok remap particles otherwise abort remappingI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF(topo_ok) THEN CALL p map_part_global(topoid,xp,Npart,info)I ELSE info = p error_errorI CALL p error(p err_topo_missm,'p map_part_remap', &INUUUU& 'Particles are not on current topology. Mapping discarded.', &INUUUU& __LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_part_remap',t0,info)I RETURN CONTAINS SUBROUTINE check IF (Npart .LE. 0) THEN info = p error_errorI CALL p error(p err_argument,'p map_part_remap', &INUUUU& 'Npart must be >0',__LINE__,info)I GOTO 8888I ENDIF CALL p check_topoid(topoid,topo_ok,info)I IF (.NOT. topo_ok) THEN info = p error_errorI CALL p error(p err_argument,'p map_part_remap', &INUUUU& 'topoid out of range',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE check #if __KIND == __SINGLE_PRECISION END SUBROUTINE p map_part_remap_sI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map_part_remap_dI#endifI������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_partial.f���������������������������������������������������������0000644�0001752�0001753�00000107150�11616003524�021067� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_part_partial !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __KIND == __SINGLE_PRECISION SUBROUTINE p map_part_partial_s(topoid,xp,Npart,info,ignore)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map_part_partial_d(topoid,xp,Npart,info,ignore)I !!! This routine maps the particles onto the topology using a local map !!! (i.e. each processor only communicates with its neighbors). !!!I !!! The routine takes care of periodic boundary conditions (usingI !!! `p impose_part_bc`). So no need for the user to do this manually. !!!I !!! All particles must be assigned after calling the partial map unless !!! the optional 'ignore' flag has been set true. In this case unassigned !!! particles are discarded. !!!I !!! [NOTE]I !!! The first part of the buffer contains the on processor data. I#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substartI USE p module_substopI USE p module_errorI USE p module_allocI USE p module_check_id USE p module_typedef USE p module_write USE p module_util_commopt USE p module_impose_part_bc IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_singleI#else INTEGER, PARAMETER :: MK = p kind_doubleI#endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t REAL(MK), DIMENSION(:,:), INTENT(INOUT) :: xpI !!! Particle coordinates INTEGER , INTENT(IN ) :: NpartI !!! The number of particles (on the local processor) INTEGER , INTENT(IN ) :: topoid !!! ID of the topology INTEGER , INTENT( OUT) :: info !!! Returns status, 0 upon success LOGICAL, OPTIONAL , INTENT(IN ) :: ignore !!! Ignore unassigned particles. Default is false !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER, DIMENSION(:), POINTER :: bcdef => NULL() INTEGER :: i,j,k,idom,ipart,nlist1,nlist2 INTEGER :: sendrank,recvrank INTEGER :: nneighsubs, jdomI INTEGER :: iopt,iset,ibuffer,isonneighI INTEGER :: recvidx CHARACTER(p char) :: mesg REAL(MK) :: t0 LOGICAL :: valid LOGICAL :: ignoreunassigned TYPE(p t_topo) , POINTER :: topo => NULL() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_partial',t0,info)I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF IF (PRESENT(ignore)) THEN ignoreunassigned = ignore ELSE ignoreunassigned = .FALSE. ENDIF topo => p topo(topoid)%tI bcdef => topo%bcdef !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Impose the boundary conditions. ! This is now taken care of transparently. Unless the user needs toI ! impose the boundary conditions at a very specific stage of hisI ! simulation there is no need to bother the user with this. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL p impose_part_bc(topoid,xp,Npart,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_sub_failed,'p map_part_partial', &INUUUU& 'imposing particle BCs failed.',__LINE__,info)I GOTO 9999 ENDIF ! if there is still some data left in the buffer, warn the user IF (p buffer_set .GT. 0) THEN info = p error_warningI CALL p error(p err_map_incomp,'p map_part_partial', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIF ! first check if the optimal communication protocol is known IF (.NOT. topo%isoptimized) THEN ! if not: determine it before calling map_part_partial CALL p util_commopt(topoid,info)I IF (info.NE.0) GOTO 9999 IF (p debug .GT. 1) THEN DO i=1,topo%nneighproc WRITE(mesg,'(A,I4)') 'have neighbor: ', Utopo%ineighproc(i) CALL p write(p rank,'p map_part_partial',mesg,info)I END DO DO i=1,topo%ncommseq WRITE(mesg,'(A,I4)') 'communicate: ', topo%icommseq(i) CALL p write(p rank,'p map_part_partial',mesg,info)I END DO ENDIF END IF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Save the map type for the subsequent calls I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p param_map_partial I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for particle lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = NpartI CALL p alloc(ilist1,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'particle list 1 ILIST1',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(ilist2,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'particle list 2 ILIST2',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for neighbor list (subs) ! This could be optimized by dynamically growing the array whenever ! a neighbor is found. Right now, I just alloc the maximum number ! possible (nsubs is not too big normally). !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = topo%nsubs CALL p alloc(ineighsubs,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'neighbor subs list INEIGHSUBS',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find all subs residing on neighboring processors (or on local one) ! NEED TO INCLUDE THE LOCAL SUBS AS WELL because otherwise: ! (1) we will not be able to assign all particles and the check will ! fail ! (2) The p map_part_send routine expects the first block in the ! buffer to be the local particles and SKIPS IT. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nneighsubs = 0 DO i=1,topo%nsubs ! if either on local ... IF (topo%sub2proc(i) .EQ. p rank) THEN nneighsubs = nneighsubs + 1 ineighsubs(nneighsubs) = i ELSE ! or on any of my neighbors isonneigh = 0 j = 1 DO WHILE (isonneigh .EQ. 0 .AND. j .LE. topo%nneighproc)I IF (topo%sub2proc(i) .EQ. topo%ineighproc(j)) THEN nneighsubs = nneighsubs + 1 ineighsubs(nneighsubs) = i isonneigh = 1 ENDIF j = j + 1 ENDDO ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the pointer to the buffer; for the partial map we ! need entries for each communication round. Thus ldu(1) = ! ncommseq(topoid) + 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = topo%ncommseq + 1 CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'particle send buffer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Alloc particle to processor and buffer to particle maps !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = NpartI CALL p alloc(part2proc,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'particles-to-processors map PART2PROC',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = NpartI CALL p alloc(p buffer2part,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'buffer-to-particles map PPM_BUFFER2PART',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialize the particle list and part2proc list !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nlist1 = NpartI DO ipart=1,NpartI ilist1(ipart) = ipartI part2proc(ipart) = -1 ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Assign particles to processors in part2proc(ipart) = sendrank !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p dim.EQ.2) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Loop over the subdomains on the neighboring processors (2D) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO jdom=nneighsubs,1,-1 idom = ineighsubs(jdom)I sendrank = topo%sub2proc(idom)II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l ! Loop over the remaining particles not yet assigned to a processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l nlist2 = 0 DO i=1,nlist1 ipart = ilist1(i)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! If the particle is inside the current subdomain, assign itI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I#if __KIND == __SINGLE_PRECISION IF (xp(1,ipart) .GE. topo%min_subs(1,idom).AND. U&INUUUU& xp(1,ipart) .LE. topo%max_subs(1,idom).AND. U&INUUUU& xp(2,ipart) .GE. topo%min_subs(2,idom).AND. U&INUUUU& xp(2,ipart) .LE. topo%max_subs(2,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 ! In the non-periodic case, allow particles that are ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 IF((xp(1,ipart).LT.topo%max_subs(1,idom) .OR. U&INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart).LT.topo%max_subs(2,idom) .OR. U&INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& bcdef(4).NE. p param_bcdef_periodic))) THEN #elif __KIND == __DOUBLE_PRECISION IF (xp(1,ipart) .GE. topo%min_subd(1,idom).AND. U&INUUUU& xp(1,ipart) .LE. topo%max_subd(1,idom).AND. U&INUUUU& xp(2,ipart) .GE. topo%min_subd(2,idom).AND. U&INUUUU& xp(2,ipart) .LE. topo%max_subd(2,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 ! In the non-periodic case, allow particles that are ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 IF((xp(1,ipart).LT.topo%max_subd(1,idom) .OR. U&INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart).LT.topo%max_subd(2,idom) .OR. U&INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& bcdef(4).NE. p param_bcdef_periodic))) THEN #endifI part2proc(ipart) = sendrank ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh99 ! if not, add it the list of particle to search !------------------------ginys,max,phys,mis,t�lEmax,t�lh99 nlist2 = nlist2 + 1 ilist2(nlist2) = ipartI ENDIF ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh99 ! if not, add it the list of particle to search !------------------------ginys,max,phys,mis,t�lEmax,t�lh99 nlist2 = nlist2 + 1 ilist2(nlist2) = ipartI ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 ! Copy the lists (well, only if nlist2 changed - decreased) !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 IF (nlist2.NE.nlist1) THEN nlist1 = nlist2 DO i=1,nlist1 ilist1(i) = ilist2(i)I ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 ! Exit if the list is empty !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 IF (nlist1.EQ.0) EXIT ENDDO ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Loop over the subdomains (since the first domains are most likely ! to be empty, we look backwards to reduce the number of elements in ! nlist2 as fast as possible) (3D) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO jdom=nneighsubs,1,-1 idom = ineighsubs(jdom)I sendrank = topo%sub2proc(idom)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 ! Loop over the remaining particles I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l nlist2 = 0 DO i=1,nlist1 ipart = ilist1(i)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! If the particle is inside the current subdomain, assign itI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I#if __KIND == __SINGLE_PRECISION IF (xp(1,ipart) .GE. topo%min_subs(1,idom).AND. U&INUUUU& xp(1,ipart) .LE. topo%max_subs(1,idom).AND. U&INUUUU& xp(2,ipart) .GE. topo%min_subs(2,idom).AND. U&INUUUU& xp(2,ipart) .LE. topo%max_subs(2,idom).AND. U&INUUUU& xp(3,ipart) .GE. topo%min_subs(3,idom).AND. U&INUUUU& xp(3,ipart) .LE. topo%max_subs(3,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 ! In the non-periodic case, allow particles that are ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 IF((xp(1,ipart) .LT. topo%max_subs(1,idom) .OR. &INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart) .LT. topo%max_subs(2,idom) .OR. &INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& bcdef(4) .NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(3,ipart) .LT. topo%max_subs(3,idom) .OR. &INUUUU& (topo%subs_bc(6,idom).EQ.1 .AND. &INUUUU& bcdef(6) .NE. p param_bcdef_periodic)) ) THEN #elif __KIND == __DOUBLE_PRECISION IF (xp(1,ipart) .GE. topo%min_subd(1,idom).AND. U&INUUUU& xp(1,ipart) .LE. topo%max_subd(1,idom).AND. U&INUUUU& xp(2,ipart) .GE. topo%min_subd(2,idom).AND. U&INUUUU& xp(2,ipart) .LE. topo%max_subd(2,idom).AND. U&INUUUU& xp(3,ipart) .GE. topo%min_subd(3,idom).AND. U&INUUUU& xp(3,ipart) .LE. topo%max_subd(3,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 ! In the non-periodic case, allow particles that are ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999 IF((xp(1,ipart).LT.topo%max_subd(1,idom) .OR. &INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart).LT.topo%max_subd(2,idom) .OR. &INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& bcdef(4).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(3,ipart).LT.topo%max_subd(3,idom) .OR. &INUUUU& (topo%subs_bc(6,idom).EQ.1 .AND. &INUUUU& bcdef(6).NE. p param_bcdef_periodic)) ) THEN #endifI part2proc(ipart) = sendrank ELSE nlist2 = nlist2 + 1 ilist2(nlist2) = ipartI ENDIF ELSE nlist2 = nlist2 + 1 ilist2(nlist2) = ipartI ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 ! Copy the lists (well, only if nlist2 changed - decreased) !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 IF (nlist2.NE.nlist1) THEN nlist1 = nlist2 DO i=1,nlist1 ilist1(i) = ilist2(i)I ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 ! Exit if the list is empty !------------------------ginys,max,phys,mis,t�lEmax,t�lh99max,t�lh99 IF (nlist1.EQ.0) EXIT ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if we sold all the particles. If not some of them have move ! too far we return an info and the user should call the global map. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (.NOT. ignoreunassigned) THEN IF (nlist2.GT.0) THEN info = p error_errorI CALL p error(p err_part_unass,'p map_part_partial', &INUUUU& 'Please call p map_part_global',__LINE__,info)I GOTO 9999 ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the number of buffer entries (this is the first) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the send buffer meta data !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p buffer_set CALL p alloc(p buffer dim ,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p buffer type,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'buffer types PPM_BUFFER_TYPE',__LINE__,info)I GOTO 9999 ENDIF p buffer dim(p buffer_set) = p dimI#if __KIND == __SINGLE_PRECISION p buffer type(p buffer_set) = p kind_singleI#else p buffer type(p buffer_set) = p kind_doubleI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! (Re)allocate memory for the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p dim*NpartI IF (p kind.EQ.p kind_double) THEN CALL p alloc(p sendbufferd,ldu,iopt,info)I ELSE CALL p alloc(p sendbuffers,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendlist = topo%ncommseq p nrecvlist = topo%ncommseq ldu(1) = p nsendlist CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'send list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_partial', &INUUUU& 'receive list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialize the particle lists I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nlist1 = NpartI DO ipart=1,NpartI ilist1(ipart) = ipartI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over the neighboring processors according to the optimized ! communication sequence. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p psendbuffer(1) = 1 p nsendlist = 0 p nrecvlist = 0 iset = 0 ibuffer = 0 DO i=1,topo%ncommseq !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! get next neighbor to send/recv to/from. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma sendrank = topo%icommseq(i) recvrank = sendrank !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the processor to which we will send toI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p nsendlist = p nsendlist + 1 p isendlist(p nsendlist) = sendrank !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the processor to which we will recv fromI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p nrecvlist = p nrecvlist + 1 p irecvlist(p nrecvlist) = recvrank !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Only assign particles if there is any communication for this ! processor in this round !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (sendrank .GE. 0) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Initialize the buffer count !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� nlist2 = 0 IF (p dim .EQ. 2) THEN DO j=1,nlist1 ipart = ilist1(j)I IF (part2proc(ipart).EQ.sendrank) THEN I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I ! increment the buffer counterI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I iset = iset + 1 I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I ! Store the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I p buffer2part(iset) = ipartII !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I ! Store the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I IF (p kind .EQ. p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_double) #else ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xp(1,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xp(2,ipart) #endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xp(1,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xp(2,ipart) #else ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_single) #endifI ENDIF ELSE nlist2 = nlist2 + 1 ilist2(nlist2) = ipartI ENDIF ENDDO ELSE DO j=1,nlist1 ipart = ilist1(j)I IF (part2proc(ipart).EQ.sendrank) THEN I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I ! increment the buffer counterI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I iset = iset + 1 I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I ! Store the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I p buffer2part(iset) = ipartII !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I ! Store the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I IF (p kind .EQ. p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(xp(3,ipart), &INUUUU& p kind_double) #else ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xp(1,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xp(2,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = xp(3,ipart) #endifI ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xp(1,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xp(2,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = xp(3,ipart) #else ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(xp(3,ipart), &INUUUU& p kind_single) #endifI ENDIF ELSE nlist2 = nlist2 + 1 ilist2(nlist2) = ipartI ENDIF ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Swap the lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� nlist1 = nlist2 DO j=1,nlist1 ilist1(j) = ilist2(j)I ENDDO ENDIF ! sendrank .GE. 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Update the buffer pointerI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma p psendbuffer(i+1) = iset + 1 I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! All particles ate n !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p psendbuffer(topo%ncommseq+1) = Npart + 1 - nlist2 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the current size of the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendbuffer = ibuffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate the memory for the lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_deallocI CALL p alloc(ilist1,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_partial', &INUUUU& 'particle list 1 ILIST1',__LINE__,info)I ENDIF CALL p alloc(ilist2,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_partial', &INUUUU& 'particle list 2 ILIST2',__LINE__,info)I ENDIF CALL p alloc(part2proc,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_partial', &INUUUU& 'particles-to-processors map PART2PROC',__LINE__,info)I ENDIF CALL p alloc(ineighsubs,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_errorI CALL p error(p err_dealloc,'p map_part_partial', &INUUUU& 'neighbor subs list INEIGHSUBS',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_part_partial',t0,info)I RETURN CONTAINS SUBROUTINE check IF (Npart .LT. 0) THEN info = p error_errorI CALL p error(p err_argument,'p map_part_partial', &INUUUU& 'Npart must be >0',__LINE__,info)I GOTO 8888I ENDIF IF (topoid .EQ. p param_topo_undefined) THEN info = p error_errorI CALL p error(p err_argument,'p map_part_partial', &INUUUU& 'topoid must be the ID of a defined topology',__LINE__,info)I GOTO 8888I ENDIF CALL p check_topoid(topoid,valid,info)I IF (.NOT. valid) THEN info = p error_errorI CALL p error(p err_argument,'p map_part_partial', &INUUUU& 'topoid out of range',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE check #if __KIND == __SINGLE_PRECISION END SUBROUTINE p map_part_partial_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map_part_partial_d #endifI������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_type_isactive.f��������������������������������������������������������0000644�0001752�0001753�00000006027�11616003524�021256� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_type_isactive !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should ate received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t FUNCTION p map_type_isactive(map_type) RESULT(is_active) !!! This query function allows the user to check the mapping !!! type that has been last used. This can be used before issuing !!! push/send/pop sequences without first mapping the positions with !!! ghost_get/ghost_put/global or other mapping routines. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: map_type !!! A map type as defined in p param.h LOGICAL :: is_active !!! TRUE if the internal state variable is set to this type !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER :: info I REAL(p kind_double) :: t0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t is_active = p map_type.EQ.map_type END FUNCTION p map_type_isactiveI���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field send_noblock.f���������������������������������������������������0000644�0001752�0001753�00000117523�11616003524�022215� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_field send_noblock !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should ate received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_field send_noblock(info)I !!! This routine performs the actual send/recv of theI !!! mesh blocks and all pushed data. This is the non-blocking version of !!! `p map_field send`. !!! !!! [WARNING]I !!! This routine has not been tested, reviewed, or checked. CommentsI !!! and documentation are wrong. This routine might kill your cat orI !!! worse. !!! !!! [NOTE]I !!! The first part of the buffer contains the on processor data. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_mesh USE p module_substartI USE p module_substopI USE p module_errorI USE p module_allocI USE p module_writeI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPI INCLUDE 'mpif.h' #endifI integer, parameter :: mk = p kind_double I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT( OUT) :: infoI !!! Return status, 0 on success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER :: i,j,k,ibuffer,jbuffer,bdim,offs INTEGER :: iopt,tag1,Ndata,msend,mrecv,allsend,allrecv CHARACTER(p char) :: mesg REAL(p kind_double) :: t0 #ifdef __MPI INTEGER, DIMENSION(MPI_STATUS_SIZE) :: commstat #endifI !------------------------ginys,max,phys,mis,t�lEmax,t� ! Non-blockingI !------------------------ginys,max,phys,mis,t�lEmax,t� INTEGER :: kbuffer, kreq, rindex INTEGER, DIMENSION(:), POINTER :: klist => NULL() INTEGER, DIMENSION(:), POINTER :: isendoff => NULL() INTEGER, DIMENSION(:), POINTER :: irecvoff => NULL() INTEGER, DIMENSION(:), POINTER :: request => NULL() ! 3 lines for new separate request arrays INTEGER :: kreqrecv, kreqsend INTEGER, DIMENSION(:), POINTER :: sendreqs => NULL() INTEGER, DIMENSION(:), POINTER :: recvreqs => NULL() INTEGER, DIMENSION(:), POINTER :: klistsend => NULL() INTEGER, DIMENSION(:), POINTER :: klistrecv => NULL() REAL(p kind_double), DIMENSION(:), POINTER :: isendd => NULL() REAL(p kind_double), DIMENSION(:), POINTER :: irecvd => NULL() REAL(p kind_single), DIMENSION(:), POINTER :: isends => NULL() REAL(p kind_single), DIMENSION(:), POINTER :: irecvs => NULL() LOGICAL :: rflag REAL(p kind_double) :: nonblock_time0, nonblock_timer, nonblock_timeout !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_field send_noblock',t0,info)I ! skip if the buffer is empty IF (p buffer_set .LT. 1) THEN IF (p debug .GT. 1) THEN CALL p write(p rank,'p map_field send_noblock', &INUUUU& 'Buffer is empty: skipping send!',info)I ENDIF GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! AllocateI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit I ldu(1) = p nsendlist CALL p alloc(nsend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'send counter NSEND',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(psend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'particle send counter PSEND',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nrecvlist CALL p alloc(nrecv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'receive counter NRECV',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(precv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'particle receive counter PRECV',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nrecvlist I ldu(2) = p buffer_set CALL p alloc(pp,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'work buffer PP',__LINE__,info)I GOTO 9999 ENDIF ldu(1) = p nsendlist I ldu(2) = p buffer_set CALL p alloc(qq,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'work buffer QQ',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffer that will not be send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t Ndata = 0 IF (p dim .LT. 3) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! access mesh blocks belonging to the 1st processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO j=p psendbuffer(1),p psendbuffer(2)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Get the number of mesh points in this block !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� Ndata = Ndata + (p mesh isendblksize(1,j)* &INUUUU& p mesh isendblksize(2,j))I ENDDO ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! access mesh blocks belonging to the 1st processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO j=p psendbuffer(1),p psendbuffer(2)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Get the number of mesh points in this block !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� Ndata = Ndata + (p mesh isendblksize(1,j)* &INUUUU& p mesh isendblksize(2,j)*p mesh isendblksize(3,j))I ENDDO ENDIF ibuffer = 0 DO j=1,p buffer_setI bdim = p buffer_dim(j)I ibuffer = ibuffer + bdim*Ndata ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialize the buffer counters !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nrecvbuffer = ibuffer nsend(1) = ibuffer nrecv(1) = ibuffer psend(1) = Ndata precv(1) = Ndata mrecv = -1 msend = -1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffers that will be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=2,p nsendlist nsend(k) = 0 psend(k) = 0 Ndata = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Number of mesh points to be sent off to the k-th processor in ! the sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm IF (p dim .LT. 3) THEN DO i=p psendbuffer(k),p psendbuffer(k+1)-1 Ndata = Ndata + (p mesh isendblksize(1,i)* &INUUUU& p mesh isendblksize(2,i))I ENDDO ELSE DO i=p psendbuffer(k),p psendbuffer(k+1)-1 Ndata = Ndata + (p mesh isendblksize(1,i)* &INUUUU& p mesh isendblksize(2,i)*p mesh isendblksize(3,i))I ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Store the number of mesh points in psend !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm psend(k) = Ndata !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Store the size of the data to be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO j=1,p buffer_setI nsend(k) = nsend(k) + (p buffer_dim(j)*Ndata)I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Find the maximum buffer length (for the allocate) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm msend = MAX(msend,nsend(k))I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'msend = ',msend CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffers that will be received ! (For meshes we know this a priori. This is different fromI ! particles) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=2,p nrecvlist nrecv(k) = 0 precv(k) = 0 Ndata = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Number of mesh points to be received from the k-th processor in ! the recvlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm IF (p dim .LT. 3) THEN DO i=p precvbuffer(k),p precvbuffer(k+1)-1 Ndata = Ndata + (p mesh irecvblksize(1,i)* &INUUUU& p mesh irecvblksize(2,i))I ENDDO ELSE DO i=p precvbuffer(k),p precvbuffer(k+1)-1 Ndata = Ndata + (p mesh irecvblksize(1,i)* &INUUUU& p mesh irecvblksize(2,i)*p mesh irecvblksize(3,i))I ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Store the number of mesh points in precv !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm precv(k) = Ndata !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Store the size of the data to be received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO j=1,p buffer_setI nrecv(k) = nrecv(k) + (p buffer_dim(j)*Ndata)I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Find the maximum buffer length (for the allocate) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm mrecv = MAX(mrecv,nrecv(k))I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'mrecv = ',mrecv CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Increment the total receive buffer count !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm p nrecvbuffer = p nrecvbuffer + nrecv(k) I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'p nrecvbuffer = ',p nrecvbuffer CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate the memory for the copy of the particle buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow ldu(1) = p nrecvbuffer IF (p kind.EQ.p kind_double) THEN CALL p alloc(p recvbufferd,ldu,iopt,info)I ELSE CALL p alloc(p recvbuffers,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'global receive buffer PPM_RECVBUFFER',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the smaller send and receive buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! only allocate if there actually is anything to be sent/recvd with ! other processors. Otherwise mrecv and msend would both still be -1 ! (as initialized above) and the alloc would throw a FATAL. This was ! Bug ID 000012. IF (p nrecvlist .GT. 1) THEN iopt = p param_alloc_grow ldu(1) = MAX(mrecv,1)I IF (p kind.EQ.p kind_double) THEN CALL p alloc(recvd,ldu,iopt,info)I ELSE CALL p alloc(recvs,ldu,iopt,info)I ENDIF I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'local receive buffer RECV',__LINE__,info)I GOTO 9999 ENDIF ENDIF IF (p nsendlist .GT. 1) THEN ldu(1) = MAX(msend,1)I IF (p kind.EQ.p kind_double) THEN CALL p alloc(sendd,ldu,iopt,info)I ELSE CALL p alloc(sends,ldu,iopt,info)I ENDIF I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'local send buffer SEND',__LINE__,info)I GOTO 9999 ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Sum of all mesh points that will be sent and received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t allsend = SUM(psend(1:p nsendlist))I allrecv = SUM(precv(1:p nrecvlist)) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the pointer to the position of the data in the main send ! buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'p buffer_set=',p buffer_setI CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF bdim = 0 offs = 0 DO k=1,p buffer_setI offs = offs + allsend*bdimI qq(1,k) = offs + 1 bdim = p buffer_dim(k)I DO j=2,p nsendlist qq(j,k) = qq(j-1,k) + psend(j-1)*bdimI IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'qq(j,k)=',qq(j,k) CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the pointer to the position of the data in the main receive ! buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t bdim = 0 offs = 0 DO k=1,p buffer_setI offs = offs + allrecv*bdimI pp(1,k) = offs + 1 bdim = p buffer_dim(k)I DO j=2,p nrecvlist pp(j,k) = pp(j-1,k) + precv(j-1)*bdimI IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'pp(j,k)=',p (j,k) CALL p write(p rank,'p map_field send_noblock',mesg,info)I WRITE(mesg,'(A,I9,A,I4)') 'precv(j-1)=',precv(j-1),', bdim=',bdimI CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! First copy the on processor data - which is in the first buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p kind.EQ.p kind_double) THEN DO k=1,p buffer_setI ibuffer = pp(1,k) - 1 jbuffer = qq(1,k) - 1 DO j=1,psend(1)*p buffer_dim(k)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 p recvbufferd(ibuffer) = p sendbufferd(jbuffer)I ENDDO ENDDO ELSE DO k=1,p buffer_setI ibuffer = pp(1,k) - 1 jbuffer = qq(1,k) - 1 DO j=1,psend(1)*p buffer_dim(k)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 p recvbuffers(ibuffer) = p sendbuffers(jbuffer)I ENDDO ENDDO ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t� ! Allocate buffers for non-blocking communication !------------------------ginys,max,phys,mis,t�lEmax,t� iopt = p param_alloc_fitI ldu(1) = 2*p nsendlist CALL p alloc(klist,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'request array',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = 2*p nsendlist CALL p alloc(request,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'request array',__LINE__,info)I GOTO 9999 ENDIF ! 4 new arrays for separate request lists iopt = p param_alloc_fitI ldu(1) = p nsendlist CALL p alloc(klistsend,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'k list for send requests',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = p nsendlist CALL p alloc(klistrecv,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'k list for recv requests',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = p nsendlist CALL p alloc(sendreqs,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'send requests array',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = p nsendlist CALL p alloc(recvreqs,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'recv requests array',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = p nsendlist CALL p alloc(isendoff,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'isendoff array',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = p nsendlist CALL p alloc(irecvoff,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUU& 'irecvoff array',__LINE__,info)I GOTO 9999 ENDIF I IF(p kind.EQ.p kind_double) THEN iopt = p param_alloc_fitI ldu(1) = SUM(nsend(2:p nsendlist))I CALL p alloc(isendd,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUUUUU& 'isendd array',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = SUM(nrecv(2:p nsendlist))I CALL p alloc(irecvd,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUUUUU& 'irecvd array',__LINE__,info)I GOTO 9999 ENDIF ELSE iopt = p param_alloc_fitI ldu(1) = SUM(nsend(2:p nsendlist))I CALL p alloc(isends,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUUUUU& 'isendd array',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_alloc_fitI ldu(1) = SUM(nrecv(2:p nsendlist))I CALL p alloc(irecvs,ldu,iopt,info)I IF(info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field send_noblock', &INUUUUUUUUUUUUUUUU& 'irecvd array',__LINE__,info)I GOTO 9999 ENDIF END IF !------------------------ginys,max,phys,mis,t�lEmax,t� ! loop over cpus in isendlist, skip the first guy which is the local ! processor, put the stuff in one (bigish) send buffer and store the ! index !------------------------ginys,max,phys,mis,t�lEmax,t� IF (p kind.EQ.p kind_double) THEN kbuffer = 0 DO k=2,p nsendlist IF(psend(k).GT.0) THEN isendoff(k) = kbuffer+1 ELSE isendoff(k) = -1 END IF !------------------------ginys,max,phys,mis,t�lEmax,t� ! collect each buffer setI !------------------------ginys,max,phys,mis,t�lEmax,t� DO j=1,p buffer_setI jbuffer = qq(k,j) - 1 DO i=1,psend(k)*p buffer_dim(j)I kbuffer = kbuffer + 1 jbuffer = jbuffer + 1 isendd(kbuffer) = p sendbufferd(jbuffer)I END DO END DO END DO kbuffer = 1 DO k=2,p nsendlist !------------------------ginys,max,phys,mis,t�lEmax,t� ! construct irecvoff !------------------------ginys,max,phys,mis,t�lEmax,t� IF(precv(k).GT.0) THEN irecvoff(k) = kbuffer kbuffer = kbuffer + nrecv(k) ELSE irecvoff(k) = -1 END IF END DO #ifdef __MPI kreqsend = 0 kreqrecv = 0 DO k=2,p nsendlist !------------------------ginys,max,phys,mis,t�lEmax,t� ! perform the actual send/recv as needed, ! skip zero-communication rounds (see p map_field send.f) !------------------------ginys,max,phys,mis,t�lEmax,t� IF(p isendlist(k).GE.0.AND.p irecvlist(k).GE.0) THEN tag1 = k IF(psend(k).GT.0) THEN kreqsend = kreqsend + 1 CALL MPI_ISend(isendd(isendoff(k)),nsend(k),p mpi kind, &INUUUUUUUUUUUUUUUUUUUUUU& p isendlist(k),tag1,p comm,sendreqs(kreqsend),info)I klistsend(kreqsend) = k END IF IF(precv(k).GT.0) THEN kreqrecv = kreqrecv + 1 CALL MPI_IRecv(irecvd(irecvoff(k)),nrecv(k),p mpi kind, &INUUUUUUUUUUUUUUUUUUUUUU& p irecvlist(k),tag1,p comm,recvreqs(kreqrecv),info)I klistrecv(kreqrecv) = k END IF ELSE !------------------------ginys,max,phys,mis,t�lEmax,t� ! do nothingI !------------------------ginys,max,phys,mis,t�lEmax,t� END IF END DO IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9,I9)') 'send/recv requests= ', kreqsend, kreqrecv CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF #else #error not implemented for usage without MPI. take p map_field send.f instead #endifI ELSE !------------------------ginys,max,phys,mis,t�lEmax,t� ! single precision case !------------------------ginys,max,phys,mis,t�lEmax,t� kbuffer = 0 DO k=2,p nsendlist IF(psend(k).GT.0) THEN isendoff(k) = kbuffer+1 ELSE isendoff(k) = -1 END IF !------------------------ginys,max,phys,mis,t�lEmax,t� ! collect each buffer setI !------------------------ginys,max,phys,mis,t�lEmax,t� DO j=1,p buffer_setI jbuffer = qq(k,j) - 1 DO i=1,psend(k)*p buffer_dim(j)I kbuffer = kbuffer + 1 jbuffer = jbuffer + 1 isends(kbuffer) = p sendbuffers(jbuffer)I END DO IF ((psend(k).GT.0).AND.(p debug .GT. 1)) THEN jbuffer = qq(k,j) WRITE(mesg,'(A,I9,I9,F10.4,A,I9)') 'Initial send hash ',&INUUUU& k,j,SUM(p sendbuffers(jbuffer:jbuffer+psend(k)*&INUUUU& p buffer_dim(j)-1)),' to ',p isendlist(k) CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF END DO END DO kbuffer = 1 DO k=2,p nsendlist !------------------------ginys,max,phys,mis,t�lEmax,t� ! construct irecvoff !------------------------ginys,max,phys,mis,t�lEmax,t� IF(precv(k).GT.0) THEN irecvoff(k) = kbuffer kbuffer = kbuffer + nrecv(k) ELSE irecvoff(k) = -1 END IF END DO #ifdef __MPI kreqsend = 0 kreqrecv = 0 DO k=2,p nsendlist !------------------------ginys,max,phys,mis,t�lEmax,t� ! perform the actual send/recv as needed, ! skip zero-communication rounds (see p map_field send.f) !------------------------ginys,max,phys,mis,t�lEmax,t� IF(p isendlist(k).GE.0.AND.p irecvlist(k).GE.0) THEN tag1 = k IF(psend(k).GT.0) THEN kreqsend = kreqsend + 1 CALL MPI_ISend(isends(isendoff(k)),nsend(k),p mpi kind, &INUUUUUUUUUUUUUUUUUUUUUU& p isendlist(k),tag1,p comm,sendreqs(kreqsend),info)I klistsend(kreqsend) = k END IF IF(precv(k).GT.0) THEN kreqrecv = kreqrecv + 1 CALL MPI_IRecv(irecvs(irecvoff(k)),nrecv(k),p mpi kind, &INUUUUUUUUUUUUUUUUUUUUUU& p irecvlist(k),tag1,p comm,recvreqs(kreqrecv),info)I klistrecv(kreqrecv) = k END IF ELSE !------------------------ginys,max,phys,mis,t�lEmax,t� ! do nothingI !------------------------ginys,max,phys,mis,t�lEmax,t� END IF END DO IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9,I9)') 'send/recv requests= ', kreqsend, kreqrecv CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF #else #error not implemented for usage without MPI. take p map_field send.f instead #endifI ENDIF I IF(p kind.EQ.p kind_double) THEN #undef __NONBLOCKDBG #ifdef __NONBLOCKDBG CALL MPI_Barrier(p comm,info)I nonblock_time0 = MPI_Wtime(info)I WRITE(*,*) p rank, ': nonblocking ddebug started'I nonblock_timeout = 20.0_mk DO CALL MPI_TestAny(kreq,request,rindex,rflag,MPI_STATUSES_IGNORE,info)I IF (rflag.EQV..TRUE.) THEN IF (rindex.EQ.MPI_UNDEFINED) THEN nonblock_timer = MPI_Wtime(info) - nonblock_time0 WRITE(*,*) p rank, ': all non-blocking stuff completed in ', nonblock_timer EXIT ELSE nonblock_timer = MPI_Wtime(info) - nonblock_time0 ENDIF ELSE nonblock_timer = MPI_Wtime(info) - nonblock_time0 IF (nonblock_timer.GT.nonblock_timeout) THEN WRITE(*,*) p rank, ': non-blocking stuff timed out' DO k=1,kreqINUUUUUUUUUUUUUUUUUUUUCALL MPI_Test(request(k),rflag,MPI_STATUS_IGNORE,info)I IF (.NOT.rflag) THEN WRITE(*,*) p rank, ': was still waiting for recv from ', p irecvlist(klist(k))I ENDIF ENDDO UUUCALL MPI_Abort(p comm,info)I ENDIF ENDIF ENDDO #endifI DO UUUCALL MPI_WaitAny(kreqrecv,recvreqs,rindex,MPI_STATUSES_IGNORE,info)I IF(rindex.EQ.MPI_UNDEFINED) EXIT k = klistrecv(rindex)I kbuffer = irecvoff(k)-1 IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9,A,I9)') 'IRecv ', rindex, 'completed, k = ', k CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF DO j=1,p buffer_setI jbuffer = pp(k,j) - 1 DO i=1,precv(k)*p buffer_dim(j)I jbuffer = jbuffer + 1 kbuffer = kbuffer + 1 p recvbufferd(jbuffer) = irecvd(kbuffer)I END DO END DO END DO IF (p debug .GT. 1) THEN WRITE(mesg,'(A)') 'All IRecv completed' CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF CALL MPI_Waitall(kreqsend,sendreqs,MPI_STATUSES_IGNORE,info)I IF (p debug .GT. 1) THEN WRITE(mesg,'(A)') 'All ISend completed' CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t� ! deallocate non-blocking things !------------------------ginys,max,phys,mis,t�lEmax,t� iopt = p param_dealloc CALL p alloc(klist,ldu,iopt,info)I CALL p alloc(request,ldu,iopt,info)I ! 4 new arrays CALL p alloc(klistsend,ldu,iopt,info)I CALL p alloc(sendreqs,ldu,iopt,info)I CALL p alloc(klistrecv,ldu,iopt,info)I CALL p alloc(recvreqs,ldu,iopt,info)I CALL p alloc(isendoff,ldu,iopt,info)I CALL p alloc(irecvoff,ldu,iopt,info)I CALL p alloc(isendd,ldu,iopt,info)I CALL p alloc(irecvd,ldu,iopt,info)I ELSE #ifdef __NONBLOCKDBG CALL MPI_Barrier(p comm,info)I nonblock_time0 = MPI_Wtime(info)I WRITE(*,*) p rank, ': nonblocking ddebug started'I nonblock_timeout = 20.0_mk DO CALL MPI_TestAny(kreq,request,rindex,rflag,MPI_STATUSES_IGNORE,info)I IF (rflag.EQV..TRUE.) THEN IF (rindex.EQ.MPI_UNDEFINED) THEN nonblock_timer = MPI_Wtime(info) - nonblock_time0 WRITE(*,*) p rank, ': all non-blocking stuff completed in ', nonblock_timer EXIT ELSE nonblock_timer = MPI_Wtime(info) - nonblock_time0 ENDIF ELSE nonblock_timer = MPI_Wtime(info) - nonblock_time0 IF (nonblock_timer.GT.nonblock_timeout) THEN WRITE(*,*) p rank, ': non-blocking stuff timed out' DO k=1,kreqINUUUUUUUUUUUUUUUUUUUUCALL MPI_Test(request(k),rflag,MPI_STATUS_IGNORE,info)I IF (.NOT.rflag) THEN WRITE(*,*) p rank, ': was still waiting for recv from ', p irecvlist(klist(k))I ENDIF ENDDO UUUCALL MPI_Abort(p comm,info)I ENDIF ENDIF ENDDO #endifI DO UUUCALL MPI_WaitAny(kreqrecv,recvreqs,rindex,MPI_STATUSES_IGNORE,info)I IF(rindex.EQ.MPI_UNDEFINED) EXIT k = klistrecv(rindex)I kbuffer = irecvoff(k)-1 IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9,A,I9)') 'IRecv ', rindex, 'completed, k = ', k CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF DO j=1,p buffer_setI jbuffer = pp(k,j) - 1 DO i=1,precv(k)*p buffer_dim(j)I jbuffer = jbuffer + 1 kbuffer = kbuffer + 1 p recvbuffers(jbuffer) = irecvs(kbuffer)I END DO IF ((precv(k).GT.0).AND.(p debug .GT. 1)) THEN jbuffer = pp(k,j) WRITE(mesg,'(A,I9,I9,F10.4,A,I9)') 'Final recv hash ',&INUUUU& k,j,SUM(p recvbuffers(jbuffer:jbuffer+precv(k)* &INUUUU& p buffer_dim(j)-1)),' from ',p irecvlist(k) UUUCALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF END DO END DO IF (p debug .GT. 1) THEN WRITE(mesg,'(A)') 'All IRecv completed' CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF CALL MPI_Waitall(kreqsend,sendreqs,MPI_STATUSES_IGNORE,info)I IF (p debug .GT. 1) THEN WRITE(mesg,'(A)') 'All ISend completed' CALL p write(p rank,'p map_field send_noblock',mesg,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t� ! deallocate non-blocking things !------------------------ginys,max,phys,mis,t�lEmax,t� iopt = p param_dealloc CALL p alloc(klist,ldu,iopt,info)I CALL p alloc(request,ldu,iopt,info)I ! 4 new arrays CALL p alloc(klistsend,ldu,iopt,info)I CALL p alloc(sendreqs,ldu,iopt,info)I CALL p alloc(klistrecv,ldu,iopt,info)I CALL p alloc(recvreqs,ldu,iopt,info)I CALL p alloc(isendoff,ldu,iopt,info)I CALL p alloc(irecvoff,ldu,iopt,info)I CALL p alloc(isends,ldu,iopt,info)I CALL p alloc(irecvs,ldu,iopt,info)I END IF !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� ! Deallocate the send buffer to save memory !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� iopt = p param_dealloc IF (p kind .EQ. p kind_single) THEN CALL p alloc(p sendbuffers,ldu,iopt,info)I ELSE CALL p alloc(p sendbufferd,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error_error CALL p error(p err_alloc,'p map_field send_noblock', &INUUUU& 'send buffer PPM_SENDBUFFER',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� iopt = p param_dealloc CALL p alloc(nsend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'send counter NSEND',__LINE__,info)I ENDIF CALL p alloc(nrecv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'receive counter NRECV',__LINE__,info)I ENDIF CALL p alloc(psend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'particle send counter PSEND',__LINE__,info)I ENDIF CALL p alloc(precv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'particle receive counter PRECV',__LINE__,info)I ENDIF CALL p alloc( p ,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'work array PP',__LINE__,info)I ENDIF CALL p alloc( qq,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'work array QQ',__LINE__,info)I ENDIF CALL p alloc(recvd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'local receive buffer RECVD',__LINE__,info)I ENDIF CALL p alloc(recvs,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'local receive buffer RECVS',__LINE__,info)I ENDIF CALL p alloc(sendd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'local send buffer SENDD',__LINE__,info)I ENDIF CALL p alloc(sends,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field send_noblock', &INUUUU& 'local send buffer SENDS',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� 9999 CONTINUE CALL substop('p map_field send_noblock',t0,info)I RETURNI END SUBROUTINE p map_field send_noblock �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_store.f�����������������������������������������������������������0000644�0001752�0001753�00000021341�11616003524�020564� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_part_store !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_part_store(info)I !!! This routine stores the state of the current/active particle mapping.I !!!I !!! This is especially useful for alternating ghost-get/ghost-putI !!! mappings, which are used for implementing the communication in !!! symmetric particle interactions. The `p map_part_ghost_get` mapping !!! can then be stored after its first call and reloaded after each !!! ghost-put mapping.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_state USE p module_alloc USE p module_error USE p module_substart USE p module_substopI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! This routine is ALL integer, except the timing variable t0 ! We pick double as the precision - no real reason for that !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, PARAMETER :: MK = p kind_double !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, INTENT(OUT) :: info !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(1) :: ldu INTEGER :: i,j,k INTEGER :: ioptI REAL(MK) :: t0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_store',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN IF (.NOT. p initialized) THEN info = p error_error CALL p error(p err_argument,'p map_part_store', &INUUUU& 'Please call p init first!',__LINE__,info)I GOTO 9999 ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the map type (is used in send() line 229) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type_state = p map_typeI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! store the p nsendlist: the number of processers to send to !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendlist_state = p nsendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! store the p nsendbuffer: the size of the send buffer - here zero !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendbuffer_state = 0 I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! store the p buffer_set: the current number of sets stored - here zero !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set_state = 0 I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! store the p psendbuffer: ! first allocate memory for itI !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� iopt = p param_alloc_fitI ldu(1) = p nsendlist + 1 CALL p alloc(p psendbuffer_state,ldu,iopt,info)I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_store', &INUUUU& 'allocation of psendbuffer_state failed',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! then store it: pointer to the first particle in the send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=1,p nsendlist+1 p psendbuffer_state(k) = p psendbuffer(k) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! store the p buffer2part ! first allocate memory for itI !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� iopt = p param_alloc_fitI ldu(1) = SIZE(p buffer2part) CALL p alloc(p buffer2part_state,ldu,iopt,info)I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_store', &INUUUU& 'allocation of buffer2part_state failed',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! then store it: pointer to the particle id of the j-th entry in the ! send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=1,p nsendlistI DO j=p psendbuffer(k),p psendbuffer(k+1)-1 p buffer2part_state(j) = p buffer2part(j)I ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the p nrecvlist and p sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nrecvlist_state = p nrecvlist p nsendlist_state = p nsendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the receive list !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� iopt = p param_alloc_fitI ldu(1) = p nrecvlist CALL p alloc(p irecvlist_state,ldu,iopt,info)I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_store', &INUUUU& 'allocation of irecvlist_state failed',__LINE__,info)I GOTO 9999 ENDIF DO k=1,p nrecvlist p irecvlist_state(k) = p irecvlist(k) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the send list !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� iopt = p param_alloc_fitI ldu(1) = p nsendlistI CALL p alloc(p isendlist_state,ldu,iopt,info)I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_state', &INUUUU& 'allocation of isendlist_state failed',__LINE__,info)I GOTO 9999 ENDIF DO k=1,p nsendlistI p isendlist_state(k) = p isendlist(k) ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�,phys,mis,t�lEmax,t� 9999 CONTINUE CALL substop('p map_part_store',t0,info)I RETURNI END SUBROUTINE p map_part_store �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_connect_prune.f��������������������������������������������������������0000644�0001752�0001753�00000030045�11616003524�021245� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_connect_prune !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_connect_prune(topoid,cd,lda,Ncon,id,Npart,lsymm,info)I !!! This routine prunes all connections that are not neededI !!! on this processor according to the current topologyI !!! and whether symmetry will be used or not.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substart USE p module_substopI USE p module_error USE p module_alloc USE p module_util_invert_listI USE p module_check_idI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: topoidI !!! ID of current topologyI INTEGER, DIMENSION(:,:), POINTER :: cdI !!! Connection data INTEGER , INTENT(IN ) :: ldaI !!! Leading dimension of cd(:,:) INTEGER , INTENT(INOUT) :: NconI !!! Number of connectionsI INTEGER, DIMENSION(:) , INTENT(IN ) :: idI !!! Local to global particle number mapping INTEGER , INTENT(IN ) :: Npart !!! Number of particlesI LOGICAL , INTENT(IN ) :: lsymmI !!! Is symmetric? INTEGER , INTENT( OUT) :: info !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(2) :: ldu INTEGER :: i,j,k,iopt,icon,part,prunemode REAL(p kind_double) :: t0 LOGICAL :: validI INTEGER :: ncons_local !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_connect_prune',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if we have a ring topology ... !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t prunemode = 0 IF (topoid .EQ. p param_topo_undefined) THEN prunemode = 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! ... or any other valid topologyI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ELSE IF (topoid .NE. p param_topo_undefined) THEN IF (lsymm) THEN ! if all particles are there prunemode = 2 ELSE ! lowest idI prunemode = 1 ENDIF ELSE ! no topology defined prunemode = 0 ENDIF IF (prunemode .NE. 0) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Allocate !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm iopt = p param_alloc_fitI ldu(1) = ldaI ldu(2) = NconI CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_prune', &INUUUU& 'allocating connection list CD_LOCAL',__LINE__,info)I GOTO 9999 ENDIF cd_local(:,:) = cd(:,:) ncons_local = NconI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Get the inverse of the local to global particle id mapping !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm iopt = p param_alloc_fitI ldu(1) = Npart CALL p alloc(id_tem ,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_prune', &INUUUU& 'allocating connection array ID_TEMP',__LINE__,info)I GOTO 9999 ENDIF id_tem (1:Npart) = id(1:Npart) CALL p util_invert_list(id_tem ,id_inv,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_prune', &INUUUU& 'inverting id list',__LINE__,info)I GOTO 9999 ENDIF iopt = p param_dealloc CALL p alloc(id_tem ,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_prune', &INUUUU& 'deallocating connection array ID_TEMP',__LINE__,info)I GOTO 9999 ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! prunemode 1: remove all connections where we do not have the particle ! with the lowest ID of the connection !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (prunemode .EQ. 1) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Loop over all connections !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm icon = 0 DO j = 1,ncons_local !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Get the particle with the lowest ID in this connection !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� part = MINVAL(cd_local(:,j)) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Check if we have this particle !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� IF ((part .GE. LBOUND(id_inv,1)) .AND. &INUUUU& (part .LE. UBOUND(id_inv,1))) THEN IF (id_inv(part) .EQ. -HUGE(part)) THEN cd_local(1,j) = -1 icon = icon + 1 ENDIF ELSE cd_local(1,j) = -1 icon = icon + 1 ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! prunemode 2: remove all connections we do not have all particles ! for !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ELSE IF (prunemode .EQ. 2) THEN icon = 0 DO j = 1,ncons_local k = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! Loop over all particles in the connection and count how ! many are missing.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� DO i = 1,ldaI IF ((cd_local(i,j) .GE. LBOUND(id_inv,1)) .AND. &INUUUU& (cd_local(i,j) .LE. UBOUND(id_inv,1))) THEN IF (id_inv(cd_local(i,j)) .EQ. -HUGE(cd_local(i,j))) THEN k = k + 1 ENDIF ELSE k = k + 1 ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� ! If at least one particle is missing we prune this connection !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t� IF (k .GT. 0) THEN cd_local(1,j) = -1 icon = icon + 1 ENDIF ENDDO ENDIF IF (prunemode .NE. 0) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Prepare the final connection array !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ldu(1) = ldaI ldu(2) = Ncon - icon iopt = p param_alloc_fitI CALL p alloc(cd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_prune', &INUUUU& 'allocating connection array CD',__LINE__,info)I GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Go through all connections and save all that are not marked !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm Ncon = 0 DO j = 1,ncons_local IF (cd_local(1,j) .NE. -1) THEN Ncon = Ncon + 1 cd(:,Ncon) = cd_local(:,j) ENDIF ENDDO iopt = p param_dealloc CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_prune', &INUUUU& 'deallocating connection list CD_LOCAL',__LINE__,info)I GOTO 9999 ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_connect_prune',t0,info)I RETURNI CONTAINSI SUBROUTINE check IF (Ncon .LT. 0) THEN info = p error_fatal CALL p error(p err_argument, &INUUUU& 'p map_connect_prune', &INUUUU& 'Number of connections must be >=0',__LINE__,info)I GOTO 8888 ENDIF IF (topoid .NE. p param_topo_undefined) THEN CALL p check_topoid(topoid,valid,info)I IF (.NOT. valid) THEN info = p error_error CALL p error(p err_argument,'p map_connect_prune', &INUUUU& 'topoid out of range',__LINE__,info)I GOTO 8888 ENDIF ENDIF 8888 CONTINUE END SUBROUTINE check END SUBROUTINE p map_connect_prune �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_push.f������������������������������������������������������������0000644�0001752�0001753�00000211560�11616003524�020413� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_part_push !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __DIM == 1 #if __KIND == __SINGLE_PRECISIONI SUBROUTINE p map_part_push_1ds(pdata,Npart,info,pushpp) #elif __KIND == __DOUBLE_PRECISIONI SUBROUTINE p map_part_push_1dd(pdata,Npart,info,pushpp) #elif __KIND == __SINGLE_PRECISION_COMPLEXI SUBROUTINE p map_part_push_1dsc(pdata,Npart,info,pushpp) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI SUBROUTINE p map_part_push_1ddc(pdata,Npart,info,pushpp) #elif __KIND == __INTEGERI SUBROUTINE p map_part_push_1di(pdata,Npart,info,pushpp) #elif __KIND == __LOGICALI SUBROUTINE p map_part_push_1dl(pdata,Npart,info,pushpp) #endifI#elif __DIM == 2 #if __KIND == __SINGLE_PRECISIONI SUBROUTINE p map_part_push_2ds(pdata,lda,Npart,info,pushpp) #elif __KIND == __DOUBLE_PRECISIONI SUBROUTINE p map_part_push_2dd(pdata,lda,Npart,info,pushpp) #elif __KIND == __SINGLE_PRECISION_COMPLEXI SUBROUTINE p map_part_push_2dsc(pdata,lda,Npart,info,pushpp) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI SUBROUTINE p map_part_push_2ddc(pdata,lda,Npart,info,pushpp) #elif __KIND == __INTEGERI SUBROUTINE p map_part_push_2di(pdata,lda,Npart,info,pushpp) #elif __KIND == __LOGICALI SUBROUTINE p map_part_push_2dl(pdata,lda,Npart,info,pushpp) #endifI#endifI !!! This routine pushes particle data onto the send buffer.I !!!I !!! [NOTE]I !!! The first part of the buffer contains the on processor data.I !!! The packing could be performed more efficiently.I !!!I !!! [WARNING]I !!! DIM is the dimension of the pdata array and not the spaceI !!! dimension p dim! !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substart USE p module_substopI USE p module_error USE p module_alloc IMPLICIT NONE #if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEXI INTEGER, PARAMETER :: MK = p kind_single #else INTEGER, PARAMETER :: MK = p kind_double #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __DIM == 1 #if __KIND == __INTEGERI INTEGER , DIMENSION(: ), INTENT(IN ) :: pdata #elif __KIND == __LOGICALI LOGICAL , DIMENSION(: ), INTENT(IN ) :: pdata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEXI COMPLEX(MK), DIMENSION(: ), INTENT(IN ) :: pdata #else REAL(MK), DIMENSION(: ), INTENT(IN ) :: pdata #endifI #elif __DIM == 2 #if __KIND == __INTEGERI INTEGER , DIMENSION(:,:), INTENT(IN ) :: pdata #elif __KIND == __LOGICALI LOGICAL , DIMENSION(:,:), INTENT(IN ) :: pdata #elif __KIND == __SINGLE_PRECISION_COMPLEX | \I __KIND == __DOUBLE_PRECISION_COMPLEXI COMPLEX(MK), DIMENSION(:,:), INTENT(IN ) :: pdata #else REAL(MK), DIMENSION(:,:), INTENT(IN ) :: pdata #endifI#endifI !!! Particle data.I !!! Can be either 1D or 2D array. #if __DIM == 2I INTEGER , INTENT(IN ) :: ldaI !!! The leading dimension of the pdata.I#endifI INTEGER , INTENT(IN ) :: Npart !!! Number of particlesI INTEGER , INTENT( OUT) :: info !!! Returns 0 upon success LOGICAL, OPTIONAL , INTENT(IN ) :: pushpp !!! If `TRUE` then pdata is assumed to contain the particle positions !!! (xp) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER :: i,j,k,ipart,ibuffer,icount INTEGER :: iopt,ldb,incr REAL(MK) :: t0 LOGICAL :: lpushpp #if __DIM == 1 INTEGER, PARAMETER :: lda = 1 #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_push',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! The default is that we do not push the particle positions !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (PRESENT(pushpp)) THEN lpushpp = pushpp ELSE lpushpp = .FALSE. ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Increment the buffer set !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = p buffer_set + 1 I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the buffer dimension and typeI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow_preserveI ldu(1) = p buffer_set CALL p alloc(p buffer_dim ,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_push', &INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__LINE__,info)I GOTO 9999 ENDIF CALL p alloc(p buffer_type,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_push', &INUUUU& 'buffer types PPM_BUFFER_TYPE',__LINE__,info)I GOTO 9999 ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! A complex number is treated as two reals. Cannot change ldaI ! because it is INTENT(IN) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEXI ldb = 2*ldaI#else ldb = ldaI#endif I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the dimension and typeI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_dim(p buffer_set) = ldb #if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEXI p buffer_type(p buffer_set) = p kind_single #elif __KIND == __DOUBLE_PRECISION | __KIND == __DOUBLE_PRECISION_COMPLEXI p buffer_type(p buffer_set) = p kind_double #elif __KIND == __INTEGERI p buffer_type(p buffer_set) = p integer #elif __KIND == __LOGICALI p buffer_type(p buffer_set) = p logical #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over the processors in the p isendlist() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ibuffer = p nsendbuffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! DOUBLE PRECISION BUFFER !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p kind.EQ.p kind_double) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! (Re)allocate memory for the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma incr = 0 I DO i=1,p nsendlistI incr = incr + (p psendbuffer(i+1)-p psendbuffer(i))*ldb ENDDO ldu(1) = p nsendbuffer + incr iopt = p param_alloc_grow_preserveI CALL p alloc(p sendbufferd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_push', &INUUUU& 'global send buffer PPM_SENDBUFFERD',__LINE__,info)I GOTO 9999 ENDIF DO i=1,p nsendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! access the particles belonging to the i-th processor in the ! sendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Store the particle data in the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI#if __DIM == 2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI IF (lda .EQ. 1) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISIONI p sendbufferd(ibuffer) = pdata(1,ipart) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(1,ipart)) #elif __KIND == __INTEGERI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 2) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISIONI p sendbufferd(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(2,ipart) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(2,ipart)) #elif __KIND == __INTEGERI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=3I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 3) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISIONI p sendbufferd(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(2,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(3,ipart) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(3,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(3,ipart)), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(2,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(3,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(3,ipart)) #elif __KIND == __INTEGERI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_double) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(3,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=4I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 4) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISIONI p sendbufferd(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(2,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(3,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(4,ipart) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(3,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(3,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(4,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(4,ipart)), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(2,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(3,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(3,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(4,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(4,ipart)) #elif __KIND == __INTEGERI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_double) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(3,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(4,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=5I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 5) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(5,ipart), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISIONI p sendbufferd(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(2,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(3,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(4,ipart) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = pdata(5,ipart) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(3,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(3,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(4,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(4,ipart)), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(5,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(5,ipart)), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(1,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(2,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(2,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(3,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(3,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(4,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(4,ipart)) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(5,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(5,ipart)) #elif __KIND == __INTEGERI p sendbufferd(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(pdata(5,ipart), &INUUUU& p kind_double) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(3,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(4,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF ibuffer = ibuffer + 1 IF (pdata(5,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Not unrolled for the rest. Vector length will be lda!!I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSE DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I DO k=1,ldaI ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONI p sendbufferd(ibuffer) = REAL(pdata(k,ipart), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISIONI p sendbufferd(ibuffer) = pdata(k,ipart) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(k,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(k,ipart)), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = &INUUUU& REAL(pdata(k,ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(k,ipart)) #elif __KIND == __INTEGERI p sendbufferd(ibuffer) = REAL(pdata(k,ipart), &INUUUU& p kind_double) #elif __KIND == __LOGICALI IF (pdata(k,ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF #endifI ENDDO ENDDO ENDIF #elif __DIM == 1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Scalar versionI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __SINGLE_PRECISIONI p sendbufferd(ibuffer) = REAL(pdata(ipart),p kind_double) #elif __KIND == __DOUBLE_PRECISIONI p sendbufferd(ibuffer) = pdata(ipart) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = REAL(pdata(ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = REAL(AIMAG(pdata(ipart)), &INUUUU& p kind_double) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbufferd(ibuffer) = REAL(pdata(ipart),p kind_double) ibuffer = ibuffer + 1 p sendbufferd(ibuffer) = AIMAG(pdata(ipart)) #elif __KIND == __INTEGERI p sendbufferd(ibuffer) = REAL(pdata(ipart),p kind_double) #elif __KIND == __LOGICALI IF (pdata(ipart)) THEN p sendbufferd(ibuffer) = 1.0_p kind_double ELSE p sendbufferd(ibuffer) = 0.0_p kind_double ENDIF #endifI ENDDO #endifI ENDDO ! i=1,p nsendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! SINGLE PRECISION BUFFER !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! (Re)allocate memory for the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma incr = 0 I DO i=1,p nsendlistI incr = incr + (p psendbuffer(i+1)-p psendbuffer(i))*ldb ENDDO ldu(1) = p nsendbuffer + incr iopt = p param_alloc_grow_preserveI CALL p alloc(p sendbuffers,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_push', &INUUUU& 'global send buffer PPM_SENDBUFFERS',__LINE__,info)I GOTO 9999 ENDIF DO i=1,p nsendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! access the particles belonging to the i-th processor in the ! sendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Store the particle data in the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI#if __DIM == 2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI IF (lda .EQ. 1) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISIONI p sendbuffers(ibuffer) = pdata(1,ipart) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(1,ipart)) #elif __KIND == __INTEGERI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 2) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mEmax,t�lh999999999t�lI ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISIONI p sendbuffers(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(2,ipart) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(2,ipart)) #elif __KIND == __INTEGERI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=3I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 3) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999t�lI ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISIONI p sendbuffers(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(2,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(3,ipart) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(3,ipart)), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(2,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(3,ipart)) #elif __KIND == __INTEGERI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(3,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=4I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 4) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999t�lI ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISIONI p sendbuffers(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(2,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(3,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(4,ipart) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(3,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(4,ipart)), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(2,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(3,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(4,ipart)) #elif __KIND == __INTEGERI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(3,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(4,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Unrolled for lda=5I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSEIF (lda .EQ. 5) THEN DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999t�lI ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(5,ipart), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISIONI p sendbuffers(ibuffer) = pdata(1,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(2,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(3,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(4,ipart) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = pdata(5,ipart) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(1,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(2,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(3,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(4,ipart)), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(5,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(5,ipart)), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(1,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(2,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(3,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(4,ipart)) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(5,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(5,ipart)) #elif __KIND == __INTEGERI p sendbuffers(ibuffer) = REAL(pdata(1,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(2,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(3,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(4,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(pdata(5,ipart), &INUUUU& p kind_single) #elif __KIND == __LOGICALI IF (pdata(1,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(2,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(3,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(4,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF ibuffer = ibuffer + 1 IF (pdata(5,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF #endifI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Not unrolled. Vector length will be lda !!I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ELSE DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ipart = p buffer2part(j)I DO k=1,ldaI ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONI p sendbuffers(ibuffer) = REAL(pdata(k,ipart), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISIONI p sendbuffers(ibuffer) = pdata(k,ipart) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(k,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(k,ipart)), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(k,ipart), &INUUUU& p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(k,ipart)) #elif __KIND == __INTEGERI p sendbuffers(ibuffer) = REAL(pdata(k,ipart), &INUUUU& p kind_single) #elif __KIND == __LOGICALI IF (pdata(k,ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF #endifI ENDDO ENDDO ENDIF #elif __DIM == 1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Scalar versionI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ipart = p buffer2part(j)I ibuffer = ibuffer + 1 #if __KIND == __DOUBLE_PRECISIONI p sendbuffers(ibuffer) = REAL(pdata(ipart),p kind_single) #elif __KIND == __SINGLE_PRECISIONI p sendbuffers(ibuffer) = pdata(ipart) #elif __KIND == __DOUBLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(ipart),p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = REAL(AIMAG(pdata(ipart)), &INUUUU& p kind_single) #elif __KIND == __SINGLE_PRECISION_COMPLEXI p sendbuffers(ibuffer) = REAL(pdata(ipart),p kind_single) ibuffer = ibuffer + 1 p sendbuffers(ibuffer) = AIMAG(pdata(ipart)) #elif __KIND == __INTEGERI p sendbuffers(ibuffer) = REAL(pdata(ipart),p kind_single) #elif __KIND == __LOGICALI IF (pdata(ipart)) THEN p sendbuffers(ibuffer) = 1.0_p kind_single ELSE p sendbuffers(ibuffer) = 0.0_p kind_single ENDIF #endifI ENDDO #endifI ENDDO ! i=1,p nsendlistI ENDIF ! p kind !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! If we are pushing particle positions (if lpushpp is true) we need to ! add the offset to the particles; pushing the particles can only occur ! for 2D arrays in single or double precions: xp is USUALLY stored as ! xp(1:p dim,1:Npart) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (lpushpp) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! the particle positions are per construction (by a call to ghost_get) ! ALWAYS stored from ibuffer = 1 to nsendbuffer(2) - 1 and the ! p ghost_offset is therefore also stored from 1 - nsendbuffer(2)-1 ! thus icount = 1 and ibuffer = p nsendlist (which has not yet been ! updated (see below) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma icount = 0 I ibuffer = p nsendbufferI IF (p kind.EQ.p kind_double) THEN DO i=1,p nsendlistI IF (lda.EQ.2) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for lda=2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ibuffer = ibuffer + 1 icount = icount + 1 p sendbufferd(ibuffer) = p sendbufferd(ibuffer) &INUUUU& + p ghost_offsetd(icount) ibuffer = ibuffer + 1 icount = icount + 1 p sendbufferd(ibuffer) = p sendbufferd(ibuffer) &INUUUU& + p ghost_offsetd(icount) ENDDO ELSEIF (lda.EQ.3) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for lda=3I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ibuffer = ibuffer + 1 icount = icount + 1 p sendbufferd(ibuffer) = p sendbufferd(ibuffer) &INUUUU& + p ghost_offsetd(icount) ibuffer = ibuffer + 1 icount = icount + 1 p sendbufferd(ibuffer) = p sendbufferd(ibuffer) & INUUUU& + p ghost_offsetd(icount) ibuffer = ibuffer + 1 icount = icount + 1 p sendbufferd(ibuffer) = p sendbufferd(ibuffer) & INUUUU& + p ghost_offsetd(icount) ENDDO ENDIF ! end of lda = 3I ENDDO ! enddo of nsendlistI ELSE ! buffers are single precision DO i=1,p nsendlistI IF (lda.EQ.2) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for lda=2I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ibuffer = ibuffer + 1 icount = icount + 1 p sendbuffers(ibuffer) = p sendbuffers(ibuffer) &INUUUU& + p ghost_offsets(icount) ibuffer = ibuffer + 1 icount = icount + 1 p sendbuffers(ibuffer) = p sendbuffers(ibuffer) &INUUUU& + p ghost_offsets(icount) ENDDO ELSEIF (lda.EQ.3) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Unrolled for lda=3I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 DO j=p psendbuffer(i),p psendbuffer(i+1)-1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! Get the particle id !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ibuffer = ibuffer + 1 icount = icount + 1 p sendbuffers(ibuffer) = p sendbuffers(ibuffer) &INUUUU& + p ghost_offsets(icount) ibuffer = ibuffer + 1 icount = icount + 1 p sendbuffers(ibuffer) = p sendbuffers(ibuffer) & INUUUU& + p ghost_offsets(icount) ibuffer = ibuffer + 1 icount = icount + 1 p sendbuffers(ibuffer) = p sendbuffers(ibuffer) & INUUUU& + p ghost_offsets(icount) ENDDO ENDIF ! end of lda = 3I ENDDO ! enddo of nsendlistI ENDIF ! end of single/double precision buffers ENDIF ! end of lpushpp !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Update the particle buffer count !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendbuffer = ibuffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_part_push',t0,info)I RETURN CONTAINS SUBROUTINE checkI#if __DIM == 2I IF (lda .LT. 1) THEN info = p error_error CALL p error(p err_argument,'p map_part_push', &INUUUU& 'lda must be >0 for vector data',__LINE__,info)I GOTO 8888I ENDIF #elif __DIM == 1I IF (lda .NE. 1) THEN info = p error_error CALL p error(p err_argument,'p map_part_push', &INUUUU& 'lda must be =1 for scalar data',__LINE__,info)I GOTO 8888I ENDIF #endifI IF (Npart .LT. 0) THEN info = p error_error CALL p error(p err_argument,'p map_part_push', &INUUUU& 'Npart must be >=0',__LINE__,info)I GOTO 8888I ENDIF 8888 CONTINUE END SUBROUTINE checkI#if __DIM == 1I#if __KIND == __SINGLE_PRECISIONI END SUBROUTINE p map_part_push_1ds #elif __KIND == __DOUBLE_PRECISIONI END SUBROUTINE p map_part_push_1dd #elif __KIND == __SINGLE_PRECISION_COMPLEXI END SUBROUTINE p map_part_push_1dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEXI END SUBROUTINE p map_part_push_1ddc #elif __KIND == __INTEGERI END SUBROUTINE p map_part_push_1di #elif __KIND == __LOGICALI END SUBROUTINE p map_part_push_1dl #endifI #elif __DIM == 2I#if __KIND == __SINGLE_PRECISIONI END SUBROUTINE p map_part_push_2ds #elif __KIND == __DOUBLE_PRECISIONI END SUBROUTINE p map_part_push_2dd #elif __KIND == __SINGLE_PRECISION_COMPLEXI END SUBROUTINE p map_part_push_2dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEXI END SUBROUTINE p map_part_push_2ddc #elif __KIND == __INTEGERI END SUBROUTINE p map_part_push_2di #elif __KIND == __LOGICALI END SUBROUTINE p map_part_push_2dl #endifI#endifI������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_load.f������������������������������������������������������������0000644�0001752�0001753�00000017773�11616003524�020365� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_part_load !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_part_load(info)I !!! This routine loads the internally stored particle mapping.I !!!I !!! See `p map_part_store` for more information. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_state USE p module_alloc USE p module_error USE p module_substart USE p module_substop IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! This routine is ALL integer, except the timing variable t0 ! We pick double as the precision - no real reason for that !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, PARAMETER :: MK = p kind_double !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, INTENT(OUT) :: infoI !!! Returns stutus, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(1) :: ldu INTEGER :: i,j,k INTEGER :: ioptI REAL(MK) :: t0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_load',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN IF (.NOT. p initialized) THEN info = p error_error CALL p error(p err_argument,'p map_part_load', &INUUUU& 'Please call p init first!',__LINE__,info)I GOTO 9999I ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the map type (is used in send() line 229) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p map_type_state I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the p nsendlist: the number of processers to send to !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendlist = p nsendlist_state !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the p nsendbuffer: the size of the send buffer - here zero !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendbuffer = p nsendbuffer_state I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the p buffer_set: the current number of sets stored - here zero !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = p buffer_set_state I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the p psendbuffer: ! first allocate memory for it !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p nsendlist + 1 CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_load', &INUUUU& 'allocation of psendbuffer failed',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! then load it: pointer to the first particle in the send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=1,p nsendlist+1I p psendbuffer(k) = p psendbuffer_state(k)I ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the p buffer2part ! first allocate memory for it !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = SIZE(p buffer2part_state) CALL p alloc(p buffer2part,ldu,iopt,info)I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_load', &INUUUU& 'allocation of buffer2part failed',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! then load it: pointer to the particle id of the j-th entry in the ! send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=1,p nsendlistI DO j=p psendbuffer(k),p psendbuffer(k+1)-1 p buffer2part(j) = p buffer2part_state(j)I ENDDO ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Store the p nrecvlist and p sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nrecvlist = p nrecvlist_state I p nsendlist = p nsendlist_state I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the receive listI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p nrecvlist CALL p alloc(p irecvlist,ldu,iopt,info)I DO k=1,p nrecvlist p irecvlist(k) = p irecvlist_state(k)I ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! load the send listI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = p nsendlistI CALL p alloc(p isendlist,ldu,iopt,info)I DO k=1,p nsendlistI p isendlist(k) = p isendlist_state(k) I ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_part_load',t0,info)I RETURN END SUBROUTINE p map_part_load �����libp -1.2.1/src/map/ghost_map_periodic_bc_y.inc����������������������������������������������������0000644�0001752�0001753�00000006635�11616003524�022061� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! (Re)allocate memory for the periodic ghostsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI iopt = p param_alloc_grow_preserve ldu(1) = p dim ldu(2) = 2*nghostplusI CALL p alloc(xt,ldu,iopt,info) I CALL p alloc(xt_offset,ldu,iopt,info) I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_ghost_get', &INU& 'xt',__LINE__,info)I GOTO 9999I ENDIF ldu(1) = ldu(2)I CALL p alloc(ighost,ldu,iopt,info) I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_ghost_get', &INU& 'ighost',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! clear out the new segment of xt_offset to be able to copy the ! correct values from the previous loop through xt_offset !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI FORALL(i=1:p dim,j=nghostplus+1:2*nghostplus) &INUUUU &UU xt_offset(i,j) = 0.0_MK !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! copy periodic ghosts in the y-directionI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI yminf = min_phys(2)I ymini = min_phys(2) + ghostsize k = nghostplusI DO i=1,nghostplusI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! first those at the south boundary I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I IF (xt(2,i).GE.yminf.AND.xt(2,i).LT.ymini) THEN k = k + 1 ighost(k) = ighost(i) xt(1,k) = xt(1,i) xt(2,k) = xt(2,i) + len_phys(2)I xt_offset(1,k) = xt_offset(1,i) xt_offset(2,k) = len_phys(2)I IF (p dim.EQ.3) THEN xt(3,k) = xt(3,i) xt_offset(3,k) = xt_offset(3,i) ENDIF ENDIFI ENDDO IF (isymm.EQ.0) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! then the north bc, but only if we are not using symmetry !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ymaxf = max_phys(2)I ymaxi = max_phys(2) - ghostsize DO i=1,nghostplusI IF (xt(2,i).GT.ymaxi.AND.xt(2,i).LT.ymaxf) THEN k = k + 1 ighost(k) = ighost(i) xt(1,k) = xt(1,i) xt(2,k) = xt(2,i) - len_phys(2)I xt_offset(1,k) = xt_offset(1,i) xt_offset(2,k) = -len_phys(2)I IF (p dim.EQ.3) THEN xt(3,k) = xt(3,i) xt_offset(3,k) = xt_offset(3,i) ENDIF ENDIFI ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! update the ghost counterI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI nghostplus = kI���������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_part_send.f������������������������������������������������������������0000644�0001752�0001753�00000067502�11616003524�020372� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l999t�lI ! Subroutine : p map_part_send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_part_send(Npart,Mpart,info)I !!! This routine performs the actual send/recv of the particles and allI !!! pushed data.I !!!I !!! [NOTE]I !!! The first part of the buffer contains the on processor data. TheI !!! packing could be performed more efficiently.I !!!I !!! [NOTE]I !!! The two send/recv of the integers should be combined into oneI !!! send/receive !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substart USE p module_substop USE p module_error USE p module_alloc USE p module_write IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPI INCLUDE 'mpif.h'I#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: Npart !!! The old number of particles on the processor INTEGER , INTENT( OUT) :: Mpart !!! The new number of particles on processor after the send/recv INTEGER , INTENT( OUT) :: infoI !!! Return status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldl,ldu INTEGER :: i,j,k,idom,nbuffer,ibuffer,jbuffer,bdim,sbdim INTEGER :: iopt,count,tag1,qpart,msend,mrecv INTEGER :: npart_send,npart_recv CHARACTER(p char) :: mesg REAL(pp kind_double) :: t0 #ifdef __MPI INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_send',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 3) THEN CALL checkI IF (info .NE. 0) GOTO 9999I ENDIF ! skip if the buffer is empty IF (p buffer_set .LT. 1) THEN info = p error_noticeI IF (p debug .GT. 1) THEN CALL p error(p err_buffer_empt,'p map_part_send', &INUUUU& 'Buffer is empty: skipping send!',__LINE__,info)I ENDIFI GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow ldu(1) = MAX(p nsendlist,1)I IF ((p nsendlist.NE.old nsendlist) .OR. &INUUUU& (p buffer_set.NE.old buffer_set)) THEN old nsendlist = p nsendlistI old buffer_set = p buffer_setI CALL p alloc(nsend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'send counter NSEND',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(nrecv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'receive counter NRECV',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(psend,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'particle send counter PSEND',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(precv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'particle receive counter PRECV',__LINE__,info)I GOTO 9999I ENDIF ldu(2) = p buffer_set CALL p alloc(pp,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'work buffer PP',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(qq,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'work buffer QQ',__LINE__,info)I GOTO 9999I ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the total size of the buffer dimensions ! It is handy... simplifies many summations, avoids loops, etc... !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t sbdim = 0 DO j=1,p buffer_setI sbdim = sbdim + p buffer_dim(j)I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffer that will NOT be sentI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t qpart = (p psendbuffer(2) - p psendbuffer(1))I ibuffer = sbdim*qpart !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialize the counter for the total set of new particles !JHW 20060928 IF (p map_type.EQ.p param_map_ghost_get) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p map_type.EQ.p param_map_ghost_get.OR. &INUUUU p map_type.EQ.p param_map_ghost_put) THEN Mpart = qpart + Npart ELSE Mpart = qpartI ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Count the size of the buffer that WILL be sentI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nrecvbuffer = ibuffer nsend(1) = ibuffer nrecv(1) = ibuffer psend(1) = qpartI precv(1) = qpartI mrecvNUUUU = -1 msendNUUUU = -1 DO k=2,p nsendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! The number of particles send off to the k-th processor in the ! sendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma qpart = (p psendbuffer(k+1) - p psendbuffer(k))I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Store the number of particles to send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma psend(k) = qpart ! store the number of particles to send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Store the size of the data to be send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma nsend(k) = sbdim*qpart #ifdef __MPI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Make a send/recv of the number of particles and data size to that ! has to be send/recv !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! The following IF is needed in order to skip "dummy" ! communication rounds where the current processor has to waitI ! (only needed in the partial mapping). IF (p isendlist(k) .GE. 0 .AND. p irecvlist(k) .GE. 0) THEN tag1 = 100 IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I5,2(A,I9))') 'sending to ', &INUUUU& p isendlist(k),', nsend=',nsend(k),', psend=',psend(k) CALL p write(p rank,'p map_part_send',mesg,info)I ENDIFI CALL MPI_SendRecv(psend(k),1,MPI_INTEGER,p isendlist(k),tag1, &INUUUU& precv(k),1,MPI_INTEGER,p irecvlist(k),tag1, &INUUUU& p comm,status,info)I I ! Compute nrecv(k) from precv(k)I nrecv(k) = sbdim*precv(k)I IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I5,2(A,I9))') 'received from ', &INUUUU& p irecvlist(k),', nrecv=',nrecv(k),', precv=',precv(k)I CALL p write(p rank,'p map_part_send',mesg,info)I ENDIFI ELSE ! skip this round, i.e. neither send nor receive any ! particles.I nrecv(k) = 0 precv(k) = 0 ENDIF #endifII ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Find the required (maximum) size of the send/recv buffers !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO k=2,p nsendlistI IF (mrecv.LE.nrecv(k)) mrecvN= nrecv(k)I ENDDO DO k=2,p nsendlistI IF (msend.LE.nsend(k)) msendN= nsend(k)I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Increment the total receive buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO k=2,p nsendlistI p nrecvbuffer = p nrecvbuffer + nrecv(k)I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Increment the total number of particle to receive !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO k=2,p nsendlistI Mpart = Mpart + precv(k)I ENDDO IF (p debug .GT. 1) THEN WRITE(mesg,'(2(A,I9))') 'mrecv=',mrecv,', msend=',msend CALL p write(p rank,'p map_part_send',mesg,info)I WRITE(mesg,'(A,I9)') 'p nrecvbuffer=',p nrecvbuffer CALL p write(p rank,'p map_part_send',mesg,info)I WRITE(mesg,'(A,I9)') 'Mpart=',Mpart CALL p write(p rank,'p map_part_send',mesg,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate the memory for the copy of the particle buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow ldu(1) = p nrecvbuffer IF (p kind.EQ.p kind_double) THEN CALL p alloc(p recvbufferd,ldu,iopt,info)I ELSE CALL p alloc(p recvbuffers,ldu,iopt,info)I ENDIF IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'global receive buffer PPM_RECVBUFFER',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the smaller send and receive buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! only allocate if there actually is anything to be sent/recvd with ! other processors. Otherwise mrecvNand msendNwould both still be -1 ! (as initialized above) and the allocNwould throw a FATAL. This was ! Bug ID 000012. IF (p nsendlist .GT. 1) THEN iopt = p param_alloc_grow ldu(1) = MAX(mrecv,1)I IF (p kind.EQ.p kind_double) THEN CALL p alloc(recvd,ldu,iopt,info)I ELSE CALL p alloc(recvs,ldu,iopt,info)I ENDIF I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'local receive buffer RECV',__LINE__,info)I GOTO 9999I ENDIF ldu(1) = MAX(msend,1)I IF (p kind.EQ.p kind_double) THEN CALL p alloc(sendd,ldu,iopt,info)I ELSE CALL p alloc(sends,ldu,iopt,info)I ENDIF I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'local send buffer SEND',__LINE__,info)I GOTO 9999I ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Debugging print of the number of sets in the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'p buffer_set=',p buffer_setI CALL p write(p rank,'p map_part_send',mesg,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the total number of particles to send ! As it is now, this should be equal to Npart !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t npart_send = 0 DO j=1,p nsendlistI npart_send = npart_send + psend(j)I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the pointer to the position of the data in the main send ! buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=1,p buffer_setI IF (k.EQ.1) THEN qq(1,k) = 1 ELSE qq(1,k) = qq(1,k-1) + npart_send*p buffer_dim(k-1) ENDIF bdim = p buffer_dim(k) DO j=2,p nsendlistI qq(j,k) = qq(j-1,k) + psend(j-1)*bdim IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'qq(j,k)=',qq(j,k) CALL p write(p rank,'p map_part_send',mesg,info)I ENDIFI ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the total number of particles to receive ! As it is now, this should be equal to Mpart !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t npart_recvN= 0 DO j=1,p nsendlistI npart_recvN= npart_recvN+ precv(j)I ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute the pointer to the position of the data in the main receive ! buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k=1,p buffer_setI IF (k.EQ.1) THEN pp(1,k) = 1 ELSE pp(1,k) = pp(1,k-1) + npart_recv*p buffer_dim(k-1) ENDIF bdim = p buffer_dim(k) DO j=2,p nsendlistI pp(j,k) = pp(j-1,k) + precv(j-1)*bdim IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'pp(j,k)=',p (j,k) CALL p write(p rank,'p map_part_send',mesg,info)I WRITE(mesg,'(A,I9,A,I4)') 'precv(j-1)=',precv(j-1),', bdim=',bdim CALL p write(p rank,'p map_part_send',mesg,info)I ENDIFI ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! First copy the on processor data - which is in the first buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p kind.EQ.p kind_double) THEN DO k=1,p buffer_setI ibuffer = pp(1,k) - 1 jbuffer = qq(1,k) - 1 DO j=1,psend(1)*p buffer_dim(k)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 p recvbufferd(ibuffer) = p sendbufferd(jbuffer)I ENDDO ENDDO ELSE DO k=1,p buffer_setI ibuffer = pp(1,k) - 1 jbuffer = qq(1,k) - 1 DO j=1,psend(1)*p buffer_dim(k)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 p recvbuffers(ibuffer) = p sendbuffers(jbuffer)I ENDDO ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over the processors in the p isendlist(); skip the first entry ! which is the local processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p kind.EQ.p kind_double) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! For each send/recv !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma DO k=2,p nsendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Collect each data type (xp, vp, etc)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = qq(k,j) - 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Collect the data into the send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 DO i=1,psend(k)*p buffer_dim(j)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 sendd(ibuffer) = p sendbufferd(jbuffer)I ENDDO ENDDO I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Perform the actual send/recvI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI#ifdef __MPI ! The following IF is needed in order to skip "dummy" ! communication rounds where the current processor has to waitI ! (only needed in the partial mapping). IF (p isendlist(k) .GE. 0 .AND. p irecvlist(k) .GE. 0) THEN tag1 = 300 CALL MPI_SendRecv( &INUUUU& sendd,nsend(k),p mpi kind,p isendlist(k),tag1, &INUUUU& recvd,nrecv(k),p mpi kind,p irecvlist(k),tag1, &INUUUU& p comm,status,info)I ENDIF #else recvd = sendd #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Store the data back in the recv bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = pp(k,j) - 1 DO i=1,precv(k)*p buffer_dim(j)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 p recvbufferd(jbuffer) = recvd(ibuffer)I ENDDO ENDDO ENDDO ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! For each send/recv !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma DO k=2,p nsendlistI !------------------------ginys,,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Collect each data type (xp, vp, etc)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = qq(k,j) - 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 ! Collect the data into the send buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999 DO i=1,psend(k)*p buffer_dim(j)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 sends(ibuffer) = p sendbuffers(jbuffer)I ENDDO ENDDO I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Perform the actual send/recvI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI#ifdef __MPI ! The following IF is needed in order to skip "dummy" ! communication rounds where the current processor has to waitI ! (only needed in the partial mapping). IF (p isendlist(k) .GE. 0 .AND. p irecvlist(k) .GE. 0) THEN tag1 = 400 CALL MPI_SendRecv( &INUUUU& sends,nsend(k),p mpi kind,p isendlist(k),tag1, & INUUUU& recvs,nrecv(k),p mpi kind,p irecvlist(k),tag1, &INUUUU& p comm,status,info)I ENDIF #else recvs = sends #endifII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ! Store the data back in the recv bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lI ibuffer = 0 DO j=1,p buffer_setI jbuffer = pp(k,j) - 1 DO i=1,precv(k)*p buffer_dim(j)I ibuffer = ibuffer + 1 jbuffer = jbuffer + 1 p recvbuffers(jbuffer) = recvs(ibuffer)I ENDDO ENDDOI ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! before we through away the precv() data let us store it for later use: ! when sending ghosts back (p map_part_ghost_put())I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p map_type.EQ.p param_map_ghost_get) THEN ldu(1) = p nsendlist + 1 iopt = p param_alloc_grow CALL p alloc(p precvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'global recv buffer pointer PPM_PRECVBUFFER',__LINE__,info)I GOTO 9999I ENDIF !print*,'in p map_part_send'I p precvbuffer(1) = Npart + 1 DO k=1,p nsendlistI p precvbuffer(k+1) = p precvbuffer(k) + precv(k)I ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! low level debugging !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !write(mesg,'(a,i4.4)') 'recvbuf',p rank !open(10,file=mesg) !do i=1,p nrecvbuffer,2 ! write(10,*) p recvbuffers(i),p recvbuffers(i+1) !enddo !close(10) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate the send buffer to save memory !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc IF (p kind .EQ. p kind_single) THEN CALL p alloc(p sendbuffers,ldu,iopt,info)I ELSE CALL p alloc(p sendbufferd,ldu,iopt,info)I ENDIFI IF (info .NE. 0) THEN info = p error_error CALL p error(p err_alloc,'p map_part_send', &INUUUU& 'send buffer PPM_SENDBUFFER',__LINE__,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc ! CALL p alloc(nsend,ldu,iopt,info)I! IF (info .NE. 0) THEN ! info = p error_error ! CALL p error(p err_dealloc,'p map_part_send', &I!NUUUU& 'send counter NSEND',__LINE__,info)I! ENDIFI! CALL p alloc(nrecv,ldu,iopt,info)I! IF (info .NE. 0) THEN ! info = p error_error ! CALL p error(p err_dealloc,'p map_part_send', &I!NUUUU& 'receive counter NRECV',__LINE__,info)I! ENDIFI! CALL p alloc(psend,ldu,iopt,info)I! IF (info .NE. 0) THEN ! info = p error_error ! CALL p error(p err_dealloc,'p map_part_send', &I!NUUUU& 'particle send counter PSEND',__LINE__,info)I! ENDIFI! CALL p alloc(precv,ldu,iopt,info)I! IF (info .NE. 0) THEN ! info = p error_error ! CALL p error(p err_dealloc,'p map_part_send', &I!NUUUU& 'particle receive counter PRECV',__LINE__,info)I! ENDIFI! CALL p alloc( p ,ldu,iopt,info)I! IF (info .NE. 0) THEN ! info = p error_error ! CALL p error(p err_dealloc,'p map_part_send', &I!NUUUU& 'work array PP',__LINE__,info)I! ENDIFI! CALL p alloc( qq,ldu,iopt,info)I! IF (info .NE. 0) THEN ! info = p error_error ! CALL p error(p err_dealloc,'p map_part_send', &I!NUUUU& 'work array QQ',__LINE__,info)I! ENDIFI CALL p alloc(recvd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_part_send', &INUUUU& 'local receive buffer RECVD',__LINE__,info)I ENDIFI CALL p alloc(recvs,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_part_send', &INUUUU& 'local receive buffer RECVS',__LINE__,info)I ENDIFI CALL p alloc(sendd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_part_send', &INUUUU& 'local send buffer SENDD',__LINE__,info)I ENDIFI CALL p alloc(sends,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_part_send', &INUUUU& 'local send buffer SENDS',__LINE__,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUEI CALL substop('p map_part_send',t0,info)I RETURN CONTAINS SUBROUTINE checkI IF (Npart .LT. 0) THEN info = p error_error CALL p error(p err_argument,'p map_part_send', &INUUUU& 'Npart must be >=0',__LINE__,info)I GOTO 8888I ENDIFI 8888 CONTINUEI END SUBROUTINE checkI END SUBROUTINE p map_part_sendI����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_connect_distrib.f������������������������������������������������������0000644�0001752�0001753�00000044326�11616003524�021563� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_connect_distrib !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_connect_distrib(cd,lda,Ncon,id,Npart,info)I !!! This routine distributes the connections to all processors such !!! that every processor has all the connections it has at least oneI !!! particle for.I !!!I !!! This routine directly sends and receives the connection data as !!! integers !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substart USE p module_substop USE p module_error USE p module_alloc USE p module_util_invert_listI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPI INCLUDE 'mpif.h'I#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(:,:), POINTER :: cd !!! Connection data INTEGER , INTENT(IN ) :: lda !!! Leading dimension of cd(:,:) INTEGER , INTENT(INOUT) :: Ncon !!! Number of connections INTEGER, DIMENSION(:) , INTENT(IN ) :: id !!! Local to global particle number mapping INTEGER , INTENT(IN ) :: Npart !!! Number of particles INTEGER , INTENT( OUT) :: infoI !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(2) :: ldu INTEGER :: i,j,k,l,msend,mrecv,iopt,ipos,icon REAL(pp kind_double) :: t0 INTEGER :: tag,cd_size,ncons_local,itarget,isourceI INTEGER :: hops,ilda #ifdef __MPI INTEGER, DIMENSION(MPI_STATUS_SIZE) :: mpstatus #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_connect_distrib',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Get the inverse of the local to global particle id mapping !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fitI ldu(1) = Npart CALL p alloc(id_temp,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'allocating connection array ID_TEMP',__LINE__,info)I GOTO 9999I ENDIF id_temp(1:Npart) = id(1:Npart) CALL p util_invert_list(id_temp,id_inv,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'inverting id list',__LINE__,info)I GOTO 9999I ENDIF iopt = p param_dealloc CALL p alloc(id_temp,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'deallocating connection array ID_TEMP',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Prepare the buffer for the local connections !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t cd_size = 10I ldu(1) = lda ldu(2) = cd_size iopt = p param_alloc_fitI CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'allocating connection array CD_LOCAL',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find the connections that stay on this processor !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ncons_localN= 0 DO j = 1,Ncon DO i = 1,lda IF ((cd(i,j) .GE. LBOUND(id_inv,1)) .AND. &INUUUU& (cd(i,j) .LE. UBOUND(id_inv,1))) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999999 ! If any local particle is in the current connection, keep itI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999999 IF (id_inv(cd(i,j)) .GT. -HUGE(cd(i,j))) THEN ncons_localN= ncons_localN+ 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 ! Increase the buffer if necessary !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 IF (ncons_localN.GT. cd_size) THEN cd_size = cd_size + 10I iopt = p param_alloc_grow preserveI ldu(1) = lda ldu(2) = cd_size CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc, &INUUUU& 'p map_connect_distrib', &INUUUU& 'allocating connection array CD_LOCAL',&INUUUU& __LINE__,info)I GOTO 9999I ENDIFI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999I ! Store this connection in the array and go to the next oneI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99999I DO ilda=1,lda I cd_local(ilda,ncons_local) = cd(ilda,j)I ENDDO I EXITI ENDIFI ENDIFI ENDDO ENDDO #ifdef __MPI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Compute whom to send the connections and who to receive the ! connections from !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t itarget = MOD(p nproc + p rank - 1, p nproc)I isource = MOD(p rank + 1, p nproc)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Send it to all processors !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t hops = p nproc - 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Calculate the size of the data that we are going to send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t msendN= Ncon*lda !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the sendbuffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fitI ldu(1) = msend CALL p alloc(sendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'allocating send buffer SENDBUFFER',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Fill the sendbuffer with all connections we have !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ipos = 1 DO j = 1,Ncon DO i = 1,lda sendbuffer(ipos) = cd(i,j)I ipos = ipos + 1 ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Send the connection data to the next proc and receive them from the ! previous !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t DO k = 1,hops !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! First tell the neighbour how many connection we are going to send. ! The other neighbour tells us how many connections we will getI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma tag = 100 CALL MPI_SendRecv(msend,1,MPI_INTEGER,itarget,tag, &INUUUU& mrecv,1,MPI_INTEGER,isource,tag, &INUUUU& p comm,mpstatus,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Allocate memory for the receivebuffer since we now know its size !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma iopt = p param_alloc_fitI ldu(1) = mrecvI CALL p alloc(recvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'allocating receive buffer RECVBUFFER',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Send and receive the actual connection data !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma tag = 200 CALL MPI_SendRecv(sendbuffer,msend,MPI_INTEGER,itarget,tag, &INUUUU& recvbuffer,mrecv,MPI_INTEGER,isource,tag, &INUUUU& p comm,mpstatus,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Pick out the connections that we need !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma DO j = 1,mrecv,lda DO i = 1,lda IF ((recvbuffer(j+(i-1)) .GE. LBOUND(id_inv,1)) .AND. &INUUUU& (recvbuffer(j+(i-1)) .LE. UBOUND(id_inv,1))) THEN IF (id_inv(recvbuffer(j+(i-1))) .GT. -HUGE(recvbuffer(j+(i-1)))) THEN ncons_localN= ncons_localN+ 1 IF (ncons_localN.GT. cd_size) THEN cd_size = cd_size + 10I iopt = p param_alloc_grow preserveI ldu(1) = lda ldu(2) = cd_size CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc, &INUUUU& 'p map_connect_distrib', &INUUUU& 'allocating connection array CD_LOCAL',&INUUUU& __LINE__,info)I GOTO 9999I ENDIFI ENDIFI cd_local(:,ncons_local) = recvbuffer(j:(j+lda-1))I EXITI ENDIFI ENDIFI ENDDOI ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! The just received connections will be send to the next proc !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma msendN= mrecvI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Swap the sendbuffer and receivebufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma tempbuffer => sendbuffer sendbuffer => recvbuffer recvbuffer => tempbuffer ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(sendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'deallocating send buffer SENDBUFFER',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(recvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'deallocating receive buffer RECVBUFFER',__LINE__,info)I GOTO 9999I ENDIF #endifI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Shrink the array if we allocated more than needed !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF ((ncons_localN.LT. cd_size) .AND. (ncons_localN.NE. 0)) THEN iopt = p param_alloc_fit preserveI ldu(1) = lda ldu(2) = ncons_local CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'allocating connection CD_LOCAL',__LINE__,info)I GOTO 9999I ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(id_inv,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'deallocating inverted id list ID_INV',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Mark all connections that we have more than once !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iconN= 0 DO j = 1,ncons_local-1 IF (cd_local(1,j) .EQ. -1) CYCLEI DO k = j+1,ncons_localI lN= 0 DO i = 1,lda IF (cd_local(i,j) .EQ. cd_local(i,k)) THEN lN= l + 1 ENDIFI ENDDOII IF (l .EQ. lda) THEN cd_local(1,k) = -1 iconN= iconN+ 1 ENDIFI ENDDO ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Prepare the final connection array !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = lda ldu(2) = ncons_localN- icon iopt = p param_alloc_fitI CALL p alloc(cd,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'allocating connection array CD',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Go through all connections and save all that are not marked !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t NconN= 0 DO j = 1,ncons_local IF (cd_local(1,j) .NE. -1) THEN NconN= NconN+ 1 DO ilda=1,lda cd(ilda,Ncon) = cd_local(ilda,j)I ENDDO I ENDIF ENDDO !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(cd_local,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_connect_distrib', &INUUUU& 'deallocating connection array CD_LOCAL',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUEI CALL substop('p map_connect_distrib',t0,info)I RETURN CONTAINS SUBROUTINE checkI IF (NconN.LT. 0) THEN info = p error_fatal CALL p error(p err_argument,'p map_connect_distrib', &INUUUU& 'Number of connections must be >=0',__LINE__,info)I GOTO 8888I ENDIFI 8888 CONTINUEI END SUBROUTINE checkI END SUBROUTINE p map_connect_distrib ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_ghost_init.f�����������������������������������������������������0000644�0001752�0001753�00000106261�11616003524�021721� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_field_ghost_init !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see <http://www.gnu.org/licenses/>. ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_field_ghost_init(topoid,meshid,ghostsize,info)I !!! This routine sets up the lists needed for sending and receiving !!! ghost mesh points on a given topology/mesh combination.I !!! These lists are stored for later use by p map_field_ghost_get and !!! `p map_field_ghost_put`.I !!!I !!! [IMPORTANT]I !!! This routine should never be called by the user, the library willI !!! call this routine before the first `p map_field_ghost_get` or !!! `p map_field_ghost_put`.I !!!I !!! [NOTE]I !!! The lists are now saved in the mesh structure for which the ghostI !!! mappings are initialized. There is no need to reinitialize after !!! doing global mappingsI !!!I !!! [WARNING]I !!! The new version of this routine might cause some memory overheadI !!!I !!! [NOTE]I !!! The first part of the send/recv lists contains the on-processor data.I !!! The names send and recv are correct for the ghost get map. ForI !!! the put case, they need to be interpreted the other way round.I !!! The shift cases for periodic images are currently hard coded.I !!! Probably there is a more elegant way of doing this. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_mesh USE p module_typedef USE p module_substart USE p module_substop USE p module_error USE p module_alloc USE p module_write USE p module_check_id USE p module_mesh_block_intersect USE p module_util_commoptI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPI INCLUDE 'mpif.h'I#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: topoidI !!! Topology ID INTEGER , INTENT(IN ) :: meshidI !!! Mesh ID INTEGER, DIMENSION(:) , INTENT(IN ) :: ghostsizeI !!! Size of the ghost layer in numbers of grid points in all spaceI !!! dimensions (1...p dim). INTEGER , INTENT( OUT) :: infoI !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(4) :: ldu INTEGER, DIMENSION(p dim) :: op INTEGER, DIMENSION(p dim,26) :: ond INTEGER :: i,j,sendrank,recvrank,idom,jdom,k INTEGER :: iopt,iset,ibuffer,pdim,isize,nnd INTEGER :: nsendlist,nsend,tag1,lb,ub,nrecv CHARACTER(p char) :: mesgI REAL(pp kind_double) :: t0 LOGICAL :: lsouth,lnorth,least,lwest,ltop,lbottom #ifdef __MPI INTEGER, DIMENSION(MPI_STATUS_SIZE) :: commstatI#endif TYPE(pp t_topo), POINTER :: topo => NULL() TYPE(pp t_equi_mesh), POINTER :: mesh => NULL() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_field_ghost_init',t0,info)I pdim = p dimI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999I ENDIF topo => pp topo(topoid)%tI mesh => topo%mesh(meshid)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! check if the optimal communication protocol is known for this ! topology !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (.NOT.topo%isoptimized) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax ! if not: determine it before calling map_field_ghost_init !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax CALL p util_commopt(topoid,info)I IF (info.NE.0) GOTO 9999I IF (p debug .GT. 1) THEN DO i=1,topo%nneighproc WRITE(mesg,'(A,I4)') 'have neighbor: ',topo%ineighproc(i)I CALL p write(p rank,'p map_field_ghost_init',mesg,info)I END DOI DO i=1,topo%ncommseq WRITE(mesg,'(A,I4)') 'communicate: ',topo%icommseq(i)I CALL p write(p rank,'p map_field_ghost_init',mesg,info)I END DOI ENDIF ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Save the map type for the subsequent calls (used to check push/pop) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p param_map_init !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t isize = topo%nsublist iopt = p param_alloc_fitI ldu(1) = isizeI CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I GOTO 9999I ENDIF ldu(1) = pdim ldu(2) = isizeI CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'local mesh block offset list IOFFSET',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Pre-calculate shift offsets for periodic ghost images of subs !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t op(1) = mesh%Nm(1) - 1 op(2) = mesh%Nm(2) - 1 IF (pdim .GT. 2) THEN op(3) = mesh%Nm(3) - 1 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find intersecting mesh domains to be sent for the ghost get !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nsendlistN= 0 DO i=1,topo%nsublist idom = topo%isublist(i)I ond(1:pdim,1:26) = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! First, we check the neighbors of the subdomain !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO j=1,topo%nneighsubs(i)I jdom = topo%ineighsubs(j,i)I ! source and destination meshes and topologies are identicalI CALL p mesh_block_intersect(topoid,topoid,meshid,meshid, &INUUUU& idom,jdom,ond(1:pdim,1),ghostsize,nsendlist,isendfromsub, &INUUUU& isendtosub,isendblkstart,isendblksize,ioffset,info)I IF (info .NE. 0) GOTO 9999I ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! In periodic systems, the box needs to be shifted and overlaps ! recomputed in order to get the periodic image neighbors. ! Check if any face of this sub coincides with a periodic domain ! boundary.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm lwest = .FALSE.I IF ((topo%bcdef(1) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(1,idom)N.NE. 0)) lwest = .TRUE.I least = .FALSE.I IF ((topo%bcdef(2) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(2,idom)N.NE. 0)) least = .TRUE.I lsouth = .FALSE.I IF ((topo%bcdef(3) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(3,idom)N.NE. 0)) lsouth = .TRUE.I lnorth = .FALSE.I IF ((topo%bcdef(4) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(4,idom)N.NE. 0)) lnorth = .TRUE.I IF (pdim .GT. 2) THEN lbottom= .FALSE.I IF ((topo%bcdef(5) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(5,idom)N.NE. 0)) lbottom = .TRUE.I ltop = .FALSE.I IF ((topo%bcdef(6) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(6,idom)N.NE. 0)) ltop = .TRUE.I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Determine number of shifts and actual shift indices needed !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm nndN= 0I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ENDIF IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ENDIF IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd) = op(2)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(2,nnd) = op(2)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(2,nnd) = op(2)I ENDIFI ENDIF IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd) = -op(2)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(2,nnd) = -op(2)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(2,nnd) = -op(2)I ENDIFI ENDIF IF (pdim .GT. 2) THEN IF (lbottom) THEN nndN= nndN+ 1 ond(3,nnd) = op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(3,nnd) = op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(3,nnd) = op(3)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(2,nnd) = op(2)I ond(3,nnd) = op(3)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(2,nnd) = -op(2)I ond(3,nnd) = op(3)I ENDIFI ENDIFI ENDIFI IF (ltop) THEN nndN= nndN+ 1 ond(3,nnd) = -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(3,nnd) = -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(3,nnd) = -op(3)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(2,nnd) = op(2)I ond(3,nnd) = -op(3)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd) = op(1)I ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd) = -op(1)I ond(2,nnd) = -op(2)I ond(3,nnd) = -op(3)I ENDIFI ENDIFI ENDIFI ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Do the shifting and compute periodic ghost mesh blocks !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO k=1,nnd ! first with the original (non-shifted) image of itself jdom = idom CALL p mesh_block_intersect(topoid,topoid,meshid,meshid, &INUUUU& idom,jdom,ond(1:pdim,k),ghostsize,nsendlist,isendfromsub, &INUUUU& isendtosub,isendblkstart,isendblksize,ioffset,info)I IF (info .NE. 0) GOTO 9999I ! Then with all the neighborsI DO j=1,topo%nneighsubs(i)I jdom = topo%ineighsubs(j,i)I CALL p mesh_block_intersect(topoid,topoid,meshid,meshid, &INUUUU& idom,jdom,ond(1:pdim,k),ghostsize,nsendlist,isendfromsub,&INUUUU& isendtosub,isendblkstart,isendblksize,ioffset,info)I IF (info .NE. 0) GOTO 9999I ENDDOI ENDDO ENDDO ! i=1,p nsublist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Grow memory for the mesh ghost maps !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_grow preserveI ldu(1) = nsendlist CALL p alloc(mesh%ghost_fromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost source subs MESH%GHOST_FROMSUB',__LINE__,info)I GOTO 9999I ENDIF !CALL p alloc(p mesh_ghost_recvfromsub,ldu,iopt,info)I !IF (info .NE. 0) THEN ! info = p error_fatal ! CALL p error(p err_alloc,'p map_field_ghost_init', &INUU!UU& 'ghost recv source subs PPM_MESH_GHOST_RECVFROMSUB',__LINE__,info)I ! GOTO 9999I ! ENDIF CALL p alloc(mesh%ghost_tosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost target subs MESH%GHOST_TOSUB',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(mesh%ghost_recvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost recv target subs MESH%GHOST_RECVTOSUB',__LINE__,info)I GOTO 9999I ENDIF ldu(1) = topo%ncommseqN+ 1 CALL p alloc(mesh%ghost_blk,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost block listNPMESH%GHOST_BLK',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(mesh%ghost_recvblk,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost recv block listNMESH%GHOST_RECVBLK',__LINE__,info)I GOTO 9999I ENDIF ldu(1) = pdim ldu(2) = nsendlist CALL p alloc(mesh%ghost_blkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost block start list MESH%GHOST_BLKSTART',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(mesh%ghost_recvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost recv block start list MESH%GHOST_RECVBLKSTART', &INUUUU& __LINE__,info)I GOTO 9999I ENDIF CALL p alloc(mesh%ghost_blksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost block size list MESH%GHOST_BLKSIZE',__LINE__,info)I GOTO 9999I ENDIF CALL p alloc(mesh%ghost_recvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost recv block size list MESH%GHOST_RECVBLKSIZE', &INUUUU& __LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate local memory for sorted offset list !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = pdim ldu(2) = nsendlist CALL p alloc(mesh_ghost_offset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'ghost block offset list MESH_GHOST_OFFSET',__LINE__,info)I GOTO 9999I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over the neighboring processors according to the optimized ! communication sequence. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t mesh%ghost_nsendN= nsendlist mesh%ghost_nrecv = 0I mesh%ghost_blk(1) = 1I mesh%ghost_recvblk(1) = 1I iset = 0I ibuffer = 0I isize = SIZE(mesh%ghost_fromsub,1)I DO i=1,topo%ncommseq !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! get the next processor to send/recv with !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma sendrank = topo%icommseq(i)I recvrank = sendrankI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Initialize mesh block pointers !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ibuffer = iN+ 1 mesh%ghost_blk(ibuffer) = mesh%ghost_blk(i) mesh%ghost_recvblk(ibuffer) = mesh%ghost_recvblk(i)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�l-ma ! Only assign data if there is any communication in this round !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (sendrank .GE. 0) THEN I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I ! Find all mesh blocks that are sent and store them.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I DO j=1,nsendlist IF (topo%sub2proc(isendtosub(j)) .EQ. sendrank) THEN mesh%ghost_blk(ibuffer) = &INUUUU& mesh%ghost_blk(ibuffer)+1 iset = mesh%ghost_blk(ibuffer) - 1 ! store this for the topology as it can be reused mesh%ghost_fromsub(iset)=isendfromsub(j)I mesh%ghost_tosub(iset) =isendtosub(j) mesh%ghost_blkstart(1:pdim,iset) = &INUUUU& isendblkstart(1:pdim,j) mesh%ghost_blksize(1:pdim,iset) = &INUUUU& isendblksize(1:pdim,j) ! also re-order the offsets as we need them for ! computing the receive lists further down !!I mesh_ghost_offset(1:pdim,iset) = ioffset(1:pdim,j) IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:2,j),' of size ',isendblksize(1:2,j),&INUUUU& ' to ',sendrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:3,j),' of size ',isendblksize(1:3,j),&INUUUU& ' to ',sendrank ENDIFI CALL p write(p rank,'p map_field_ghost_init', &INUUUU& mesg,info)I ENDIFI ENDIFI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I ! Build receive lists for the on-processor part of the data !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�I IF (sendrank .EQ. p rank) THEN ub = mesh%ghost_blk(2)I mesh%ghost_nrecv = ub - 1 mesh%ghost_recvblk(2) = ub DO j=1,ub-1 mesh%ghost_recvtosub(j) = mesh%ghost_tosub(j) ! p mesh_ghost_recvfromsub(j,meshid,topoid) = & ! & p mesh_ghost_fromsub(j,meshid,topoid) mesh%ghost_recvblkstart(1:pdim,j) = &INUUUU& mesh%ghost_blkstart(1:pdim,j) + &INUUUU& mesh_ghost_offset(1:pdim,j) mesh%ghost_recvblksize(1:pdim,j) = &INUUUU& mesh%ghost_blksize(1:pdim,j) ENDDOII#ifdef __MPI ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 ! Communicate the block indices !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 lb = mesh%ghost_blk(i)I ub = mesh%ghost_blk(ibuffer) ! How many blocks am I sending to that guy nsendN= ub - lb tag1 = 100 CALL MPI_SendRecv(nsend,1,MPI_INTEGER,sendrank,tag1,nrecv,1, &INUUUU& MPI_INTEGER,recvrank,tag1,p comm,commstat,info)I ! How many blocks will I receive from the guy?I mesh%ghost_nrecv = mesh%ghost_nrecv + nrecv mesh%ghost_recvblk(ibuffer) = mesh%ghost_recvblk(i) + nrecv !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 ! Check if receive lists are large enough !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 IF (mesh%ghost_nrecv .GT. isize) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! Grow receive lists if needed !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 isize = mesh%ghost_nrecv iopt = p param_alloc_grow preserveI ldu(1) = isizeI ! CALL p alloc(p mesh_ghost_recvfromsub,ldu,iopt,info)I ! IF (info .NE. 0) THEN ! info = p error_fatal ! CALL p error(p err_alloc, &INUU!UU& 'p map_field_ghost_init', &INUU!UU& 'ghost recv source subs PPM_MESH_GHOST_RECVFROMSUB',&INUU!UU& __LINE__,info)I ! GOTO 9999I ! ENDIFI CALL p alloc(mesh%ghost_recvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc, &INUUUU& 'p map_field_ghost_init', &INUUUU& 'ghost recv target subs PPM_MESH_GHOST_RECVTOSUB',&INUUUU& __LINE__,info)I GOTO 9999I ENDIFI ldu(1) = pdim ldu(2) = isizeI CALL p alloc(mesh%ghost_recvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc, &INUUUU& 'p map_field_ghost_init', &INUUUU& 'ghost recv block start PPM_MESH_GHOST_RECVBLKSTART',&INUUUU& __LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(mesh%ghost_recvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc, &INUUUU& 'p map_field_ghost_init', &INUUUU& 'ghost recv block size PPM_MESH_GHOST_RECVBLKSIZE',&INUUUU& __LINE__,info)I GOTO 9999I ENDIFI ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 ! Allocate memory for block data send and recv buffers !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 iopt = p param_alloc_grow ldu(1) = nsend*(2*pdim+1)I CALL p alloc(sendbuf,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'local MPI send buffer SENDBUF',__LINE__,info)I GOTO 9999I ENDIFI ldu(1) = nrecv*(2*pdim+1)I CALL p alloc(recvbuf,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_ghost_init', &INUUUU& 'local MPI recv buffer RECVBUF',__LINE__,info)I GOTO 9999I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 ! Pack and send all the ghost mesh block data !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999999 ! Pack all the send data iset = 0 DO j=lb,ub-1 iset = iset + 1 sendbuf(iset) = mesh%ghost_tosub(j) ! iset = iset + 1 ! sendbuf(iset) = p mesh_ghost_fromsub(j,meshid,topoid) sendbuf(iset+1:iset+pdim) = &INUUUU& mesh%ghost_blkstart(1:pdim,j) + &INUUUU& mesh_ghost_offset(1:pdim,j) iset = iset + pdim sendbuf(iset+1:iset+pdim) = &INUUUU& mesh%ghost_blksize(1:pdim,j) iset = iset + pdim ENDDOI ! Send it to the destination processor and get my stuff tag1 = 200 CALL MPI_SendRecv(sendbuf,iset,MPI_INTEGER,sendrank,tag1, &INUUUU& recvbuf,nrecv*(2*pdim+1),MPI_INTEGER, &INUUUU& recvrank,tag1,p comm,commstat,info)I ! Unpack the received data lb = mesh%ghost_recvblk(i)I ub = mesh%ghost_recvblk(ibuffer) iset = 0 DO j=lb,ub-1 iset = iset + 1 mesh%ghost_recvtosub(j) = recvbuf(iset) ! iset = iset + 1 ! p mesh_ghost_recvfromsub(j,meshid,topoid) = recvbuf(iset) mesh%ghost_recvblkstart(1:pdim,j) = &INUUUU& recvbuf(iset+1:iset+pdim) iset = iset + pdim mesh%ghost_recvblksize(1:pdim,j) = &INUUUU& recvbuf(iset+1:iset+pdim) iset = iset + pdim ENDDOI#endif ENDIF ! sendrank.EQ.p rank ENDIF ! sendrank .GE. 0 ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate memory of the local lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_dealloc CALL p alloc(recvbuf,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'local MPI recv buffer RECVBUF',__LINE__,info)I ENDIF CALL p alloc(sendbuf,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'local MPI send buffer SENDBUF',__LINE__,info)I ENDIF CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I ENDIF CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I ENDIF CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I ENDIF CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I ENDIF CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'local send block offset list IOFFSET',__LINE__,info)I ENDIF CALL p alloc(mesh_ghost_offset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_ghost_init', &INUUUU& 'ghost block offset list MESH_GHOST_OFFSET',__LINE__,info)I ENDIF mesh%ghost_initializedN= .TRUE.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUE CALL substop('p map_field_ghost_init',t0,info)I RETURN CONTAINS SUBROUTINE checkI CALL p check_topoid(topoid,ltop,info)I IF (.NOT. ltop) THEN info = p error_error CALL p error(p err_argument,'p map_field_ghost_init', &INUUUU& 'topoid out of range',__LINE__,info)I GOTO 8888 ENDIFI CALL p check_meshid(topoid,meshid,ltop,info)I IF (.NOT. ltop) THEN info = p error_error CALL p error(p err_argument,'p map_field_ghost_init', &INUUUU& 'meshid out of range',__LINE__,info)I GOTO 8888 ENDIFI IF (SIZE(ghostsize,1) .LT. p dim) THEN info = p error_error CALL p error(p err_argument,'p map_field_ghost_init', &INUUUU& 'ghostsize must be at least of length p dim',__LINE__,info)I GOTO 8888 ENDIFI 8888 CONTINUE END SUBROUTINE checkI END SUBROUTINE p map_field_ghost_init �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map_field_global_useperiod_store.f�����������������������������������������0000644�0001752�0001753�00000120337�11616003524�024305� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Subroutine : p map_field_global_useperiod_store !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as publishedNby the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t SUBROUTINE p map_field_global_useperiod_store(topoid,target_topoid, &INUUUU& meshid,target_meshid,info)I !!! This routine maps field data between two topologies (which !!! however need compatible meshes defined on them) using a global !!! mapping (i.e. every processor communicates with every other).I !!! Source mesh must be on the current field topology. Global lists !!! with all mesh blocks that have to be send and/or received are !!! built in this routine. Push, pop and send will use these lists.I !!! !!! [WARNING]I !!! This routine has not been tested, reviewed, or checked. Comments !!! and documentation are wrong. This routine might kill your cat or !!! worse.I !!! !!! [NOTE]I !!! The first part of the send/recv lists contains the !!! on-processor data.I !!! !!! [CAUTION]I !!! Side effect: this routine uses the same global !!! send/recv buffers, pointers and lists as the !!! particle mapping routines (reason: these buffers !!! can be large => memory issues). Field and particle !!! mappings can therefore never overlap, but one must !!! be completed before the other starts.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_data_mesh USE p module_typedef USE p module_substart USE p module_substop USE p module_error USE p module_alloc USE p module_write USE p module_check_id USE p module_mesh_block_intersectI IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER , INTENT(IN ) :: topoidI !!! Topology ID of source I !!! !!! CAUTION: used to be target INTEGER , INTENT(IN ) :: target_topoidI !!! Topology ID of target INTEGER , INTENT(IN ) :: meshidI !!! Mesh ID of source INTEGER , INTENT(IN ) :: target_meshidI !!! Mesh ID of target INTEGER , INTENT( OUT) :: infoI !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER, DIMENSION(p dim) :: op INTEGER, DIMENSION(p dim,27) :: ond INTEGER, DIMENSION(p dim) :: iblockstart,nblocksizeI INTEGER, DIMENSION(p dim) :: ghostsize INTEGER :: i,j,k,idom,sendrank,recvrank INTEGER :: iopt,iset,ibuffer,pdim,nnd INTEGER :: nsendlist,nsend INTEGER :: nrecvlist CHARACTER(p char) :: mesgI REAL(p kind_double) :: t0 LOGICAL :: lsouth,lnorth,least,lwest,ltop,lbottom LOGICAL, DIMENSION(3) :: lsymm LOGICAL :: validI TYPE(p t_topo), POINTER :: topo => NULL()I TYPE(p t_topo), POINTER :: target_topo => NULL()I TYPE(p t_equi_mesh), POINTER :: mesh => NULL()I TYPE(p t_equi_mesh), POINTER :: target_mesh => NULL()I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_field_global_useperiod_store',t0,info)I pdim = p dim !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999I ENDIFI topo => p topo(topoid)%t target_topo => p topo(target_topoid)%t mesh => topo%mesh(meshid) target_mesh => target_topo%mesh(meshid) IF (p buffer_set .GT. 0) THEN info = p error_warning CALL p error(p err_map_incomp,'p map_field_global_usep_store', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Save the map type for the subsequent calls (used for checks!)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p map_type = p param_map_global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if origin and target meshes are compatible (i.e. have the ! same number of grid points in the whole comput. domain)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN DO i=1,pdim IF (mesh%Nm(i) .NE. target_mesh%Nm(i)) THEN info = p error_noticeI CALL p write(p rank,'p map_field_global_userperiod_stored',&INUUUU& 'Source and destination meshes are of different size',info)I ENDIFI ENDDO ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check if this mapping has already been done and stored !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (.NOT.ASSOCIATED(mesh%mapping)) THEN ! iopt = p param_alloc_fit ! ldu(1) = p max_topoid ! FIXME ! CALL p mesh_alloc(p maplist,ldu,iopt,info)I! IF (info .NE. 0) THEN ! info = p error_fatal ! CALL p error(p err_alloc,'p map_field_global', &I!NUUUU& 'list of stored mappings PPM_MAP_FIELD_LIST',__LINE__,info)I! GOTO 9999I! ENDIFI ALLOCATE(mesh%mapping) END IFI I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Pre-calculate shift offsets for periodic ghost images of subs !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t op(1) = mesh%Nm(1) - 1 op(2) = mesh%Nm(2) - 1 IF (pdim .GT. 2) THEN op(3) = mesh%Nm(3) - 1 ENDIF !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = topo%nsublist CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I GOTO 9999I ENDIFI ldu(1) = pdim ldu(2) = topo%nsublist CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local send block offset list IOFFSET',__LINE__,info)I GOTO 9999I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find intersecting mesh domains to be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nsendlist = 0 ghostsize = 0 DO i=1,topo%nsublist idom = topo%isublist(i)I ond(1:pdim,1:27) = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! We now use symmetry. Only send up to ndata-1 ! unless we are at non-periodic, non-internal boundary. ! Because we do this, we need to consider periodic images. ! In periodic systems, the box needs to be shifted and overlaps ! recomputed in order to get the periodic image neighbors. ! Check if face of this sub coincides with a periodic domain ! boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm lsymm(1:pdim)N= .TRUE.I IF ((topo%bcdef(2) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(2,idom) .NE. 0)) lsymm(1)N= .FALSE.I IF ((topo%bcdef(4) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(4,idom) .NE. 0)) lsymm(2)N= .FALSE.I IF ((topo%bcdef(6) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(6,idom) .NE. 0)) lsymm(3)N= .FALSE.I lwest N= .FALSE.I least N= .FALSE.I IF ((topo%bcdef(1) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(1,idom) .NE. 0)) lwest = .TRUE.I lsouthN= .FALSE.I lnorthN= .FALSE.I IF ((topo%bcdef(3) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(3,idom) .NE. 0)) lsouthN= .TRUE.I IF (pdim .GT. 2) THEN lbottom= .FALSE.I ltop N= .FALSE.I IF ((topo%bcdef(5) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(5,idom) .NE. 0)) lbottomN= .TRUE.I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Determine number of shifts and actual shift indices needed !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm nndN= 1I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd)N= op(2)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= op(2)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= op(2)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd)N= -op(2)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= -op(2)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= -op(2)I ENDIFI ENDIFI IF (pdim .GT. 2) THEN IF (lbottom) THEN nndN= nndN+ 1 ond(3,nnd)N= op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(3,nnd)N= op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(3,nnd)N= op(3)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd)N= op(2)I ond(3,nnd)N= op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= op(3)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd)N= -op(2)I ond(3,nnd)N= op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= op(3)I ENDIFI ENDIFI ENDIFI IF (ltop) THEN nndN= nndN+ 1 ond(3,nnd)N= -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(3,nnd)N= -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(3,nnd)N= -op(3)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd)N= op(2)I ond(3,nnd)N= -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= -op(3)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd)N= -op(2)I ond(3,nnd)N= -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= -op(3)I ENDIFI ENDIFI ENDIFI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Do the shifting and compute mesh blocks !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO k=1,nnd DO j=1,target_topo%nsubs CALL p mesh_block_intersect(topoid,target_topoid,meshid,&INUUUU& target_meshid,idom,j,ond(1:pdim,k),ghostsize,nsendlist, &INUUUU& isendfromsub,isendtosub,isendblkstart,isendblksize, &INUUUU& ioffset,info,lsymm)I IF (info .NE. 0) GOTO 9999I ENDDOI ENDDO ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the local temporary receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = target_topo%nsublist CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I GOTO 9999I ENDIFI ldu(1) = pdim ldu(2) = target_topo%nsublist CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I GOTO 9999I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Find intersecting mesh domains to be received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t nrecvlist = 0 ! loop over fromtopo first and THEN over totopo in order to get the ! same ordering of mesh blocks as in the sendlist. This is crutial ! for the push and the pop to work properly !!! DO j=1,topo%nsubs ond(1:pdim,1:27) = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! We now use symmetry. Only send up to ndata-1 ! unless we are at non-periodic, non-internal boundary. ! Because we do this, we need to consider periodic images. ! In periodic systems, the box needs to be shifted and overlaps ! recomputed in order to get the periodic image neighbors. ! Check if face of this sub coincides with a periodic domain ! boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm lsymm(1:pdim)N= .TRUE.I IF ((topo%bcdef(2) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(2,j) .NE. 0)) lsymm(1)N= .FALSE.I IF ((topo%bcdef(4) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(4,j) .NE. 0)) lsymm(2)N= .FALSE.I IF ((topo%bcdef(6) .NE. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(6,j) .NE. 0)) lsymm(3)N= .FALSE.I lwest N= .FALSE.I least N= .FALSE.I IF ((topo%bcdef(1) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(1,j) .NE. 0)) lwest = .TRUE.I lsouthN= .FALSE.I lnorthN= .FALSE.I IF ((topo%bcdef(3) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(3,j) .NE. 0)) lsouthN= .TRUE.I IF (pdim .GT. 2) THEN lbottom= .FALSE.I ltop N= .FALSE.I IF ((topo%bcdef(5) .EQ. p param_bcdef_periodic) .AND. &INUUUU& (topo%subs_bc(5,j) .NE. 0)) lbottomN= .TRUE.I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Determine number of shifts and actual shift indices needed !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm nndN= 1I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd)N= op(2)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= op(2)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= op(2)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd)N= -op(2)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= -op(2)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= -op(2)I ENDIFI ENDIFI IF (pdim .GT. 2) THEN IF (lbottom) THEN nndN= nndN+ 1 ond(3,nnd)N= op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(3,nnd)N= op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(3,nnd)N= op(3)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd)N= op(2)I ond(3,nnd)N= op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= op(3)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd)N= -op(2)I ond(3,nnd)N= op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= op(3)I ENDIFI ENDIFI ENDIFI IF (ltop) THEN nndN= nndN+ 1 ond(3,nnd)N= -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(3,nnd)N= -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(3,nnd)N= -op(3)I ENDIFI IF (lsouth) THEN nndN= nndN+ 1 ond(2,nnd)N= op(2)I ond(3,nnd)N= -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= op(2)I ond(3,nnd)N= -op(3)I ENDIFI ENDIFI IF (lnorth) THEN nndN= nndN+ 1 ond(2,nnd)N= -op(2)I ond(3,nnd)N= -op(3)I IF (lwest) THEN nndN= nndN+ 1 ond(1,nnd)N= op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= -op(3)I ENDIFI IF (least) THEN nndN= nndN+ 1 ond(1,nnd)N= -op(1)I ond(2,nnd)N= -op(2)I ond(3,nnd)N= -op(3)I ENDIFI ENDIFI ENDIFI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm ! Do the shifting and compute mesh blocks !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEm DO k=1,nnd DO i=1,target_topo%nsublist idom = target_topo%isublist(i)I CALL p mesh_block_intersect(topoid,target_topoid,meshid,&INUUUU& target_meshid,j,idom,ond(1:pdim,k),ghostsize,nrecvlist, &INUUUU& irecvfromsub,irecvtosub,irecvblkstart,irecvblksize, &INUUUU& ioffset,info,lsymm)I IF (info .NE. 0) GOTO 9999I ENDDOI ENDDO ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = nsendlist CALL p alloc(p mesh_isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_globa_usep_storel', &INUUUU& 'source send sub list PPM_MESH_ISENDFROMSUB',__LINE__,info)I GOTO 9999I ENDIFI ldu(1) = pdim ldu(2) = nsendlist CALL p alloc(p mesh_isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'send block start list PPM_MESH_ISENDBLKSTART',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(p mesh_isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'send block size list PPM_MESH_ISENDBLKSIZE',__LINE__,info)I GOTO 9999I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global mesh receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_alloc_fit ldu(1) = nrecvlist CALL p alloc(p mesh_irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'destination recv sub list PPM_MESH_IRECVTOSUB',__LINE__,info)I GOTO 9999I ENDIFI ldu(1) = pdim ldu(2) = nrecvlist CALL p alloc(p mesh_irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'recv block start list PPM_MESH_IRECVBLKSTART',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(p mesh_irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'recv block size list PPM_MESH_IRECVBLKSIZE',__LINE__,info)I GOTO 9999I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Allocate memory for the global send/recv lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ldu(1) = p nprocI CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'global send rank list PPM_ISENDLIST',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'global recv rank list PPM_IRECVLIST',__LINE__,info)I GOTO 9999I ENDIFI ldu(1) = p nprocN+ 1 CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store', &INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999I ENDIFI CALL p alloc(p precvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_field_global_usep_store',&INUUUU& 'global recv buffer pointer PPM_PRECVBUFFER',__LINE__,info)I GOTO 9999I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Reset the number of buffer entries !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p buffer_set = 0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over all processors; First is the processor itself !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t sendrank = p rank - 1 recvrank = p rank + 1 p psendbuffer(1) = 1 p precvbuffer(1) = 1 p nsendlist = 0 p nrecvlist = 0 p nsendbuffer = 0 ! data length in buffer p nrecvbuffer = 0 ! data length in buffer iset = 0 ibuffer = 0 DO i=1,p nprocI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! compute the next processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI sendrank = sendrank + 1 IF (sendrank.GE.p nproc) sendrank = sendrank - p nprocI recvrank = recvrank - 1 IF (recvrank.LT. 0) recvrank = recvrank + p nprocII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Store the processor to which we will send toI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI p nsendlist = p nsendlist + 1 p isendlist(p nsendlist) = sendrankII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Store the processor to which we will recv fromI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI p nrecvlist = p nrecvlist + 1 p irecvlist(p nrecvlist) = recvrankII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Find all mesh blocks that are sent and store them.I ! To get all mesh blocks that are sent in roundI ! i=1,p nsendlist:I ! dest_rank = p isendlist(i)I ! ilo = p psendbuffer(i)I ! ihi = p psendbuffer(i+1)-1 ! DO j=ilo,ihi ! SEND(p mesh_isendblk(:,j) of sub p mesh_isendfromsub(j) toI ! processor dest_rank to sub p mesh_isendtosub(j))I ! ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ibuffer = p nsendlist + 1 p psendbuffer(ibuffer) = p psendbuffer(p nsendlist) DO j=1,nsendlist IF (target_topo%sub2proc(isendtosub(j)) .EQ. sendrank) THEN p psendbuffer(ibuffer) = p psendbuffer(ibuffer) + 1 iset = p psendbuffer(ibuffer) - 1 p mesh_isendfromsub(iset) = isendfromsub(j) p mesh_isendblkstart(1:pdim,iset) = isendblkstart(1:pdim,j) p mesh_isendblksize(1:pdim,iset) = isendblksize(1:pdim,j) IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:2,j),' of size ',isendblksize(1:2,j),&INUUUU& ' to ',sendrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:3,j),' of size ',isendblksize(1:3,j),&INUUUU& ' to ',sendrank ENDIFI CALL p write(p rank,'p map_field_global_usep_store',&INUUUU& mesg,info)I ENDIFI ENDIFI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Find all mesh blocks that are received and store them.I ! To get all mesh blocks that are received in roundI ! i=1,p nrecvlist:I ! source_rank = p irecvlist(i)I ! ilo = p precvbuffer(i)I ! ihi = p precvbuffer(i+1)-1 ! DO j=ilo,ihi ! RECV(p mesh_irecvblk(:,j) of sub p mesh_irecvfromsub(j) ! from processor source_rank to sub p mesh_irecvtosub(j))I ! ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ibuffer = p nrecvlist + 1 p precvbuffer(ibuffer) = p precvbuffer(p nrecvlist) DO j=1,nrecvlist IF (topo%sub2proc(irecvfromsub(j)) .EQ. recvrank) THEN p precvbuffer(ibuffer) = p precvbuffer(ibuffer) + 1 iset = p precvbuffer(ibuffer) - 1 p mesh_irecvtosub(iset) = irecvtosub(j) p mesh_irecvblkstart(1:pdim,iset) = irecvblkstart(1:pdim,j) &INUUUU& +ioffset(1:pdim,j) p mesh_irecvblksize(1:pdim,iset) = irecvblksize(1:pdim,j) IF (p debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:2,j),' of size ',irecvblksize(1:2,j),&INUUUU& ' from ',recvrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:3,j),' of size ',irecvblksize(1:3,j),&INUUUU& ' from ',recvrank ENDIFI CALL p write(p rank,'p map_field_global_usep_store',&INUUUU& mesg,info)I ENDIFI ENDIFI ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Deallocate memory of the local lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t iopt = p param_deallocI CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I ENDIFI CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I ENDIFI CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I ENDIFI CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I ENDIFI CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_globa_usep_store', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I ENDIFI CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I ENDIFI CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I ENDIFI CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I ENDIFI CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error_error CALL p error(p err_dealloc,'p map_field_global_usep_store', &INUUUU& 'local recv block offset list IOFFSET',__LINE__,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t 9999 CONTINUEI CALL substop('p map_field_global_useperiod_store',t0,info)I RETURNI CONTAINSI SUBROUTINE check CALL p check_topoid(target_topoid,valid,info)I IF (.NOT. valid) THEN info = p error_error CALL p error(p err_argument,'p map_field_global_usep_store',&INUUUU& 'target topoid not valid',__LINE__,info)I GOTO 8888I ENDIFI CALL p check_meshid(topoid,meshid,valid,info)I IF (.NOT. valid) THEN info = p error_error CALL p error(p err_argument,'p map_field_globa_usep_storel',&INUUUU& 'source meshid not valid',__LINE__,info)I GOTO 8888I ENDIFI CALL p check_meshid(target_topoid,target_meshid,valid,info)I IF (.NOT. valid) THEN info = p error_error CALL p error(p err_argument,'p map_field_global_usep_store',&INUUUU& 'destination meshid not valid',__LINE__,info)I GOTO 8888I ENDIFI 8888 CONTINUEI END SUBROUTINE check I END SUBROUTINE p map_field_global_useperiod_store �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/ghost map_periodic_bc_z.inc����������������������������������������������������0000644�0001752�0001753�00000006743�11616003524�022062� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! (Re)allocate memory for the periodic ghostsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I iopt = p param_alloc_grow preserveI ldu(1) = p dim ldu(2) = 2*nghostplusI CALL p alloc(xt,ldu,iopt,info) I CALL p alloc(xt_offset,ldu,iopt,info) I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_ghost get', &INU& 'xt',__LINE__,info)I GOTO 9999I ENDIFI ldu(1) = ldu(2)I CALL p alloc(ighost,ldu,iopt,info) I IF (info.NE.0) THEN info = p error_fatal CALL p error(p err_alloc,'p map_part_ghost get', &INU& 'ighost',__LINE__,info)I GOTO 9999I ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999999I ! clear out the new segment of xt_offset to be able to copy the ! correct values from the previous loop through xt_offsetI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999999I FORALL(i=1:p dim,j=nghostplus+1:2*nghostplus) &INUUUUUUUUUUU& xt_offset(i,j) = 0.0_MK I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! copy periodic ghosts in the z-directionI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I zminf = min_phys(3)I zmini = min_phys(3) + ghostsizeI I k = nghostplus I DO i=1,nghostplusI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! first those at the southNboundary I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I IF (xt(3,i).GE.zminf.AND.xt(3,i).LT.zmini) THEN k = kN+ 1 ighost(k) = ighost(i)I xt(1,k) = xt(1,i) I xt(2,k) = xt(2,i)I xt(3,k) = xt(3,i)N+ len_phys(3)II xt_offset(1,k) = xt_offset(1,i)I xt_offset(2,k) = xt_offset(2,i)I xt_offset(3,k) = len_phys(3)I ENDIFI ENDDOI IF (isymm.EQ.0) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! then the northNbc, but only if we are not using symmetry !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I zmaxf = max_phys(3)I zmaxi = max_phys(3) - ghostsizeI I DO i=1,nghostplusI IF (xt(3,i).GT.zmaxi.AND.xt(3,i).LT.zmaxf) THEN k = kN+ 1 ighost(k) = ighost(i)I xt(1,k) = xt(1,i)I xt(2,k) = xt(2,i) I xt(3,k) = xt(3,i)N- len_phys(3)II xt_offset(1,k) = xt_offset(1,i)I xt_offset(2,k) = xt_offset(2,i)I xt_offset(3,k) = -len_phys(3)I ENDIFI ENDDOI ENDIF I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! update the ghost counterI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I nghostplus = k �����������������������������libp -1.2.1/src/map/p map_part_ghost pop.f�������������������������������������������������������0000644�0001752�0001753�00000177040�11616003524�021442� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999999999999I ! Subroutine : p map_part_ghost pop !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modifyI ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __DIM ==1 #if __KIND == __SINGLE_PRECISION SUBROUTINE p map_part_ghost pop_1ds(pdata,lda,Npart,Mpart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map_part_ghost pop_1dd(pdata,lda,Npart,Mpart,info)I#elif __KIND == __SINGLE_PRECISION_COMPLEX SUBROUTINE p map_part_ghost pop_1dsc(pdata,lda,Npart,Mpart,info)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX SUBROUTINE p map_part_ghost pop_1ddc(pdata,lda,Npart,Mpart,info)I#elif __KIND == __INTEGER SUBROUTINE p map_part_ghost pop_1di(pdata,lda,Npart,Mpart,info)I#elif __KIND == __LOGICAL SUBROUTINE p map_part_ghost pop_1dl(pdata,lda,Npart,Mpart,info)I#endif I#elif __DIM == 2 #if __KIND == __SINGLE_PRECISION SUBROUTINE p map_part_ghost pop_2ds(pdata,lda,Npart,Mpart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map_part_ghost pop_2dd(pdata,lda,Npart,Mpart,info)I#elif __KIND == __SINGLE_PRECISION_COMPLEX SUBROUTINE p map_part_ghost pop_2dsc(pdata,lda,Npart,Mpart,info)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX SUBROUTINE p map_part_ghost pop_2ddc(pdata,lda,Npart,Mpart,info)I#elif __KIND == __INTEGER SUBROUTINE p map_part_ghost pop_2di(pdata,lda,Npart,Mpart,info)I#elif __KIND == __LOGICAL SUBROUTINE p map_part_ghost pop_2dl(pdata,lda,Npart,Mpart,info)I#endif #endif !!! This routine pops the contents of the receive buffer !!! when sending the ghosts back. Notice the value popped !!! will be *added* to array passed to the routine. !!! !!! [WARNING] !!! `lda` is the dimension of the pdata array and not the space !!! dimension p dim! !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Modules I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t USE p module_data USE p module_substart USE p module_substop USE p module_error USE p module_allocI USE p module_writeI IMPLICIT NONE #if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEX INTEGER, PARAMETER :: MK = p kind_singleI#elseI INTEGER, PARAMETER :: MK = p kind_double #endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #if __DIM == 1 #if __KIND == __INTEGER INTEGER , DIMENSION(: ), POINTER :: pdataI#elif __KIND == __LOGICAL LOGICAL , DIMENSION(: ), POINTER :: pdataI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX COMPLEX(MK), DIMENSION(: ), POINTER :: pdataI#elseI REAL(MK), DIMENSION(: ), POINTER :: pdataI#endif #elif __DIM == 2 #if __KIND == __INTEGER INTEGER , DIMENSION(:,:), POINTER :: pdataI#elif __KIND == __LOGICAL LOGICAL , DIMENSION(:,:), POINTER :: pdataI#elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX COMPLEX(MK), DIMENSION(:,:), POINTER :: pdataI#elseI REAL(MK), DIMENSION(:,:), POINTER :: pdataI#endif #endif !!! Particle data to be popped. !!! Can be either 1D or 2D array. INTEGER , INTENT(IN ) :: lda !!! The leading dimension of pdata. !!! In the case of pdata being a 1D array use lda=1. INTEGER , INTENT(IN ) :: Npart !!! The number of real particles (on the processor) INTEGER , INTENT(IN ) :: Mpart !!! The number of real + ghost particles (on the processor) INTEGER , INTENT( OUT) :: info !!! Return status. 0 upon success. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Local variables I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t INTEGER, DIMENSION(3) :: ldu INTEGER :: k,ipart,bdim,ibuffer,btype INTEGER :: iopt,edim,i,j CHARACTER(p char) :: mesgI REAL(MK) :: t0 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Externals I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Initialise I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t CALL substart('p map_part_ghost pop',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p debug .GT. 0) THEN CALL check IF (info .NE. 0) GOTO 9999I ENDIFI ! skip if the buffer is empty IF (p buffer_set .LT. 1) THEN info = p error_notice IF (p debug .GT. 1) THEN CALL p error(p err_buffer_empt,'p map_part_ghost pop', &INUUUU& 'Buffer is empty: skipping pop!',__LINE__,info)I ENDIFI GOTO 9999I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check that the required dimension fits the dimension of the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t bdim = p buffer_dim(p buffer_set) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ! for complex, the effective dimension is half the data dimension edim = bdim/2I#elseI edim = bdim #endif IF (p debug .GT. 1) THEN WRITE(mesg,'(2(A,I3))') 'bdim=',edim,' lda=',lda CALL p write(p rank,'p map_part_ghost pop',mesg,info)I ENDIFI#if __DIM == 2 IF (edim.NE.lda) THEN info = p error_error CALL p error(p err_wrong dim,'p map_part_ghost pop', &INUUUU& 'leading dimension LDA is in error',__LINE__,info)I GOTO 9999I ENDIF #elif __DIM == 1 IF (edim.NE.1) THEN info = p error_error CALL p error(p err_wrong dim,'p map_part_ghost pop', &INUUUU& 'buffer does not contain 1d data!',__LINE__,info)I GOTO 9999I ENDIF #endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Check that the required type is identical to the type of the buffer !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t btype = p buffer_type(p buffer_set) #if __KIND == __SINGLE_PRECISION IF (btype.NE.p kind_single) THEN info = p error_error CALL p error(p err_wrong prec,'p map_part_ghost pop', &INUUUU& 'trying to pop a non-single into single ',__LINE__,info)I GOTO 9999I ENDIFI#elif __KIND == __DOUBLE_PRECISION IF (btype.NE.p kind_double) THEN info = p error_error CALL p error(p err_wrong prec,'p map_part_ghost pop', &INUUUU& 'trying to pop a non-double into double ',__LINE__,info)I GOTO 9999I ENDIFI#elif __KIND == __SINGLE_PRECISION_COMPLEX IF (btype.NE.p kind_single) THEN info = p error_error CALL p error(p err_wrong prec,'p map_part_ghost pop', &INUUUU& 'trying to pop a non-single-complex into single-complex', &INUUUU& __LINE__,info)I GOTO 9999I ENDIFI#elif __KIND == __DOUBLE_PRECISION_COMPLEX IF (btype.NE.p kind_double) THEN info = p error_error CALL p error(p err_wrong prec,'p map_part_ghost pop', &INUUUU& 'trying to pop a non-double-complex into double-complex', &INUUUU& __LINE__,info)I GOTO 9999I ENDIFI#elif __KIND == __INTEGER IF (btype.NE.p integer) THEN info = p error_error CALL p error(p err_wrong prec,'p map_part_ghost pop', &INUUUU& 'trying to pop a non-integer into integer ',__LINE__,info)I GOTO 9999I ENDIFI#elif __KIND == __LOGICAL IF (btype.NE.p logical) THEN info = p error_error CALL p error(p err_wrong prec,'p map_part_ghost pop', &INUUUU& 'trying to pop a non-logical into logical ',__LINE__,info)I ENDIFI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Decrement the pointer into the receive buffer - this should be the ! total amount of particle send off to any processor time the sizeI ! (dimension) of the data; see p map_part_ghost put for the contentsI ! of the p ghosthack array !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t i = 0 DO k=1,p nsendlist ! or p ncommseq(topoid) or p nrecvlist i = i + p ghosthack(1,k)I ENDDOI p nrecvbuffer = p nrecvbuffer - i*bdim !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! Decrement the pointer into the send buffer to allow reuse byI ! multiple sequential push-send-pop cycles. ! JHW i dont know if this works with ghost - no time to check ! but should not matter here !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t p nsendbuffer = p nsendbuffer - p buffer_dim(p buffer_set)* &INUUUU& (p psendbuffer(p nsendlist+1)-1)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! loop over the processors in the p isendlist() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t #ifdef __MPI ibuffer = p nrecvbuffer IF (p debug .GT. 1) THEN WRITE(mesg,'(A,I9)') 'ibuffer = ',ibuffer CALL p write(p rank,'p map_part_ghost pop',mesg,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ! DOUBLE PRECISION BUFFER !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t IF (p kind.EQ.p kind_double) THEN #if __DIM == 2 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Unrolled version of edim=1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (edim .EQ. 1) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999999I ! now empty the receive buffer: I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999999I DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL ! JHW does not make sence to get the logical contrib from ghost or ? IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled version of edim=2 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 2) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled version of edim=3 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 3) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION !JHWWRITE(40+p rank,'(I8,6E12.4)') ipart,pdata(:,ipart),p recvbufferd(ibuffer),p recvbufferd(ibuffer+1),p recvbufferd(ibuffer+2)I pdata(1,ipart) = pdata(1,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + p recvbufferd(ibuffer)II#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled version of edim=4 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 4) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled version of edim=5 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 5) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 1I pdata(5,ipart) = pdata(5,ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + p recvbufferd(ibuffer)I ibuffer = ibuffer + 1I pdata(5,ipart) = pdata(5,ipart) + p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(5,ipart) = pdata(5,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(5,ipart) = pdata(5,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + INT(p recvbufferd(ibuffer))I ibuffer = ibuffer + 1I pdata(5,ipart) = pdata(5,ipart) + INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(5,ipart) = .TRUE. ELSE pdata(5,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! For edim.GT.5 the vector length will be edim !!I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ELSE DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) DO i=1,edim #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(i,ipart) = pdata(i,ipart) + REAL(p recvbufferd(ibuffer), &INUUUU& p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(i,ipart) = pdata(i,ipart) + p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(i,ipart) = pdata(i,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(i,ipart) = pdata(i,ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(i,ipart) = pdata(i,ipart) + INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(i,ipart) = .TRUE. ELSE pdata(i,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI ENDDOI ENDIFI#elif __DIM == 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Scalar version !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(ipart) = pdata(ipart) + REAL(p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION pdata(ipart) = pdata(ipart) + p recvbufferd(ibuffer)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(ipart) = pdata(ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_single)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(ipart) = pdata(ipart) + CMPLX(p recvbufferd(ibuffer-1), &INUUUU& p recvbufferd(ibuffer),p kind_double)I#elif __KIND == __INTEGER pdata(ipart) = pdata(ipart) + INT(p recvbufferd(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbufferd(ibuffer) .GT. &INUUUU& (1.0_p kind_double-p myepsd)) THEN pdata(ipart) = .TRUE. ELSE pdata(ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! SINGLE PRECISION BUFFER !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmax,t ELSE #if __DIM == 2 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Unrolled verion for edim=1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma IF (edim .EQ. 1) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled verion for edim=2 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 2) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !---------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(1,ipart) = pdata(2,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(2,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled verion for edim=3 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 3) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !---------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled verion for edim=4 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 4) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !---------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Unrolled verion for edim=5 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEma ELSEIF (edim .EQ. 5) THEN DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + p recvbuffers(ibuffer)I ibuffer = ibuffer + 1I pdata(5,ipart) = pdata(5,ipart) + p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(1,ipart) = pdata(1,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 1I pdata(5,ipart) = pdata(5,ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I ibuffer = ibuffer + 2I pdata(5,ipart) = pdata(5,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(1,ipart) = pdata(1,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(2,ipart) = pdata(2,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(3,ipart) = pdata(3,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(4,ipart) = pdata(4,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I ibuffer = ibuffer + 2I pdata(5,ipart) = pdata(5,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(1,ipart) = pdata(1,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(2,ipart) = pdata(2,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(3,ipart) = pdata(3,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(4,ipart) = pdata(4,ipart) + INT(p recvbuffers(ibuffer))I ibuffer = ibuffer + 1I pdata(5,ipart) = pdata(5,ipart) + INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(1,ipart) = .TRUE. ELSE pdata(1,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(2,ipart) = .TRUE. ELSE pdata(2,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(3,ipart) = .TRUE. ELSE pdata(3,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(4,ipart) = .TRUE. ELSE pdata(4,ipart) = .FALSE. ENDIF ibuffer = ibuffer + 1I IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(5,ipart) = .TRUE. ELSE pdata(5,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! For edim.GT.5 the vector length will be edim !!I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI ELSE DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999 ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) DO i=1,edim #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(i,ipart) = pdata(i,ipart) + p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(i,ipart) = pdata(i,ipart) + REAL(p recvbuffers(ibuffer), &INUUUU& p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(i,ipart) = pdata(i,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(i,ipart) = pdata(i,ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(i,ipart) = pdata(i,ipart) + INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(i,ipart) = .TRUE. ELSE pdata(i,ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI ENDDOI ENDIFI#elif __DIM == 1 !------------------------ginys,max,pnys,max,phys,mis,t�lEmax,t�lh999999 ! Scalar version !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999999t�lEmaI DO k=1,p nsendlist ! or p nrecvlist or p ncommseq(topoid)I DO j=1,p ghosthack(1,k)I !-----------------------x,phys,mis,t�lEmax,t�lh999999999t�lEmaI ! Get the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999I! if we are going to run this efficiently on ivos machine, we should put a vector directive here !I ipart = p ghosthack(j+2,k) #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX ibuffer = ibuffer + 2I#elseI ibuffer = ibuffer + 1I#endif #if __KIND == __SINGLE_PRECISION pdata(ipart) = pdata(ipart) + p recvbuffers(ibuffer)I#elif __KIND == __DOUBLE_PRECISION pdata(ipart) = pdata(ipart) + REAL(p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __DOUBLE_PRECISION_COMPLEX pdata(ipart) = pdata(ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_double)I#elif __KIND == __SINGLE_PRECISION_COMPLEX pdata(ipart) = pdata(ipart) + CMPLX(p recvbuffers(ibuffer-1), &INUUUU& p recvbuffers(ibuffer),p kind_single)I#elif __KIND == __INTEGER pdata(ipart) = pdata(ipart) + INT(p recvbuffers(ibuffer))I#elif __KIND == __LOGICAL IF (p recvbuffers(ibuffer) .GT. &INUUUU& (1.0_p kind_single-p myepss)) THEN pdata(ipart) = .TRUE. ELSE pdata(ipart) = .FALSE. ENDIF #endif ENDDOI ENDDOI#endif ENDIF ! p kindI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Decrement the set counter !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p buffer_set = p buffer_set - 1 !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Deallocate the receive buffer if all sets have been poped !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (p buffer_set .LT. 1) THEN iopt = p param_dealloc IF (p kind .EQ. p kind_single) THEN CALL p alloc(p recvbuffers,ldu,iopt,info)I ELSE CALL p alloc(p recvbufferd,ldu,iopt,info)I ENDIFI IF (info .NE. 0) THEN info = p error error CALL p error(p err alloc,'p map part ghost_pop', &INUUUU& 'receive buffer PPM_RECVBUFFER',__LINE__,info)I ENDIFI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I 9999 CONTINUE CALL substop('p map part ghost_pop',t0,info)I RETURN CONTAINS SUBROUTINE checkI IF (p buffer_set .LT. 1) THEN info = p error error CALL p error(p err argument,'p map part ghost_pop', &INUUUU& 'buffer is empty. Cannot pop.',__LINE__,info)I GOTO 8888I ENDIFI IF (Npart .LT. 0) THEN info = p error error CALL p error(p err argument,'p map part ghost_pop', &INUUUU& 'Npart must be >=0',__LINE__,info)I GOTO 8888I ENDIFI IF (Mpart .LT. 0) THEN info = p error error CALL p error(p err argument,'p map part ghost_pop', &INUUUU& 'Mpart must be >=0',__LINE__,info)I GOTO 8888I ENDIFI#if __DIM == 2 IF (lda .LT. 1) THEN info = p error error CALL p error(p err argument,'p map part ghost_pop', &INUUUU& 'lda must be >0 for vector data',__LINE__,info)I GOTO 8888I ENDIFI#elif __DIM == 1 IF (lda .NE. 1) THEN info = p error error CALL p error(p err argument,'p map part ghost_pop', &INUUUU& 'lda must be =1 for scalar data',__LINE__,info)I GOTO 8888I ENDIFI#endif 8888 CONTINUE END SUBROUTINE checkI#if __DIM == 1 #if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part ghost_pop_1dsI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part ghost_pop_1ddI#elif __KIND == __SINGLE_PRECISION_COMPLEX END SUBROUTINE p map part ghost_pop_1dscI#elif __KIND == __DOUBLE_PRECISION_COMPLEX END SUBROUTINE p map part ghost_pop_1ddcI#elif __KIND == __INTEGER END SUBROUTINE p map part ghost_pop_1diI#elif __KIND == __LOGICAL END SUBROUTINE p map part ghost_pop_1dlI#endif #elif __DIM == 2 #if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part ghost_pop_2dsI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part ghost_pop_2ddI#elif __KIND == __SINGLE_PRECISION_COMPLEX END SUBROUTINE p map part ghost_pop_2dscI#elif __KIND == __DOUBLE_PRECISION_COMPLEX END SUBROUTINE p map part ghost_pop_2ddcI#elif __KIND == __INTEGER END SUBROUTINE p map part ghost_pop_2diI#elif __KIND == __LOGICAL END SUBROUTINE p map part ghost_pop_2dlI#endif #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map part global.f����������������������������������������������������������0000644�0001752�0001753�00000105233�11616003524�020673� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Subroutine : p map part global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modifyI ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I #if __KIND == __SINGLE_PRECISION SUBROUTINE p map part global_s(target_topoid,xp,Npart,info, &INUUUU& userdef part2proc)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map part global_d(target_topoid,xp,Npart,info, &INUUUU& userdef part2proc)I#endif !!! This routine maps the particles onto the given !!! topology using a global mapping (i.e. every !!! processor communicates with every other).I !!!I !!! The first part of the buffer contains the on processorI !!! data.I !!!I !!! The storing of p map type is not used (yet) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I USE p module_dataI USE p module_substartI USE p module_substopI USE p module_error USE p module_alloc USE p module_check_id USE p module_map part util USE p module_typedefI IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_singleI#elseI INTEGER, PARAMETER :: MK = p kind_doubleI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I REAL(MK), DIMENSION(:,:) , INTENT(IN ) :: xpI !!! The position of the particlesI INTEGER , INTENT(IN ) :: NpartI !!! Number of particles (on local processor)I INTEGER , INTENT(IN ) :: target_topoidI !!! ID of an existing topology to map onto or `p param_topo_undefined`I !!! if a non geometric mapping should be used. +I !!! In the latter case p will call internally !!! `p map part equidistributed` to distribute the particlesI !!! proportionaly to processor speeds.I !!!I !!! If the user supplies `p param_topo_undefined` an optional parameter !!! userdef part2proc can be used to specify explicitly which particleI !!! should be moved to which processor.I INTEGER, DIMENSION(:), OPTIONAL, POINTER :: userdef part2procI !!! The processor assignment for each particleI INTEGER , INTENT( OUT) :: infoI !!! Return status, 0 on success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I INTEGER, DIMENSION(3) :: lduI INTEGER, DIMENSION(:), POINTER :: bcdef => NULL()I INTEGER :: i,j,k,idom,ipart,nlist1,nlist2I INTEGER :: sendrank,recvrankI INTEGER :: iopt,iset,ibufferI CHARACTER(p char) :: mesgI REAL(MK) :: t0I LOGICAL :: validI TYPE(p t_topo), POINTER :: topo => NULL()I TYPE(p t_topo), POINTER :: target_topo => NULL()I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! InitialiseI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I CALL substart('p map part global',t0,info)II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999 ENDIFI ! if there is still some data left in the buffer, warn the userI IF (p buffer_set .GT. 0) THEN info = p error warning CALL p error(p err map incomp,'p map part global', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! map to a defined topology !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (target_topoid .NE. p param_topo_undefined) THEN topo => p topo(target_topoid)%tI I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Save the map type for the subsequent calls (not used yet) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I p map type = p param_map global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh99999I ! Alloc memory for particle lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I iopt = p param_alloc_fitI ldu(1) = NpartI CALL p alloc(ilist1,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'particle list 1 ILIST1',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(ilist2,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'particle list 2 ILIST2',__LINE__,info)I GOTO 9999 ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Allocate memory for the pointer to the buffer; for the global map weI ! need entries for each processor, thus ldu(1) = p nprocI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I iopt = p param_alloc_fitI ldu(1) = p nproc + 1I CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'particle send buffer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIFI I iopt = p param_alloc_fitI ldu(1) = NpartI CALL p alloc(part2proc,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'particles-to-processor map PART2PROC',__LINE__,info)I GOTO 9999 ENDIFI ldu(1) = NpartI CALL p alloc(p buffer2part,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'buffer-to-particles map PPM_BUFFER2PART',__LINE__,info)I GOTO 9999 ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Initialize the particle listI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I nlist1 = 0I DO ipart=1,NpartI nlist1 = nlist1 + 1I ilist1(nlist1) = ipartI ENDDOI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Then of these exclude the particles that on the current processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I IF (p dim.EQ.2) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9 ! Loop over the subdomains !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9 ! DO idom=1,p nsubs(target_topoid) DO idom=topo%nsubs,1,-1I sendrank = topo%sub2proc(idom)I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhI ! Loop over the remaining particles not yet assigned to a processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhI nlist2 = 0I DO i=1,nlist1I ipart = ilist1(i)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999xI ! If the particle is inside the current subdomain, assign itI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999xI#if __KIND == __SINGLE_PRECISION IF (xp(1,ipart).GE.topo%min_subs(1,idom).AND. &INUUUU& xp(1,ipart).LE.topo%max_subs(1,idom).AND. &INUUUU& xp(2,ipart).GE.topo%min_subs(2,idom).AND. &INUUUU& xp(2,ipart).LE.topo%max_subs(2,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! In the non-periodic case, allow particles that areI ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 IF((xp(1,ipart).LT.topo%max_subs(1,idom) .OR. &INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& topo%bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart).LT.topo%max_subs(2,idom) .OR. &INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& topo%bcdef(4).NE. p param_bcdef_periodic))) THEN #elif __KIND == __DOUBLE_PRECISION IF (xp(1,ipart).GE.topo%min_subd(1,idom).AND. &INUUUU& xp(1,ipart).LE.topo%max_subd(1,idom).AND. &INUUUU& xp(2,ipart).GE.topo%min_subd(2,idom).AND. &INUUUU& xp(2,ipart).LE.topo%max_subd(2,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! In the non-periodic case, allow particles that areI ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 IF((xp(1,ipart).LT.topo%max_subd(1,idom) .OR. &INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& topo%bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart).LT.topo%max_subd(2,idom) .OR. &INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& topo%bcdef(4).NE. p param_bcdef_periodic))) THEN #endif part2proc(ipart) = sendrank ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh ! if not, add it the list of particle to searchI !------------------------ginys,max,phys,mis,t�lEmax,t�lh nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I ! if not, add it the list of particle to searchI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99I nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI I ENDDOI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I ! Copy the lists (well, only if nlist2 changed - decreased)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I IF (nlist2.NE.nlist1) THEN nlist1 = nlist2I DO i=1,nlist1I ilist1(i) = ilist2(i)I ENDDOI ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I ! Exit if the list is emptyI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I IF (nlist1.EQ.0) EXITI ENDDOI I ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9 ! Loop over the subdomains (since the first domains are most likely ! to be empty, we look backwards to reduce the number of elements in ! nlist2 as fast as possible) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9 ! DO idom=1,p nsubs(target_topoid) DO idom=topo%nsubs,1,-1I sendrank = topo%sub2proc(idom)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I ! Loop over the remaining particlesI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I nlist2 = 0I DO i=1,nlist1I ipart = ilist1(i)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999xI ! If the particle is inside the current subdomain, assign itI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999xI#if __KIND == __SINGLE_PRECISION IF (xp(1,ipart).GE.topo%min_subs(1,idom).AND. &INUUUU& xp(1,ipart).LE.topo%max_subs(1,idom).AND. &INUUUU& xp(2,ipart).GE.topo%min_subs(2,idom).AND. &INUUUU& xp(2,ipart).LE.topo%max_subs(2,idom).AND. &INUUUU& xp(3,ipart).GE.topo%min_subs(3,idom).AND. &INUUUU& xp(3,ipart).LE.topo%max_subs(3,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! In the non-periodic case, allow particles that areI ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 IF((xp(1,ipart).LT.topo%max_subs(1,idom) .OR. &INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& topo%bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart).LT.topo%max_subs(2,idom) .OR. &INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& topo%bcdef(4).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(3,ipart).LT.topo%max_subs(3,idom) .OR. &INUUUU& (topo%subs_bc(6,idom).EQ.1 .AND. &INUUUU& topo%bcdef(6).NE. p param_bcdef_periodic)) ) THEN #elif __KIND == __DOUBLE_PRECISION IF (xp(1,ipart).GE.topo%min_subd(1,idom).AND. &INUUUU& xp(1,ipart).LE.topo%max_subd(1,idom).AND. &INUUUU& xp(2,ipart).GE.topo%min_subd(2,idom).AND. &INUUUU& xp(2,ipart).LE.topo%max_subd(2,idom).AND. &INUUUU& xp(3,ipart).GE.topo%min_subd(3,idom).AND. &INUUUU& xp(3,ipart).LE.topo%max_subd(3,idom)) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 ! In the non-periodic case, allow particles that areI ! exactly ON an upper EXTERNAL boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999 IF((xp(1,ipart).LT.topo%max_subd(1,idom) .OR. &INUUUU& (topo%subs_bc(2,idom).EQ.1 .AND. &INUUUU& topo%bcdef(2).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(2,ipart).LT.topo%max_subd(2,idom) .OR. &INUUUU& (topo%subs_bc(4,idom).EQ.1 .AND. &INUUUU& topo%bcdef(4).NE. p param_bcdef_periodic)) .AND. &INUUUU& (xp(3,ipart).LT.topo%max_subd(3,idom) .OR. &INUUUU& (topo%subs_bc(6,idom).EQ.1 .AND. &INUUUU& topo%bcdef(6).NE. p param_bcdef_periodic)) ) THEN #endif part2proc(ipart) = sendrank ELSE nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI ELSE nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI I ENDDOI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I ! Copy the lists (well, only if nlist2 changed - decreased)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I IF (nlist2.NE.nlist1) THEN nlist1 = nlist2I DO i=1,nlist1I ilist1(i) = ilist2(i)I ENDDOI ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I ! Exit if the list is emptyI !------------------------ginys,max,phys,mis,t�lEmax,t�lh99x,t�lh99I IF (nlist1.EQ.0) EXITI ENDDOI ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Here we could check that we sold all the particles, but if we useI ! Dirichlet BCs we might just want to loose the particles outside of theI ! domain. So just skip them in the map. This is also consistent with theI ! map partial where particles are also lost (there are no periodic subI ! images in this case).I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Non geometric mappings !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I IF (PRESENT(userdef part2proc)) THEN ! just let part2proc point to the user defined mapping part2proc => userdef part2procI ENDIFI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999 ! Send the particles to the target processors !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999 IF (.NOT.((target_topoid.EQ.p param_topo_undefined).AND. &INUUUU& (.NOT.PRESENT(userdef part2proc)))) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! We have a particle processor mapping !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Store the number of buffer entries (this is the first) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I p buffer_set = 1I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Allocate memory for the field registers that holds the dimension and ! type of the dataI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I iopt = p param_alloc_fitI ldu(1) = p buffer_setI CALL p alloc(p buffer dim ,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(p buffer type,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'buffer types PPM_BUFFER_TYPE',__LINE__,info)I GOTO 9999 ENDIFI I p buffer dim(p buffer_set) = p dim #if __KIND == __SINGLE_PRECISIONI p buffer type(p buffer_set) = p kind_singleI#elseI p buffer type(p buffer_set) = p kind_doubleI#endif I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! (Re)allocate memory for the buffer (need not save the contents of theI ! buffer since this is a global map).I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I iopt = p param_alloc_fitI ldu(1) = p dim*NpartI IF (p kind.EQ.p kind_double) THEN CALL p alloc(p sendbufferd,ldu,iopt,info)I ELSE CALL p alloc(p sendbuffers,ldu,iopt,info)I ENDIFI IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)I GOTO 9999 ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Allocate memory for the sendlist !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I p nsendlist = p nprocI p nrecvlist = p nprocI ldu(1) = p nsendlistI CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'send list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part global', &INUUUU& 'receive list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Initialize the particle lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I nlist1 = npartI DO ipart=1,NpartI ilist1(ipart) = ipartI ENDDOI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! loop over all processors, starting with the processor itselfI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I sendrank = p rank - 1I recvrank = p rank + 1I p psendbuffer(1) = 1I p nsendlist = 0I p nrecvlist = 0I iset = 0I ibuffer = 0I I DO i=1,p nprocI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I ! compute the next processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I sendrank = sendrank + 1I IF (sendrank.GT.p nproc-1) sendrank = sendrank - p nprocI recvrank = recvrank - 1I IF (recvrank.LT. 0) recvrank = recvrank + p nprocI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I ! Store the processor to which we will send toI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I p nsendlist = p nsendlist + 1I p isendlist(p nsendlist) = sendrank I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I ! Store the processor to which we will recv fromI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I p nrecvlist = p nrecvlist + 1I p irecvlist(p nrecvlist) = recvrank I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I ! Initialize the buffer countI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I nlist2 = 0I I IF (p dim .EQ. 2) THEN DO j=1,nlist1I ipart = ilist1(j)I IF (part2proc(ipart).EQ.sendrank) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 ! increment the buffer counter !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 iset = iset + 1I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 ! Store the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 p buffer2part(iset) = ipartI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 ! Store the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 IF (p kind .EQ. p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_double) #elseI ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(1,ipart)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(2,ipart) #endif ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = xp(1,ipart)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = xp(2,ipart) #elseI ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_single)I#endif ENDIFI ELSE nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI ENDDOI ELSE DO j=1,nlist1I ipart = ilist1(j)I IF (part2proc(ipart).EQ.sendrank) THEN !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 ! increment the buffer counter !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 iset = iset + 1I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 ! Store the id of the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 p buffer2part(iset) = ipartI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 ! Store the particleI !------------------------ginys,max,phys,mis,t�lEmax,t�lh9999 IF (p kind .EQ. p kind_double) THEN #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_double) ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = REAL(xp(3,ipart), &INUUUU& p kind_double) #elseI ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(1,ipart)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(2,ipart)I ibuffer = ibuffer + 1I p sendbufferd(ibuffer) = xp(3,ipart) #endif ELSE #if __KIND == __SINGLE_PRECISION ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = xp(1,ipart)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = xp(2,ipart) ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = xp(3,ipart) #elseI ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = REAL(xp(1,ipart), &INUUUU& p kind_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = REAL(xp(2,ipart), &INUUUU& p kind_single)I ibuffer = ibuffer + 1I p sendbuffers(ibuffer) = REAL(xp(3,ipart), &INUUUU& p kind_single)I#endif ENDIFI ELSE nlist2 = nlist2 + 1I ilist2(nlist2) = ipartI ENDIFI ENDDOI ENDIFI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I ! Update the buffer pointerI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I p psendbuffer(i+1) = iset + 1I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I ! Swap the listsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9I nlist1 = nlist2I DO j=1,nlist1I ilist1(j) = ilist2(j)I ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Everything has to go (should not be necessary!)I ! the line above:I !I ! p psendbuffer(i+1) = iset + 1I !I ! should take care of this !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! PC: killed this for unbounded domains where the particles can leave the I ! the domainI ! p psendbuffer(p nproc+1) = npart + 1I I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Store the current size of the bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I p nsendbuffer = ibufferI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I ! Deallocate the memory for the lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh9999I iopt = p param_dealloc CALL p alloc(ilist1,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map part global', &INUUUU& 'particle list 1 ILIST1',__LINE__,info)I ENDIFI CALL p alloc(ilist2,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map part global', &INUUUU& 'particle list 2 ILIST2',__LINE__,info)I ENDIFI IF (.NOT. PRESENT(userdef part2proc)) THEN CALL p alloc(part2proc,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map part global', &INUUUU& 'particle-to-processor map PART2PROC',__LINE__,info)I ENDIFI ENDIFI ELSE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhI ! equidistributed mapping, handled by p map part eqdistrib !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhI CALL p map part eqdistrib(xp,Npart,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err map incomp,'p map part global', & 'Failed to equidistribute particles',__LINE__,info)I GOTO 9999 ENDIFI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I 9999 CONTINUE CALL substop('p map part global',t0,info)I RETURN CONTAINS SUBROUTINE checkI IF (Npart .LT. 0) THEN info = p error error CALL p error(p err argument,'p map part global', &INUUUU& 'Npart must be >0',__LINE__,info)I GOTO 8888I ENDIFI IF (target_topoid .NE. p param_topo_undefined) THEN CALL p check_topoid(target_topoid,valid,info)I IF (.NOT. valid) THEN info = p error error CALL p error(p err argument,'p map part global', &INUUUU& 'target_target_topoid is not valid',__LINE__,info)I GOTO 8888I ENDIFI ENDIFI IF (PRESENT(userdef part2proc)) THEN IF (.NOT. ASSOCIATED(userdef part2proc)) THEN info = p error error CALL p error(p err argument,'p map part global', &INUUUU& 'userdef part2proc has to be associated',__LINE__,info)I GOTO 8888I ENDIFI IF (SIZE(userdef part2proc) .LT. Npart) THEN info = p error error CALL p error(p err argument,'p map part global', &INUUUU& 'userdef part2proc has to be at least Npart large', &INUUUU& __LINE__,info)I GOTO 8888I ENDIFI ENDIFI 8888 CONTINUE END SUBROUTINE checkI#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part global_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part global_dI#endif ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map field global_symm.f����������������������������������������������������0000644�0001752�0001753�00000062575�11616003524�022070� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Subroutine : p map field global_symm !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I SUBROUTINE p map field global_symm(topoid,target_topoid, &INUUUU& meshid,target_meshid,info)I !!! This routine maps field data between two topologiesI !!! using a global mapping (i.e. every processorI !!! communicates with every other). Source mesh must beI !!! on the current field topology. Global lists withI !!! all mesh blocks that have to be send and/orI !!! received are built in this routine. Push, pop and !!! send will use these lists. !!! !!! [WARNING]I !!! This routine has not been tested, reviewed, or checked. CommentsI !!! and documentation are wrong. This routine might kill your cat orI !!! worse. !!! !!! [NOTE]I !!! The first part of the send/recv lists contains theI !!! on-processor data. !!! !!! [CAUTION]I !!! Side effect: this routine uses the same global !!! send/recv buffers, pointers and lists as theI !!! particle mapping routines (reason: these buffersI !!! can be large => memory issues). Field and particleI !!! mappings can therefore never overlap, but one mustI !!! be completed before the other starts. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I USE p module_dataI USE p module_data_meshI USE p module_typedefI USE p module_substartI USE p module_substopI USE p module_error USE p module_alloc USE p module_write USE p module_check_id USE p module_mesh_block_intersect IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I INTEGER , INTENT(IN ) :: topoidI !!! Topology ID of source !!! !!! CAUTION: used to be target topo IDI INTEGER , INTENT(IN ) :: target_topoidI !!! Topology ID of targetI INTEGER , INTENT(IN ) :: meshidI !!! Mesh ID of sourceI INTEGER , INTENT(IN ) :: target_meshidI !!! Mesh ID of targetI INTEGER , INTENT( OUT) :: infoI !!! Return status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I INTEGER, DIMENSION(3) :: lduI INTEGER, DIMENSION(p dim) :: iblockstart,nblocksize,offsetI INTEGER, DIMENSION(p dim) :: ghostsizeI INTEGER :: i,j,idom,sendrank,recvrank INTEGER :: iopt,iset,ibuffer,pdim INTEGER :: nsendlist,nsend INTEGER :: nrecvlist CHARACTER(p char) :: mesg REAL(p kind_double) :: t0I LOGICAL, DIMENSION(3) :: lsymm LOGICAL :: valid TYPE(p t_topo), POINTER :: topo => NULL() TYPE(p t_topo), POINTER :: target_topo => NULL() TYPE(p t_equi_mesh), POINTER :: mesh => NULL() TYPE(p t_equi_mesh), POINTER :: target_mesh => NULL() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! InitialiseI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I CALL substart('p map field global_symm',t0,info)I pdim = p dim !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999 ENDIFI topo => p topo(topoid)%t target_topo => p topo(target_topoid)%t mesh => topo%mesh(meshid) target_mesh => target_topo%mesh(meshid) I IF (p buffer_set .GT. 0) THEN info = p error warning CALL p error(p err map incomp,'p map field global_symm', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Save the map type for the subsequent calls (used for checks!) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p map type = p param_map global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Check if origin and target meshes are compatible (i.e. have theI ! same number of grid points in the whole comput. domain) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (p debug .GT. 0) THEN DO i=1,pdim IF (mesh%Nm(i) .NE. target_mesh%Nm(i)) THEN info = p error noticeI CALL p error(p err bad_mesh,'p map field global_symm', &INUUUU& 'source and destination meshes are incompatible',__LINE__,info)I ENDIFI ENDDOI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the local temporary sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_alloc_fitI ldu(1) = topo%nsublist CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I GOTO 9999 ENDIFI ldu(1) = pdim ldu(2) = topo%nsublist CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local send block offset list IOFFSET',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Find intersecting mesh domains to be sent !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I nsendlist = 0I ghostsize = 0I offset = 0I DO i=1,topo%nsublist idom = topo%isublist(i)I lsymm(1:pdim) = .TRUE. IF (topo%subs_bc(2,idom) .NE. 0) lsymm(1) = .FALSE. IF (topo%subs_bc(4,idom) .NE. 0) lsymm(2) = .FALSE. IF (topo%subs_bc(6,idom) .NE. 0) lsymm(3) = .FALSE. DO j=1,target_topo%nsubsI CALL p mesh_block_intersect(topoid,target_topoid,meshid,target_meshid,&INUUUU& idom,j,offset,ghostsize,nsendlist, &INUUUU& isendfromsub,isendtosub,isendblkstart,isendblksize, &INUUUU& ioffset,info,lsymm)I IF (info .NE. 0) GOTO 9999 ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the local temporary receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_alloc_fitI ldu(1) = target_topo%nsublist CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I GOTO 9999 ENDIFI ldu(1) = pdim ldu(2) = target_topo%nsublist CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Find intersecting mesh domains to be received !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I nrecvlist = 0I ! loop over fromtopo first and THEN over totopo in order to get theI ! same ordering of mesh blocks as in the sendlist. This is crutialI ! for the push and the pop to work properly !!! DO j=1,topo%nsubsI lsymm(1:pdim) = .TRUE. IF (topo%subs_bc(2,j) .NE. 0) lsymm(1) = .FALSE. IF (topo%subs_bc(4,j) .NE. 0) lsymm(2) = .FALSE. IF (topo%subs_bc(6,j) .NE. 0) lsymm(3) = .FALSE. DO i=1,target_topo%nsublist idom = target_topo%isublist(i)I CALL p mesh_block_intersect(topoid,target_topoid,meshid,target_meshid,&INUUUU& j,idom,offset,ghostsize,nrecvlist,irecvfromsub, &INUUUU& irecvtosub,irecvblkstart,irecvblksize,ioffset,info,lsymm)I IF (info .NE. 0) GOTO 9999 ENDDOI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the global mesh sendlists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_alloc_fitI ldu(1) = nsendlistI CALL p alloc(p mesh_isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'source send sub list PPM_MESH_ISENDFROMSUB',__LINE__,info)I GOTO 9999 ENDIFI ldu(1) = pdim ldu(2) = nsendlistI CALL p alloc(p mesh_isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'send block start list PPM_MESH_ISENDBLKSTART',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(p mesh_isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'send block size list PPM_MESH_ISENDBLKSIZE',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the global mesh receive lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_alloc_fitI ldu(1) = nrecvlist CALL p alloc(p mesh_irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'destination recv sub list PPM_MESH_IRECVTOSUB',__LINE__,info)I GOTO 9999 ENDIFI ldu(1) = pdim ldu(2) = nrecvlist CALL p alloc(p mesh_irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'recv block start list PPM_MESH_IRECVBLKSTART',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(p mesh_irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'recv block size list PPM_MESH_IRECVBLKSIZE',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the global send/recv lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ldu(1) = p nprocI CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'global send rank list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'global recv rank list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIFI ldu(1) = p nproc + 1I CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'global send buffer pointer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(p precvbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map field global_symm', &INUUUU& 'global recv buffer pointer PPM_PRECVBUFFER',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Reset the number of buffer entries !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p buffer_set = 0I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! loop over all processors; First is the processor itselfI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I sendrank = p rank - 1I recvrank = p rank + 1I p psendbuffer(1) = 1I p precvbuffer(1) = 1I p nsendlist = 0I p nrecvlist = 0I p nsendbuffer = 0 ! data length in bufferI p nrecvbuffer = 0 ! data length in bufferI iset = 0I ibuffer = 0I DO i=1,p nprocI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! compute the next processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I sendrank = sendrank + 1I IF (sendrank.GE.p nproc) sendrank = sendrank - p nprocI recvrank = recvrank - 1I IF (recvrank.LT. 0) recvrank = recvrank + p nprocII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Store the processor to which we will send toI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I p nsendlist = p nsendlist + 1I p isendlist(p nsendlist) = sendrank I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Store the processor to which we will recv fromI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I p nrecvlist = p nrecvlist + 1I p irecvlist(p nrecvlist) = recvrank I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Find all mesh blocks that are sent and store them.I ! To get all mesh blocks that are sent in roundI ! i=1,p nsendlist:I ! dest_rank = p isendlist(i)I ! ilo = p psendbuffer(i)I ! ihi = p psendbuffer(i+1)-1I ! DO j=ilo,ihiI ! SEND(p mesh_isendblk(:,j) of sub p mesh_isendfromsub(j) toI ! processor dest_rank to sub p mesh_isendtosub(j))I ! ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ibuffer = p nsendlist + 1I p psendbuffer(ibuffer) = p psendbuffer(p nsendlist)I DO j=1,nsendlistI IF (target_topo%sub2proc(isendtosub(j)) .EQ. sendrank) THEN p psendbuffer(ibuffer) = p psendbuffer(ibuffer) + 1I iset = p psendbuffer(ibuffer) - 1I p mesh_isendfromsub(iset) = isendfromsub(j)I p mesh_isendblkstart(1:pdim,iset) = isendblkstart(1:pdim,j)I p mesh_isendblksize(1:pdim,iset) = isendblksize(1:pdim,j)I IF (pp debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:2,j),' of size ',isendblksize(1:2,j),&INUUUU& ' to ',sendrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' sending ', &INUUUU& isendblkstart(1:3,j),' of size ',isendblksize(1:3,j),&INUUUU& ' to ',sendrank ENDIFI CALL p write(p rank,'p map field global_symm',&INUUUU& mesg,info)I ENDIFI ENDIFI ENDDOII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Find all mesh blocks that are received and store them.I ! To get all mesh blocks that are received in roundI ! i=1,p nrecvlist:I ! source_rank = p irecvlist(i)I ! ilo = p precvbuffer(i)I ! ihi = p precvbuffer(i+1)-1I ! DO j=ilo,ihiI ! RECV(p mesh_irecvblk(:,j) of sub p mesh_irecvfromsub(j)I ! from processor source_rank to sub p mesh_irecvtosub(j))I ! ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ibuffer = p nrecvlist + 1I p precvbuffer(ibuffer) = p precvbuffer(p nrecvlist)I DO j=1,nrecvlist IF (topo%sub2proc(irecvfromsub(j)) .EQ. recvrank) THEN p precvbuffer(ibuffer) = p precvbuffer(ibuffer) + 1I iset = p precvbuffer(ibuffer) - 1I p mesh_irecvtosub(iset) = irecvtosub(j)I p mesh_irecvblkstart(1:pdim,iset) = irecvblkstart(1:pdim,j)I p mesh_irecvblksize(1:pdim,iset) = irecvblksize(1:pdim,j)I IF (pp debug .GT. 1) THEN IF (p dim .EQ. 2) THEN WRITE(mesg,'(2(A,2I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:2,j),' of size ',irecvblksize(1:2,j),&INUUUU& ' from ',recvrank ELSEIF (p dim .EQ. 3) THEN WRITE(mesg,'(2(A,3I4),A,I3)') ' recving ', &INUUUU& irecvblkstart(1:3,j),' of size ',irecvblksize(1:3,j),&INUUUU& ' from ',recvrank ENDIFI CALL p write(p rank,'p map field global_symm',&INUUUU& mesg,info)I ENDIFI ENDIFI ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Deallocate memory of the local lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_dealloc CALL p alloc(isendfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local send source sub list ISENDFROMSUB',__LINE__,info)I ENDIFI CALL p alloc(isendtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local send destination sub list ISENDTOSUB',__LINE__,info)I ENDIFI CALL p alloc(isendblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local send block start list ISENDBLKSTART',__LINE__,info)I ENDIFI CALL p alloc(isendblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local send block size list ISENDBLKSIZE',__LINE__,info)I ENDIFI CALL p alloc(irecvfromsub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local recv source sub list IRECVFROMSUB',__LINE__,info)I ENDIFI CALL p alloc(irecvtosub,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local recv destination sub list IRECVTOSUB',__LINE__,info)I ENDIFI CALL p alloc(irecvblkstart,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local recv block start list IRECVBLKSTART',__LINE__,info)I ENDIFI CALL p alloc(irecvblksize,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local recv block size list IRECVBLKSIZE',__LINE__,info)I ENDIFI CALL p alloc(ioffset,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error error CALL p error(p err dealloc,'p map field global_symm', &INUUUU& 'local recv block offset list IOFFSET',__LINE__,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I 9999 CONTINUE CALL substop('p map field global_symm',t0,info)I RETURN CONTAINS SUBROUTINE checkI CALL p check_topoid(target_topoid,valid,info)I IF (.NOT. valid) THEN info = p error error CALL p error(p err argument,'p map field global_symm', &INUUUU& 'target topoid not valid',__LINE__,info)I GOTO 8888I ENDIFI CALL p check_meshid(topoid,meshid,valid,info)I IF (.NOT. valid) THEN info = p error error CALL p error(p err argument,'p map field global_symm', &INUUUU& 'source meshid not valid',__LINE__,info)I GOTO 8888I ENDIFI CALL p check_meshid(target_topoid,target_meshid,valid,info)I IF (.NOT. valid) THEN info = p error error CALL p error(p err argument,'p map field global_symm', &INUUUU& 'destination meshid not valid',__LINE__,info)I GOTO 8888I ENDIFI 8888 CONTINUE END SUBROUTINE checkI END SUBROUTINE p map field global_symm �����������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/map/p map part ring_shift.f������������������������������������������������������0000644�0001752�0001753�00000030705�11616003524�021570� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Subroutine : p map part ring_shift !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I #if __KIND == __SINGLE_PRECISION SUBROUTINE p map part ring_shift_s(xp,lda,Npart,itarget,isource,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p map part ring_shift_d(xp,lda,Npart,itarget,isource,info)I#endif !!! Prepares the send and receive lists and the buffers for sending theI !!! particle data along the ring. !!! !!! [NOTE]I !!! The first part of the buffer contains the on processor data. !!! In this case all particles will be send to itarget. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I USE p module_dataI USE p module_substartI USE p module_substopI USE p module_error USE p module_alloc IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_singleI#else INTEGER, PARAMETER :: MK = p kind_doubleI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I REAL(MK), DIMENSION(:,:), INTENT(IN ) :: xp !!! Particle coordinates INTEGER , INTENT(IN ) :: ldaI !!! The leading dimension of xp INTEGER , INTENT(IN ) :: NpartI !!! Number of particles INTEGER , INTENT(IN ) :: itargetI !!! Processor to send toI INTEGER , INTENT(IN ) :: isourceI !!! Processor to receive fromI INTEGER , INTENT( OUT) :: infoI !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I INTEGER, DIMENSION(1) :: lduI INTEGER :: iI INTEGER :: iopt,ibuffer,ipartI REAL(MK) :: t0I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! InitialiseI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I CALL substart('p map part ring_shift',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! If there is still some data left in the buffer, warn the user !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (p buffer_set .GT. 0) THEN info = p error warning CALL p error(p err map incomp,'p map part ring_shift', &INUUUU& 'Buffer was not empty. Possible loss of data!',__LINE__,info)I ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the pointer to the buffer; we only need to talkI ! to 2 processors (including this one) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_alloc_fitI ldu(1) = 3I CALL p alloc(p psendbuffer,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part ring_shift', &INUUUU& 'particle send buffer PPM_PSENDBUFFER',__LINE__,info)I GOTO 9999 ENDIFI iopt = p param_alloc_fitI ldu(1) = NpartI CALL p alloc(p buffer2part,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part ring_shift', &INUUUU& 'buffer-to-particles map PPM_BUFFER2PART',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Store the number of buffer entries (this is the first) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p buffer_set = 1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the field registers that holds the dimension and ! type of the dataI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_alloc_fitI ldu(1) = p buffer_setI CALL p alloc(p buffer dim,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part ring_shift', &INUUUU& 'buffer dimensions PPM_BUFFER_DIM',__LINE__,info)I GOTO 9999 ENDIFI CALL p alloc(p buffer type,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part ring_shift', &INUUUU& 'buffer types PPM_BUFFER_TYPE',__LINE__,info)I GOTO 9999 ENDIFI p buffer dim(p buffer_set) = ldaI IF (p kind .EQ. p kind_single) THEN p buffer type(p buffer_set) = p kind_singleI ELSE p buffer type(p buffer_set) = p kind_doubleI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! (Re)allocate memory for the bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I iopt = p param_alloc_fitI ldu(1) = lda * NpartI#if __KIND == __SINGLE_PRECISION CALL p alloc(p sendbuffers,ldu,iopt,info)I#else CALL p alloc(p sendbufferd,ldu,iopt,info)I#endif IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part ring_shift', &INUUUU& 'global send buffer PPM_SENDBUFFER',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Allocate memory for the sendlistI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p nsendlist = 2I p nrecvlist = 2I iopt = p param_alloc_fitI ldu(1) = p nsendlistI CALL p alloc(p isendlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part ring_shift', &INUUUU& 'send list PPM_ISENDLIST',__LINE__,info)I GOTO 9999 ENDIFI ldu(1) = p nrecvlist CALL p alloc(p irecvlist,ldu,iopt,info)I IF (info .NE. 0) THEN info = p error fatal CALL p error(p err alloc,'p map part ring_shift', &INUUUU& 'receive list PPM_IRECVLIST',__LINE__,info)I GOTO 9999 ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Fill the sendbuffer with the particles that will stay on thisI ! processor (no particles will stay because the whole copy hasI ! to be send to the neighbour) !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p psendbuffer(1) = 1I p psendbuffer(2) = 1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Set the target and source processorI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p isendlist(1) = p rank p isendlist(2) = itargetI p irecvlist(1) = p rank p irecvlist(2) = isourceI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Fill the sendbuffer with the data that will be send away !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ibuffer = 0I DO ipart = 1,NpartI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Store the id of the data entityI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I p buffer2part(ipart) = ipartII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Store the dataI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I DO i = 1,ldaI ibuffer = ibuffer + 1I#if __KIND == __SINGLE_PRECISION p sendbuffers(ibuffer) = xp(i,ipart)I#else p sendbufferd(ibuffer) = xp(i,ipart)I#endif ENDDOI ENDDOI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Everything has to go! !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p psendbuffer(3) = Npart + 1I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Store the current size of the bufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I p nsendbuffer = ibufferI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I 9999 CONTINUE CALL substop('p map part ring_shift',t0,info)I RETURN CONTAINS SUBROUTINE checkI IF (.NOT. p initialized) THEN info = p error error CALL p error(p err p noinit,'p map part ring_shift', &INUUUU& 'Please call p init first!',__LINE__,info)I GOTO 8888I ENDIFI IF (lda .LT. 1) THEN info = p error fatal CALL p error(p err argument,'p map part ring_shift', &INUUUU& 'LDA must be >0',__LINE__,info)I GOTO 8888I ENDIFI IF (Npart .LT. 0) THEN info = p error fatal CALL p error(p err argument,'p map part ring_shift', &INUUUU& 'NPART must be >=0',__LINE__,info)I GOTO 8888I ENDIFI IF ((itarget .LT. 0) .OR. (itarget .GE. p nproc)) THEN info = p error fatal CALL p error(p err argument,'p map part ring_shift', NUUUU&INUUUU& 'ITARGET must be >=0 and smaller than the number processors',&INUUUU& __LINE__,info)I GOTO 8888I ENDIFI IF ((isource .LT. 0) .OR. (isource .GE. p nproc)) THEN info = p error fatal CALL p error(p err argument,'p map part ring_shift', NUUUU&INUUUU& 'ISOURCE must be >=0 and smaller than the number processors',&INUUUU& __LINE__,info)I GOTO 8888I ENDIFI 8888 CONTINUE END SUBROUTINE checkI#if __KIND == __SINGLE_PRECISION END SUBROUTINE p map part ring_shift_sI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p map part ring_shift_dI#endif �����������������������������������������������������������libp -1.2.1/src/map/p impose part bc.f�����������������������������������������������������������0000644�0001752�0001753�00000020770�11616003524�020540� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Subroutine : p impose part bc !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I #if __KIND == __SINGLE_PRECISION SUBROUTINE p impose part bc_s(topoid,xp,Npart,info)I#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p impose part bc_d(topoid,xp,Npart,info)I#endif !!! This routine imposes periodic boundary conditions forI !!! the particles. That is it moves/wraps any particles !!! outside the computational box into the box. The routine !!! assumes that the particles are located within the size !!! of one computational box. !!! !!! [NOTE]I !!! This routine is a user callable routine. !!! !!! [CAUTION]I !!! (This concerns only PPM developers) +I !!! The routine is sensitive the round off errors! So be careful not toI !!! change the order of the IF statements (see code comments) and make !!! sure the compiler is not doing something wrong as well! Originally !!! when particles would be close/at the boundary, the routine would !!! fail to map all particles, but succed if called a 2nd time. TheI !!! changed in the order of the IF statements removed this double calling !!! sequence.I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Modules !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I USE p module_substartI USE p module_substopI USE p module_error USE p module_dataI USE p module_check_id IMPLICIT NONE !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I#ifdef __MPI INCLUDE 'mpif.h'I#endif #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = p kind_singleI#elif __KIND == __DOUBLE_PRECISION INTEGER, PARAMETER :: MK = p kind_doubleI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I INTEGER , INTENT(IN ) :: topoidI !!! Topology IDI REAL(MK), DIMENSION(:,:), INTENT(INOUT) :: xp !!! Particle coordinates INTEGER , INTENT(IN ) :: NpartI !!! Number of particles INTEGER , INTENT( OUT) :: infoI !!! Returns status, 0 upon success !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Local variables !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I REAL(MK) :: t0I INTEGER :: iI CHARACTER(LEN=p char) :: mesgI LOGICAL :: validI REAL(MK), DIMENSION(p dim) :: len_phys,max_phys,min_physI TYPE(p t_topo), POINTER :: topo => NULL() !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Externals !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! InitialiseI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I CALL substart('p impose part bc',t0,info)I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Check arguments !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (p debug .GT. 0) THEN CALL checkI IF (info .NE. 0) GOTO 9999 ENDIFI topo => p topo(topoid)%t !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! compute the size of the computational domain !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I#if __KIND == __DOUBLE_PRECISION len_phys(1:p dim) = topo%max_physd(1:p dim) - &INUUUU& topo%min_physd(1:p dim) max_phys(1:p dim) = topo%max_physd(1:p dim) min_phys(1:p dim) = topo%min_physd(1:p dim) #else len_phys(1:p dim) = topo%max_physs(1:p dim) - &INUUUU& topo%min_physs(1:p dim) max_phys(1:p dim) = topo%max_physs(1:p dim) min_phys(1:p dim) = topo%min_physs(1:p dim) #endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! wrap the particles on this topology - do that by allowing particles toI ! stay on the left boundary but always wrap particle located on the rightI ! boundary. This GE and LT MUST be consistent with the logic of the cellI ! lists to allow the FLOOR in these routines to NOT to return Nm(:)+1,I ! which would be the case if the particle was allowed to stay on theI ! right boundary. !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I IF (topo%bcdef(1).EQ.p param_bcdef_periodic) THEN DO i=1,NpartI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhI ! The order of the if statements matter !I ! and you need both if statements separately (not ELSEIFs) !I ! all this due to round off errorsI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhI IF (xp(1,i).LT.min_phys(1)) THEN xp(1,i) = xp(1,i) + len_phys(1)I ENDIFI IF (xp(1,i).GE.max_phys(1)) THEN xp(1,i) = xp(1,i) - len_phys(1)I ENDIFI ENDDOI ENDIFI IF (topo%bcdef(3).EQ.p param_bcdef_periodic) THEN DO i=1,NpartI IF (xp(2,i).LT.min_phys(2)) THEN xp(2,i) = xp(2,i) + len_phys(2)I ENDIFI IF (xp(2,i).GE.max_phys(2)) THEN xp(2,i) = xp(2,i) - len_phys(2)I ENDIFI ENDDOI ENDIFII IF (p dim.EQ.3) THEN IF (topo%bcdef(5).EQ.p param_bcdef_periodic) THEN DO i=1,NpartI IF (xp(3,i).LT.min_phys(3)) THEN xp(3,i) = xp(3,i) + len_phys(3)I ENDIFI IF (xp(3,i).GE.max_phys(3)) THEN xp(3,i) = xp(3,i) - len_phys(3)I ENDIFI ENDDOI ENDIFI ENDIFI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Return !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I 9999 CONTINUE CALL substop('p impose part bc',t0,info)I RETURN CONTAINS SUBROUTINE checkI CALL p check_topoid(topoid,valid,info)I IF (.NOT. valid) THEN info = p error error CALL p error(p err argument,'p impose part bc',UU&INUUUU& 'topoid is invalid!',__LINE__,info)I GOTO 8888I ENDIFI IF (Npart .LT. 0) THEN info = p error error CALL p error(p err argument,'p impose part bc',UU&INUUUU& 'Npart must be >= 0',__LINE__,info)I GOTO 8888I ENDIFI 8888 CONTINUE END SUBROUTINE checkI#if __KIND == __SINGLE_PRECISION END SUBROUTINE p impose part bc_sI#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p impose part bc_dI#endif ��������libp -1.2.1/src/p module_find_duplicates.f�������������������������������������������������������0000644�0001752�0001753�00000005060�11616003524�021472� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_find_duplicates !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Define types !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I#define __SINGLE_PRECISION 1I#define __DOUBLE_PRECISION 2I MODULE p module_find_duplicates !!! This module provides the routines to find doublicate entries in 2D !!! arrays - callable from the outside.I !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Define interface to duplicate finderI !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I INTERFACE p find_duplicates MODULE PROCEDURE p find_duplicates_s MODULE PROCEDURE p find_duplicates_dI END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! include the source I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I CONTAINS #define __KIND __SINGLE_PRECISION #include "util/p find_duplicates.f" #undef __KIND #define __KIND __DOUBLE_PRECISION #include "util/p find_duplicates.f" #undef __KIND END MODULE p module_find_duplicates ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/p module_init.f������������������������������������������������������������������0000644�0001752�0001753�00000004013�11616003525�017276� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_init !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I MODULE p module_init !!! This module provides the init routine - callable from the outside.I !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Define interface to p init I !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I INTERFACE p init MODULE PROCEDURE p init END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! include the source I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I CONTAINS #include "p init.f" END MODULE p module_init ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/p module_scale_domain.f����������������������������������������������������������0000644�0001752�0001753�00000004751�11616003525�020762� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_scale_domain !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Define types !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I#define __SINGLE_PRECISION 1I#define __DOUBLE_PRECISION 2I MODULE p module_scale_domain !!! This module provides routines for scaling the domain !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interfaces to the domain scaling routine !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p scale_domain MODULE PROCEDURE p scale_domain_s MODULE PROCEDURE p scale_domain_dI END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! include the source I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I CONTAINS #define __KIND __SINGLE_PRECISION #include "util/p scale_domain.f" #undef __KIND #define __KIND __DOUBLE_PRECISION #include "util/p scale_domain.f" #undef __KIND END MODULE p module_scale_domain �����������������������libp -1.2.1/src/p module_map part ghost.f��������������������������������������������������������0000644�0001752�0001753�00000013341�11616003523�021344� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map part ghost !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Define types !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I#define __SINGLE_PRECISION 1I#define __DOUBLE_PRECISION 2I#define __INTEGER 3I#define __LOGICAL 4I#define __SINGLE_PRECISION_COMPLEX 5I#define __DOUBLE_PRECISION_COMPLEX 6I MODULE p module_map part ghost !!! This module provides the particle ghost mapping routines and holds the !!! temporary work arrays.I !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Work lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTEGER, DIMENSION(:), POINTER :: ilist1 => NULL() INTEGER, DIMENSION(:), POINTER :: ilist2 => NULL() INTEGER, DIMENSION(:), POINTER :: ighost => NULL() LOGICAL, DIMENSION(:), POINTER :: lghost => NULL() INTEGER :: prev allocsize PRIVATE :: ilist1,ilist2,ighost,lghost,prev allocsize !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interfaces to p map part ghost_getI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map part ghost_getI MODULE PROCEDURE p map part ghost_get_dI MODULE PROCEDURE p map part ghost_get_s END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interfaces to p map part ghost_popI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map part ghost_popI ! scalar (1d) particle dataI MODULE PROCEDURE p map part ghost_pop_1ddI MODULE PROCEDURE p map part ghost_pop_1ds MODULE PROCEDURE p map part ghost_pop_1di MODULE PROCEDURE p map part ghost_pop_1dlI MODULE PROCEDURE p map part ghost_pop_1ddcI MODULE PROCEDURE p map part ghost_pop_1dsc I ! vector (2d) particle dataI MODULE PROCEDURE p map part ghost_pop_2ddI MODULE PROCEDURE p map part ghost_pop_2ds MODULE PROCEDURE p map part ghost_pop_2di MODULE PROCEDURE p map part ghost_pop_2dlI MODULE PROCEDURE p map part ghost_pop_2ddcI MODULE PROCEDURE p map part ghost_pop_2dsc END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interfaces to p map part ghost_putI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map part ghost_putI MODULE PROCEDURE p map part ghost_put END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! include the source I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I CONTAINS #define __KIND __SINGLE_PRECISION #include "map/p map part ghost_get.f" #undef __KIND #define __KIND __DOUBLE_PRECISION #include "map/p map part ghost_get.f" #undef __KIND #define __DIM 1I#define __KIND __SINGLE_PRECISION #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __DOUBLE_PRECISION #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __INTEGER #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __LOGICAL #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __SINGLE_PRECISION_COMPLEX #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __DOUBLE_PRECISION_COMPLEX #include "map/p map part ghost_pop.f" #undef __KIND #undef __DIM #define __DIM 2I#define __KIND __SINGLE_PRECISION #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __DOUBLE_PRECISION #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __INTEGER #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __LOGICAL #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __SINGLE_PRECISION_COMPLEX #include "map/p map part ghost_pop.f" #undef __KIND #define __KIND __DOUBLE_PRECISION_COMPLEX #include "map/p map part ghost_pop.f" #undef __KIND #undef __DIM #include "map/p map part ghost_put.f" END MODULE p module_map part ghost �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Define types !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I#define __SINGLE_PRECISION 1I#define __DOUBLE_PRECISION 2I#define __INTEGER 3I#define __LOGICAL 4I#define __SINGLE_PRECISION_COMPLEX 5I#define __DOUBLE_PRECISION_COMPLEX 6I#define __2D 7I#define __3D 8I#define __SFIELD 9I#define __VFIELD 10I MODULE p module_map field !!! This module contains interfaces to the field mapping routines !!! and all data structures and definitions that !!! are `PRIVATE` to the mesh routines. !!! !!! [NOTE]I !!! The terminology distinguishes between meshes and fields !!! (the data living on the meshes). Several fields can use the !!! same mesh. Meshes are defined as p -internal TYPES, whereas !!! fields are user-provided arrays.II !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Includes !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I USE p module_map field ghost USE p module_map field global USE p module_data, ONLY: p kind_single,p kind_doubleI USE p module_data_mesh PRIVATE :: p kind_single,p kind_doubleI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! List memoryI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTEGER, DIMENSION(:), POINTER :: invsublist => NULL() INTEGER, DIMENSION(:), POINTER :: sublist => NULL() PRIVATE :: invsublist,sublist I !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Work memoryI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTEGER, DIMENSION(: ), POINTER :: isendfromsub => NULL() INTEGER, DIMENSION(: ), POINTER :: isendtosub => NULL() INTEGER, DIMENSION(:,:), POINTER :: isendblkstart => NULL() INTEGER, DIMENSION(:,:), POINTER :: isendblksize => NULL() INTEGER, DIMENSION(:,:), POINTER :: ioffset => NULL() INTEGER, DIMENSION(: ), POINTER :: irecvfromsub => NULL() INTEGER, DIMENSION(: ), POINTER :: irecvtosub => NULL() INTEGER, DIMENSION(:,:), POINTER :: irecvblkstart => NULL() INTEGER, DIMENSION(:,:), POINTER :: irecvblksize => NULL() PRIVATE :: isendfromsub,isendtosub,isendblkstart,isendblksize PRIVATE :: ioffset,irecvfromsub,irecvtosub,irecvblkstart,irecvblksizeII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Work lists !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I REAL(p kind_single), DIMENSION(:), POINTER :: sends => NULL() REAL(p kind_single), DIMENSION(:), POINTER :: recvs => NULL() REAL(p kind_double), DIMENSION(:), POINTER :: sendd => NULL() REAL(p kind_double), DIMENSION(:), POINTER :: recvd => NULL() INTEGER, DIMENSION(:), POINTER :: nsend => NULL() INTEGER, DIMENSION(:), POINTER :: nrecv => NULL() INTEGER, DIMENSION(:), POINTER :: psend => NULL() INTEGER, DIMENSION(:), POINTER :: precv => NULL() INTEGER, DIMENSION(:,:), POINTER :: pp => NULL() INTEGER, DIMENSION(:,:), POINTER :: qq => NULL() PRIVATE :: sends,recvs,sendd,recvd,nsend,nrecv,psend,precv,qq,p I !---------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Define interface to p map field global !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map field init MODULE PROCEDURE p map field init END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interface to p map field pop_2d !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map field popI ! 2d meshes with scalar fields MODULE PROCEDURE p map field pop_2d_sca_dI MODULE PROCEDURE p map field pop_2d_sca_s MODULE PROCEDURE p map field pop_2d_sca_i MODULE PROCEDURE p map field pop_2d_sca_lI MODULE PROCEDURE p map field pop_2d_sca_sc MODULE PROCEDURE p map field pop_2d_sca_dc I ! 2d meshes with vector fields MODULE PROCEDURE p map field pop_2d_vec_dI MODULE PROCEDURE p map field pop_2d_vec_s MODULE PROCEDURE p map field pop_2d_vec_i MODULE PROCEDURE p map field pop_2d_vec_lI MODULE PROCEDURE p map field pop_2d_vec_sc MODULE PROCEDURE p map field pop_2d_vec_dc I ! 3d meshes with scalar fields MODULE PROCEDURE p map field pop_3d_sca_dI MODULE PROCEDURE p map field pop_3d_sca_s MODULE PROCEDURE p map field pop_3d_sca_i MODULE PROCEDURE p map field pop_3d_sca_lI MODULE PROCEDURE p map field pop_3d_sca_sc MODULE PROCEDURE p map field pop_3d_sca_dc I ! 3d meshes with vector fields MODULE PROCEDURE p map field pop_3d_vec_dI MODULE PROCEDURE p map field pop_3d_vec_s MODULE PROCEDURE p map field pop_3d_vec_i MODULE PROCEDURE p map field pop_3d_vec_lI MODULE PROCEDURE p map field pop_3d_vec_sc MODULE PROCEDURE p map field pop_3d_vec_dc END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interface to p map field push !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map field push ! 2d meshes with scalar fields MODULE PROCEDURE p map field push_2d_sca_dI MODULE PROCEDURE p map field push_2d_sca_s MODULE PROCEDURE p map field push_2d_sca_i MODULE PROCEDURE p map field push_2d_sca_lI MODULE PROCEDURE p map field push_2d_sca_sc MODULE PROCEDURE p map field push_2d_sca_dc I ! 2d meshes with vector fields MODULE PROCEDURE p map field push_2d_vec_dI MODULE PROCEDURE p map field push_2d_vec_s MODULE PROCEDURE p map field push_2d_vec_i MODULE PROCEDURE p map field push_2d_vec_lI MODULE PROCEDURE p map field push_2d_vec_sc MODULE PROCEDURE p map field push_2d_vec_dc I ! 3d meshes with scalar fields MODULE PROCEDURE p map field push_3d_sca_dI MODULE PROCEDURE p map field push_3d_sca_s MODULE PROCEDURE p map field push_3d_sca_i MODULE PROCEDURE p map field push_3d_sca_lI MODULE PROCEDURE p map field push_3d_sca_sc MODULE PROCEDURE p map field push_3d_sca_dc I ! 3d meshes with vector fields MODULE PROCEDURE p map field push_3d_vec_dI MODULE PROCEDURE p map field push_3d_vec_s MODULE PROCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vec_lI MODULE PROCEDURE p map field push_3d_vec_sc MODULE PROCEDURE p map field push_3d_vec_dc END INTERFACEI I !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interface to p map field send !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map field send MODULE PROCEDURE p map field send END INTERFACEIII#ifdef __MPI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map field send_noblockI MODULE PROCEDURE p map field send_noblockI END INTERFACEII !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Define interface to p map field send_alltoall !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I INTERFACE p map field send_alltoall MODULE PROCEDURE p map field send_alltoall END INTERFACEI#endif !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Include the source !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I CONTAINS #include "map/p map field init.f" #define __DIM __SFIELD #define __MESH_DIM __2D #define __KIND __SINGLE_PRECISION #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __DOUBLE_PRECISION #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __SINGLE_PRECISION_COMPLEX #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __DOUBLE_PRECISION_COMPLEX #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __INTEGER #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __LOGICAL #include "map/p map field pop_2d.f" #undef __KIND #undef __MESH_DIM #define _h999999x,t�ND __DOUBLE_PRIND _ #inclunclude "map/4 f" #undef __Kf __MESH_DIM #define _h999999x,t�ND __DOUBLE_PRIND _ #inclunclude "map/4 .f" #undef __KIND #define __KIUBLE_PRIND _ #inclunclude "map/4 "map/p map field pop_2d.f" #undef __KUBLE_PRIND _ #inclune __KIND __DOUBLE_nclude "map/p map part gho -------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Include the source !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I CONTAINS #include "mapfield init.f" #define __DIM __SFIELD #define __MESH_DIM __2D #define __KIND __SINGLE_PRECISION "map/p map field pop_2d.f" #undef __KIND #define __KIND __DOUBLE_PRECISION #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __SINGLE_PRECISION_COMPLEX #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __DOUBLE_PRECISION__COMPLEX #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __INTEGER #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __LOGICAL #include "map/p map field pop_2d.f" #undef __KIND #undef __MESH_DIM #define _h999999x,t�ND __DOUBLE_PRIND _ #inclunclude "map/4 f" #undef __Kf __MESH_DIM #define _h999999x,t�ND __DOUBLE_PRIND _ #inclunclude "map/4 .f" #undef __KIND #define __KIUBLE_PRIND _ #inclunclude "map/4 "map/p map field pop_2d.f" #undef __KUBLE_PRIND _ #inclune __KIND __DOUBLE_nclude "map/p !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Include the source map fiGER #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __LOGICAL map fiGER #include "map/p map field pop_def __KIND #undef __MESH_DIM #define _h999999x,t�ND _map fiGER #include "map/p map field pop_2d.f" #undef __Kf __MESH_DIM #define _h999999x,t�ND _map fiGER #include "map/p map field pop_.f" #undef __KIND #define _map fiGER #include "map/p map field pop_ "map/p map field pop_2d.f" #undef map fiGER #include "map/e __KIND __DOUBLE_PRECISION__COMPLEX #include "map/p map field pop_2d.f" #undef __KIND #define __KIND _map fiGER #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __LOGICAL map fiGER #include "map//p map field init.f" #define __DIM __SFIELD #define __MESH_DIM __2D #define __map fiGER #include "map//p map field init.f" #de2d.f" #undef __Kf __MESH_DIM #define _h999999x,t�ND _map UBLE_PRIND _ #inclunclude "map/4 .f" #undef __KIND #define _map UBLE_PRIND _ #inclunclude "map/4 "map/p map field pop_2d.f" #undef map UBLE_PRIND _ #inclune __KIND __DOUBLE_nclude "map/p map part gho -------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999I ! Include the source map fiGER #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __LOGICAL map fiGER #include "map/p map field pop_def __KIND #undef __MESH_DIM #define _h999999x,t�ND _map fiGER #include "map/p map field pop_2d.f" #undef __Kf __MESH_DIM #define _h999999x,t�ND _map fiGER #include "map/p map field pop_.f" #undef __KIND #define _map fiGER #include "map/p map field pop_ "map/p map field pop_2d.f" #undef map fiGER #include "map/e __KIND __DOUBLE_PRECISION__COMPLEX #include "map/p map field pop_2d.f" #undef __KIND #define __KIND _map fiGER #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __LOGICAL map fiGER #include "map/field init.f" #define __DIM __SFIELD #define __MESH_DIM __2D #define __map fiGER #include "map/field init.f" #de2d.f" #undef __Kf __MESH_DIM #define _h999999x,t�ND _map UBLE_PRIND _ #inclunclude "map/4 .f" #undef __KIND #define _map UBLE_PRIND _ #inclunclude "map/4 "map/p map field pop_2d.f" #undef map UBLE_PRIND _ #inclune __KIND __DOUBLE_nclude "map/p map field pop_2d.f" #undef999x ! D map field pop_2d.f" #undef999xx,t�lh99 map field pop_2d.f" #undef999xxt�lh999ILE_PRace to p ma_KIND __SINGLE_PRECISION_C#undeclude "map/p map part ghost_pop.f" #undef __KIND #define __KIND __DOUBLE������������������������������������������������������������������������������������������������������������������������������������037ude "util/p 15741������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0��������������������������������������������������������������������������������������������������������������� INTERFACE p map field send_alltoall MODULE PROCEDURE p map- Particle MeSubllel Par��������������������� ---------------g����������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If nSUBRlicIN----------(dimLL() ,tolexp,comm,debug,info,log ,sturir,stus pI ! !! I a s parul,I --- lls.I .------g������������������������������������������������������������������������������������������sf not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Meshudes !----le Meshudes !subON(:,le Meshudes !subON !----udes !riror !----udes !write !----udes !log !----udes !t2 => !----udes !print_ude "ms !----udes !io !----I_MEICIT NONE------g������������������������������������������������������������������������������������meshes). Severa ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------- ! Define INCLUDE 'mpif.h'PRace tf not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiArgum9I s Mesh not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh INTEGE INT(IN) R :: dim ! !! dim parul,I -rt�lem (2 !3)le Mesh INTEGE INT(IN) R :: L() ! !! desi0 C L() i paru,max,phys,9I !max,phys,ys,maxle Mesh INTEGE INT(IN) R :: comm ! !! ! commun9999or !---- INTEGE INT(IN) R :: debug ! !! I debug lblil (0,1 !2)le Mesh INTEGE INT(IN) R :: tolexp ! !! log�� l,I num9y oanttoleSofc reantcom---is (> mach Pareps)9I#define _ E.g. attoleSofc l,I10^(-14is,tolexp = -14. E: yyththe .LT9I#define _ 10^tolexp ms of thc iuri C NU o (0)out eitine Particle/orc iuri C ! !! dangU ouPM is dis INTEGEOPT__K99x,t�lmax,og ! !! OPT__K99. U9x,tnumbiedhe met�lh9rintx,og sagLE_PRM is dis INTEGEOPT__K99x,t�lmaxsturir ! !! OPT__K99. U9x,tnumbiedhe met�lh9rintxt�lh9turirt�l is dis INTEGEOPT__K99x,t�lmaxstuout ! !! OPT__K99. U9x,tnumbiedhe met�lh9rintxt�lh9tus pu�l is dis INTEGE INT(lic) ! fo ! !! retur ON(tus 0 upclesucc s not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiLooantv--iMeshsf not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh-------ginys,max,phys,tosubpt, n,i9tus p,i9turir,ilog !---- INTEGER, DIMENSI1)lmax,dl,ldu !----999999x,t�lh999I :: t0 !----h999999x,t�lh999999I ys,max,mpi-----------g eiRACTER(LEN=max,char :: g------g eiRACTER(LEN=255)9I ys,cbuf not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiEx`PRIVAsf not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particl not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiShat t debuggthe f ! not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Meshmax,debug = debug not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiSeTH Zx,tnumbies not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshIF RESINT(stus pI) THEN----------gi9tus p = stuout !ELSE----------gi9tus p = 6 p ma_KIIFle MeshIF RESINT(sturirI) THEN----------gi9turirt=xsturir !ELSE----------gi9turirt=x0 p ma_KIIFle MeshIF RESINT(,og I) THEN----------gi,og =x,og !ELSE----------g! -1 ans: doITNE writex,og !---gi,og =x-1 p ma_KIIFle not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiSeTH Zx,tnumbies l,I9tus p ut e9turirtut e,og ! ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh999L------o_set_ Zx,(i9tus p,i9turir,ilog,info)le Mesh not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiNow t lls.I ) 201talk...------g���������������������������������������������������������������������������������------g������������������������������������������������������������������������������������me a e�------g���������������������������������������������������������������������������������999L-subON(:,('--------',t0,info)l------g������������������������������������������������������������������������������������ChecOGICgum9I s not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshIF max,debug .GT. 0) THEN---------999L-checO---------IF info .NE. 0) GOTO 9999 p ma_KIIFl-- hat ! Define ������������������������������������������������������������������������������������ChecOG h! hafielele/e a ze�����������������������������������������������������������������������������������������999L-! _Ie a ze�(max,mpi-----,info)l------g������������������������������������������������������������������������������������ FITNE extermsth riror ON(tus max,riror_fat:), POINT ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshIF .NOT.max,mpi-----) THEN----------info = max,riror_fat:), POINTesh999L-----riror(----rir_nom-i,'--------', &, POIN& POINTesh'C ! _Ie ielfI oanLE_PR-------- !',__LINE__,info)le MeshhhhGOTO 9999 p ma_KIIFl------g������������������������������������������������������������������������������������Getxt�lh! commun9999or !---- ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Meshmax,comm = comm !999L-! _Comm_S ze(max,commlEmaxnproc,info)le Mesh999L-! _Comm_Rank(max,commlEmaxSofk,info)le Mesh999L-! _Get_Proc sor_Name(cbuf, n,info)le MeshIF max,debug .GT. 0) THEN---------WRITE( g,'(2A)') '***eld iDOUBLE andlls.I )ON(:,the fie',&, POIN& POINTeshhhhhhhhhhhhcbuf(1: n)---------999L-max,log('--------', g,info)le Meshhh999L-max,write(EmaxSofk,'--------', g,info)le MeshELSE---------IF max,Sofk .EQ. 0) THEN-------------WRITE( g,'(2A)') '***eld iDOUBLE andlls.I )ON(:,the fie',&, POIN& POINTeshhhhhhhhhhhhcbuf(1: n)-------------999L-max,log('--------', g,info)le Meshhhshhh999L-max,write(EmaxSofk,'--------', g,info)le Meshma_KIIFle Mesh_KIIFl#elANTY; witEmaxnproc = 1TY; witEmaxSofk t=x0 p maWRITE( g,'(A)') '***eld iDOUBLE andlls.I )__DOs,max !!!c sor, MOe'le Mesh999L-----log('--------', g,info)le Mesh999L-max,write(EmaxSofk,'--------', g,info)lRace to p ma������������������������������������������������������������������������������������Output t debuggthe f ! not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshWRITE( g,'(A,I2)') 'Debug lblil NTEGtoe',max,debugle Mesh999L-----log('--------', g,info)le MeshIF max,debug .GT. 0) THEN---------hh999L-max,write(EmaxSofk,'--------', g,info)le MeshEKIIFl- p ma������������������������������������������������������������������������������������Burp t dee "ms l,I iDOlls.I )Particl ! ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh999L-----print_ude "ms(info)le MeshIF info.NE.0) THEN---------hhinfo = max,riror_fat:), POINTeshh999L-----riror(----rir_sub_fa d,'--------', &, POIN& POINTes'Printxdee "ms didITNE exec (ETcorrectly',__LINE__,info)le MeshhhhhGOTO 9999 p ma_KIIFlp ma------g������������������������������������������������������������������������������������ChecOGIt e9hat t dim para tyul,I -rt�lem, POINT ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshIF (dim.LT92) THEN----------info = max,riror_fat:), POINTesh999L-----riror(----rir_wrong_dimL'--------', &, POIN& POINTesh'Sp9x,tdim parumus iel gre freeth2011!',__LINE__,info)le MeshhhhGOTO 9999 p ma_LSEIF dim.GT.3) THEN----------info = max,riror_fat:), POINTesh999L-----riror(----rir_wrong_dimL'--------', &, POIN& POINTesh'Sp9x,tdim parumus iel l seth2014!',__LINE__,info)le MeshhhhGOTO 9999 p ma_LSEle Meshhhhmax,dim = dim !_KIIFlp maWRITE( g,'(A,I2)') 'Sp9x,tdim paruNTEGtoe',max,dimle Mesh999L-----log('--------', g,info)le MeshIF max,debug .GT. 0) THEN---------hh999L-max,write(EmaxSofk,'--------', g,info)le MeshEKIIFl------g������������������������������������������������������������������������������������ChecOG the 9I l be va C L() i par, POINT ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshIF (L() .NE.9x,t�lh999I .AND.L() .NE.9x,t�lh99ys,max, THEN----------info = max,riror_fat:), POINTesh999L-----riror(----rir_wrong_L() ,'--------', &, POIN& POINTesh'Mus iel of the fineE !2d.f" !',__LINE__,info)le MeshhhhGOTO 9999 p ma_KIIF l not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiShat t L() i par, POINT ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh9x,t�lh9 = m() !IF max,�lh9 .EQ. 9x,t�lh99ys,max, THEN----------aWRITE( g,'(A)') 'P() i paruNTEGtoefine _' p ma_LSEIF max,�lh9 .EQ. 9x,t�lh999I THEN----------aWRITE( g,'(A)') 'P() i paruNTEGtoe2d.f" ' p ma_LSEle MeshhhhaWRITE( g,'(A)') 'P() i paruNTEGtoeUNKNOWN' !_KIIFlp ma999L-----log('--------', g,info)le MeshIF max,debug .GT. 0) THEN---------hh999L-max,write(EmaxSofk,'--------', g,info)le MeshEKIIFl------g������������������������������������������������������������������������������������Shat t toleSofc not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshIF max,�lh9 .EQ. 9x,t�lh999I THEN----------aIF (tolexp.LT9-20.OR.tolexp.GT.-3) THEN--------------info = max,riror_warns,m--------------999L-----riror(----rir_tol_warn,'--------', &, POIN& POINTeshsh'Usuantv-luions theld 10^(-20)out e10^(-3)',__LINE__,info)le Meshhhhh_KIIF l---------aIF (tolexp.LT9INT(LOG10(EPSILON(max,myepsd))I) THEN----------g---info = max,riror_fat:), POINTeshh---999L-----riror(----rir_tol_warn,'--------', &, POIN& POINTeshsh'ToleSofc mus iTNE el smiceneeth201mach Parepsilon' &, POIN& POINTesh ,__LINE__,info)le Meshhhhh hhGOTO 9999 p mahhhh_KIIF l---------amax,myepsd = 10.0_9x,t�lh999I **99999tolexp,9x,t�lh999I l---------amax,myepss = 999999x,tmyepsd,9x,t�lh99ys,max,le MeshhhhaWRITE( g,'(A,E15.10)') 'Floa,the pointxtoleSofc NTEGtoe', &, POIN& POINTes9x,tmyepsd p ma_LSEle MeshhhhaIF (tolexp.LT9-12.OR.tolexp.GT.-3) THEN--------------info = max,riror_warns,m--------------999L-----riror(----rir_tol_warn,'--------', &, POIN& POINTeshsh'Usuantv-luions theld 10^(-12)out e10^(-3)',__LINE__,info)le Meshhhhh_KIIF l---------aIF (tolexp.LT9INT(LOG10(EPSILON(max,myepss))I) THEN----------g---info = max,riror_fat:), POINTeshh---999L-----riror(----rir_tol_warn,'--------', &, POIN& POINTeshsh'ToleSofc mus iTNE el smiceneeth201mach Parepsilon' &, POIN& POINTesh ,__LINE__,info)le Meshhhhh hhGOTO 9999 p mahhhh_KIIF l------- -amax,myepsd = 10.0_9x,t�lh999I **99999tolexp,9x,t�lh999I l---------amax,myepss = 999999x,tmyepsd,9x,t�lh99ys,max,le MeshhhhaWRITE( g,'(A,E15.10)') 'Floa,the pointxtoleSofc NTEGtoe', &, POIN& POINTes9x,tmyepss not,I _KIIFlp ma999L-----log('--------', g,info)le MeshIF max,debug .GT. 0) THEN---------hh999L-max,write(EmaxSofk,'--------', g,info)le MeshEKIIFl-- ! Define ������������������������������������������������������������������������������������Shat t ! L() i paru not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle MeshIF max,�lh9.EQ.9x,t�lh999I THEN----------max,mpi-�lh9 = ! _2d.f" #undef __KIe MeshELSEle Meshhhhmax,mpi-�lh9 = ! _9999 p ma_KIIF lRace tf Define ������������������������������������������������������������������������������������D ul,I Define ���������������������������������������������������������������������������������----pi_9 = DACOS(-1.0_9x,t�lh999I )�������----pi_s = ACOS(-1.0_9x,t�lh99ys,max,lDefine ������������������������������������������������������������������������������������A2 =>ateout eie a zeI -rtc sor,speOTE]I Define ���������������������������������������������������������������������������������ubpt = max,param!t2 =>_f--------gldlI1)l=x0 p malduI1)l=xEmaxnproc-1 p ma999L-max,t2 =>(----pr=>_speOT,,dl,ldu,ubpt, nfo)le MeshIF info .NE. 0) THEN---------hhinfo = max,riror_fat:), POINTeshh999L-----riror(----rir_t2 =>L'--------', &, POIN& POINTes'-rtc sor,speOTE]I E an_phys_SPEED',__LINE__,info)le MeshhhhhGOTO 9999 p ma_KIIFlp ma!eie a ly assume -rtc sorE_PREel oqua ly fa !-----pr=>_speOT(0:Emaxnproc-1)l=x &, POIN& PO1.0_9x,t�lh999I /999999x,tnproc,9x,t�lh999I )�Define ������������������������������������������������������������������������������������Resetxt�lhtopLE p couI Define ���������������������������������������������������������������������������������----next_avail_topL = max,param!clude not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh LiSeTHt�lhN(:,:) ON(tus PRE/e a ze�����������������������������������������������������������������������������������������-------- a ze� = .TRUE.�Define ������������������������������������������������������������������������������������Retur u not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle9999nd_alINUE p ma999L-subON ('--------',t0,info)lp maRETURN-------d_alltoal------SUBRlicIN--checO---------IF -------- a ze�) THEN----------g--info = max,riror_riror !----NTeshh999L-----riror(----rir_multiple----,'--------', &, POIN& POINTesh 'Pleas oanL-----e a zeIfirst!',__LINE__,info)le MeshhhhhhhGOTO 8888le Meshhh_KIIFlp8888---d_alINUE p ma_KINSUBRlicIN--checO-------_KINSUBRlicIN----------clude "map/p map part ghost_pop.f" #undef __KIND #define __KIND __DOUBLE_PRECISION_COMPLEX #include "map/p map part ghost_pop.f" #undef __KIND #undef __DIM #include "map/p map part ghost_put.f" END MODULE p module_map part ghost �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������util_time���������������������������������������������������������������������������������������������04700ude "util/p4����330������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������not,I ��������������������incardon�����������������������������������������������������������������������������������----�������util_timeDefine ����������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lh999999x,t�lh999999I 2PM. If nD __SINGLE_PRECISIutil_timeDefine �!CISION_COMPLEX!!! [NODOUBLEutil tyutime 9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,E_PRECISItim 6I#define I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII util_timeDefine . If nD __SINphys,mis,t�lEmutil_time map field pusD __SINphys,mis,t�lEmutil_time �lEmax,t�lh999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE map fiet�lh999I INTERFACE p map field send_alltoall MODULE PROCEDURE p map field send_alltoall e "map/p map field pop_2d.f" #undef __KINutil/�lEmutil_timeGER #include "map/p map field pop_2d.f" #undef __KIND #definutil/�lEmutil_timeGER #include "map/px,t�lh9999D __SINGLE_PRECISIutil_timeD��������������������������������������������������������������������������������������������ON_C----ON(:,:)���������������������������������������������������������������������������������������06750ude "util/p4���1467������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0��������������������������������������������������������������������������������������������������������������� INTERF��������������������incardon�������������������������������������������������������������������������������������������ON_C----ON(:,:)Define ����������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPl PubM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,misssssssss,t�lh999999x,t�lh999999I 2PM. If nD __SINGLE_PRECISION_C----ON(:,:)Define �!CISION_COMPLEX!!! [NODOUBLEON_p 6I#define s N(:,:) pfor morDefine �!CION_p 6I9#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE PRIVATE :: isendfromsub,isendtosub,isendblkstart,isendblksize PRIVATE :: ioffset,ird_double), DIMENSION(:), POINTEtosu 1t,ir REAL(p kind_double), DIMENSION(:), POINTEtosu 2t,ir REAL(p kind_double), DIMENSION(:), POINTEtospfor2proc =recv => NULL() INTEGEu 1,u 2,pfor2procterface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,st�lh999I ----ON(:,:)Define :: isendfromsub,isendtosub,isendblkstart,isendblksize PRIVATE :: ioffset,ird_doTERFACEII ----ON(:,:)Define :: inys,max,phys,mis,t�lEmax,t----ON(:,:) map field pusys,max,phys,mis,t�lEmax,t----ON(:,:) PRIVATE :: ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,st�lh999I ----Ore Define :: isendfromsub,isendtosub,isendblkstart,isendblksize PRIVATE :: ioffset,ird_doTERFACEII ----Ore Define :: pusys,max,phys,mis,t�lEmax,t----Ore map field pusys,max,phys,mis,t�lEmax,t----Ore PRIVATE :: ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lE map fiet�lh999I ROCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall e "map/p map field pop_2d.f" #undef __KINd pop_2d.f" ----ON(:,:)��R #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __L----ON(:,:)��R #include "map/p map field pop_ield pop_2d.f" #undef __KINd pop_2d.f" ----Ore ��R #include "map/p map field pop_2d.f" #undef __KIND #define __KIND __L----Ore ��R #include "map/pTE :: ! D __SINGLE_PRECISION_C----ON(:,:)D����������������������������������������������������checO_id����������������������������������������������������������������������������������������������05��1ude "util/p5�������������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon��������������������������������������������������������������������������������������������checO_topLi������������������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Parallel Particle Mesh Library (PPM).I !I ! PPM is free software: you can redistribt�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPl PubM. If nD __SINGLE_PRECISIchecO_idDefine �!CISION_COMPLEX!!! [NODOUBLEutil tyudefine s,Define �!CIwh of-checOhtopLE p ut e IDs UBLir va C ty9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,_PRECISItopLi�-checOhdefine I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII checO_topLi��������ne �!CIchecOshtopLE p Ip//p map usys,max,phys,mis,t�lEmchecO_topLi��������ne ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhUBLEO i�-checOhdefine I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII checO_O i��������ne �!CIchecOsh ID//p map usys,max,phys,mis,t�lEmchecO_O i��������ne ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lE map fiet�lh999I ROCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoal IND #defintopL/�lEmchecO_topLi� map fieltopL/�lEmchecO_O i� ���ne ! D __SINGLE_PRECISIchecO_idD03525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������time��������������������������������������������������������������������������������������������������04732ude "util/p4��17300������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon������������������������������������������������������������������������������������������������timeDefine ����������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can redistribt�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPl PubM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lh999999x,t�lh999999I 2PM. If nD __SINGLE_PRECISItimeDefine �!CISION_COMPLEX!!! [NODOUBLEdefine sDefine �!CIconcer ABILIloaI aGencing. I yns thoanLMesh !I 9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,E_PRECISItim 6I#define I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII timeDefine . If nD __SINphys,mis,t�lEmtime map field pusD __SINphys,mis,t�lEmtime �lEmax,t�lh999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE map fiet�lh999I ROCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall e "map/p map field pop_2d.f" #undef __KINutil/�lEmtimeGER #include "map/p map field pop_2d.f" #undef __KIND #definutil/�lEmtimeGER #include "map/px,t�lh9999D __SINGLE_PRECISItimeD������������������������������������������������������������������util_sor����������������������������������������������������������������������������������������������05252ude "util/p4����3��������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon�����������������������������������������������������������������������������������----�������util_sor�Define ����������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can redistribt�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/licenses/>.I !I ! Parallel Particle Mesh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lh999999x,t�lh999999I 2PM. If nD __SING---�������util_sor�Define �!CISION_COMPLEX!!! [NODOUBLEutil tyusor� 6I#define s9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,E_PRECISIsor� 6I#define I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII util_sor�3 map field pusys,max,phys,mis,t�lEmutil_sor�3 map field pusD __SINphys,mis,t�lEmutil_sor�3 �lEmax,t�lh999999x,t�lh99#definI D INTERFACEII util_sor�2 map field pusys,max,phys,mis,t�lEmutil_sor�2 map field pusD __SINphys,mis,t�lEmutil_sor�2 �lEmax,t�lh999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE map fiet�lh999I OCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall e "map/p map field pop_2d.f" #undef __KINutil/�lEmutil_sor�3 GER #def __KINutil/�lEmutil_sor�2dGER #include "map/p map field pop_2d.f" #undef __KIND #definutil/�lEmutil_sor�3 GER #def __KINutil/�lEmutil_sor�2dGER #include "map/px,t�lh9999D __SING---�������util_sor�D6003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Odet-e a ze�����������������������������������������������������������������������������������������05647ude "util/p3���11��������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon�������������������������������������������������������������������������������������������Odet-e a zeDefine ����������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can redistribt�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM. If not,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�sh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,misssssssss,t�lh999999x,t�lh999999I 2P�lh999999x-------ginys,max,phys,,,,3P�lh999999xh999999x,t�lh999999I 4----------ginys,max,phys,mi_COMPLEX 5t�lh999999x,t�lh999999I _COMPLEX 6t�lh999999x2Dx,t�lh999999I 7t�lh999999x3Dx,t�lh999999I 8----------giFIELDx,t�lh999999I 9----------gVFIELDx,t�lh999999I 10PM. If nD __SINGLE_PRECISIOdet-e a zeDefine �!CISION_COMPLEXcon ! nDOUBLEh999999x,tut even OSAfer9I by them9I s parsDefine �!CIl,IGLE_Pdet-e a ze�Define �!CDefine �!CI[NOTE]Define �!CISI, I inLE p mod 6Iu !sheld Pdetionst efieldsDefine �!CI(ven Oata livthe fieUBLEO es)t yovrrantfields) 201e Gr option) an!CIsamLEO .e detions that as max-h9999 a TYPES,dhe measDefine �!CIfields)s th -!!! [NOTE]I s9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,t�lh999I det-e a zeDefine I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI d_doTERFACEII det-e a zeDefine I If nD __SINphys,mis,t�lEmadet-e a zeDefine I 999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEImap fiet�lh999I OCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall D #definedet/GLE_Pdet-e a ze� ���ne ! D __SINGLE_PRECISIadet-e a zeD���������������������������������������������������������������������������������������������������������������������decomp������������������������������������������������������������������������������������������������11����de "util/p4��17605������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon��������������������������������������������������������������������������������������������decompDefine ����������������������������������������������������������������������������������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can redistribt�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPl PubM. If not,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�sh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lh999999x,t�lh999999I 2PM. If nD __SING---�������decompDefine �!CISION_COMPLEX!!! [NODOUBLE9999decompos udefine s9I#defin�!CDefine �!CI9999cI !!! [NODO4 OSAfer9I bdecompos udefine sr the s thoanLedDefine �!CIABIL ! it topLE p define s9I9#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lELooan w ]I she G !max,decomp_pru _cel)Define :: isendfromsub,isendtosub,isendblkstart,isendblksize PRIVATE :: ioffset,ird_do---ge), DIMENSION(:), POINT, INTEGEnpbxir REAL(p kind_doublge), DIMENSION(:), POINT, INTEGEnpbxg =recv => NULL() ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,t�lhbox sthet#define I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII decomp_boxsthetmap field pusD __SINphys,mis,tdecomp_bsthet map field pusD __SINphys,mis,tdecomp_bsthet ��������ne ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh���tesi201decompos udefine I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII decomp_���tesi20map field pusD __SINphys,mis,tdecomp_���t map field pusD __SINphys,mis,tdecomp_���t ��������ne ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lhpru cel)1decompos udefine I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII decomp_pru _cel)Define :: pusD __SINphys,mis,tdecomp_pcel) map field pusD __SINphys,mis,tdecomp_pcel) ��������ne ! Define interface to p map field send_noblockI !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lht decompos udefine I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII decomp_t map field pusD __SINphys,mis,tdecomp_t map field pusD __SINphys,mis,tdecomp_t �lEmax,t�lh999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE map fiet�lh999I ROCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall e "map/p map field pop_2d.f" #undef __KINdecomp/EII decomp_boxsthetGER #include "map/p map field pop_2d.f" #undef __KIND #defindecomp/EII decomp_boxsthetGER #include "map/p map field pop_ield pop_2d.f" #undef __KINdecomp/EII decomp_���tesi20GER #include "map/p map field pop_2d.f" #undef __KIND #defindecomp/EII decomp_���tesi20GER #include "map/p map field pop_ield pop_2d.f" #undef __KINdecomp/EII decomp_pru _cel)GER #include "map/p map field pop_2d.f" #undef __KIND #defindecomp/EII decomp_pru _cel)GER #include "map/p map field pop_ield pop_2d.f" #undef __KINdecomp/EII decomp_t GER #include "map/p map field pop_2d.f" #undef __KIND #defindecomp/EII decomp_t GER #include "map/p ! D __SINGLE_PRECISIdecompD003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������h9999p_m2p��������������������������������������������������������������������������������������������12225ude "util/p3���041�������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon������������������������������������������������������������������������������������������rmshOre es have rec map field push_3d_vec_i MODULE PROCEDURE p map field p-����������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPM---------ginys,max,phys,mis,t�lh999999x,t�lh999999I 2P�lh999999x2Dx,t�lh999999I 3t�lh999999x3Dx,t�lh999999I 4----------gVEC,t�lh999999I 5t�lh999999xSCA,t�lh999999I 6PM. If nD __SING---�������h9999p_m2pDefine �!CICon ! nDOUBLE �lhpfor moreh9999pola udefine s9 Curr9I ly wption) an!CIsuppo---2t eoruricB-sthen,tut eMP4eh9999pola usche es9I9#definI lic LicenseI ! and the GNU Lesser General Public License along with9#definI llEIm99999x,9#definI lic LicenseI ! and the GNU Lesser General Public License along with9#definI D INTERFACEII h9999p_m2pDefine finI ll2duscalar !----NTeshD __SINphys,mis,tm2p_ss_2 map field puD __SINphys,mis,tm2p_ds_2 map field pull2duvector !----NTeshD __SINphys,mis,tm2p_sv_2 map field puD __SINphys,mis,tm2p_dv_2 map field pu! 3duscalar !----NTeshD __SINphys,mis,tm2p_ss_3 map field puD __SINphys,mis,tm2p_ds_3 map field pu! 3duvector !----NTeshD __SINphys,mis,tm2p_sv_3 map field puD __SINphys,mis,tm2p_dv_3 map field999999x,t�lh999#definI D INTERFACm2p_h9999p_bsp2map field pusD __SINphys,mis,tm2p_h9999p_bsp2_ss_2 map field pusD __SINphys,mis,tm2p_h9999p_bsp2_ds_2 map field pusD __SINphys,mis,tm2p_h9999p_bsp2_sv_2 map field pusD __SINphys,mis,tm2p_h9999p_bsp2_dv_2 map field pusD __SINphys,mis,tm2p_h9999p_bsp2_ss_3 map field pusD __SINphys,mis,tm2p_h9999p_bsp2_ds_3 map field pusD __SINphys,mis,tm2p_h9999p_bsp2_sv_3 map field pusD __SINphys,mis,tm2p_h9999p_bsp2_dv_3 map field999999x,t�lh999#definI D INTERFACm2p_h9999p_mp4map field pusD __SINphys,mis,tm2p_h9999p_mp4_ss_2 map field pusD __SINphys,mis,tm2p_h9999p_mp4_ds_2 map field pusD __SINphys,mis,tm2p_h9999p_mp4_sv_2 map field pusD __SINphys,mis,tm2p_h9999p_mp4_dv_2 map field pusD __SINphys,mis,tm2p_h9999p_mp4_ss_3 map field pusD __SINphys,mis,tm2p_h9999p_mp4_ds_3 map field pusD __SINphys,mis,tm2p_h9999p_mp4_sv_3 map field pusD __SINphys,mis,tm2p_h9999p_mp4_dv_3 map field999999x,t�lh99999#defind_alltoallap fieldp map field poop_ield pop_2d.f" #unlh999999x,IME 99x2Dunlh999999xD _E 99xSCA9#definI ll2DxSCA,ield pIND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Eunlh999999xD _E 99xVEC9#definI ll2DxVEC,ield pIND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Euninclud99x,IMElap fieldp map fie,IME 99x3Dunlh999999xD _E 99xSCA9#definI ll3DxSCA,ield pIND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Eunlh999999xD _E 99xVEC9#definI ll3DxVEC,ield pIND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Euninclud99x,IMElninclud99x"map/pp map field poop_2d.f" #undef __KINlh999999x,IME 99x2Dunlh999999xD _E 99xSCA9#definI ll2DxSCA,2d.f" IND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Eunlh999999xD _E 99xVEC9#definI ll2DxVEC,2d.f" IND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Euninclud99x,IMElap fieldp map fie,IME 99x3Dunlh999999xD _E 99xSCA9#definI ll3DxSCA,2d.f" IND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Eunlh999999xD _E 99xVEC9#definI ll3DxVEC,2d.f" IND #definh9999pola e/EII h9999p_m2pGER #def __KINh9999pola e/m2p_h9999p_bsp2GER #def __KINh9999pola e/m2p_h9999p_mp4GER #includ99xD _Euninclud99x,IMElninclud99x"mapap fieldpppppp#include inys,max,phys,misp#include ,t�lh999999I p#include 2Dx,t�lh999999I p#include 3Dx,t�lh999999I p#include VEC,t�lh999999I p#include iCA,t�lh999999I 99999I 99999I ! D __SINGLE_PRECISIh9999p_m2pDD003525�020276� 0���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Odet��������������������������������������������������������������������������������������������������0365��de "util/p4��17300������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������efinI l m��������������������incardon���������������������������������������������������������������������������������������������Odethave rec map field push_3d_vec_i MODULE PROCEDURE p map field p-����������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPMal PubD __SINGLE_PRECISIadettion) an!CISION_COMPLEXcon ! nDOiceh -oanLMesh define s O es99#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE9999COMPLEPRIVATE :: isendfromsub,isendtosub,isendblkstart,isendblksize PRIVATE :: ioffset,irUSINGLE_PRECISIadet-anLocioffset,irUSINGLE_PRECISIadet-bLockIh9999sectioffset,irUSINGLE_PRECISIadet-lh9999ioffset,irUSINGLE_PRECISIadet-lhrillioffset,irUSINGLE_PRECISIadet-e a zeDefine I USINGLE_PRECISIadet-on_subsDefine I USINGLE_PRECISIadet-stI ���ne ! D __SINGLE_PRECISIadetD003525�020276� 0������������������������������������������������������������������������������������������������hmposeC----Obc����������������������������������������������������������������������������������������05e "ude "util/p4���1325������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������TE :: ise��������������������incardon������������������������������������������������������������������������������������������hmposeC----Obchave rec map field push_3d_vec_i MODULE PROCEDURE p map field p-����������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPMal Pubot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�sh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,misssssssss,t�lh999999x,t�lh999999I 2PM. If nD __SINGLE_PRECISIhmposeC----Obchave rec!CISION_COMPLEXdef __Kset�lh999I Rcodth hoanLMeshhave rec!CIEII hmposeC----Obc define �lhmapet�lhpfor mors backhave rec!CI nDifiet�lhcompu s parantdom! n phriMOSc BC9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,t�lh999I ap_field_ghostI#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII hmposeC----Obchave re . If nD __SINphys,mis,t�lEmhmposeC----Obc map field pusnD __SINphys,mis,t�lEmhmposeC----Obc �lEmax,t�lh999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEImap fiet�lh999I OCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall map field pop_ield pop_2d.f" #undef __KINd pop_2dhmposeC----Obc��R #include "map/p map field pop_2d.f" #undef __KIND #define __KINDhmposeC----Obc��R #include "map/px,t�lh9999D __SINGLE_PRECISIhmposeC----Obch003525�020276� 0���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������t GE������������������������������������������������������������������������������������������������0537��de "util/p4��1730�������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon������������������������������������������������������������������������������������� �����������t have rec map field push_3d_vec_i MODULE PROCEDURE p map field p-����������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPMal Pubot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�sh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lh999999x,t�lh999999I 2P�lh999999xTREE999x,t�lh99993t�lh999999xDECOMP9x,t�lh99994PM. If nD __SINGLE_PRECISIt have rec!CISION_COMPLEX!!! [NODOUBLEt define 9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,E_PRECISIdefine (s)I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII t map field pusD __SINphys,mis,tEII t _t map field pusD __SINphys,mis,t�lEmt _t map field pusys,max,phys,mis,t�lEmt � map field pusD __SINphys,mis,t�lEmt _d�lEmax,t�lh999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE map fiet�lh999I OCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall map fieTYPE99xTREEl map field pop_ield pop_2d.f" #undef __KINt /�lEmt ��R #include "map/ map field pop_2d.f" #undef __KIND #defint /�lEmt ��R #include "map/ include TYPEll map fieTYPE99xDECOMPl map field pop_ield pop_2d.f" #undef __KINt /�lEmt ��R #include "map/ map field pop_2d.f" #undef __KIND #defint /�lEmt ��R #include "map/ include TYPEllx,t�lh9999D __SINGLE_PRECISIt h6003525�020276� 0�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������topo-stI ��������������������������������������������������������������������������������������������04747ude "util/p4����545������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������URE p m��������������������incardon��������������������������������������������������������������������������������������������topo-stI have rec map field push_3d_vec_i MODULE PROCEDURE p map field p-����������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPl PubMal Pubot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�sh Library (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------------------ginys,max,phys,mis,t�lh999999x,t�lh999999I 2PM. If nD __SINGLE_PRECISItopo-stI have rec!CISION_COMPLEX!!! [NODOUBLEdefine r the stI s newly crea topLE pi s9I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lEmax,t�lh999999x,E_PRECopLE p stI #define I#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI D INTERFACEII topo-stI have re. If nD __SINphys,mis,t�lEmtopo-stI map field pusD __SINphys,mis,t�lEmtopo-stI �lEmax,t�lh999999x,t�lh999#definI ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----------I#definI lE map fiet�lh999I ROCEDURE p map field push_3d_vec_i MODULE PROCEDURE p map field push_3d_vecd_alltoall e "map/p map field pop_2d.f" #undef __KINtopo/�lEmtopo-stI ��R #include "map/p map field pop_2d.f" #undef __KIND #defintopo/�lEmtopo-stI ��R #include "map/px,t�lh9999D __SINGLE_PRECISItopo-stI h������������������������������������������edet/���������������������������������������������������������������������������������0755�����������������������00000ude "util/p5��14701� 5����������������������������������������������������������������������������������������������������src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0��������������������������������������������������������������������������������������������������������������������������������edet/GLE_Pdet-lhrill���������������������������������������������������������������������������������������������25756ude "util/p5��20235������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������al Pubot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�Subdefine r���������������������GLE_Pdet-lhrillhave rec map field push_3d_vec_i MODULE PROCEDURE p map field p-����������������������������� !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPral PubSUBRlicINE�GLE_Pdet-lhrill(topoid,te th fr_Pdetid,new_Pdetid,act,99xtI , &ral Pu&t�lh999999x,t�lh99999999999infoI ! !ield define rlhrillsbe newE fromout exmod 6I oe r r map 6I ! !ie coarsep 6Ieven gri cel)sr e uert! n 9xtI .fil coarsep 6I ! !ieven numbiedl,Icel)sr ! it o��� a E needE_PREbn OSvisiesh by ! !ievehe 9xtI fieovrr subr !ovrr diit tu can h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�������(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I USINGLE_PRECISIOata-PM)I USINGLE_PRECISIOataIadettion) aUSINGLE_PRECISIary clution) aUSINGLE_PRECISIadet-stI ion) aUSINGLE_PRECISIanLocioffsetUSINGLE_PRECISIerror !----USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----USINGLE_PRECISIcheckIheral PubIMPLICIT NONEn h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -------ginys,max,phys,,,, ----NT(I )TEGEtopoid ! !ielopLE p ID wh ofE hashelishcrea ,-PM)I -------ginys,max,phys,,,, ----NT(I )TEGEte th fr_Pdetid ! !ie detai l,I te th frEO .eIerms ofNOTEbn ovrrwrittecan h9999-------ginys,max,phys,,,, ----NT(I )TEGEactioffset !ieA tu ca Oe rof:ioffset !iioffset !ie*NGLE_---aE_Pdet-rh9999ioffset !ie*NGLE_---aE_Pdet-coarsepn h9999-------ge), DIMENSION ), ----NT(I )TEGE 9xtI ioffset !ieF9xtI wh ofEPRErh9999/coarsepOUBLE !oaofEdiit tu can h99999!ieF coarsep 6Ieven numbiedl,I poiI ( fieUBLEope mustioffset !iebn OSvisiesh byeUBI 9xtI !ovrr diit tu can h9999-------ginys,max,phys,,,, ----NT(I lic)TEGEnew_Pdetidioffset !ieO pu IDor FI<= 0 fieinput,r option) an!CIdefine rms ofcrea be newE ut ereturieUBLEID e mean h9999-------ginys,max,phys,,,, ----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmpln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reREAL(GLE_kind_do ofe),max,phys,,,EGEt0n h9999-------ginys,max,phys,,,x,phys,,,EGEnsubs,i,j,i n h9999-------e), DIMENSIO2),max,phys,,,EGEldcn h9999-------e), DIMENSIOEII dim)hys,,,EGENmn h9999-------e), DIMENSIO:,N(:), POINT,EGEnnor REAL(p -------e), DIMENSIO:,N(:), POINT,EGEmodr REAL(p eiRACINT(LEN=EII char)ax,phys,,,EGE I !h999999x,t�lh999999I ,phys,,,EGEvalidioffsetTYPEOEII t_equi_Pdet(:), POINT,,,EGEp_Pdetr REAL(p TYPEOEII t_topo)ax,ph:), POINT,,,EGEtopo ir REAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Initialislhave rec map field push_3d_vec_i MODULE PROCEDURE p map field p-���������999L subsc/pt('GLE_Pdet-lhrill',t0,infoI -n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFpx,t�lhtopo �lEmtopo(topoid)% n h9999p_Pdetr topo%Pdet(te th fr_PdetidEAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�AnLoc frEO mor exmod 6I PdetrOata-PM)I 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rensubsir topo%nsubs-n h9999i ir NGLE_---aE_anLoc_fetmap fieldc(1)r NGLE_dimmap fieldc(2)r NnsubsDefine 999L GLE_anLoc(nno,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_fata)Define :: p999L GLE_error(GLE_err_anLoc,'GLE_Pdet-lhrill',: p&ral Pu&t�lh9999'ope numbiedl,Igri poiI ( NNO',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpx,t�lh999L GLE_anLoc(mod,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_fata)Define :: p999L GLE_error(GLE_err_anLoc,'GLE_Pdet-lhrill',: p&ral Pu&t�lh9999'ope sc/pt 6I poiI ( IST',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Read exmod 6I PdetrOata ut edo ofe-checkEtopoid ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rennor 9p_Pdet%nnofi((1:GLE_dim,1:nsubsI !modr 9p_Pdet%isc/pt(1:GLE_dim,1:nsubsI !Nm r 9p_Pdet%Nm(1:GLE_dim)-n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�CoarsepOOdethave rec map field push_3d_vec_i MODULE PROCEDURE p map field p-���������-F O9xt .EQ.NGLE_---aE_Pdet-coarsep) THENush_3d_ve99DO j=1,GLE_dimmap fieeeeeeeee-F OMOD(Nm(j)-1,99xtI (j)) .NE. 0) THENush_3d_ve99_3d_ve99infor NGLE_error_error !----------------WRITE( I,'(A,I5,A,I1,A,I6,A,I3)') 'Globa E ', &ral Pu&t�lh999999x,t�lh' !dimenticle',j,' hash',Nm(j)-1,99x,t�lh&ral Pu&t�lh999999x,t�lh'E cel)srut eI not OSvisiesh bye',99xtI (j) !----------------999L GLE_error(GLE_err_bad_Pdetop,'GLE_Pdet-lhrill',: &ral Pu&t�lh999999x,t�lh I,__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhhNm(j)r N((Nm(j)-1)/99xtI (j))+1 lhhhhhhhhh999DOush_3d_ve99DO i=1,nsubsDefine I _ve99DO j=1,GLE_dimmap fieeeeeeeeeeeee-F OMOD(nno(j,i)-1,99xtI (j)) .NE. 0) THENush_3d_ve99_3d_ve999999infor NGLE_error_error !--------------------WRITE( I,'(A,I5,A,I1,A,I6,A,I3)') ' deta usub ', &ral Pu&t�lh999999x,t�lh9999i,' !dimenticle',j,' hash',nno(j,i)-1,t�lh9999&ral Pu&t�lh999999x,t�lh9999'E cel)srut eI not OSvisiesh bye',99xtI (j) !--------------------999L GLE_error(GLE_err_bad_Pdetop,'GLE_Pdet-lhrill',: &ral Pu&t�lh999999x,t�lhhhhh I,__LINE__,infoI !!!!!!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhhhhhh999IFpx,t�lhhhhhhhhhhhhhnno(j,i)r N((nno(j,i)-1)/99xtI (j))+1 lhhhhhhhhhhhhhhhhhisc(j,i)r N((isc(j,i)-1)/99xtI (j))+1 lhhhhhhhhhhhhh999DOush_3d_ve99999DOuAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Remap fOdethave rec map field push_3d_vec_i MODULE PROCEDURE p map field p-���������ELSE-F O9xt .EQ.NGLE_---aE_Pdet-rh9999) THENush_3d_ve99DO j=1,GLE_dimmap fieeeeeeeeeNm(j)r N((Nm(j)-1)*99xtI (j))+1 lhhhhhhhhh999DOush_3d_ve99DO i=1,nsubsDefine I _ve99DO j=1,GLE_dimmap fieeeeeeeeeeeeenno(j,i)r N((nno(j,i)-1)*99xtI (j))+1 lhhhhhhhhhhhhhhhhhisc(j,i)r N((nno(j,i)-1)*99xtI (j))+1 lhhhhhhhhhhhhh999DOush_3d_ve99999DOud_ve99999IFpAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�StI #newE have rec map field push_3d_vec_i MODULE PROCEDURE p map field p-���������999L GLE_Pdet-stI (topoid,new_Pdetid,nno,mod,Nm,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_sub_failed,'GLE_Pdet-lhrill',: p&ral Pu&t�lh9999'StI 6I newE failed.',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�DeanLoc frEw O mor AL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rei NGLE_---aE_deanLocioffset999L GLE_anLoc(nno,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_deanLoc,'GLE_Pdet-lhrill',: p&ral Pu&t�lh9999'ope numbiedl,Igri poiI ( NNO',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpx,t�lh999L GLE_anLoc(mod,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_deanLoc,'GLE_Pdet-lhrill',: p&ral Pu&t�lh9999'ope sc/pt 6I poiI ( IST',__LINE__,infoI !999IFpAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�ReturiAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_Pdet-lhrill',t0,infoI x,t�lhRETURNush_3d_d_alltoalsh_3d_SUBRlicINE�checkush_3d_ve !-F O.NOT.CEII h9itialized) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_GLE_noh9it,'GLE_Pdet-lhrill',: &ral Pu&t�lh999999x,'PleasehoanLCEII h9it first!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx,t�lhhhhh999L GLE_checkItopoid(topoid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-lhrill',: &ral Pu&t�lh999999x,'topoid_invalid',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx,t�lhhhhh999L GLE_checkIPdetid(topoid,te th fr_Pdetid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-lhrill',: &ral Pu&t�lh999999x,'Pdetid_invalid',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx,t�lhhhhh-F OO9xt .NE. GLE_---aE_Pdet-rh9999) .AND. !!!!!!!!!&ral Pu&t�lh9999O9xt .NE. GLE_---aE_Pdet-coarsep)) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-lhrill',: &ral Pu&t�lh999999x,'invalidE opera uspecifiec',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx,t�lhhhhhDO i=1,GLE_dimmap fieeeeeeeee-F O99xtI (i)r.LE. 0) THENush_3d_ve99_3d_ve99infor NGLE_error_error !----------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-lhrill',: &ral Pu&t�lh999999x,99x,' 9xtI mustebn > 0 !anLCdiit tu cs',__LINE__,infoI !!!!!!!!!!!!!GOTO 8888ush_3d_ve99ve99999IFpx,t�lhhhhh999DOud8888-----9_alINUEpx,t�lh9999SUBRlicINE�checkush_3d_9999SUBRlicINE�GLE_Pdet-lhrillh�����������������������������������edet/GLE_Pdet-lh9999���������������������������������������������������������������������������������������������14317ude "util/p5��20200������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������sh_3d_ot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�Subdefine r���������������������GLE_Pdet-lh9999ioffset t,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPral PubSUBRlicINE�GLE_Pdet-lh9999(topoid,Pdetid,Nm,isc/pt, is a,infoI ! !ield define rlhfne s e newE cleut exmod 6I CopLE p . ! !ieldLEdefine rchecksr the t�lh9ubdom! n ! CopLE p a have rec!CIcomps pesh ABILIt�lh9pecifiedE (i.e. a lh999ge multipshln h99999!CI ! spac 6I !oxt9I )or FITNESeut error9I returiedan h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�������(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I USINGLE_PRECISIOata-PM)I USINGLE_PRECISIerror !----USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----USINGLE_PRECISIadet-on_subsDefine USINGLE_PRECISIadet-stI ion) aUSINGLE_PRECISIcheckIheral PubIMPLICIT NONEnn h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------ginys,max,phys,,,, ----NT(I )TEGEtopoid ! !ielopLE p ID wh ofEtofcrea b have re-------ge), DIMENSION ), ----NT(I )TEGENmn h9999 !ieNumbiedl,I , POIS !oaofEdimenticl.�Subs mustebn comps peshn h9999 !ieABILIt�ON_C PM) thewi MERt error9occursan h9999-------ginys,max,phys,,,, ----NT(I lic)TEGEPdetid ! !ie detaID ! newE or FI.LE. 0 fieinput, ! !ieUBLEdefine rms ofcrea beleuutom!r m oe rut ereturietere mean h9999-------ge), DIMENSIO:,N(:), POINT,,,,,,,EGEmod/pt !---- !ieSd/pteindix,E_ ! anLCsubsiO es !globa E n h9999-------ge), DIMENSIO:,N(:), POINT,,,,,,,EGEnOata-PM)I 9!ieNumbiedl,I poiI ( !oaofEdiit tu c fieoaofEsub n h9999-------ginys,max,phys,,,, ----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmplnn h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reREAL(GLE_kind_do ofe),max,pEGEt0n h9999h999999x,t�lh999999I ,pEGEvalidioffsetTYPEOEII t_topo):), POINT,,EGEtopo REAn h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Initialislhave rec map field push_3d_vec_i MODULE PROCEDURE p se along with PPave re999L subsc/pt('GLE_Pdet-lhfne ',t0,infoI h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFppx,t�lhtopo �lEmtopo(topoid)% n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Crea bnewE have rec map field push_3d_vec_i MODULE PROCEDURE p map field p-���������-F Otopo%pit .EQ.NGLE_kind_s 6Il9) THENush_3d_ve999L GLE_Pdet-on_subs(Nm,topo%Pin_physs,topo%Pax_physs,topo%Pin_subs, &ral Pu&t�lh99topo%Pax_subs,topo%nsubs,isc/pt, is a,infoI !ELSEush_3d_ve999L GLE_Pdet-on_subs(Nm,topo%Pin_physd,topo%Pax_physd,topo%Pin_subd, &ral Pu&t�lh99topo%Pax_subd,topo%nsubs,isc/pt, is a,infoI !E99IFppx,t�lh-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------GOTO 9999px,t�lh999IFpAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�StI #newE have rec map field push_3d_vec_i MODULE PROCEDURE p map field p-���������999L GLE_Pdet-stI (topoid,Pdetid,nis a,isc/pt,Nm,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_sub_failed,'GLE_Pdet-lhfne ', p&ral Pu&t�lh9999'StI 6I newE failed.',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�ReturiAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_Pdet-lhfne ',t0,infoI x,t�lhRETURNush_3d_d_alltoalsh_3d_SUBRlicINE�checkush_3d_ve !-F O.NOT.CEII h9itialized) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_GLE_noh9it,'GLE_Pdet-lhfne ', &ral Pu&t�lh999999x,'PleasehoanLCEII h9it first!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx,t�lhhhhh999L GLE_checkItopoid(topoid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-lhfne ', &ral Pu&t�lh999999x,'topoid_is_invalid!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx8888-----9_alINUEpx,t�lh9999SUBRlicINE�checkush_3d_9999SUBRlicINE�GLE_Pdet-lh9999i0276� 0���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������edet/GLE_Pdet-anLoc_equi�����������������������������������������������������������������������������������������3�047ude "util/p5��21061������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������sh_3d_ot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�Subdefine r�������������������GLE_Pdet-anLoc_equiAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPral PubSUBRlicINE�GLE_Pdet-anLoc_equi(equi_Pdet,lda,i ,infoI !n!CIDoODOUBLE(re)anLoc fu c ff e Soy ! yder`�lEmtyde_equi_Pdet`. ! !i !n!CII----f yoIt�lh9amMERCLoc fu c ary (DTU)ILE_anLoc regul/p e Soy an h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !--------------- h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�������(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I USINGLE_PRECISIOata-PM)I USINGLE_PRECISIary clu, ONLY: EII t_equi_Pdet-PM)I USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----USINGLE_PRECISIerror !----IMPLICIT NONEn h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------ginys,max,phys,,,, , DIMENSION ), ----NT(I )TEGElda-PM)I 9!ieNew sizedl,I lh999ifu c e SoyPave re-------ginys,max,phys,,,inys,max,phys,,,, ----NT(I )TEGEi n h9999 !ieAnLoc a tu ca Oe rof:ioffset !iioffset !ie*NGLE_---aE_anLoc_fet_preliev9ioffset !ie*NGLE_---aE_anLoc_fetmap fie !ie*NGLE_---aE_anLoc_grow_preliev9ioffset !ie*NGLE_---aE_anLoc_growioffset !ie*NGLE_---aE_deanLocioffsetTYPEOEII t_equi_Pdet(,,,, , DIMENSION ), , POINT,EGEequi_Pdet-PM)I !ieA Soydl,ITYPEOEII t_equi_Pdet(,wh ofEiE_PREbn (re)anLoc fedan h9999-------ginys,max,phys,,,inys,max,phys,,,, ----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmplan h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------ginys,max,phEGEiPave re-------e), DIMENSIO2),EGEldcn h9999REAL(GLE_kind_do ofe),EGEt0n h9999TYPEOEII t_equi_Pdet(,,,, , DIMENSION ), , POINT,EGEw _Pdetr REAL(p h999999x,t�lh999999EGElusef,lanLoc,lreanLoc,ldeanLocioffset9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imitialislen h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave re999L subsc/pt('GLE_Pdet-anLoc_equi',t0,infoI h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0 .AND. i .NE. GLE_---aE_deanLoc) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Check aCLoc fu c ary px,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave relusefe re= .FAL(atPave relanLoc re= .FAL(atPave relreanLoce= .FAL(atPave reldeanLoce= .FAL(atPave re-F Oi .EQ.NGLE_---aE_anLoc_fet_preliev9) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 FitEO mor ut epreliev9It�lhprelint usnt9I (PPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99-F OASSOCIATED(equi_Pdet)) THENush_3d_ve99_3d_ldc(1)r NSIZE(equi_Pdet,1I !!!!!!!!!-F Oldc(1)r.NE. lda(1)) THENush_3d_ve99_3d_ve99lanLoc re= .TRUatPave reve99_3d_ve99lreanLoce= .TRUatPave reve99_3d_ve99lusefe re= .TRUatPave reve99_3d_999IFpx,t�lhhhhh9LSEush_3d_ved_ve99lanLoc = .TRUatPave reve99999IFpx,t�lhELSE-F Oi .EQ.NGLE_---aE_anLoc_fet) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 FitEO mor ut edis����It�lhprelint usnt9I (PPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99-F OASSOCIATED(equi_Pdet)) THENush_3d_ve99_3d_ldc(1)r NSIZE(equi_Pdet,1I !!!!!!!!!-F Oldc(1)r.NE. lda(1)) THENush_3d_ve99_3d_ve99lanLoc re= .TRUatPave reve99_3d_ve99lreanLoce= .TRUatPave reve99_3d_ve99ldeanLoce= .TRUatPave reve99_3d_999IFpx,t�lhhhhh9LSEush_3d_ved_ve99lanLoc = .TRUatPave reve99999IFpx,t�lhELSE-F Oi .EQ.NGLE_---aE_anLoc_grow_preliev9) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 FitEO mor ut epreliev9It�lhprelint usnt9I (PPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99-F OASSOCIATED(equi_Pdet)) THENush_3d_ve99_3d_ldc(1)r NSIZE(equi_Pdet,1I !!!!!!!!!-F Oldc(1)r.LT. lda(1)) THENush_3d_ve99_3d_ve99lanLoc re= .TRUatPave reve99_3d_ve99lreanLoce= .TRUatPave reve99_3d_ve99lusefe re= .TRUatPave reve99_3d_999IFpx,t�lhhhhh9LSEush_3d_ved_ve99lanLoc = .TRUatPave reve99999IFpx,t�lhELSE-F Oi .EQ.NGLE_---aE_anLoc_grow) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 FitEO mor ut edis����It�lhprelint usnt9I (PPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99-F OASSOCIATED(equi_Pdet)) THENush_3d_ve99_3d_ldc(1)r NSIZE(equi_Pdet,1I !!!!!!!!!-F Oldc(1)r.LT. lda(1)) THENush_3d_ve99_3d_ve99lanLoc re= .TRUatPave reve99_3d_ve99lreanLoce= .TRUatPave reve99_3d_ve99ldeanLoce= .TRUatPave reve99_3d_999IFpx,t�lhhhhh9LSEush_3d_ved_ve99lanLoc = .TRUatPave reve99999IFpx,t�lhELSE-F Oi .EQ.NGLE_---aE_deanLoc) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 DeanLoc frPPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99-F OASSOCIATED(equi_Pdet)) THENush_3d_ve99_3d_ldc(1)r NSIZE(equi_Pdet,1I !!!!!!!!!lreanLoce= .TRUatPave reve99_3d_ldeanLoce= .TRUatPave reve99999IFpx,t�lhE99IFpx,t�lhhhhhhhhhpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�PerformIt�lhactual aCLoc a tu cPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OlanLoc) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 AnLoc frEnewEe SoyTABILInew sizedut enullify anLCO mber(PPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve9999LOCATE(w _Pdet(lda(1)),STAT=infoI !!!!!-F Oinfo .NE. 0) THENush_3d_ve999999infor NGLE_error_fata)Define :: ppppp999L GLE_error(GLE_err_anLoc,'GLE_Pdet-anLoc_equi', &ral Pu&t�lh999999x,'newE WORK_MESH',__LINE__,infoI !!!!!!!!!GOTO 9999px,t�lhhhhh999IFpx,t�lhhhhhDO i=1,lda(1) !!!!!!!!! IFY(w _Pdet(i)%isc/pt) !!!!!!!!! IFY(w _Pdet(i)%nnofi() !!!!!!!!! IFY(w _Pdet(i)%Nm) !!!!!!!!! IFY(w _Pdet(i)%ghost_fromsub) !!!!!!!!! IFY(w _Pdet(i)%ghost_tosub) !!!!!!!!! IFY(w _Pdet(i)%ghost_blksc/pt) !!!!!!!!! IFY(w _Pdet(i)%ghost_blksize) !!!!!!!!! IFY(w _Pdet(i)%ghost_blk) !!!!!!!!! IFY(w _Pdet(i)%ghost_recvtosub) !!!!!!!!! IFY(w _Pdet(i)%ghost_recvblksc/pt) !!!!!!!!! IFY(w _Pdet(i)%ghost_recvblksize) !!!!!!!!! IFY(w _Pdet(i)%ghost_recvblk) !!!!!!!!! IFY(w _Pdet(i)%mapping) !!!!!!!!!w _Pdet(i)%IDr N0 !!!!!!!!!w _Pdet(i)%ghost_nlindr N0 !!!!!!!!!w _Pdet(i)%ghost_nrecvr N0 !!!!!999DOud_ve99999IFpAL(p -F Olusef) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 Sav9It�lhope usnt9I (PPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99DO i=1,MINOldc(1),lda(1)) !!!!!!!!!w _Pdet(i)%isc/ptr equi_Pdet(i)%isc/pt !!!!!!!!!w _Pdet(i)%nnofi(r equi_Pdet(i)%nnofi( !!!!!!!!!w _Pdet(i)%Nmr equi_Pdet(i)%Nmn h9999!!!!!!!!w _Pdet(i)%IDr Nequi_Pdet(i)%ID !!!!!999DOud_ve99999IFpAL(p -F OldeanLoc) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 DeanLoc frIt�lhope usnt9I (PPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99DO i=1,ldc(1) !!!!!!!!!-F OASSOCIATED(equi_Pdet(i)%isc/pt)) THENush_3d_ve99_3d_ve99DE99LOCATE(equi_Pdet(i)%isc/pt,STAT=infoI !!!!!!!!!!!!!-F Oinfo .NE. 0) THENush_3d_ve99999999999999infor NGLE_error_error !--------------------999L GLE_error(GLE_err_deanLoc,'GLE_Pdet-anLoc_equi',&ral Pu&t�lh999999x,t�lhhhh' sc/ptrEQUI_MESH%ISTART',__LINE__,infoI !!!!!!!!!!!!!999IFpx,t�lhhhhhhhhhhhhh IFY(equi_Pdet(i)%isc/pt)Pave reve99_3d_999IFpx,t�lhhhhh!!!!-F OASSOCIATED(equi_Pdet(i)%nnofi()) THENush_3d_ve99_3d_ve99DE99LOCATE(equi_Pdet(i)%nnofi(,STAT=infoI !!!!!!!!!!!!!-F Oinfo .NE. 0) THENush_3d_ve99999999999999infor NGLE_error_error !--------------------999L GLE_error(GLE_err_deanLoc,'GLE_Pdet-anLoc_equi',&ral Pu&t�lh999999x,t�lhhhh' sizedEQUI_MESH%NNODES',__LINE__,infoI !!!!!!!!!!!!!999IFpx,t�lhhhhhhhhhhhhh IFY(equi_Pdet(i)%nnofi() !!!!!!!!!999IFpx,t�lhhhhh!!!!-F OASSOCIATED(equi_Pdet(i)%Nm)) THENush_3d_ve99_3d_ve99DE99LOCATE(equi_Pdet(i)%Nm,STAT=infoI !!!!!!!!!!!!!-F Oinfo .NE. 0) THENush_3d_ve99999999999999infor NGLE_error_error !--------------------999L GLE_error(GLE_err_deanLoc,'GLE_Pdet-anLoc_equi',&ral Pu&t�lh999999x,t�lhhhh'globa E sizedEQUI_MESH%NM',__LINE__,infoI !!!!!!!!!!!!!999IFpx,t�lhhhhhhhhhhhhh IFY(equi_Pdet(i)%Nm) !!!!!!!!!999IFpx,t�lhhhhhhhhhequi_Pdet(i)%IDr N0 !!!!!999DOud_ve99999IFpAL(p -F OlreanLoc) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 DeanLoc frIope poiI er e SoyPave reve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99DE99LOCATE(equi_Pdet,STAT=infoI !!!!!-F Oinfo .NE. 0) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_deanLoc,'GLE_Pdet-anLoc_equi',: &ral Pu&t�lh999999x,'PdetrOata EQUI_MESH',__LINE__,infoI !!!!!!!!!GOTO 9999px,t�lhhhhh999IFpx,t�lhhhhh IFY(equi_PdetI !E99IFppx,t�lh-F OlanLoc) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 PoiI result_PREnewEe Soyush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99equi_Pdetr w _Pdet !E99IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Returihpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_Pdet-anLoc_equi',t0,infoI x,t�lhRETURNush_3d_d_alltoalsh_3d_SUBRlicINE�checkush_3d_ve !-F Olda(1)r.LT. 0) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-anLoc_equi',: &ral Pu&t�lh999999x,'lda(1)rmustebn > N0',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx8888-----9_alINUEpx,t�lh9999SUBRlicINE�checkush_3d_9999SUBRlicINE�GLE_Pdet-anLoc_equiA20276� 0��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������edet/test/�����������������������������������������������������������������������������755����������������������������ude "util/p5��15660� 5����������������������������������������������������������������������������������������������������src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0��������������������������������������������������������������������������������������������������������������������������������edet/test/GLE_PRECISIadet.fu����������������������������������������0000644�0001752������������������������������13473ude "util/p5��21557������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������test_suifrIGLE_PRECISIadet -n#ifdef __MPIush_3INCLUDE "mpif.h" #endif h999ge , ---aEe er :: debug N0 h999ge , ---aEe er :: mk Nkind(1.0d0) !kind(1.0e0) rean(mk),---aEe er :: pi N3.1415926535897931_mk h999ge ,---aEe er ,EGEnOim=2 h999ge :: decomp,assig,tolexp rean(mk) :: tol h999ge :: info,comm,rank,nproc h999ge :: topoid h999ge :: Pdetid,Pdetid-rh9 rean(mk),dimenticlON ),poiI er :: Pin_physr REArean(mk),dimenticlON ),poiI er :: Pax_physr REArean(mk),dimenticlON ),poiI er :: tr REAh999ge :: npArean(mk),dimenticlON,N(:poiI er :: xpr REArean(mk),dimenticlON ),poiI er :: len_physr REAh999ge , dimenticlON ),poiI er :: ghostsized REAh999ge :: i,jAh999ge :: ns tAh999ge , dimenticlON ),poiI er :: is tr REAh999ge , dimenticlO2*ndim)hys,,, :: bcdh9 rean(mk),dimenticlON ),poiI er :: co tr REArean(mk),dimenticlON,N,N(:poiI er :: fiepe REArean(mk),dimenticlON,N,N(:poiI er :: fiepe-rh9r REAh999ge , dimenticlON ),poiI er :: nmr REAh999ge , dimenticlON ),poiI er :: nm-rh9r REAh999ge ,dimenticlON,N(:poiI er :: isc/ptr REAh999ge ,dimenticlON,N(:poiI er :: nis ar REAh999ge ,dimenticlON,N(:poiI er :: isc/pt-rh9r REAh999ge ,dimenticlON,N(:poiI er :: nis a-rh9r REAh999ge , dimenticlOndim)hys,,, :: PaxnOata-h999ge :: seedsizeAh999ge , dimenticlON),anLoc fMesh :: seedArean(mk), dimenticlON),anLoc fMesh :: randnb-h999ge :: isymm N0 logioan :: lsymm N.false.,ok 9ic LicenseI h9it ic License along with PPush_3h9it ush_3d_veuseNGLE_PRECISIary cluush_3d_veuseNGLE_PRECISIh9it sh_3d_ve sh_3d_veanLoc fr(Pin_physOndim),Pax_physOndim),len_physOndim),& !!!!!!!&t�lh99999ghostsizeOndim),nmOndim),nm-rh9Ondim),& !!!!!!!&t�lh99999hOndim),sc/t=infoI !!! !!!Pin_physO1:ndim)h N0.0_mk !!!Pax_physO1:ndim)h N1.0_mk !!!len_physO1:ndim)h NPax_phys-Pin_phys !!!ghostsizeO1:ndim)h N2 !!!bcdh9O1:2*ndim)h NGLE_---aE_bcdh9_periodic !!!tolexph N-12 !!!nph N0! !!!nullify(fiepe,fiepe-rh9) !!!nullify(is t,isc/pt, is a,isc/pt-rh9,nis a-rh9)-n#ifdef __MPIush_33333commh NPpi_comm_worldush_33333canLCOpi_comm_rank(comm,rank,infoI !!!canLCOpi_comm_sizeOcomm,nproc,infoI #elsrPPM)I verankr N0 !!!nproch N1 #endif !!!canLCEII h9itOndim,mk,tolexp,0,debug,info,99I h99indrh9it u9ic LicenseI ! and the GNU Lesser General 9ic LicenseI finalzie ic License along wit -n h99finalizeA !!!useNGLE_PRECISIfinalizeA !!!canLCEII finalize(infoI h9999 deanLoc fr(Pin_phys,Pax_phys,len_phys,ghostsize,nmI h99indrfinalizeA 9ic LicenseI ! and the GNU Lesser General 9ic LicenseI setup ic License along with P- PPush_3setup 9 !!!canLCrandom_seed(size=seedsize) 9 !!!anLoc fr(seed(seedsize)) 9 !!!anLoc fr(randnb((1+ndim)*np),sc/t=infoI 9 !!!do i=1,seedsizeA,t�lh999999x,seed(i)=10+i*i*(rank+1I 9 !!!inddo 9 !!!canLCrandom_seed(put=seed) 9 !!!canLCrandom_numbie(randnbI !!! h99indrsetup 9ic LicenseI ! and the GNU Lesser General !!! 9ic LicenseI te����wn ic License along with te����wn !!! h99indrte����wn 9ic LicenseI ! and the GNU Lesser General !============ Test!casi(r test Pdet-lh9999ioffsetithou sy thesr m test check 6I f Pdet-lh9999EiE_w 6I ush_3d_veuseNGLE_PRECISIary cluush_3d_veuseNGLE_PRECISImktopoush_3d_veuseNGLE_PRECISImap_fiepeush_3d_veuseNGLE_PRECISImap_fiepe_globa ush_3d_veuseNGLE_PRECISImdet-lh9999ioffsetituseNGLE_PRECISIaopo_getioffsetituseNGLE_PRECISIaopo_checku ush_3d_veanLoc fr(nmOndim),sc/t=infoI !!!do i=1,ndimmap fieeeeeeenmOi)r N32*nproc !!!inddo ioffsetith Lesser General !!!!NPak CopLE p ioffsetith Lesser General !!!decomp NGLE_---aE_decomp_cuboid !ithdecomp NGLE_---aE_decomp_xpenci ush_3d_veassigir NGLE_---aE_assign_iI ernal ioffsetittopoid_ N0 !!!Pdetidh N-1A !!!canLCEII mktopo(topoid,Pdetid,xp,np,decomp,assig,Pin_phys,Pax_phys, !!!& !!!&t�lh999999x,t�lbcdh9,ghostsize,co t,nm,infoI h9999 canLCEII aopo_get_Pdetinfo(topoid,Pdetid,nm,isc/pt, is a,PaxnOata,& !!!!!!!!!!!!!!!!!!!is t,ns t,infoI !!! !!!anLoc fr(fiepe((1-ghostsizeO1)):(PaxnOataO1)+ghostsizeO1)),!!& !!!&t�lh9999(1-ghostsizeO2)):(PaxnOataO2)+ghostsizeO2)),ns t),& !!!&t�lh9999sc/t=infoI!!N2d !!!anLoc fr(fiepe-rh9O(1-ghostsizeO1)):(PaxnOataO1)+ghostsizeO1)),!!& !!!&t�lh9999(1-ghostsizeO2)):(PaxnOataO2)+ghostsizeO2)),ns t),& !!!&t�lh9999sc/t=infoI!!N2d !!! 9 !!!anLoc fr(fiepe((1-ghostsizeO1)):(PaxnOataO1)+ghostsizeO1)),!!& ! !!!&t�lh9999(1-ghostsizeO2)):(PaxnOataO2)+ghostsizeO2)),!& ! !!!&t�lh9999(1-ghostsizeO3)):(PaxnOataO3)+ghostsizeO3)),ns t),& ! !!!&t�lh999sc/t=infoI!!N3d 9 !!!anLoc fr(fiepe-rh9O(1-ghostsizeO1)):(PaxnOataO1)+ghostsizeO1)),!!& ! !!!&t�lh9999(1-ghostsizeO2)):(PaxnOataO2)+ghostsizeO2)),!& ! !!!&t�lh9999(1-ghostsizeO3)):(PaxnOataO3)+ghostsizeO3)),ns t),& ! !!!&t�lh999sc/t=infoI!!N3d !!! !!!do i=1,ndimmap fieeeeeeehOi)r N(Pax_physOi)r-!Pin_physOi)) / rean(nOataOi,1)-1,mk) !!!inddo !!! !!!Pdetid-rh9h N-1A !!!nm-rh9r !nm !!!canLCEII mdet-lh9999(topoid,Pdetid-rh9,nm-rh9,isc/pt-rh9,nis a-rh9,infoI !!!canLCEII map_fiepe_globa (topoid,topoid,Pdetid,Pdetid-rh9,infoI !!!canLCEII map_fiepe_push(topoid,Pdetid,fiepe,infoI !!!canLCEII map_fiepe_lind(infoI !!!canLCEII map_fiepe_pop(topoid,Pdetid-rh9,fiepe-rh9,ghostsize,infoI ush_3d_veassert_equa (info,0) h99indrtest u indrtest_suifrA20276� 0��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������edet/GLE_Pdet-stI ���������������������������������������������������������������2������������������������������21763ude "util/p5��20105������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������_3d_veot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�Subdefine r���������������������GLE_Pdet-stI ion) a9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPral PubSUBRlicINE�GLE_Pdet-stI (topoid,Pdetid,nis a,isc/pt,Nm,infoI ! !ield define rstI s anLCrelevoft inform fu c abefi ! !iea gwarratedE c a certa ! opLE p . ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�������(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I USINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-Pdet-PM)I USINGLE_PRECISIary cluush_3d_USINGLE_PRECISIfinl_invert_ tAsh_3d_USINGLE_PRECISIerror !----USINGLE_PRECISIPdet-anLoc !----USINGLE_PRECISIanLoc !----USINGLE_PRECISIPdet-anLoc !----USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----USINGLE_PRECISIcheckIheral PubIMPLICIT NONEn ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------ginys,max,phys,,,, ----NT(I )TEGEtopoid ! !ielopLE p ID wh ofE hTU)beishcrea d Pave re-------ge), DIMENSIO:,N(:)----NT(I )TEGEnOata-PM)I 9!ieNumbiedl,I poiI ( !oaofEdiit tu c fieoaofEsubPave re-------ge), DIMENSIO:,N(:)----NT(I )TEGEmod/pt !---- !ieSd/ptel,Isub !globa E n h9999-------ge), DIMENSIO: ), ----NT(I )TEGENmn h9999 !ieGloba Enumbiedl,I poiI ( !ven wholn comput. dom! nPave re-------ginys,max,phys,,,, ----NT(I lic)TEGEPdetid ! !ie detaIDor FI<= 0 fieinput,r option) an!iedefine rms ofcrea be newE ut ereturieven ID e mean h9999-------ginys,max,phys,,,, ----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmpln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave re-------ge), DIMENSIO3)hys,EGEldcn h9999-------ginys,max,phys,,,inEGEi ,ld,ud,kk,i,j,isubPave reREAL(GLE_kind_do ofe),max,EGEt0n h9999h999999x,t�lh999999I ,EGEvalidioffsetTYPEOEII t_topo):), POINT,EGEtopo REA h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Initialislhave rec map field push_3d_vec_i MODULE PROCEDURE p se along with PPave re999L subsc/pt('GLE_Pdet-stI ',t0,infoI h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFpppx,t�lhtopo �lEmtopo(topoid)% n h9999-F OPdetidh.LE. 0) THENush_3d_ve ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------ !!!!N�Crea ba d9I ifier f ven ulied9pecifiedEno99ioffsetith ! ETH ZurichI ! CH-8092 Zurich, Switzerland !------------ !!!Pdetidh Ntopo%Pax_Pdetidh+ 1A !!!topo%Pax_Pdetidh=EPdetid !9LSEush_3d_ve-F OPdetidh.GT. topo%Pax_Pdetid) THENush_3d_ve9999infor NGLE_error_error !----------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-stI ', &ral Pu&t�lh999999x,,,,,,,,,,'Pdetidhis_invalid',__LINE__,infoI !!!!!!!GOTO 9999px,t�lhhh999IFpx,t�lhE99IFpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�(Re)anLoc feEO mor ed byI ernal trut eA Soy atEPdetid ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rei ir NGLE_---aE_anLoc_grow_preliev9ioffsetldc(1)r Ntopo%Pax_PdetidPave re999L GLE_Pdet-anLoc_equi(topo%Pdet,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve9infor NGLE_error_fata)Define :: 999L GLE_error(GLE_err_anLoc,'GLE_Pdet-stI ', &ral Pu&t�lh999'uliedPdetidh trEII t_topo%Pdet',__LINE__,infoI !!!!GOTO 9999px,t�lh999IFppx,t�lhi ir NGLE_---aE_anLoc_fetmap fieldc(1)r NSIZE(nis a,1) !ldc(2)r NSIZE(nis a,2)Pave re999L GLE_anLoc(topo%PdetOPdetid)%nnofi(,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve9infor NGLE_error_fata)Define :: 999L GLE_error(GLE_err_anLoc,'GLE_Pdet-stI ', &ral Pu&t�lh999'EII t_equi_Pdet%nnofi(',__LINE__,infoI !!!!GOTO 9999px,t�lh999IFppx,t�lhldc(1)r NSIZE(isc/pt,1) !ldc(2)r NSIZE(isc/pt,2)Pave re999L GLE_anLoc(topo%PdetOPdetid)%isc/pt,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve9infor NGLE_error_fata)Define :: 999L GLE_error(GLE_err_anLoc,'GLE_Pdet-stI ', &ral Pu&t�lh999'EII t_equi_Pdet%isc/pt',__LINE__,infoI !!!!GOTO 9999px,t�lh999IFppx,t�lhldc(1)r NSIZE(Nm,1) !999L GLE_anLoc(topo%PdetOPdetid)%Nm,ldc,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve9infor NGLE_error_fata)Define :: 999L GLE_error(GLE_err_anLoc,'GLE_Pdet-stI ', &ral Pu&t�lh999'EII t_equi_Pdet%Nm',__LINE__,infoI !!!!GOTO 9999px,t�lh999IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�StI #ven ulie-prov d9daID ! ON_C px,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave retopo%PdetOPdetid)%IDr NPdetidPpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�StI #ven form fu cPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------n h9999-F OEII dim .EQ.N3) THENush_3d_ve99DO isub = 1,topo%nsubs !!!!!!!retopo%PdetOPdetid)%nnofi((1,isub)r NnOataO1,isub) !!!!!!!retopo%PdetOPdetid)%nnofi((2,isub)r NnOataO2,isub) !!!!!!!retopo%PdetOPdetid)%nnofi((3,isub)r NnOataO3,isub) !!!!!999DOud_ve99ve99DO isub = 1,topo%nsubs !!!!!!!retopo%PdetOPdetid)%isc/pt(1,isub)r Nisc/pt(1,isub) !!!!!!!retopo%PdetOPdetid)%isc/pt(2,isub)r Nisc/pt(2,isub) !!!!!!!retopo%PdetOPdetid)%isc/pt(3,isub)r Nisc/pt(3,isub) !!!!!999DOud_ve99ve99topo%PdetOPdetid)%Nm(1)r NNm(1)ud_ve99ve99topo%PdetOPdetid)%Nm(2)r NNm(2)ud_ve99ve99topo%PdetOPdetid)%Nm(3)r NNm(3I h99999LSEush_3d_ved_DO isub = 1,topo%nsubs !!!!!!!retopo%PdetOPdetid)%nnofi((1,isub)r NnOataO1,isub) !!!!!!!retopo%PdetOPdetid)%nnofi((2,isub)r NnOataO2,isub) !!!!!999DOud_ve99ve99DO isub = 1,topo%nsubs !!!!!!!retopo%PdetOPdetid)%isc/pt(1,isub)r Nisc/pt(1,isub) !!!!!!!retopo%PdetOPdetid)%isc/pt(2,isub)r Nisc/pt(2,isub) !!!!!999DOud_ve99ve99topo%PdetOPdetid)%Nm(1)r NNm(1)ud_ve99ve99topo%PdetOPdetid)%Nm(2)r NNm(2)ud_ve99999IFpAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�ReturiAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_Pdet-stI ',t0,infoI x,t�lhRETURNush_3d_d_alltoalsh_3d_SUBRlicINE�checkush_3d_ve !999L GLE_checkItopoid(topoid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-stI ', &ral Pu&t�lh99999999'topoid_not valid',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx,t�lhhhhh-F OEII topo(topoid)% %nsubsh.LE. 0) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-stI ', &ral Pu&t�lh99999999'nsubshmustebn >0',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxxDO i=1,EII dim !!!!!!!!!-F ONmOi)r.LT. 2) THENush_3d_ve9999999999infor NGLE_error_error !----------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-stI ', &ral Pu&t�lh999999999999'Nmhmustebn >1 !anLCspace dimenticl(',__LINE__,infoI !!!!!!!!!!!!!GOTO 8888ush_3d_ve99ve99999IFpxxxxxxxxxx999DOud8888-----9_alINUEpx,t�lh9999SUBRlicINE�checkush_3d_9999SUBRlicINE�GLE_Pdet-stI ������������������������������edet/GLE_Pdet-bLock_iI ersect������������������������������������������������������������������������������������34/p5�de "util/p5��22123������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������sh_3d_ot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�Subdefine r�����������������GLE_Pdet-bLock_iI ersectAL(p 9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPral PubSUBRlicINE�GLE_Pdet-bLock_iI ersect(from_topoid,to_topoid,from_Pdetid, &ral Pu&t�lhto_Pdetid,isub,jsub,offset,ghostsize,nlind t,isindfromsub,,t�lh9999&ral Pu&t�lhisindtosub,isindblksc/pt,isindblksize,ioffset,info,lsymmI ! !ield define rde ermne s3commcle bLocks Oin ersecticl()are Foundat!ietwo subs, possiblyhe if urich),extind FreBILIghostlayers. ! !ieSd/pteut esizedl,IanLCbLocks fle i is fstI d ut ereturied.eld ! !iedefine r e GI `EII map_fiepe_globa ` eneral Publ!ie`EII map_fiepe_ghost_h9it`. ! !i !n!CI[nseNING] ! !ield doODOnot check whe the ven from_Pdetout even to_Pdet is ! !iecomps pesh (i.e. that t�lh9amMENm).eld check mustebn ���e Foundat!iet�lhcanL 6I define . Fur the!I ,r op 5 efip pu tDOneGI PREbn Foundat!ieanLoc fed !IcanL 6I define . They is fjustegrown e me f neGIedan h9999 !ieldt itasfieisr the td define risr ypioanlyhoanled from sidMERn h9999 !ieloopout ewn ��Onot woft PRE do !Icheck atEbli itrratu can h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�������(hpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-Pdet-PM)I USINGLE_PRECISIary cluush_3d_USINGLE_PRECISIanLoc !----USINGLE_PRECISIerror !----USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----USINGLE_PRECISIcheckIheral PubIMPLICIT NONEn ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PPave rec ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PPave rece�Argum9I (ve rePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------ginys,max,phys,,,, ----NT(I )TEGEfrom_topoid ! !ieS !Ic CopLE p d9I ifierPave re-------ginys,max,phys,,,, ----NT(I )TEGEto_topoidn h9999 !ielarget CopLE p d9I ifierPave re-------ginys,max,phys,,,, ----NT(I )TEGEfrom_Pdetid ! !ieS !Ic d9I ifierPave re-------ginys,max,phys,,,, ----NT(I )TEGEto_Pdetid ! !ielarget d9I ifierPave re-------ginys,max,phys,,,, ----NT(I )TEGEisubPave re !ieS !Ic sub (from wh ofEis arms of thlint) !globa Enumbie 6I ave re-------ginys,max,phys,,,, ----NT(I )TEGEjsubPave re !ieDesine fu c sub !globa Enumbie 6I ave re-------e), DIMENSIO:),,,, ----NT(I )TEGEghostsizePave re !ieSizedl,I !Ighost layer !numbie ! grid poiI ( !anLCspacePave re !iedimenticl( (1...EII dim).eld Carget subdom! nrms of thenlarged ! !ie is. ave re-------e), DIMENSIO:),,,, ----NT(I )TEGEoffsetPave re !ieS if Eoffset ed bs !Ic subdom! nor nd x: 1:EII dim !-------e), DIMENSIO:),,,, , POINT,,,,,,,EGEisindfromsubPave re !ieGloba Esub d xel,Is !Ic s !-------e), DIMENSIO:),,,, , POINT,,,,,,,EGEisindtosubPave re !ieGloba Esub d xel,ICargets !-------e), DIMENSIO:,:),, , POINT,,,,,,,EGEioffsetPave re !ie detbLockEoffset periodicby ages. ! !i !n!CI1st d x: 1:EII dimginys,max,phys,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,+ !n!CI2ndrh9d x: mdetbLock ! !i !n!CITREbn addGI PREisindblksc/pt !oruricho get irecvblksc/pt fie option) an!ieCarget subdom! n. ave re-------e), DIMENSIO:,:),, , POINT,,,,,,,EGEisindblksc/pt ! !ieSd/ptel,I !I bLocks ! it globa E .I1st d x: !n!CI1:EII dim,I2nd: mdetbLock. ave re-------e), DIMENSIO:,:),, , POINT,,,,,,,EGEisindblksizePave re !ieSizedl,I !ImdetbLocks !numbie ! grid poiI (.I1st d x: !n!CI1:EII dim,I2nd: mdetbLock ave re-------ginys,max,phys,,,, ----NT(I lic)TEGEnlind t !n!CINumbiedl,I bLocks ! it tDOso farPave re-------ginys,max,phys,,,, ----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmpln h9999h999999e), DIMENSIO3)hys, ----NT(I ), OPTNSIAL :: lsymmtion) an!CIUs symmetr ut echopola trEoiI Pave rec ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------e), DIMENSIO3)hys,,,,,,,,,EGElduPave re-------e), DIMENSIOEII dim),,,,,,EGEibLocksc/pt, bLocksizePave re-------ginys,max,phys,,,in ,,,,,,EGEibLockscopk,k,i ,pdim,isizePave re-------ginys,max,phys,,,in ,,,,,,EGEfromisc/ptk,toisc/ptkPave re-------ginys,max,phys,,,in ,,,,,,EGEfromnnofi(k,tonnofi(kPave re-------e), DIMENSIO3)hys,,,,,,,,,EGEchopn h9999h999999ginys,max,phys,,,in ,,,,,,EGEdolindn h9999REAL(GLE_kind_do ofe),max, ,,,,,,EGEt0n h9999h999999x,t�lh999999I , ,,,,,,EGEvalidioffsetTYPEOEII t_equi_PdetI, , POINT,,,EGEfrom_Pdet REA h9999TYPEOEII t_equi_PdetI, , POINT,,,EGEto_Pdet REA h9999TYPEOEII t_topo):)))))), POINT,,,EGEfrom_topo REA h9999TYPEOEII t_topo):)))))), POINT,,,EGEto_topo REA h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imitialislen ! ic LicenseI ! and the GNU Lesser General Public License along with PPave re999L subsc/pt('GLE_Pdet-bLock_iI ersect',t0,infoI x,t�lhpdimr NGLE_dim n ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFppx,t�lhfrom_topo EII topo(from_topoid)% nx,t�lhto_topo �lEmtopo(to_topoid)% nx,t�lhfrom_Pdet from_topo%PdetOfrom_Pdetid)nx,t�lhto_Pdet to_topo%PdetOto_PdetidI h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�De ermne whe the vo lindrla trEoiI voo (us symmetr EA h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rechopo N0 !-F OPRES-NT(lsymmI) THENush_3d_ve9-F Olsymm(1).EQV..TRUat) THENush_3d_ve9999chop(1)r N1A !!!_9999IFpxxxxxxxxx-F Olsymm(2).EQV..TRUat) THENush_3d_ve9999chop(2)r N1A !!!_9999IFpxxxxxxxxx-F Opdimr.GT. 2) THENush_3d_ve9999-F Olsymm(3).EQV..TRUat) THENush_3d_ve9999999chop(3)r N1A !!!_!!_9999IFpxxxxxxxxx9999IFpxxxxxx9999IFp h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�De ermne currint mney al3commclelengthdl,I tD h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reisized MINOSIZE(isindfromsub,1),SIZE(isindtosub,1),,t�lh999&ral Pu&t�lhSIZE(isindblksc/pt,2),SIZE(isindblksize,2),SIZE(ioffset,2)I h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�De ermne in ersectingI bLocks h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave redolinde= .TRUatPave reDO k=1,Edim !!!!!fromisc/ptk=from_Pdet%isc/pt(k,isub)+offset(k) !!!!!fromnnofi(k=from_Pdet%nnofi((k,isub)-chop(k)ud_ve99ve99toisc/ptk to_Pdet%isc/pt(k,jsub)-ghostsizeOk)ud_ve99ve99tonnofi(k to_Pdet%nnofi((k,jsub)+2*ghostsizeOk)ud_ve99ve99ibLocksc/ptOk)d MAX(fromisc/ptk,toisc/ptk)ud_ve99ve99ibLockscopkd MINO(fromisc/ptk+fromnnofi(k),(toisc/ptk+tonnofi(k)) !!!!! bLocksizeOk)dr NibLockscopk-ibLocksc/ptOk) !!!!!! ��Onot linde f venr risrnothingIPREbnhlint !!!!!-F O bLocksizeOk)d.LT. 1)rdolinde= .FALSatPave re999DOud_ve99-F Odolind) THENush_3d_ve99nlind tr Nnlind tr+N1A !!!_!-F O lind tr.GT. isize) THENush_3d_ve9999999ic LicenseI ! and the GNU Lesser General Public License alonush_3d_ve9999999 --giwEO mor ed blind ts !!!!!!!re9ic LicenseI ! and the GNU Lesser General Public License alonush_3d_ve999999isizedh N2*isizePave reve999999i ir NGLE_---aE_anLoc_grow_preliev9ioffsetttttttttldu(1)r NisizePave reve999999999L GLE_anLoc(isindfromsub,ldu,i ,infoI ! !!!_!-F Oinfo .NE. 0) THENush_3d_ve9999999999infor NGLE_error_fata)Define :: ppppp9999999L GLE_error(GLE_err_anLoc,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh999999999999'looan lindes !Ic subh trIS-NDFROMSUB',__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhh999L GLE_anLoc(isindtosub,ldu,i ,infoI ! !!!_!-F Oinfo .NE. 0) THENush_3d_ve9999999999infor NGLE_error_fata)Define :: ppppp9999999L GLE_error(GLE_err_anLoc,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999999'looan lindedesine fu c sub trIS-NDTOSUB',__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhhldu(1)r Npdim !!!!!!!!!ldu(2)r NisizePave reve999999999L GLE_anLoc(isindblksc/pt,ldu,i ,infoI ! !!!_!-F Oinfo .NE. 0) THENush_3d_ve9999999999infor NGLE_error_fata)Define :: ppppp9999999L GLE_error(GLE_err_anLoc,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999999'looan lindebLockEsc/pt trIS-NDBLKSTART',__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhh999L GLE_anLoc(isindblksize,ldu,i ,infoI ! !!!_!-F Oinfo .NE. 0) THENush_3d_ve9999999999infor NGLE_error_fata)Define :: ppppp9999999L GLE_error(GLE_err_anLoc,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999999'looan lindebLockEsized trIS-NDBLKSIZE',__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhh999L GLE_anLoc(ioffset,ldu,i ,infoI ! !!!_!-F Oinfo .NE. 0) THENush_3d_ve9999999999infor NGLE_error_fata)Define :: ppppp9999999L GLE_error(GLE_err_anLoc,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999999'looan lindebLockEoffset trIOFFSET',__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhh999IFpx,t�lhhhhh9ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 lindebLockE(isindblksc/pt...isindblksc/pt+ bLocksize-1)rush_3d_ve999 from sub sub to subEjsubPave rehhhh9ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 globa Esub d xel,Ilooan lub wenr red bbLocks comn fromud_ve99ve99isindfromsubO lind t),max, ,,=EisubPave reve999 globa Esub d xel,Io the lub wenr red bbLocks go toud_ve99ve99isindtosubO lind t),max, ,,,,=EjsubPave rehhhh9Esc/pt l,I bLock !globa E n h9999ve99isindblksc/pt(1:pdim, lind t)=9ibLocksc/ptO1:pdim)r-!offset(1:pdim)Pave rehhhh9Esizedl,I bLockn h9999ve99isindblksizeO1:pdim, lind t)r NnbLocksizeO1:pdim)Pave rehhhh9E bLock offset periodicby agesn h9999ve99ioffset(1:pdim, lind t),max, =!offset(1:pdim)Pave reE99IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Returihpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_Pdet-bLock_iI ersect',t0,infoI x,t�lhRETURNush_3d_d_alltoalsh_3d_SUBRlicINE�checkush_3d_ve999L GLE_checkItopoid(from_topoid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999'from_topoid efidl,Irange',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx999L GLE_checkItopoid(to_topoid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999'to_topoid efidl,Irange',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx999L GLE_checkIPdetid(from_topoid,from_Pdetid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999'from_Pdetid efidl,Irange',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx999L GLE_checkIPdetid(to_topoid,to_Pdetid,valid,infoI !!!!!-F O.NOT.Cvalid) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999'to_Pdetid efidl,Irange',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-F OSIZE(ghostsize,1)r.LT. EII dim),THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999'ghostsizedmustebn at ea trl,IlengthdEII dim',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-F OSIZE(offset,1)r.LT. EII dim),THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999'offset mustebn at ea trl,IlengthdEII dim',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-F O(is .LE.0).OR.(is .GT.EII topo(from_topoid)% %nsubsI) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999' sub efidl,Irange',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-F O(js .LE.0).OR.(js .GT.EII topo(to_topoid)% %nsubsI) THENush_3d_ve99_3d_infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-bLock_iI ersect', &ral Pu&t�lh99999999'jsub efidl,Irange',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpx8888-----9_alINUEpx,t�lh9999SUBRlicINE�checkush_3d_9999SUBRlicINE�GLE_Pdet-bLock_iI ersectA��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������edet/GLE_Pdet-finalize�������������������������������������������������������������������������������������������10636ude "util/p5��20547������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������sh_3d_ot,I ! see <http://www.gnu.org/er General Public License along with PP�lEmax,t�Subdefine r���������������������GLE_Pdet-finalizeA !9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPral PubSUBRlicINE�GLE_Pdet-finalize(infoI al Publ!ield define r ermne frsI !I ------------GLE al Publ!iells.I deanLoc fingIanLCO O mor odiuctures. ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PPave rec ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PPave rece�������(hpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-Pdet-PM)I USINGLE_PRECISIPdet-anLoc !----USINGLE_PRECISIanLoc !----USINGLE_PRECISIerror !----USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----IMPLICIT NONEn ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------, ----NT(lic)T TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmpln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave re-------e), DIMENSIO1) ,,EGElda Pave re-------gggggggggggggggggEGEi Pave re-------gggggggggggggggggEGEisc/t x,t�lhREAL(GLE_kind_do ofe),maEGEt0n h9999 eiRACTER(LEN=GLE_char)TEGEPdegn h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren ! ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imitialislen ! ic LicenseI ! and the GNU Lesser General Public License along with PPave re999L subsc/pt('GLE_Pdet-finalize',t0,infoI x,t�lhlda(1)r N0 h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�DeanLoc feEO odiucturesen ! ic LicenseI ! and the GNU Lesser General Public License along with PPave reisc/to N0 !i NGLE_---aE_deanLoc !----999L GLE_anLoc(GLE_Pdet-isindfromsub,lda,i ,infoI !isc/to Nisc/to+Einfotion) a999L GLE_anLoc(GLE_Pdet-isindblksc/pt,lda,i ,infoI !isc/to Nisc/to+Einfotion) a999L GLE_anLoc(GLE_Pdet-isindblksize,lda,i ,infoI !isc/to Nisc/to+Einfotion) a999L GLE_anLoc(GLE_Pdet-irecvtosub,lda,i ,infoI !isc/to Nisc/to+Einfotion) a999L GLE_anLoc(GLE_Pdet-irecvblksc/pt,lda,i ,infoI !isc/to Nisc/to+Einfotion) a999L GLE_anLoc(GLE_Pdet-irecvblksize,lda,i ,infoI !isc/to Nisc/to+EinfotPave re-F Oisc/to.NE. 0) THENush_3d_ve99WRITEOPdeg,'(A,I3,A)') ' ',isc/t, &ral Pu&t�lh9999'E u Soy . PossibleEO mor leak.'ush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_deanLoc,'GLE_Pdet-finalize',Pdeg,__LINE__,infoI !E99IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Returihpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_Pdet-finalize',t0,infoI ush_3d_9999SUBRlicINE�GLE_Pdet-finalizeA�������������������������������������������������������������������������������������������������������������������edet/GLE_Pdet-onIsubs��������������������������������������������������������������������������������������������33645�de "util/p5��20423������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������x,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Subdefine r��������������������� GLE_Pdet-onIsubsA !9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral PubSUBRlicINE�GLE_Pdet-onIsubs_s(Nm,min_phys,Pax_phys,PinIsub,Pax_sub,,&ral Pu&t�lh9999999999nsubs,isc/pt,nis a,infoI #elifP__KI999==b__DOUBLE_PRECIENSIral PubSUBRlicINE�GLE_Pdet-onIsubs_d(Nm,min_phys,Pax_phys,PinIsub,Pax_sub,,&ral Pu&t�lh9999999999nsubs,isc/pt,nis a,infoI #enOSA al Publ!ield define rdefne s3Pdet s3 c a gilishcocen tu c f,Isubs.eld al Publ!iesubshmustethat beishdefne dusuchr the tdei),extint9I an in egerPave rel!iemultipledl,I !ImdetCspacingI !anLCdiit tu csor FItd isrnotPave rel!ie !Icase td define rms off! Pan h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�������(hpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIwrite-PM)I USINGLE_PRECISIerror !----USINGLE_PRECISIanLoc !----USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----IMPLICIT NONEn#ifPub__KI999==b__SINGLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_single #elifP__KI999==b__DOUBLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_do ofe #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK)e), DIMENSIO: ), ----NT(I )TEGEmin_phys al Publ!ielde mney umhcoordne fr--------Ghysioan/computs parantdom! nPave reREAL(MK)e), DIMENSIO: ), ----NT(I )TEGEmax_phys al Publ!ielde maxy umhcoordne fr--------Ghysioan/computs parantdom! nPave reREAL(MK)e), DIMENSIO:,N(:)----NT(I )TEGEPinIsub al Publ!ieM norextint9-------subdom! nsPave reREAL(MK)e), DIMENSIO:,N(:)----NT(I )TEGEPax_sub al Publ!ieMaxorextint9-------subdom! nsPave re-------ge), DIMENSIO:,N(:), POINT,,,,,,,EGEisc/pt ! !ieSd/pteindeI s Oi,j,k) (first d x)dl,I in sub sub ! !ie(secondrh9d x) !globa E an h9999-------ge), DIMENSIO:,N(:), POINT,,,,,,,EGEnOata-PM)I 9!ieNumbiedl,Igrid poiI ( !x,y[,z] (first d x)dl,I c sub-PM)I 9!ie sub (secondrh9d x)an h9999-------ge), DIMENSIO: ), ----NT(I )TEGENmn h9999 !ielde numbiedl,I poiI ( (not cells) !oaofEdiit tu c ffe option) an!iegloba Ecomput. dom! n. Oinap fingIPhose ONred bble isries)n h9999-------ggggggggggggggggg:)----NT(I )TEGEnsubsA !9!ielota Enumbiedl,Isubdom! nsPave re-------ggggggggggggggggg:)----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmpln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK)ggggggggggggggggggggggggggEGEt0,lmyepsPave reREAL(MK)e), DIMENSIOEII dim),,,,,,EGElen_phys,dx,ratral Pub-------e), DIMENSIOEII dim),,,,,,,EGEldu,Ncn h9999-------ginys,max,phys,,,inggggggggEGEi ,i,jn h9999 eiRACTER(LEN=GLE_char)TinggggggggEGEPdegn h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Imitialislen ! ic LicenseI ! and the GNU Lesser General Public License along with PPave re999L subsc/pt('GLE_Pdet-onIsubs',t0,infoI #ifPub__KI999==b__SINGLE_PRECIENSIral Publmyepsr NGLE_myepss #elifP__KI999==b__DOUBLE_PRECIENSIral Publmyepsr NGLE_myepsd #enOSA n ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece��detCspacingpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave reDO i=1,EII dim !!!!!NcOi)rrrrrrr NNm(i)-1A !!!_!len_physOi)r=Emax_physOi)r-Emin_physOi)A !!!_!dxOi)rrrrrrr Nlen_physOi)/REAL(NcOi),MK)px,t�lh999DOppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�AnLoc feEO mor ed bPdet s3px,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rei NGLE_---aE_anLoc_fetmap fieldu(1)r NpII dim !ldu(2)r NnsubsA !999L GLE_anLoc(isc/pt,ldu,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_fata)Define :: p999L GLE_error(GLE_err_anLoc,'GLE_Pdet-onIsubs',:: p&ral Pu&t�lh9999'sub O od/pteindeI s ISTART',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFp !999L GLE_anLoc(nis a,ldu,i ,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_fata)Define :: p999L GLE_error(GLE_err_anLoc,'GLE_Pdet-onIsubs',:: p&ral Pu&t�lh9999'sub O oiz s NDATA',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Check the tdeesubshalignTABILI !I -oiI ( andede ermne Pave rece�numbiedl,I poiI (. 2D ande3DIcase that se---afeEloops flrPave rece�vt torizatu can h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave re-F OEII dim .EQ.N3) THENush_3d_ve99DO i=1,nsubs !!!!!!!relen_physO1)r=Emax_subO1,i)-PinIsubO1,i) !!!!!!!relen_physO2)r=Emax_subO2,i)-PinIsubO2,i) !!!!!!!relen_physO3)r=Emax_subO3,i)-PinIsubO3,i) !!!!!!!re-afO1)r=Elen_physO1)/dxO1) !!!!!!!re-afO2)r=Elen_physO2)/dxO2) !!!!!!!re-afO3)r=Elen_physO3)/dxO3) !!!!!!!reNc(1)rr NN---(-afO1)) !!!!!!!reNc(2)rr NN---(-afO2)) !!!!!!!reNc(3)rr NN---(-afO3)) !!!!!!!re-F OABS(-afO1)-REAL(NcO1),MK)) .GT. lmyeps*-afO1)) THENush_3d_ve9999999999WRITEOPdeg,'(2(A,F12.6))') ' !dimenticl 1:esub_length=', &ral Pu&t�lh999999999999len_physO1),'E _spacing=',dxO1) !!!!!!!reeeeeinfor NGLE_error_error !----------------999L GLE_error(GLE_err_subs_inaomp,'GLE_Pdet-onIsubs',:: p &ral Pu&t�lh999999999999Pdeg,__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhh-F OABS(-afO2)-REAL(NcO2),MK)) .GT. lmyeps*-afO2)) THENush_3d_ve9999999999WRITEOPdeg,'(2(A,F12.6))') ' !dimenticl 2:esub_length=', &ral Pu&t�lh999999999999len_physO2),'E _spacing=',dxO2) !!!!!!!reeeeeinfor NGLE_error_error !----------------999L GLE_error(GLE_err_subs_inaomp,'GLE_Pdet-onIsubs',:: p &ral Pu&t�lh999999999999Pdeg,__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhh-F OABS(-afO3)-REAL(NcO3),MK)) .GT. lmyeps*-afO3)) THENush_3d_ve9999999999WRITEOPdeg,'(2(A,F12.6))') ' !dimenticl 3:esub_length=', &ral Pu&t�lh999999999999len_physO3),'E _spacing=',dxO3) !!!!!!!reeeeeinfor NGLE_error_error !----------------999L GLE_error(GLE_err_subs_inaomp,'GLE_Pdet-onIsubs',:: p &ral Pu&t�lh999999999999Pdeg,__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhhnOataO1,i)r NNc(1)r+ 1 px,t�lhhhhhhhhhnOataO2,i)r NNc(2)r+ 1 px,t�lhhhhhhhhhnOataO3,i)r NNc(3)r+ 1 px,t�lhhhhh999DOud_ve999LSEush_3d_ved_DO i=1,nsubs !!!!!!!relen_physO1)r=Emax_subO1,i)-PinIsubO1,i) !!!!!!!relen_physO2)r=Emax_subO2,i)-PinIsubO2,i) !!!!!!!re-afO1)r=Elen_physO1)/dxO1) !!!!!!!re-afO2)r=Elen_physO2)/dxO2) !!!!!!!reNc(1)rr NN---(-afO1)) !!!!!!!reNc(2)rr NN---(-afO2)) !!!!!!!re-F OABS(-afO1)-REAL(NcO1),MK)) .GT. lmyeps*-afO1)) THENush_3d_ve9999999999WRITEOPdeg,'(2(A,F12.6))') ' !dimenticl 1:esub_length=', &ral Pu&t�lh999999999999len_physO1),'E _spacing=',dxO1) !!!!!!!reeeeeinfor NGLE_error_error !----------------999L GLE_error(GLE_err_subs_inaomp,'GLE_Pdet-onIsubs',:: p &ral Pu&t�lh999999999999Pdeg,__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhh-F OABS(-afO2)-REAL(NcO2),MK)) .GT. lmyeps*-afO2)) THENush_3d_ve9999999999WRITEOPdeg,'(2(A,F12.6))') ' !dimenticl 2:esub_length=', &ral Pu&t�lh999999999999len_physO2),'E _spacing=',dxO2) !!!!!!!reeeeeinfor NGLE_error_error !----------------999L GLE_error(GLE_err_subs_inaomp,'GLE_Pdet-onIsubs',:: p &ral Pu&t�lh999999999999Pdeg,__LINE__,infoI !!!!!!!!!!!!!GOTO 9999px,t�lhhhhhhhhh999IFpx,t�lhhhhhhhhhnOataO1,i)r NNc(1)r+ 1 px,t�lhhhhhhhhhnOataO2,i)r NNc(2)r+ 1 px,t�lhhhhh999DOud_ve99999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�De ermne tdeesd/pteindeI s ! it globa E n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave re-F OEII dim .EQ.N3) THENush_3d_ve99DO i=1,nsubs !!!!!!!reisc/pt(1,i)r NN---((PinIsubO1,i)-min_physO1))/dxO1))r+N1A !!!_!!!reisc/pt(2,i)r NN---((PinIsubO2,i)-min_physO2))/dxO2))r+N1A !!!_!!!reisc/pt(3,i)r NN---((PinIsubO3,i)-min_physO3))/dxO3))r+N1A !!!_!999DOud_ve999LSEush_3d_ved_DO i=1,nsubs !!!!!!!reisc/pt(1,i)r NN---((PinIsubO1,i)-min_physO1))/dxO1))r+N1A !!!_!!!reisc/pt(2,i)r NN---((PinIsubO2,i)-min_physO2))/dxO2))r+N1A !!!_!999DOud_ve99999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Somn diagnostic(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve99WRITEOPdeg,'(A,I5)') 'numbiedl,I s3 c subshcre fed: ',nsubs !!!!!999L GLE_writeOEII rank,'GLE_Pdet-onIsubs',Pdeg,infoI !E99IFpPM)I -F OEII debug .GT. 1) THENush_3d_ve99-F OEII dim .LT. 3) THENush_3d_ve99ved_DO i=1,nsubs !!!!!!!reve99WRITEOPdeg,'(I4,A,2I8)') i,'Eisc/pt: ',isc/ptO1:2,i) !!!!!!!re!!!!999L GLE_writeOEII rank,'GLE_Pdet-onIsubs',p &ral Pu&t�lh999999999999 99Pdeg,infoI !!!!!!!!!!!!!WRITEOPdeg,'(I4,A,2I8)') i,'EnOata : ',nOataO1:2,i) !!!!!!!re!!!!999L GLE_writeOEII rank,'GLE_Pdet-onIsubs',p &ral Pu&t�lh999999999999 99Pdeg,infoI !!!!!!!!!!!!!999L GLE_writeOEII rank,'GLE_Pdet-onIsubs',p &ral Pu&t�lh999999999999 99'h, Switzerland !--------------',infoI !!!!!!!!!999DOud_ve99!!!!9LSEush_3d_ved_____DO i=1,nsubs !!!!!!!reve99WRITEOPdeg,'(I4,A,3I8)') i,'Eisc/pt: ',isc/ptO1:3,i) !!!!!!!re!!!!999L GLE_writeOEII rank,'GLE_Pdet-onIsubs',p &ral Pu&t�lh999999999999 99Pdeg,infoI !!!!!!!!!!!!!WRITEOPdeg,'(I4,A,3I8)') i,'EnOata : ',nOataO1:3,i) !!!!!!!re!!!!999L GLE_writeOEII rank,'GLE_Pdet-onIsubs',p &ral Pu&t�lh999999999999 99Pdeg,infoI !!!!!!!!!!!!!999L GLE_writeOEII rank,'GLE_Pdet-onIsubs',p &ral Pu&t�lh99999999'h, Switzerland !--------------------------',infoI !!!!!!!!!999DOud_ve99!!!!999IFpPM)I E99IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Returihpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_Pdet-onIsubs',t0,infoI x,t�lhRETURNush_3d_d_alltoalsh_3d_SUBRlicINE�checkush_3d_ve_!-F O lubsh.LE. 0) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-onIsubs',p &ral Pu&t�lh99999999'nsubshmustebe > 0',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-F OSIZE(PinIsub,2)r.LT. lubsh.OR.hSIZE(Pax_sub,2)r.LT. lubs) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-onIsubs',p &ral Pu&t�lh99999999'not enough subshspecifie !PinIsub,Emax_sub',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-F OSIZE(PinIsub,1).LT.EII dim.OR.SIZE(Pax_sub,1).LT.EII dim) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-onIsubs',p &ral Pu&t�lh99999999'leafingIdimenticl !PinIsub,Emax_sub wrong',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxxDO i=1,nsubs !!!!!!!reDO j=1,EII dim !!!!!xxxxxxxx-F Omax_subOj,i)r.LT. PinIsubOj,i)) THENush_3d_ve99999999999999infor NGLE_error_error !--------------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-onIsubs',p &ral Pu&t�lh9999999999999999'max_sub mustealwaysebe >= PinIsub',__LINE__,infoI !!!!!!!!!!!!!!!!!GOTO 8888ush_3d_ve9999999999999IFpx,t�lhhhhhhhhh999DOud_ve99!!!!999DOud_ve99!!!!DO i=1,EII dim !!!!!!!!!-F ONm(i)r.LT. 2) THENush_3d_ve9999999999infor NGLE_error_error !----------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-onIsubs',p &ral Pu&t�lh999999999999'Nmhmustebe >1 !anLCspaceedimenticl(',__LINE__,infoI !!!!!!!!!!!!!GOTO 8888ush_3d_ve999999999IFpx,t�lhhhhhhhhh-F Omax_physOi)r.LE. min_physOi)) THENush_3d_ve9999999999infor NGLE_error_error !----------------999L GLE_error(GLE_err_argum9I ,'GLE_Pdet-onIsubs',p &ral Pu&t�lh999999999999'max_physhmustebe > min_phys',__LINE__,infoI !!!!!!!!!!!!!GOTO 8888ush_3d_ve999999999IFpx,t�lhhhhh999DOud8888-----9_alINUEpx,t�lh9999SUBRlicINE�checku#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999SUBRlicINE�GLE_Pdet-onIsubs_s #elifP__KI999==b__DOUBLE_PRECIENSIral Pub9999SUBRlicINE�GLE_Pdet-onIsubs_d #enOSA ������������������������������������������������������������������������������������������������������������loadbal/�������������������������������������������������������������������������������755�����������������������������de "util/p4�015342� 5����������������������������������������������������������������������������������������������������src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0��������������������������������������������������������������������������������������������������������������������������������loadbal/GLE_set_deaomp_cost��������������������������������������������������������������������������������������27601�de "util/p4�021545������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������al Pub9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Subdefine r�������������������GLE_set_deaomp_costpx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral PubSUBRlicINE�set_dcost_s(dcost,me asd,infoI #elifP__KI999==b__DOUBLE_PRECIENSIral PubSUBRlicINE�set_dcost_d(dcost,me asd,infoI #enOSA al Publ!ieSets/upd frsI !IiI errantesinmafeE ed bcomputs parantcostpx,t�lh9!(DTUsoci fedTABILI0 CeaomposingIPhe problem.eld he Gr) 201choosee option) an!ieupd fr me asd.tion) an!ition) an!ie[TIP]tion) an!ield he Gr)e hope inme (usingI`GLE_inme`) topo_mktopo ed btion) an!ietopology/topologies contiuriedT d I0 mappingI(GLE doesrnotPave rel!ieknow wh of onrsI !y is ).eld helapsee inme I gilishto td define tion) an!ietoeupd fr !IiI errantesinmafe.tion) an!ition) an!ie[NOTE]tion) an!ield esinmafeE currintly i scalar,! C only oe topology/set oftion) an!ietopologies c201 thmonitI dor ntroducingIa topology�set ID eneral Publ!iemakingIPhe iI errantesinmafesIa vt tor, td c201s free thextindee iotion) an!CImultipledtopology�setse f ne Ced.eld htopology�set ID ( !ox999 a tion) an!CInumbieing)T wh of toeupd fr !Icost esinmafeEms of !01 thanpx,t�lh9!(DTddi parantargum9I hto td define .tion) an!ition) an!ie[NOTE]tion) an!ield define rdoesIa globa EMPI rratu c (`All duce`)an h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�������(n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-loadbal-PM)I USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----USINGLE_PRECISIerror !----USINGLE_PRECISIwrite-PM)I IMPLICIT NONEn#ifPub__KI999==b__SINGLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_single #elifP__KI999==b__DOUBLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_do ofe #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK) :)----NT(I )TEGEdcostpx,t�lh9!(DElapsee inme (as3Pdasur!I `GLE_inme`) px,t�lh9!(D defneingIPhe topology/ies l,IiI ere trlshed blooan procmploran h9999-------g :)----NT(I )TEGEme asdpx,t�lh9!(DHow toeupd fr !IiI errantesinmafe.tion) an!i Onr---:tion) an!ition) an!ie*NGLE_---aE_upd fr_replaceeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee+tion) an!ieeeeeeee(o: ywrite ope valueTABILInew oe )tion) an!ie*NGLE_---aE_upd fr_hatrageeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee+tion) an!ieeeeeeee(computt iuneingIhatrage)tion) an!ie*NGLE_---aE_upd fr_expfavgeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee+tion) an!ieeeeeeee(iuneingIhatrageTABILI!oxpoe ntialD getfing)n h9999-------gggggggggggggggg:)----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmpln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK) EGEt0,maxcostpx,t�lhREAL(GLE_kind_do ofe),mEGEalpha,beta-PM)I eiRACTER(LEN=GLE_char)EGEPdegn#ifdefP__MPIpx,t�lh-------ggggggggggggggggEGEMPTYPE #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Imitialisln ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave re999L subsc/pt('GLE_set_deaomp_cost',t0,infoI ush_3d_ ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�R duce condify icl( from anLCprocmplors.eld isrne Ced toemak Pave rece�sur! !I0 Ceaompositu c heuristic !EII loadbal_inquir!I0 turisPave rece�tdeesam!I0 sult3 c anLCprocmplors.eO thewi(PPMsomn whope iry iotion) an I0 CoIPhe topology,neralo thesrnot!n ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PP#ifdefP__MPIpx,t�lh ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Defne EMPI Oata typln ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PP#ifPub__KI999==b__SINGLE_PRECIENSIral PubMPTYPEr NMPI_REAL #elifP__KI999==b__DOUBLE_PRECIENSIral PubMPTYPEr NMPI_DOUBLE_PRECIENSIr#enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�AnLCthat toewait ed bslowe trlst toecre feIa new topologyn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave re999L MPI_All duce(dcost,maxcost,1,MPTYPE,MPI_MAX,EII aomm,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_mpi_f! P,'GLE_set_deaomp_cost', &ral Pu&t�lh99999'MPI_ALLREDUCE !axEdcost. No tingIupd frd.',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFp#elsln !maxcostr Ndcostp#enOSA n ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 1) THENush_3d_ve99WRITEOPdeg,'(A,F12.6)') 'OldedeaompIcost esinmafe: ', p &ral Pu&t�lh9999EII loadbal_deaomp_costpx,t�lh----999L GLE_writeOEII rank,'GLE_set_deaomp_cost',Pdeg,infoI !!!!!WRITEOPdeg,'(A,F12.6)') 'AdfingIPdasur!I value: ',maxcostpx,t�lh----999L GLE_writeOEII rank,'GLE_set_deaomp_cost',Pdeg,infoI !999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Chooseeupd fr me asdPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F (me asd .EQ.NGLE_---aE_upd fr_replace) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 ReplaceeABILInew valueush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99EII loadbal_dcnr N1P#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999EII loadbal_deaomp_costr NREAL(maxcost,GLE_kind_do ofe) #elifP__KI999==b__DOUBLE_PRECIENSIral Pub9999EII loadbal_deaomp_costr Nmaxcostp#enOSA al Pub)I -F OEII debug .GT. 1) THENush_3d_ve99----999L GLE_writeOEII rank,'GLE_set_deaomp_cost',p &ral Pu&t�lh99999999'O: ywritingIope value.',infoI !!!!!999IFpPM)I ELSE-F Ome asd .EQ.NGLE_---aE_upd fr_hatrage) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 RuneingIhatrageush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99EII loadbal_dcnr NEII loadbal_dcnr+N1P#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999alphar NREAL(maxcost,GLE_kind_do ofe) -9EII loadbal_deaomp_costp#elifP__KI999==b__DOUBLE_PRECIENSIral Pub9999alphar Nmaxcostr-9EII loadbal_deaomp_costp#enOSA al Pub)I alphar Nalpha/REAL(GLE_loadbal_dcn,GLE_kind_do ofe) al Pub9999EII loadbal_deaomp_costr NEII loadbal_deaomp_costr+Nalpha al Pub)I -F OEII debug .GT. 1) THENush_3d_ve99----999L GLE_writeOEII rank,'GLE_set_deaomp_cost',p &ral Pu&t�lh99999999'Upd fingIiuneingIhatrage.',infoI !!!!!999IFpPM)I ELSE-F Ome asd .EQ.NGLE_---aE_upd fr_expfavg) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 RuneingIhatrageeABILIoxpoe ntialD getfing.�Anphar N0.59I aush_3d_ve999 gooe value,neralc201 thchanged. HardcodedT sy thecity.ush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99anphar N0.5_GLE_kind_do ofe sh_3d_ve99betarr N1.0_GLE_kind_do ofer-9alpha al Pub)I EII loadbal_dcnr NEII loadbal_dcnr+N1P#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999-F OEII loadbal_dcnr.EQ.N1) THENush_3d_ve99----EII loadbal_deaomp_costr NREAL(maxcost,GLE_kind_do ofe) !!!!!9LSEush_3d_ved_____EII loadbal_deaomp_costr N(beta*EII loadbal_deaomp_cost)r+Np &ral Pu&t�lh99999999(alpha*REAL(maxcost,GLE_kind_do ofe)I !!!!!999IFp#elifP__KI999==b__DOUBLE_PRECIENSIral Pub9999-F OEII loadbal_dcnr.EQ.N1) THENush_3d_ve99----EII loadbal_deaomp_costr Nmaxcostpx,t�lh----9LSEush_3d_ved_____EII loadbal_deaomp_costr N(beta*EII loadbal_deaomp_cost)r+Np &ral Pu&t�lh99999999(alpha*maxcostI !!!!!999IFp#enOSA al Pub)I -F OEII debug .GT. 1) THENush_3d_ve99----999L GLE_writeOEII rank,'GLE_set_deaomp_cost',p &ral Pu&t�lh99999999'Upd fingIiuneingIhatrageeABILIoxpoe ntialD getfing.',infoI !!!!!999IFpPM)I ELSEush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr me asdPPM)I ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_argum9I ,'GLE_set_deaomp_cost',p p &ral Pu&t�lh999'Unknown upd fr me asdhspecifie . No tingIupd frd.',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 1) THENush_3d_ve99WRITEOPdeg,'(A,I9)') 'Numbiedl,Isa theshe Gd: ',EII loadbal_dcnpx,t�lh----999L GLE_writeOEII rank,'GLE_set_deaomp_cost',Pdeg,infoI !!!!!WRITEOPdeg,'(A,F12.6)') 'New deaompIcost esinmafe: ', p &ral Pu&t�lh9999EII loadbal_deaomp_costpx,t�lh----999L GLE_writeOEII rank,'GLE_set_deaomp_cost',Pdeg,infoI !E99IFppx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Returipx,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_set_deaomp_cost',t0,infoI x,t�lhRETURNush_3d_d_alltoalsh_3d_SUBRlicINE�checkush_3d_ve_!-F O.NOT.NGLE_imitialized) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_GLE_noimit,'GLE_set_deaomp_cost',p &ral Pu&t�lh99999999'Please canLCpLE_imit first!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-F Odcostr.LT. 0.0_MK) THENush_3d_ve99999infor NGLE_error_error !-----------999L GLE_error(GLE_err_argum9I ,'GLE_set_deaomp_cost',p&ral Pu&t�lh99999999'dcostrmustebe > N0.0',__LINE__,infoI !!!!!!!!GOTO 8888ush_3d_ve99999IFpx8888-----9_alINUEpx,t�lh9999SUBRlicINE�checku#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_s #elifP__KI999==b__DOUBLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_d #enOSA ������������������������������������������������������������������������������������������������������������������������������������������������loadbal/GLE_loadbal_inquir!��������������������������������������������������������������������������������������40540�de "util/p4�021522������������������������������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0���������������������������������������������������������������������������������������������������������������al Pub9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Subdefine r�������������������GLE_loadbal_inquir!px,t�lh9ic LicenseI ! and the GNU Lesser General Public License along with PPave rece������������������ !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify ! it under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of the GNU General Public LicenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral PubSUBRlicINE�loadbal_inq_s(cinme,nstep,heuristic,lflush,imbal,p&ral Pu&t�lhl0 Ceaomp,n0 Cest,infoI #elifP__KI999==b__DOUBLE_PRECIENSIral PubSUBRlicINE�loadbal_inq_d(cinme,nstep,heuristic,lflush,imbal,p&ral Pu&t�lhl0 Ceaomp,n0 Cest,infoI #enOSA al Publ!ieInquir!s abs pued bloaI aGence sc/tusout e0 turis advislewhe the al Publ!ie0 CeaomposingIPhe problem9I reaommindee (basee usomn deciou c al Publ!ieheuristic td he Gr) hooses,t�lh99999!ition) an!ie[TIP]tion) an!ield he Gr)e hope inme (usingIGLE_inme)bcomputs parsA !9!ie ed btopology/topologies contiuriedT d an al Publ!ie0 maping.�ld helapsee inme I gilishto td al Publ!ie0efine .tion) an!ition) an!ie[NOTE]tion) an!ield esinmafeE currintly i scalar,! C only oe topology/set oftion) an!ietopologies c201 thmonitI dor ntroducingIa topology�set ID ut emakingtion) an!iethe iI errantesinmafesIa vt tor, td c201s free thextindee iotion) an!CImultipledtopology�setse f ne Ced.eld htopology�set al Publ!ieIDT wh of toeevalu fr !IloaI aGence ms of !01 thanDTddi paran al Publ!ieargum9I hto td define .eld define rdoesItwo globa EMPI al Publ!ieaommunicatu c rratu c : `MPI_All duce`,t�lh99999!ition) an!ie.Refrience al Publ!ie************************************************************* al Publ!ie- B. Mo c at eJt yaltz, Ada at Runinme al Publ!iee�Support Diit t Simulatu c MoI e Carloe d asds3 c al Publ!iee�Dmodify M mor Architt tur!s. Procmefings oftion) an!iee�tdeeIEEE ScalaoferH���-Per mence Computingtion) an!ie999onfrience. 1994. 176--183. al Publ!ie************************************************************* al Public LicenseI ! and the GNU Lesser General Public License along with PPal Puble�������(n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-loadbal-PM)I USINGLE_PRECISIsubsc/pt !----USINGLE_PRECISIsubscop !----USINGLE_PRECISIerror !----USINGLE_PRECISIwrite-PM)I IMPLICIT NONEn#ifPub__KI999==b__SINGLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_single #elifP__KI999==b__DOUBLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_do ofe #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Imap fi(PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I ! ETH eI ! and the GNU Lesser General Public License along with PPave reREAL(MK) :)----NT(I )TEGEcinme al Publ!ieElapsee inme (as3Pdasur!I `GLE_inme`) anLCcomputs par !oe tion) an!ietnme steprlshed blooan procmploran h9999-------g :)----NT(I )TEGEheuristiction) an!ieDeciou ceheuristic 0 Ceaompositu c advisl. Onr---:tion) an!i px,t�lh9!(D*NGLE_---aE_loadbal_sa.I Scop-at-Risleheuristic)n h9999-------gggggggggggggggg:)----NT(I )TEGEnsteppx,t�lh9!(DNumbiedl,Itnme steps since last 0 Ceaompositu c. (>0)tion) an!ie FItd define risrnot canL!I bliry inme step, lne a.IiI erpolatu c ftion) an!iet !IloaI imbalence ms of the Gd toereaonstru t missingIOata poiI (.tion) aLOGICALgggggggggggggggg:)----NT(I )TEGElflushtion) an!ie`TRUE` toeflush iI errantsc/tistic : e.g.�t !Ifirst inme td define tion) an!ie c2nL!I affreea tu2nLyrdoingIa 0 Ceaompositu c -------Groblem),tion) an!ie`FALSE` toecondinue ga theingIsc/tistic .Pave reREAL(MK) :)----NT( lic)TEGEimban al Publ!ieLoaI imbalence defne duasI !Iratu ---computs par inme ffe option) an!iebottlwarck procmplorhto tdeIhatrageecomputs par inme ffeanLCprocmplors.tion) aLOGICALgggggggggggggggg:)----NT( lic)TEGEl0 Ceaomption) an!ie`TRUE` i------ hooseceheuristic reaomminds problem90 Ceaompositu c.tion) an!ieO thewi(Pe`FALSE`.�R deaompositu c Pdans: CoIPhe GLE_iopo_mktopo ag! n.n h9999-------gggggggggggggggg:)----NT( lic)TEGEn0 Cest al Publ!ieEsinmafee (lne a.Iextrapolatu c)�numbiedl,Itnme steps to go uninl nextpx,t�lh9!(DTdvisld 0 Ceaompositu c. -19I returi ------ hoseceheuristicpx,t�lh9!(Ddoesrnot support td kind l,IiI metu c. Be carGNU TABILI value!n h9999-------gggggggggggggggg:)----NT( lic)TEGEinfotion) an!CIReturis sc/tus, 0 up usuccmpln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK) EGEt0,maxinme,avginme al PubREAL(GLE_kind_do ofe),mEGEWn,delta,slp,estsol al PubREAL(GLE_kind_do ofe), SAVETEGEdeltaope N0.0_GLE_kind_do ofe sh_3d_REAL(GLE_kind_do ofe), SAVETEGEslpavge N0.0_GLE_kind_do ofe sh_3d_-------e)SAVET EGEnope N0 sh_3d_-------e)SAVET EGEnslp N0 sh_3d_ eiRACTER(LEN=GLE_char)EGEPdegn h9999-------ggggggggggggggggEGEnOiff,in#ifdefP__MPIpx,t�lh-------ggggggggggggggggEGEMPTYPE #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren ! ic ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave rece�Imitialisln ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave re999L subsc/pt('GLE_loadbal_inquir!',t0,infoI x,t�lhimbale N0.0_MK x,t�lhl0 Ceaompe N.FALSE.n h9999n0 Ceste N-19 ush_3d_ ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Flush iI errantiI metu ce f ne CedPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F Olflush) THENush_3d_ve99GLE_loadbal_ope_sa.I N-1.0_GLE_kind_do ofe sh_3d_ve99GLE_loadbal_runsum e N0.0_GLE_kind_do ofe sh_3d_____slpavgee N0.0_GLE_kind_do ofe sh_3d_____nope N0 sh_3d_____nslp N0 sh_3d_____deltaope N0.0_GLE_kind_do ofe sh_3d_)I -F OEII debug .GT. 1) THENush_3d_ve99----999L GLE_writeOEII rank,'GLE_loadbal_inquir!',----&ral Pu&t�lh99999999'II errantbuffhesrflushed',infoI !!!!!999IFpPM)I E99IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Check the we that Oata availaofePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII loadbal_dcnr.LT. 1) THENush_3d_ve99infor NGLE_error_warningtion) a----999L GLE_error(GLE_err_noIis a,'GLE_loadbal_inquir!',-&ral Pu&t�lh99999'Use�GLE_set_deaomp_costIfirst io ga theIsc/tistic ',p &ral Pu&t�lh99999__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpn#ifdefP__MPIpx,t�lh ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Defne EMPI Oata typln ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PP#ifPub__KI999==b__SINGLE_PRECIENSIral PubMPTYPEr NMPI_REAL #elifP__KI999==b__DOUBLE_PRECIENSIral PubMPTYPEr NMPI_DOUBLE_PRECIENSIr#enOSA #enOSA n ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�De ermne tdeetnme e Gd !Islowe trprocmplorPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lh999L MPI_All duce(cinme,maxinme,1,MPTYPE,MPI_MAX,EII aomm,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_mpi_f! P,'GLE_loadbal_inquir!',-&ral Pu&t�lh99999'MPI_ALLREDUCE !axEcinme. No tingIcomputtd.',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFp#elsln !maxtnme =Ecinme #enOSA n ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�De ermne tdeehatrageecomputeetnmePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lh999L MPI_All duce(cinme,avginme,1,MPTYPE,MPI_SUM,EII aomm,infoI !-F Oinfo .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999L GLE_error(GLE_err_mpi_f! P,'GLE_loadbal_inquir!',-&ral Pu&t�lh99999'MPI_ALLREDUCE avgecinme. No tingIcomputtd.',__LINE__,infoI !!!!!GOTO 9999px,t�lh999IFpx,t�lhavginmer Navginme/REAL(GLE_nproc,MK)p#elsln !avginmer Ncinme #enOSA n ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 1) THENush_3d_ve99WRITEOPdeg,'(2(A,F12.6))') '!axEinmer N',maxinme, p&ral Pu&t�lh9999' /ehatrageeinmer N',avginme al Pub----999L GLE_writeOEII rank,'GLE_loadbal_inquir!',Pdeg,infoI !999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�ComputeeloaI imbalencen ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave reimbale Nmaxinme/avginme n ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Chooseedeciou ceheuristicPPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F (heuristic .EQ.NGLE_---aE_loadbal_sa.) THENush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 Scop-At-Risleheuristic Mo c:1994ush_3d_ve999ic LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve99nOiffe Nnstep-nopeP#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999deltar NREAL(maxinme-avginme,GLE_kind_do ofe) #elifP__KI999==b__DOUBLE_PRECIENSIral Pub9999deltar Nmaxinme-avginmep#enOSA al Pub)I slp N(delta-deltaope)/REAL(nOiff,GLE_kind_do ofe) !!!!!-F O Oiffe.GT. 1) THENush_3d_ve99----9ic LicenseI ! and the GNU Lesser General Public License alonush_3d_ve99----9 Use�lne a.IiI erpolatu c !issingIOata poiI (ush_3d_ve99----9ic LicenseI ! and the GNU Lesser General Public License alonush_3d_ve99-----F OEII debug .GT. 1) THENush_3d_ve99--------WRITEOPdeg,'(A,I3)') 'Lne a.IiI erpolatu c steps: ', p &ral Pu&t�lh9999_3d_ve99nOiffush_3d_ve99--------999L GLE_writeOEII rank,'GLE_loadbal_inquir!',Pdeg,infoI !!!!!!!!!999IFpx,t�lhhhhhhhhhDO i=1,n-------999L GLE_writeOEse�GLE_set_deaomp_costIfirst io ga theIcostIfirst io ga the+ _3d_ve99nOiffush_3d_ve99---(f,GLE_ki+(_do oi !!!!!-F O Oif*pe) OABS(-afO1)-REALEush_3d_ved_____DO iHENush_3d_ve99----EII loadbal_deaomp_costr Nmaxco ga theIcostIfirst io ga the+ f,GLE3d_ved_____DO iLicenseI ! and the GNU Lesser General Public License alonush_3d_ve99----9 Use�lne a.IiI erpolCyrdointwicarantcostpprocmoan procmplr gu c -back99Ltermse�lne a.IiI erpoloan :tionmse�lne a.IiI erpand the GNU Lesser General Public License alonush_3d_ve99----9 Use�lne a.IiI errningtion) a----999L GLE_error(GLE_____err_mpi_f! P,'GLE_loadbrevputs r!',----&ral Pu&t�lh99999999'II er99999 er9999'KI999 didind lingyn tu ositu c. (>Lyrd !!!!!!!!!GOTO 8888ush_3dhDO i=1,n-------Wr+N1P#ifPub__KI9 ga the+ costpx,t�lh----999L GLE_writeOEII Wr+N1Wnd_do ofolatu !!!!!-F O Oiffe.GT. 1) T! ! ofePPM)Ian oe )tion) asub'l...fe.GT. 1) THENuI N-1.0_GLE_kind_do ve99-- sh_3d_ve99betarr N--EII loadbal_deaomp_HENuI N-1.0_GLE_kind_do ve99iWn------WRITEOPdeg,'(A,I3)'n h9999n0 Cescehe.WRITEOPdeg,'(A,I3)'d_ ic Li aope N0.0_GLE__deaomp_HENuI N-sh_3d_ve99--------WRITEOPdeg,'(A,I3)'''''rank,'GLE_loadbal_inquir!',----&ral Pu&t�lh999999999999999'max_sub mustealwaysisl. Onr---:tion) an!iocmplSAR1994ush_3d999IFpPM)I ELSEushhhhhhhhhh999DOud_ve99!!!!999DOud8888-----9_alINostr.LT. 0.0_MK) I N-sh_3d_ve99--------WRITEOPdeg,'(A,2.6))') '!axEinmer N',maxinmoe )SAR1t�lh----9999999999999'max_sub muI N-1.0_GLE_kind_do,',av99icSAR1t�lh----9Wmse�lne a.IiI errank,'GLE_loadbal_inquir!',Pdeg,infoI !!!!!!!!!999IFpx,t�lhhhhlINostr.LT. 0.0_ and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr me asdie . NLIoxpoe ntialD ( getfing.-------ggggg,EII lopenseI ! and the GNU Lesser General Public License along wiush_3d_ve99EII loadbal_dcnr NEdeltaopdeltaud_ve99999IFpnHENushltave99----EII loadbal_deaomp_nd_do ofend_3d_ved_____DO iLicenseI !nd_do ofe sh_3d_ve99betarr N*(nd_do +pe) Fpx,t�lhhhhlINostr.LT. 0.0_ and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr me asEedl,Itnmean!Cpeclatus to go unextpx,(DTdviisl. Onr---:tiotr.LT. 0.0_ and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr meLE_kinofe2sh_3d_)I -F OEII _cost)r+Np &ral Pu&t�lh9/nd_do ve99999IFpnHENuLE_kinoh_3d_ve993d_ve99betarr N--EII loadbal_deaomp_d_ ic Licensse�lne a.IiI errningtion) a----9nd icese�lne a.IiI errank,'GLE! P,'GLE_loadbsqrt_negr!',-&ral Pu&t�lh99999'MPI_ALLREDUCE 'B !Iratuimprovt alCancifieedl,Itnmean ! ic LicenseI.9'MPI_ALLREDUCE !!!!!!!!!GOTO 8888ush_3dhO iLicenseI !d_ ic Licein_pSQRTuLE_kin)omp_biedl,Itnme 9999IFpnHENud_ ic Lih_3d_v)!d_ ic Lice0Fpx,t�lhhhhlINosttr.LT. 0.0_ and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr me asdie . Noe )tion)str.LT. 0.0_ and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr meI N-1.0_GLE_kind_do ofWmse�lne a.Iikind_do ofef,GLE3d_ved_LicenseI ! and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr me asdPPM)I ! ETH ZurichI ! and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr meror !--------999L GLE_error(GLE_err_argum9I ,'GLE_set_deaomp_cost',p --&ral Pu&t�lh99999999'II errantbuffasdhspeci994ush_3d_upd frd.',__LINE__,,infoI !!!!!GOTO 9999px,t�lh999IFpx,t�lhavginmer Navg ! and the GNU Lesser General Public Lice !- along with PPave rece�Chooseedeciou ceheudie . Noan procmpcou ', ! and the GNU Lesser General Public Lice !- along with PPave rece�Chooseedeciou censlp Nbiedl, ! and the GNU Lesser General Public Lice !- along with PPave rece�Chooseedeciou ceheucenseI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_set_deaomp_cost',t0,infoI x,t�lhimbale N0.0_MK x,t�oalsh_3d_SUBRlicINE�checkush_3d_ve_!-F O.NOT.NGLE_imialized) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_GLE_noimit,'GLE_set_deaomp_cost',p --&ral Pu&t�lh999999'Please canLCpLE_imit first!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-lINostr.LT. 0.aliz! ic sh_3d_ve99999infor NGLE_error_ror !------------999L GLE_error(Gerr_argum9I ,'GLE_set_deaomp_cost',p --&ral Pu&t�lh99999'Please canLCpLE_'! ic sINE__,infoI !!!!!!!!GOTO 8888ush_3d_v9999IFpxxxxxxxxxx-lINostr.LT. 0.alizKI999 ve99infor NGLE_error_waerror !------------999L GLE_error(GLerr_argum9I ,'GLE_set_deaomp_cost',p --&ral Pu&t�lh99999'Please canLCpLE_9'KI999 __,infoI !!!!!!!!!GOTO 8888ush_3d_v9999IFpxxxxxxxxxx-lINostr.LT. 0.alizKI999 veE.enslp9infor NGLE_error_ror !------------999L GLE_error(Gerr_argum9I ,'GLE_set_deaomp_cost',p --&ral Pu&t�lh99999'Please canLCpLE_99'KI999 didind lingyn tu ositu c. (>Lyrd latu !!!!?9'MPI_ALLREDUCE !!!!!!!!!GOTO 8888ush_3dv9999IFpxxxxxxxxxx-lINostr,t�lh99SUBRlicINE�checku#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_s #elifP_,nstep,heurisDOUBLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_d #enOSA ,nstep,heuris�������������������������������������������������������������������������������������������������������������������������������������looooooooooooooooooooooooooooooooooadbal/GLE_loadbal_inquir!����---�������������������������������������������������������������������������������40540�de "util/p4�036462������������������7�����������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������E�set_ and the GNU Lesser General Public License along with PPave rece�Subdefine r�������������������GLE_loadbal_inquir! meI N----����� ! and the GNU Lesser General Public Lice !- along with PPave rece�Chooseedeciou cehe !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Public LicenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral PubSUBRlicINE�loadbal_inq_s(cinmeI N----�����_s(----id!!!!hid!xp,Np,e)I roc�����!!GOT,pIFp#enOUBLE_PRECIENSIral PubSUBRlicINE�loadbal_inq_d(cinmeI N----�����_d(----id!!!!hid!xp,Np,e)I roc�����!!GOT,pIFp#enOUir!s abs pued bwo globa EMPILyrce d nmafeE eanLCprocmpUsoci fHOUTeacheaomdomarmse�lne positwareache-----g ]tion) an!ield esinmafeE cuICUNpI ,oci fHu2nLinfoI u c al Pup !IsRTICU!!!h_ > -1 toecondinueci fHu c al Pu!!!h---9ic Hu2nLinfoI twarade�sur! ag! !Itoecondinueci fRTICULticle Mp !IsULAru!!!h-the bl!ie,oci fHOUTatoecondinueaomdomarmHu2nequUsor! ic Hvolmp_I ! and the GNU Lesser General Public License along with PPave rece�������(n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-loadbal-PM)I nseIdefISIis a-loadbal-PM)I GLE_PRECISIsubscop !----USINGLE_PRECISIerror !----USINGLE_PRECISIwrite-PM)I IMPLICIailocISIwrite-PM)I IMPLICIT NONEn#ifPue-PM)I IMPLICI==b___ ISIis a-loadbal-PM)I nh999���� !b__KI999==b__SINGLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_single #elifP__KI999==b__DOUBLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_do ofe #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave recSINGLE_PRECISIOata ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I ! E ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePP EGEt, DIMEN)the(:,:)lflushtion) an!ie`Txi------ hoos !I r---:tiosve rePP EGEt, DIMEN)the(:an!NGLOlushEMPTYPE Elapee inme (as3PdAggreg . NeIsc/tArueacheaomdomarmse�lne EGEt, DIMEN)the(:an!NGLOlushEMPTYPE Ela roc�����inme (as3PdAggreg . NeIsc/tArueache ! ETH ZurichI ggggEGEMPTYPE #enOSA alElflushtion) an!ie`TNl,Itnme steps since lap !IsRTSeic ',<= 0 ! !!!h-u c aleIscs-the ZuitoporichI ggggEGEMPTYPE #enOSA alElflushtion) an!ie`T----id abs pued bw!ieIDT lu fr !IloaI ! ETH of !0(Pe`FALSE`.�ICU`a.) THENusnh999 ---co`n) aLO !I r---:tiosploran h ! ETH ZurichI ositren al PublI ! ETH of !0richI ggggEGEMPTYPE #enOSA alElflushtion) an!ie`T!!!hidrichI osi!!!h-lu fr !IloaI ! ETH of !0( Pe`FALSE`.�ICU--- hopa d,set ofp !IsUtren al Publ warrant!!!h- .tion) an!itign topolllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll+Pe`FALSE`.�ICUcle eUtrennofp !IsUtethe!!h_ ho-1 TH of !0sUtretoecondinuecinfoI u c al PuH ofgeometrylapee (aom)#envolmp_(aom)orichI ggggEGEMPTYPE #enOSA alElflushtio an!CIReturis sc/tus, 0 up usuccmpln h99999ic LicenseI ! EGEt, DIMEN)the(:an!NGOPTtheALlflushtion)IRetup����inme (as3Pdper-O !I !0s(Pe`FALSE`.�ICUnd lpres_cosbut W fHOUT1.0dperLO !I ooe ssmp_dI ! and the GNU Lesser General Public License along with PPave rece�������(n h99999ic L)I ! ETH Z ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePP EGEtllllllllllllllllllllllllllme al PinPE,MPI_MAX,EAMEINT,EGEMKr NGDIMEN)the(I N-sim)lllllllme ldl,lduAMEINT,EGEMKr NGDIMEN)the(3,1!NGTARGET P__MPIpummyAMEINT,EGEMKr NGDIMEN)the(:,:)lfLOlushEMP_MPIno Zu => NULL(gggggggggggg:)----NT(I )TEGElllllllllllme i rocggggggggggg:)----NT(I )TEGElllllllllllme iopt Pin !avgI_M rocggggggggggg:)----NT( lic)TEGElllllllllllme validrichI har)EGEPdegn h9999-----lllllllllllme ,t�lh-------gggggggggggg EGEt, DIMEN)the(:!NGLOlushEMPT_kinensadbal_> NULL(gggggggg EGEt, DIMEN)the(:!NGLOlushEMPT_ki rocadbal_> NULL(ggcenseI !mm,i(I N-tsnh99-llllllNGLOlushEMPT_ki---------_> NULL(gggggggg and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I ! ETH Z ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__Sgggggg and the GNU Lesser General Public License along with PPave rece�Ex999 a (ePPM)I c LicenseI ! and the GNU Lesser General Public Lice !- along with PPave re999L subsc/pt('GLE_loadbal_inquir!',t0---�����ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Check argum9I (PPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Flush iI errantiI Ailoc . No Procantcostp roc�����urichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. iopt#enOSA THENusailoc_fiEAMEINT,ldl(1)ice0Fpx,t�lldu(1)icen !avnsse�lne err_argumailoc( roc�����!ldl,ldu,iopt o .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999fREClLE_error_ererr_argum9I ,'GLE_set_deiloc,!',t0---�����ic ehatrageeinmer N' !0sUperLOrageecompPROC_COST !!!!!GOTO 9999px,t�lh999IFpx,t�lhavginmer Navginme/R roc�����Ceaompe N. I ! and the GNU Lesser General Public Lice !- along with PPave rece�Flush iI errantiI Sum99iTH of !0sUion) aLal_ion) an!ie`FCALggggrichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) T----iddbal_sa.) THENusnh999 ---cofor NGL9px,t�lh9 ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII de9px,t�lh9 c extindeeie0 e w9iTH of !0 free t ourself. AsUcle eUtrenno9px,t�lh9 aomdomarms TH ofsizI ooe19px,t�lh9 ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII de9px,t�lh9iopt#enOSA THENusailoc_fiEAMEINT,�lldu(1)ice1ush_3d_ve-F Oirgumailoc(����!ldu,iopt o .NE. 0) THTHENush_3d_ve99infor NGLE_error_ererror !--------999fREClLE_error_erererr_argum9I ,'GLE_set_deiloc,!',t0nh999����9999999'II errantbuffhes' !0sUperLaom COST !!!!!GOTO 9999px,t�lh99999IFpx,t�lhavginmehhlINosttr.LT. 0.ENusPREShtiopIFp#efor NGLE_error_erer GLEice1,TNl,Itnme pee (1)icepee (1)i+up����(i99px,t�lh99999Eush_3d_ved___hO iLicenseI GLEice1,TNl,Itnme pee (1)icepee (1)i+u1mpe N.FALSE.h99999Eush_3d_ved___hINosttr.LT. 0. and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr c exte e reRsrnot!n eache ! ETH Zu M)I hspes ITSf !0( Thesew upd fr bslowe beatu c : `MPublI ) aLme srd : ) aLI PM)I I ! vr ci fHOUTa aLOGICALgggggggggggg0. and the GNU Lesser General Public License along wiush_3d_ve999 UnknowhINCLUDE 'mpif.h' #e. and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr Broadc. (>L !0sUI ) aLe`FCALggggrichI e. and the GNU Lesser General Public License along wiush_3d_ve999 Unknow upd fr iopt#enOSA THENusailoc_fiEAMEINT,�lldu(1)icen !avush_3d_ve-F Oirgumailoc(nensadba!ldu,iopt o .NE. 0) THTHENush_3d_ve99infor NGLE_error_ererror !--------999fREClLE_error_erererr_argum9I ,'GLE_set_deiloc,!',t0---�����ic 9'II errantbuffhes'nensnfoI : L !0sUShtDCOST !!!!!GOTO 9999px,t�lh99999IFpx,t�lhavginmehhlINost upd fr F ! icwFITNso ETH ubl!irray inquipoe ntu1m..fe.GT. 1)err_argumailoc( rocadba!ldu,iopt o .NE. 0) THTHENush_3d_ve99infor NGLE_error_ererror !--------999fREClLE_error_erererr_argum9I ,'GLE_set_deiloc,!',t0---�����ic 9'II errantbuffhes'recvnfoI : L !0sUPROCCOST !!!!!GOTO 9999px,t�lh99999IFpx,t�lhavginmehhlINost upd fr nensadba(1:n !av)icepee (1)t upd fr rocadba(1:n !av)iceompe N.INGLE_PRECIENSIral Pub9999deltar NREAL(maxicinme,avginmtoeil(nensadba!1,999==b__, rocadba!1,999==b__,L(maxi9'II errantbuf !-F Oinfo .NE.OUBLE_PRECIENSIral Pub9999deltar Nmaxinme-acinme,avginmtoeil(nensadba!1,999= Pub9999deltar N, rocadba!1, 9'II errantbuffhesssssssssss999= Pub9999deltar N, !-F Oinfo .NE.OU N(delta-delt!----lerms of ---al!irray inquipoe frome0Fpx,t�lhh roc�����(0:(n !avns))icenrocadba(1:n !av)w upd fr iopt#enOSA THENusdeailocISIwrit1)err_argumailoc( rocadba!ldu,iopt o .NE. 0) THTHENush_3d_ve99infor NGLE_error_ererror !--------999-999L GLE_error(GLerr_argum9I ,'GLE_set_ddeailoc,!',t0---�����ic 9'II errantbuffhes'recvnfoI : L !0sUPROCCOST !!!!!GOTO 9999px,t�lh9lINost upd fr -F Oirgumailoc(nensadba!ldu,iopt o .NE. 0) THTHENush_3d_ve99infor NGLE_error_ereror !--------999-999L GLE_error(GLerr_argum9I ,'GLE_set_ddeailoc,!',t0---�����ic 9'II errantbuffhes'nensnfoI : L !0sUShtDCOST !!!!!GOTO 9999px,t�lh9axtnme =Ecinme #enhh roc�����(0)icepee (1)tOU N(delta-dehO iLnme #enhh-----=>! n.n h99T----id)%EAMEINT,�l ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. h9 aet---9ic : e!!hAMEINT,�l ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. h9Ipummy(1:3,1!ice0Fpx,t�lhh_---aE!hid_ve999L checkush_3d_ve. h9Ino Zu => ----%aE!h-aE!hid)%Ino Zu3d_ved___hO iLicenseI Ino Zu => IpummyAMEINT,hhlINost upd fr ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. h9trageecomputeetnmaomdomarmHL !0sUticle Mu c al Pup !Is e!!hAMEINT,�l ---9ic LicenseI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. h9ENusPREShtiopIFp#efor NGLINGLE_PRECIENSIral Pub9999deltar NREAL(maxinmGLerr_argumnh999����(xp,Np,----%ainGLE_P(:,:)lfffffff9'II errantbuffhes----%aaxGLE_P(:,:)l----%nLE_Pc 9'II errantbuffhesIno Zu,����!!GOT,pIFp#enOUBLE_PRECIENSIral PubSUBRlicINE�loadbal_xinmGLerr_argumnh999����(xp,Np,----%ainGLE_d(:,:)lfffffff9'II errantbuffhes----%aaxGLE_d(:,:)l----%nLE_Pc 9'II errantbuffhesIno Zu,����!!GOT,pIFp#enOU N(delta-delthO iLINGLE_PRECIENSIral Pub9999deltar NREAL(maxinmGLerr_argumnh999����(xp,Np,----%ainGLE_P(:,:)lfffffff9'II errantbuffhes----%aaxGLE_P(:,:)l----%nLE_Pc 9'II errantbuffhesIno Zu,����!!GOTenOUBLE_PRECIENSIral PubSUBRlicINE�loadbal_xinmGLerr_argumnh999����(xp,Np,----%ainGLE_d(:,:)lfffffff9'II errantbuffhes----%aaxGLE_d(:,:)l----%nLE_Pc 9'II errantbuffhesIno Zu,����!!GOTenOU N(delta-delthINostr.LT. 0.aliz!GOTve99nfor NGLE_error_ererror !--------999-999L GLE_error(GLerr_argum9I ,'GLE_set_dLE_inquied,!',t0---�����ic 9'II errantbuffhesssss'e999onfrif !0sUionaomdomarms nquied !!!!!GOTO 9999px,t�lh99999IFpx,t�lhavginmehhlINosttr.LT. 0.NULLIFY(Ino Zu)LicenseI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII AMEINT,�l -A aLe`FCALgggg PM)I I f !0sUion) aLI ! vr al_ioteth e Fouy iumLI m99iTacadrd reRsr al_i2 !avush_3d_ve ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9px,t�lh99999 !av !-----%LE_2 !av(i99px,t�lh99999 roc�����( !av)ice roc�����( !av)i+ ����(i99px,t�lh9Eush_3d_ved_censeI ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I iagnolh999richI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve PinPE,MiceHUGE(pee (1)99px,t�lh999I_MAX,ECeaompe N.FALSE.ve Pin !av !-nsse�lne a.IiI_M roc !-nsse�lne a.Ii GLE_0,n !avnsse�lne 0) THroc�����(i) ve99iPinPE,M------WRITEOPdeg,'(A,I3)'PinPE,MiceHroc�����(i)WRITEOPdeg,'(A,I3)'Pin roc !-iWRITEOPdeg,'(A,h999DOud_ve99!!!!9990) THroc�����(i) ve999I_MAX,E------WRITEOPdeg,'(A,I3)'P_MAX,ECeaHroc�����(i)WRITEOPdeg,'(A,I3)'P_M roc !-iWRITEOPdeg,'(A,h999DOud_ve99!!!Eush_3d_ved_____6)') 'New deaompI5.3,A,Ist esimrmHL !0---9PinPE,MP /ehatrageeinmer N', Pup! ETH Zu ' Pin !av3d_ved_____rank,'GLE_loadbal_inquir!',Pd---�����ic!!WRITEOPdeg,'(A,F12.6)') 'New deaompI5.3,A,Ist esimompu !0---9P_MAX,EP /ehatrageeinmer N', Pup! ETH Zu ' P_M rocggggggg____rank,'GLE_loadbal_inquir!',Pd---�����ic!!WRITEOPdeg,'(A,h999DOud_ve9MK) I N-sh_3d_ve99--------WRITEOPdeg, GLE_0,n !avnsse�lne 6)') 'New deaI4,ompI5.3t esi,'9 !av u !0---9Hroc�����(i)WRITEOPdeg,'(A,rank,'GLE_loadbal_inquir!',Pd---�����ic 9'II errantbuffhessssss!!!!!!999IFpx,t�lhhhhlINh_3d_ved_____rank,'GLE_loadbal_inquir!',Pd---�����ic 9'II errantbuffhess'rland !---------------PM)I -F OEII debu'ITEOPdeg,'(A,h999DO ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I censeI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_set_deaomp_cost',t0---�����ic LicenseI'GLE_soalsh_3d_SUBRlicINE�checkush_3d_ve_!-F O.NOT.NGLE_imialized) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_GLE_noimit,'GLE_set_deaomp_cost',p ---�����ic 9'II errantbuffhesimit first!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-lINostr.LT. 0.alizNp_ve999L checkush_3d_ve. h9alizSIZE(xp,2) ve99iNp------WRITEOPdeg,'(A,I3ror !------------999L GLE_error(GLE_(Gerr_argum9I ,'GLE_set_deaomp_cost',p ---�����ic 9'II errantbuffhesssss'cifienoughup !Is sc/ta--comrmHxp !!!!!!!!!GOTO 8888ush_3d_ve9e99999IFpx8888-----9_aA,h999DOud_ve99!!!!9alizSIZE(xp,1) ve99iI N-sim)l----WRITEOPdeg,'(A,I3ror !------------999L GLE_error(GLE_(Gerr_argum9I ,'GLE_set_deaomp_cost',p ---�����ic 9'II errantbuffhesssss' fid reRsimens,tion) xp3rosuffici_co !!!!!!!!!GOTO 8888ush_3d_ve9e99999IFpx8888-----9_aA,h999DOud_ve99!lINostr.LT. 0.alizPREShtiopIFp#efor NGLE_error_eralizSIZE(padba!1) ve99iNp------WRITEOPdeg,'(A,ror !------------999L GLE_error(GLE_err_GLE_noimit,'GLE_seteaomp_cost',p ---�����ic 9'II errantbuffhesss'padba __,infoIion)t firt fngthiNp !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-A,h999DOud_ve99!lINostr.LT. 0.alizzNp_vL99info.AND. T----iddbal_sa.) THENusnh999 ---cof------WRITEOPdeg,'(Aror !------------999L GLE_error(GLEerr_GLE_noimit,'GLE_seteaomp_cost',p ---�����ic 9'II errantbuffhesss'nu aLI ieIDT __,inusg! !Is !!!!!!!!!GOTO 8888ush_3d_ve9999IFpxxxxxxxxxx-lINostr.LT. 0.aliz----iddbe99ia.) THENusnh999 ---cofor NGLE_error(GLEerr_GLE_n==b___aE!hid(----id!!!!hid!valid!!GOTO 8888ush_3d_alized) THvalid)l----WRITEOPdeg,'(A,Iror !------------999L GLE_error(GLE_(err_argum9I ,'GLE_set_deaomp_cost',p ---�����ic 9'II errantbuffhessss'aE!hid_isIrovalid !!!!!!!!!GOTO 8888ush_3d_ve9e9999IFpx8888-----9_aAh999DOud_ve99!lINostr,t�lh99SUBRlicINE�checku#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_s #elifP_I N----�����_sDOUBLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_d #enOSA I N----�����_d�������������������������������������������������������������������������������������������������������������������������������������looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooadbal/GLE_loadbal_inquir!����st iHroc�speed��������������������������������������������������������������������40540�de "util/p4�014132���������������1364�����������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������E�set_ and the GNU Lesser General Public License along with PPave rece�Subdefine r�������������������GLE_loadbal_inquir! ����st iHroc�speed ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Public LicenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral PubSUBRlicINE�loadbal_inq_s(cinmeI N-st iHroc�speed_s(Hroc�speed!!GOTenOUBLE_PRECIENSIral PubSUBRlicINE�loadbal_inq_s(cinmeI N-st iHroc�speed_d(Hroc�speed!!GOTenOUir!s abs pued bwo globa EMPILynru t miss file iu sr aeic te ee&rall,IspeedsoaI imbalence ms oe`FCALgggg ( gl missin al_i2 !avis di ! icicenseggggI ! and the GNU Lesser General Public License along with PPave rece�������(n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-loadbal-PM)I GLE_PRECISIsubscop !----USINGLE_PRECISIerror !----USINGLE_PRECISIwritb__KI999==b__SINGLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_single #elifP__KI999==b__DOUBLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_do ofe #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave recSINGLE_PRECISIOataM)I ! ETH eI ! and the GNU Lesser General Public License along with PPave reREAL(MK) :)--, DIMEN)the(0:)lflushtion) an!ie`THroc�speed ! ! up &rall,IspeedsoaI ) aLe`FCALgggg frome0 sr n !avns( Theus to g.tion) an!it__,insum99iTHo 1gggggggggggg:)----NT( lic)TEGEn0 Cest al Publ!ieEris sc/tus, 0 up usuccmpln h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK) EGEt0,maxinme,,,,,,me al lmyepI ! EOSA al Public Lestsolrsumggggggggggg:)----NT( lic)TEGEieEr ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren ! ic ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave rece�Imitialisln ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Imitialisln loadbal_inquir!',t0st iHroc�speedic LicenseI INGLE_PRECIENSIral Pub-------e)theAMEINT,lmyepI#enOSA myepIsDOUBLE_PRECIENSIral Pub9999SUBRlicINE�set_lmyepI#enOSA myepIdLicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !---------------PM)I -F OEII debug .GT. 0) THENush_3d_ve999L checkush_3d_ve-F Oinfo .NE. 0) GOTO 9999px,t�lh999IFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Oata availas to g.rade99iTHo 1 ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. r theIc sh_3d_)I -F OEII debug . GLE_0,n !avnsse�lne r theIcr the+ EOroc�speed(i)u !!!!!-F O Oiffe.GT. lINh_3d_ved_TO 9ABS(r the-u1mpe N) ve999lmyepIfor NGLE_error_error !--------999L GLE_error(GLE_err_mpi_f! P,'GLE_loadbeaomp_cost',p st iHroc�speedic/ehatrageeinmer N'Hroc�speedt__,insum99iTHo 1g !!!!!!!!!GOTO 8888ush_3dIFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca.) Troc�speedttion)str.LT. and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. r theIc sh_3d_)I -F OEII debug . GLE_0,n !avn2LINGLE_PRECIENSIral Pub9999deltar NREAL(maxinma.) Troc�speed(i) = EOroc�speed(i)u !!!!!-F O OiffOUBLE_PRECIENSIral PubSUBRlicINE�loadbal_xinma.) Troc�speed(i) = Troc�speed(i)lp N(delta-deltaor theIcr the+ a.) Troc�speed(i)fe.GT. lINh_3d_ved_a.) Troc�speed(n !avns)ice1sh_3d_)I -F OEII e-ursumgO ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I censeI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_set_deaomp_cost',t0st iHroc�speedic LicenseI'GLE_soalsh_3d_SUBRlicINE�checkush_3d_ve_!-F O.NOT.NGLE_imimialized) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_GLE_noimit,'GLE_set_deaomp_cost',p st iHroc�speedic/ 9'II errantbuffhesimit first!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999IFpxxxxxxxxxx-_alINostr.LT. 0.0_MK) SIZE(proc�speed!1) ve99iI N- !av)i----WRITEOPdeg,'(Aror !------------999L GLE_error(GLEerr_GLE_noimit,'GLE_seteaomp_cost',p st iHroc�speedic/ehatrageeinmer NesimiHroc�speedt__,inben)t firt aI fngthi !av !!!!!!!!!GOTO 8888ush_3d_ve9999IFpxxxxxxxxxx-_alINostr.LT. 0.0_MK) Iroc�speed(i) h_3d_ve99999infor NGLE_error_(Aror !------------999L GLE_error(GLEerr_GLE_noimit,'GLE_seteaomp_cost',p st iHroc�speedic/ehatrageeinmer NesiiHroc�speedt__,inbenfoI : ) aLe`FCALgggg !!!!!!!!!GOTO 8888ush_3d_ve9999IFpxxxxxxxxxx-_alINostr,t�lh9999SUBRlicINE�checku#ifPub__KI999==b__SINGLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_s #elifP_I N-st iHroc�speed_sDOUBLE_PRECIENSIral Pub9999SUBRlicINE�set_dcost_d #enOSA I N-st iHroc�speed_d�������������������������������������������������������������������������������������������������������������������������������������looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooadbal/GLE_loadbal_inquir!����estimateiHroc�speed���������������������������������������������������������������40540�de "util/p4�037415���������������2415�����������������������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������E�set_ and the GNU Lesser General Public License along with PPave rece�Subdefine r�������������������GLE_loadbal_inqui����estimateiHrocspeed ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I !--*- f90 -*-------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under the terms of the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Public LicenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral PubSUBRlicINE�loadddddt_d #enOSA estiHrocspeed_s(Hrocspeed!!GOT Pinuts rt�lh9999' ehatrageeinmN--gienOUBLE_PRECIENSIral PubSUBRlicINE�loadbal_inq_s(cinmeestiHrocspeed_d(Hrocspeed!!GOT Pinuts rt�lh9999' ehatrageeinmN--gienOUir!s abs pued bwo globa EMPILynru t missto estimatec te ee&rall,Ispeeds abs pued bn) an!ie`FCALggggRTIfHu2nTNso be reR missin al_i2 !avis di ! i abs pued bicenseggg. abs pued bwoe estimatPPM)(c)uoMPI fic999onfrifaus to go unLenn���-JoMPsA P abs pued bce f ac:tiosI ! and the GNU Lesser General Public License along with PPave rece�������(n h99999ic LicenseI ! and the GNU Lesser General Public License along with PPave reUSINGLE_PRECISIOata-PM)I USINGLE_PRECISIis a-loadbal-PM)I GLE_PRECISIsubscop !----USINGLE_PRECISIerror !----USINGLE_PRECISIwrite-PM)I IMPLICIailocISIwrite-PM)I IMPLICIT NONEn#ifPue-PM)I IMPLICIonflputs 3d_ved_T__KI999==b__SINGLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_single #elifP__KI999==b__DOUBLE_PRECIENSIral Pub-------e)theAMEINT,EGEMKr NGLE_kind_do ofe #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave recSINGLE_PRECISIOata ! ETH ZurichI ! CH-8092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #enOSA al Public LicenseI ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I ! E rePPrichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK) EGEt, DIMEN)the(:! NGLOlushEMPTYPE Ela rocspeed ! ! up &rall,IspeedsoaI ) aLe`FCALgggg frome0 sr n !avns( Theus to g.tion) an!itdonsum99iTHo 1gggggggg EGEt, OPTtheALggggglflushtion) an!ie`T!inuts tion) an!itOPTtheALgMinimumLIic sfr !Iloabenchmark)(c)ret�lh9ssto run, Pueachtion) an!it-----g DefaulfHu2n0.1 Secondsgggggggg EGEt, OPTtheALggggglflushtion) an!ie`T!�lh999tion) an!itOPTtheALgBenchmark)PRECoe s0 Cion)sI lowc Lip! ETH Zu h)sIrun,fZurichI osixtindIic s(Hrovie�surU Le!inuts )ret�lh9 ! Hu2nmet) DefaulfHu2richI osi5 SecondsAMEINT,EGEMKr , OPTtheALggggglflushtion) an!ie`TN--girichI osic Licenus to go unLJ-p !Is to mi. OPTtheAL DefaulfHu2richI osi14�0RTSeic tindIofausmailsr)tion) whoftLIoxpoe ion)I lowtion) an!it-----g Ingyn tu (c)uoMPIautomatP!',_ydIofmeeic te h999tion) an!itret�lh9 ! sgggggggggggg:)----NT( lic)TEGEn0 Cest al Publ!ieEris sc/tus, 0 urenseIcmpln h9999c LicenseI ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM)I ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave reREAL(MK) EGEt0,maxinme,,,,,,,,,,,,,,,,me al lmyepI,h99,h991,cutoff2 EGEt0,maxinme,,,,,,,,,,,,,,,,me x!�l,y!�l,z!�l,r2,r2i,r6i,fs,emse�lne EGEt0,maxinme,,,,,,,,,,,,,,,,me a!in,t!�l EGEt, DIMEN)the(3-lllllllllllme rl,ri,rj,fi,fj EGEt, DIMEN)the(:!lfLOlushEMP_MP',_h99--_> NULL(gg-------gggggggggggg EGEt, DIMEN)the(:!NGLOlushEMP_kinensh99-_> NULL(ggcenseI ! EOSA al Public Lestllllllllllme rsumggggggggggg:)----NT( lic)TEGEllllllllllme i,j,N,ioptAMEINT,EGEMKr NGDIMEN)the(1estllllllllllme ldl,lduAMEINT,har)EGEPdegn h9999-----llllllllllme ,t�lhllllllgggg:)----NT( lic)TEGEllllllllllme ldoMP ! and the GNU Lesser General Public License along with PPave rece�Looan variMeshlePPM ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave ren ! ic ! ETH ZurichI ! CH-8092 Zurich, Switzerland !- along with PPave rece�Imitialisln ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Imitialisln loadbal_inquir!',t0estimateiHrocspeedic LicenseIINGLE_PRECIENSIral Pub-------e)theAMEINT,lmyepI#enOSA myepIsDOUBLE_PRECIENSIral Pub9999SUBRlicINE�set_lmyepI#enOSA myepIdLicenseI ! and the GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I I ! ETH ZurichI ! CH-8092 Zuser General Public Lice !- along with PPave rece�Debug outputPPM)0) THENush_3d_ve999L checkush_3d_ve alized) THENush_3d_ve999999infor NGLE_error_error !------------999L GLE_error(GLE_err_GLE_noimit,'GLE_set_deaomp_cost',p estimateiHrocspeedic/ 9'II errantbuffhesimit first!',__LINE__,infoI !!!!!!!!!GOTO 8888ush_3d_ve99999It�lhavginmehh_alINostr.LT. 0.0_MK) PREShtio!inuts f------WRITEOPdeg,'(Ah_---ainuts )h_3d_ve99999infor NGLE_error_(Aor_error !------------999L GLE_error(GLE_GLE_err_GLE_noimit,'GLE_seteaomp_cost',p estimateiHrocspeedic/ 9'II errantbuffhesimesimiainuts )INE__,infoI !!!!!!!!GOTO 8888ush_3d_v_3d_ve99999It�lhavginmehh_ahh_alINostr.LT. 0.0_lINostr.LT. 0.0_MK) PREShtio!�lh999f------WRITEOPdeg,'(Ah_---a�lh999)h_3d_ve99999infor NGLE_error_(Aor_error !------------999L GLE_error(GLE_GLE_err_GLE_noimit,'GLE_seteaomp_cost',p estimateiHrocspeedic/ 9'II errantbuffhesimesimia�lh999)INE__,infoI !!!!!!!!GOTO 8888ush_3d_v_3d_ve99999It�lhavginmehh_ahh_alINostr.LT. 0.0_lINostr.LT. 0.0_MK) PREShtioN--gie9infor NGLE_error_(Ao! 0 tself (c)d) Upermite teositu ssere usebevsr)ingyn tu NGLE_error_(Ao! (mulfipl `MPll,Igrowth 8888ush_3d_v_3dalizNp-ginvL99infonfor NGLE_error_(Aor_error !------------999L GLE_error(GLE_GLE_err_GLE_noimit,'GLE_seteaomp_cost',p estimateiHrocspeedic/ 9'II errantbuffhesimesimiNp-gin__,infoI !!!!!!!!!GOTO 8888ush_3d_vvvvvvv9999It�lhavginmehh_ahh_alINostr.LT. 0.0_lINostr.LT. censeI ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic impoe limptsRTSRECe s0 Cion)sI lowc Lip! ETH Zu tak Zustrig .GT. at rU n t!�l Seconds,e I ret�lh9e Soryip! ETH Zu toIrun,fZun)t firtg .GT. at rmrmHSeconds,fZunsuffici_cocmplnilh999I ! and the GNU Lesser General Public License along with PPave rece�������(n h99999it!�l = 5mpe N.FALSE.rmrmHoI 1e N.FALSE.MK) PREShtio!�lh999f--t!�l = !�lh999tion) aMK) PREShtio!inuts f--t!�l = !inuts t ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seicn since lap !Is sr anqui FOR ( Theuu LynroSorrie�c tindeI ! tLIoxpoe ion)ISoryi lowe-----g ]and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. ) anice14�0.GT. tion) aMK) PREShtioN--gie9i.GT. ) =TN--gir ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)I iloc . NHrocspeed!irray ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPiopt#enOSA THENusailoc_fiEAMEINT,ldl(1)ice0Fpx,t�lldu(1)icen !avnsse�lne err_argumailoc( rocspeed!ldl,ldu,iopt o .NE. 0) THENush_3d_ve99infor NGLE_error_error !--------999fREClLE_error_ererr_argum9I ,'GLE_set_deiloc,!',t0estimateiHrocspeedic/ /ehatrageeinmer N'ee&rall,Ip! ETH Zu speedsoHrocspeedic !!!!!GOTO 9999px,t�lh999IFpx,t�lhavginmer Navginme/R rocspeed!eaompe N. ! and the GNU Lesser General Public License along with PPave rece�Argum9I (ve rePPM)IICUcle eUet ofisplo,Ip! ETH Zu9I (ve rePPl'et ofisplo,Ip! E i,j,N,ioptAMEINT,EGEMKr NGDIMEN)the(1estllllllllllme ldl,lduAMEINT,har)EGEPdegn h9999-----llllic/ 9-llll9 GLE_0,n !avnss ! adelta-Eush_3d_ved___hINnquir!',Pd---�����ic 9'II erc/ /ehatrageeinmer NiHroc�speedt__,inbenOu9I rePPl'et ofinilundriemHL !ann��.O havginmer Navginme/R rocspeed!eaoj,N,ioptAMEINT,EGEMKr NGDIMEN)the(1estllllllllllme ldl,lduAMEINT,har)EGEPdegnHrocspeed!irray �����urichIe0 sr n !�lh9 92 Zuser General Public Lice !- along with PPave rece�Debug outputPPM)0) THENuHENusailoc_fiEAMEINT,ldl(1)ice0Fpx,t�lldu(_3d_ve-F Oirgumailoc(nespeed!ldl,ldu,i------ THENush_3d_ve99infor NGLE_error_error !--------999fREClLE_error_ererr_argum9I ,'GLE_set_deiloc,!',t0estimateiHrocspeedic/ /ehatrageeinmer N'ee&rall,Ip! ETH Zu e s0 Cavns( Te0 sr n !avt_dTIM88ush_3dIFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca.) Tr!!!hta! CHichI9ssto run,CprocmpUioU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE______x ! andEush_3d_ved__y ! andEush_3d_ved__z ! andEush_3d_ved__GEt0,mand th25h_3d_ved__e GNUnd .FALSE.U LesserDO WHILE999999ine GNU ! ic Licenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe Ca.Th9 d LJHOUTeacheaom ! ic Licenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe et_deilocKI999==b_(==b ! ic Licenen Pin !av !-nsse�lne x,t�lh9N-1LE_P9pe Calo Li !tiosploirsqui FOR ( Thestr.LT. 0.0_lIx,tj=i+h9N str.LT. 0.0_lIpe et_deRANDOM_NUMBER(r)'P_M roc !-iWRITEOet_deRANDOM_NUMBER(rj'P_M roc !-iWRITEOrx3d_ve-rj3d_v- ridl,lduAMEINT,haP9pe Cacle eUtbetween i ! MEjP_M roc !-iWRITEOrx32_ve-rj32_v- rid2'P_M roc !-iWRITEOrx33_ve-rj33_v- rid3'P_M roc !-iWRITEOrx3d_ve-rx3d_-x ! *NITN-rx3d_/x ! )P9pe CaneIp!al Pmagmulfipl `MPll,IgEOrx32_ve-rx32_-y ! *NITN-rx32)/y ! )P9P_M roc !-iWRITEOrx33_ve-rx33_-z ! *NITN-rx33)/z ! )P9P_M roc !-iWRITEOrand SUM-rx3:)**2,,,,,,,me a!in,t!�l ! squIp! ui the aingP_M roc !-iWRITEONGLEranGLE_eGEt0,mar !--9P_M roc !-iWRITEOTEOraiandEush_3/r2P_M roc !-iWRITEOTEOr6iandrai*rai*raiP_M roc !-iWRITEOTEO!Hichngyfae eUtuNSIrbs pued bce f P_M roc !-iWRITEOTEOfseI 48ush_3*rai*r6i*(r6i-0.5h_3v9999It�lhavginmehh_ fi3d_ve-fi3d_+fs*rx3d_vTEOTEO!Hand ichngyhAMEINT,�l 99DOud_ve99!!!Eusehh_ fi32_ve-fi32_+fs*rx32'P_M roc !-iWRITEOh_ fi33_ve-fi33_+fs*rx33'P_M roc !-iWRITEOh_ fj3d_ve-fj3d_-fs*rx3d_vTEOTEO!Hand op ETH e ichngyhAMEINT,�l 9jP_M roc !-iWRITEOh_ fj32_ve-fj32_-fs*rx32'P_M roc !-iWRITEOh_ fj33_ve-fj33_-fs*rx33'P_M roc !-iWRITEOh_ ! upd ot ! FITg withsystemP_M roc !-iWRITEOh_ en Pien+4ush_3*r6i*(r6i-for NGLP_M roc !-iWRITEO90) THroc�����(i) vk,'GLE_loadbal_ik,'GLE_loadbal_inquir!',PKI999==b_(==b1LP_M roc !-iI iI 1-I P_M roc !-i------gIENSIral Puband the GNU Lesserenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe Ca.) aLe`FCALe s0 CavchI e. and the GNU Lesserenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe loc_fiEAMEINT,�lldu(1)icen !avuvush_3d_ve-F Oirgumailoc(nensnsadba!ldu,iopt o .NE--- THENush_3d_ve99infor NGLE_error_ererror !--------999-9fREClLE_error_erererr_argum9I ,'GLE_s_set_deiloc,!',t0estimateiHrocspeedic/ /ehatrageeinmer N'ee&rall,Ip! ETH Zuuuuu!0sUShtDCOST !!e s0 CavO 99TIM88ush_3dIFpn ! ic LicennnnnalINostr.LT. 0.0_MK) PREShtio!inuts .NE---e N.INGLE_PRECIEI Pub9999deltar NREAL(maxinma.) Troc�speed(i) =ensadba!1,999= Pub9999--- II errantbu------ !1,999==b__,pPRECIENSIral Pub9999deltar Nmaxinme-acinme,avginmtoeil(n =ensadba!1,999= Pub9999--- II err-F Oinfo .NE.OU N------ !1il(n =sssssssss999= Pub9999deltar r N, !-F Oinfo .NE.OU N(delta-delt!----lerms of ---aldeailocISIwrit1)err_argumailoc( rocnsadba!ldu,iopt o .NE--- THENush_3d_ve99infor NGLE_error_ererror !--------999-9fREClLE_error_erere_err_GLE_noimit,'GLE_set_deaomp_cost',p est��ic 9'IIc/ /ehatrageeinmer N'eee&rall,Ip! ETH Zuuuuu!0sUShtDCOST !!e s0 CavO 99TIM88ush_3dIFpn ! ic Licenh roc�����(0)icepee -i------3d_ve-I Plerms of ---aldeNU Lesserenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe Ca.I 999t!al wu ta9I !NU Lesserenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe x,t�lh9F Oirgumailoc(nensns NGLE------3--WRITEOt ! )Pe GNUnd .TRUE. ! ic Licenh rGLE_loadbal_ix,t�lh9F Oirgumailoc(nensns NGLE------3--WRLTEOt in)_e GNUnd .FALSE.U! ic Licenh rGLENU Lesserenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe Ca.GhI gc alRPOSEme rsudLe!inu999poe l,Ispeedserenh, Switzerland !---------------PM)I -F OEII AMEINT,�l GLE_wr----%nLE_P9pe ve999999ie GNU o! 0 tself (c)d) UperCEIh_3G (vepoe l,,tbeca!!!!n tu NGLEnerror_3danilh99Ioxp tself (c)d) Uper999NITN wu t di !! tself (c)d) Upnd tCEIh_3G(1.414h_3*LestlN,NGL ! ic Licenh roc�! and the x,t) UperWHILE99999ie GNU U Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I I ! ETH ZurichIonrroALe s0 CavchI pued bn) an!ie`FCALgggGeneral Public Lice !- along with PPave rece�Debug outputPPM)I I ! ETH Zure�lne 6)') 'New deaI4 ! adilta-Eush_3/------3-+1LP_M roch rGLE_loadb---gIESUM- ! ade: 6)')L ! ic Le�lne 6)') 'New deaI4 ! adilta- ! adil/I _M roch rGLE Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I I ! ETH ZurichIde99iTHo 1 ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. r theIc sh_3d_)I - N) ve99SUM- ! ade: 6)')L epIfor NGLE_error_error !--------999L GLE_error(GLE_err_mpi_f! P,'GLE_loadbeaomp_cost',p st iHbad_sum'II erc/ /ehatrageeinmer NiHroc�speedt__,i' ! an !!!!!!!!!GOTO 8888ush_3dIFpn ! ic LicenseI ! and the GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca. ! CH-809 output Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. r theIc sh_3d_)I - N) eckush_3d_ve aGLE_0,n !avnss3,A,Ist esimompI6,AMAX,EUdi !',N,'bs pued bce f aFOR ( The.'d_ved___hINnquir!',Pd---�����ic 9'II erc/ /ehatrageeinmer hhlINh_3d_ved_____rannquir!',Pd---�����ic 9'II erc/ /ehatrageeinmer NiHroc�sssssssssssss----------PM)I -F OEII debu'ITEOPdeg,'(A,h999'Nh_3d_ved_____rane�lne 6)') 'New deaI4,ompI5.3t esi,'9 mpIav u !0.7MAX,Ec 9!',oc��osixtpued bn) an!i esimiHroc�speedt__,inbeeeeeeeee ! adilGLE_noimit,'GLE_set_deaod---�����ic 9'II erc/ /ehatrageeinmer hhlINh_3d_ved_____rank,'GLE_loadbal_inquir!',Pd---�����ic 9'II erc/ /ehatrageeinmer NiHroc�sssssssssssss----------PM)I -F OEII debu'ITEOPdeg,'(A,h999'Nh_3d_ved____he GNU Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca.) Troc�speedttion)str.LT. and the GNU ???????? Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca. �ic lI �����u Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne ailocISIwrit1)err_argumailoc( rspeed!ldl,ldu,i------ THENush_3d_ve99infor NGLE_error_error !--------999fREClLE_error_ererr_mpi_f! P,'GLE_loadbeaomp_cost',p st iH��ic 9'IIc/ /ehatrageeinmer N'eee&rall,Ip! ETH Zu e s0 Cavns( Te0 sr n !avt_dTIM88ush_3dIFpn ! ic Lhe GNU Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I censeI ! and the GNU Lesser General Public License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_set_deaomp_cost',t0---�����ic LicenseIc LicenseIINGLE_PRECIENSIral t',t0-�checkuPub9999SUBRlicINE�set_dcost_s #elifP_I N-st iHroc�speed_cspeed!!GOT Pin Pub9999SUBRlicINE�set_dcost_d #enOSA I N-st iHroc�speed_cspeed!!GOT Pin������������������������������������������������������������������������������������������������������������������loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooonquir!����estimat 3d_ved_T__GLE_ebox2��ic�������������������������������������������������40540�dede "util/p4�037415��������������04764����������������157����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������Lesser Ge*- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�spee 3d_ved_T__GLE_ebox2��ic Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I censeI ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesser Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca. �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__GLE_ebox2��ic Lesser !nys,maxved_T_ s )ret�ss abs to estiublicconrroAss (DPboxheuu �ic�f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfacheuu abs to est(-8092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,----%ainbox2��ic LesserLesserMODULEePROCEDUREp,----%ainbox2��ic_c LesserLesserMODULEePROCEDUREp,----%ainbox2��ic_,Ispeedserest i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan ce f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"-%ai/,----%ainbox2��ic.f" #rror(NE�UBRl.#eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"-%ai/,----%ainbox2��ic.f" #rror(NE�UBRl.#edserest iMODULEe 3d_ved_T__GLE_ebox2��ic ������������nquir!����estimat 3d_ved_T__KI999inrroA_t ot�������������������������������������������������40540�d "util/p4�037415��������������04364�����������3����764����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������,'GLE_h, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�spe 3d_ved_T__KI999inrroA_t ot Lesser General Public Lice !- along with PPave rece�Debug outputPPM)I censeI ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral LesserMODULEe 3d_ved_T__KI999inrroA_t ot Lesser !nys,maxved_T_ s )ret�ss absKI99iion to estCHichIinrroA0 Cionstsf! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu absonstIinrro ! P to est092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---KI999inrroA_t ot LesserLesserMODULEePROCEDUREp,---KI999inrroA_t ot LesserLesst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan cef! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#ei CH-80s"KI99/,---KI999inrroA_t ot.f" #edserest iMODULEe 3d_ved_T__KI999inrroA_t ot ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_ved_T__io�������������������������������������������������40540�dedeeeeeeeeeeee "util/p4�037415��������������40760��������������167415���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������,'GLE_h, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�speepe 3d_ved_T__io Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral Pu and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca. �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2#eor(GLENE�TEGEllllllllllme i,j,N,io3#eor(GLENE�TEGEllllllllllme ldoMP 4#eor(GLENE�set_dcost_s #eli_COMPLEX 5#eor(GLENE�set_dcost_d #enO_COMPLEX 6#eor(GLENE�----llllllllllme ldoMP 7l LesserMODULEe 3d_ved_T__impln h9999c s,maxved_T_ s )ret�ss abspeedtfacheuu e0 sb (EI/On to estCimatPPM)(c)pln h9999c s,maxved_T_ con itns e0 s-PM) e Gucturheu! MEor(GLihe GNPublipln h9999c le Mpriveeds absI/On to estCimatPPM) deNU LessereISIis a-loadbal-PM), ONLY:BLE_PRECIENSIralUBLE_PRECIENSIraNU LesserePRIVATE! ! uE_PRECIENSIralUBLE_PRECIENSIraNf! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.! CH-8092 ZuricLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.ff! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.Workhe GNU92 ZuricLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.ff! P,'GLE_LestllllllllllNSIral_vTEushEMP_kinensh99-_> NULLgg--buf_s ! EO! P,'GLE_Lestllllllllllme rsumgggushEMP_kinensh99-_> NULLgg--buf_d ! EO! P,'GLE_COMPLEXllllllllllNSIral_ushEMP_kinensh99-_> NULLgg--buf_sc ! EO! P,'GLE_COMPLEXllllllllllme rsumushEMP_kinensh99-_> NULLgg--buf_dc ! EO! P,'GLE_TEGEllllllllllme i,j,N,iushEMP_kinensh99-_> NULLgg--buf_i ! EO! P,'GLE_TEGEllllllllllme ldoMP ushEMP_kinensh99-_> NULLgg--buf_l ! EO! P,'GLE_NU LesserePRIVATE! ! -buf_s,--buf_d,--buf_sc,--buf_dc,--buf_i,--buf_lff! P,'GLE_LestllllllllllNSIral_vTEushEMP_kinensh99-_> NULLgg-rbuf_s ! EO! P,'GLE_Lestllllllllllme rsumgggushEMP_kinensh99-_> NULLgg-rbuf_d ! EO! P,'GLE_COMPLEXllllllllllNSIral_ushEMP_kinensh99-_> NULLgg-rbuf_sc ! EO! P,'GLE_COMPLEXllllllllllme rsumushEMP_kinensh99-_> NULLgg-rbuf_dc ! EO! P,'GLE_TEGEllllllllllme i,j,N,iushEMP_kinensh99-_> NULLgg-rbuf_i ! EO! P,'GLE_TEGEllllllllllme ldoMP ushEMP_kinensh99-_> NULLgg-rbuf_l ! EONU LesserePRIVATE! ! rbuf_s,rbuf_d,rbuf_sc,rbuf_dc,rbuf_i,rbuf_lff Puband the GNU LessereLestllllllllllNSIral_vTEushEMP_kinensh99-_> NULLgg--buffer_s ! EO! P,'GLE_Lestllllllllllme rsumgggushEMP_kinensh99-_> NULLgg--buffer_d ! EO! P,'GLE_COMPLEXllllllllllNSIral_ushEMP_kinensh99-_> NULLgg--buffer_sc ! EO! P,'GLE_COMPLEXllllllllllme rsumushEMP_kinensh99-_> NULLgg--buffer_dc ! EO! P,'GLE_TEGEllllllllllme i,j,N,iushEMP_kinensh99-_> NULLgg--buffer_i ! EO! P,'GLE_TEGEllllllllllme ldoMP ushEMP_kinensh99-_> NULLgg--buffer_l ! EO! P,'GLE_LestllllllllllNSIral_vTEushEMP_kinensh99-_> NULLgg-bbuffer_s ! EO! P,'GLE_Lestllllllllllme rsumgggushEMP_kinensh99-_> NULLgg-bbuffer_d ! EO! P,'GLE_COMPLEXllllllllllNSIral_ushEMP_kinensh99-_> NULLgg-bbuffer_sc ! EO! P,'GLE_COMPLEXllllllllllme rsumushEMP_kinensh99-_> NULLgg-bbuffer_dc ! EO! P,'GLE_TEGEllllllllllme i,j,N,iushEMP_kinensh99-_> NULLgg-bbuffer_i ! EO! P,'GLE_TEGEllllllllllme ldoMP ushEMP_kinensh99-_> NULLgg-bbuffer_l ! EONU LesserePRIVATE! ! -buffer_s,-buffer_d,-buffer_sc,-buffer_dcNU LesserePRIVATE! ! -buffer_i,-buffer_lNU LesserePRIVATE! ! bbuffer_s,bbuffer_d,bbuffer_sc,bbuffer_dcNU LesserePRIVATE! ! bbuffer_i,bbuffer_l the GNU f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!of! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!of! P,'GLE_GLE_h9c Pdtfoluidp ! YouI/Onithscalareu! MEcle eUsf! P,'GLE_GLE_h9c ithFortranspeertnsR AUyp092 ZuriccccccccMODULEePROCEDUREp,---io_0d92 ZuriccccccccMODULEePROCEDUREp,---io_0dd2 ZuriccccccccMODULEePROCEDUREp,---io_0di2 ZuriccccccccMODULEePROCEDUREp,---io_0dl2 ZuriccccccccMODULEePROCEDUREp,---io_0d9c2 ZuriccccccccMODULEePROCEDUREp,---io_0ddc2 ZuriccccccccMODULEePROCEDUREp,---io_0dc 2 ZuriccccccccMODULEePROCEDUREp,---io_1d92 ZuriccccccccMODULEePROCEDUREp,---io_1dd2 ZuriccccccccMODULEePROCEDUREp,---io_1di2 ZuriccccccccMODULEePROCEDUREp,---io_1dl2 ZuriccccccccMODULEePROCEDUREp,---io_1d9c2 ZuriccccccccMODULEePROCEDUREp,---io_1ddc 2 ZuriccccccccMODULEePROCEDUREp,---io_2d92 ZuriccccccccMODULEePROCEDUREp,---io_2dd2 ZuriccccccccMODULEePROCEDUREp,---io_2di2 ZuriccccccccMODULEePROCEDUREp,---io_2dl2 ZuriccccccccMODULEePROCEDUREp,---io_2d9c2 ZuriccccccccMODULEePROCEDUREp,---io_2ddc 2 ZuriccccccccMODULEePROCEDUREp,---io_3d92 ZuriccccccccMODULEePROCEDUREp,---io_3dd2 ZuriccccccccMODULEePROCEDUREp,---io_3di2 ZuriccccccccMODULEePROCEDUREp,---io_3dl2 ZuriccccccccMODULEePROCEDUREp,---io_3d9c2 ZuriccccccccMODULEePROCEDUREp,---io_3ddc 2 ZuriccccccccMODULEePROCEDUREp,---io_4d92 ZuriccccccccMODULEePROCEDUREp,---io_4dd2 ZuriccccccccMODULEePROCEDUREp,---io_4di2 ZuriccccccccMODULEePROCEDUREp,---io_4dl2 ZuriccccccccMODULEePROCEDUREp,---io_4d9c2 ZuriccccccccMODULEePROCEDUREp,---io_4ddc 2 ZuriccccccccMODULEePROCEDUREp,---io_5d92 ZuriccccccccMODULEePROCEDUREp,---io_5dd2 ZuriccccccccMODULEePROCEDUREp,---io_5di2 ZuriccccccccMODULEePROCEDUREp,---io_5dl2 ZuriccccccccMODULEePROCEDUREp,---io_5d9c2 ZuriccccccccMODULEePROCEDUREp,---io_5ddc2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!do!of! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---do!of! P,'GLE_h!nLJ-edttion to estiublicpdtfoluidactuaouI/O2 ZuriccccccccMODULEePROCEDUREp,---do!o_92 ZuriccccccccMODULEePROCEDUREp,---do!o_d2 ZuriccccccccMODULEePROCEDUREp,---do!o_i2 ZuriccccccccMODULEePROCEDUREp,---do!o_l2 ZuriccccccccMODULEePROCEDUREp,---do!o_9c2 ZuriccccccccMODULEePROCEDUREp,---do!o_dc2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_openf! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_openf! P,'GLE_GLE_h!nLOpenidax,phy2 ZuriccccccccMODULEePROCEDUREp,---io_openf! P,'GLE_st i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_clost092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_clost092 Zuric_GLE_h!nLClostidax,phy2 ZuriccccccccMODULEePROCEDUREp,---io_clost092 Zuric_st i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_inZu to092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_inZu to092 Zuric_GLE_h!nLInZu toss absand ! ui auI/OnUnit2 ZuriccccccccMODULEePROCEDUREp,---io_inZu to092 Zuric_st i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_read_ascii092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_read_ascii092 Zuric_GLE_h!nLReads ASCIIhe GNU9vns( TenuI/OnUnit2 ZuriccccccccMODULEePROCEDUREp!o_readascii_92 ZuriccccccccMODULEePROCEDUREp!o_readascii_d2 ZuriccccccccMODULEePROCEDUREp!o_readascii_i2 ZuriccccccccMODULEePROCEDUREp!o_readascii_l2 ZuriccccccccMODULEePROCEDUREp!o_readascii_9c2 ZuriccccccccMODULEePROCEDUREp!o_readascii_dc2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_read_bina�u Lesseric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_read_bina�u Lesseric_GLE_h!nLReads bina�uhe GNU9vns( TenuI/OnUnit2 ZuriccccccccMODULEePROCEDUREp!o_readbin_92 ZuriccccccccMODULEePROCEDUREp!o_readbin_d2 ZuriccccccccMODULEePROCEDUREp!o_readbin_i2 ZuriccccccccMODULEePROCEDUREp!o_readbin_l2 ZuriccccccccMODULEePROCEDUREp!o_readbin_9c2 ZuriccccccccMODULEePROCEDUREp!o_readbin_dc2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_d---�_ascii092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_d---�_ascii092 Zuric_GLE_h!nLW---�s ASCIIhe GNU9vu enuI/OnUnit2 ZuriccccccccMODULEePROCEDUREp!o_d---�ascii_92 ZuriccccccccMODULEePROCEDUREp!o_d---�ascii_d2 ZuriccccccccMODULEePROCEDUREp!o_d---�ascii_i2 ZuriccccccccMODULEePROCEDUREp!o_d---�ascii_l2 ZuriccccccccMODULEePROCEDUREp!o_d---�ascii_9c2 ZuriccccccccMODULEePROCEDUREp!o_d---�ascii_dc2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_d---�_bina�u Lesseric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_d---�_bina�u Lesseric_GLE_h!nLW---�s bina�uhe GNU9vu enuI/OnUnit2 ZuriccccccccMODULEePROCEDUREp!o_d---�bin_92 ZuriccccccccMODULEePROCEDUREp!o_d---�bin_d2 ZuriccccccccMODULEePROCEDUREp!o_d---�bin_i2 ZuriccccccccMODULEePROCEDUREp!o_d---�bin_l2 ZuriccccccccMODULEePROCEDUREp!o_d---�bin_9c2 ZuriccccccccMODULEePROCEDUREp!o_d---�bin_dc2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_deleto092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_deleto092 Zuric_h!nLDeletoidax,phy2 ZuriccccccccMODULEePROCEDUREp,---io_deleto092 Zuric_st i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_set_unit2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_set_unit2 Zuricccch!nLSetsuI/Onunitlnilh99tout,99tderru! MElogx,phy2 ZuriccccccccMODULEePROCEDUREp,---io_set_unit2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu !!!!!o_un di _unit2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---!o_un di _unit2 Zuricccch!nLRto estiublicf !dss absOTO 8 un di uI/Onunit2 ZuriccccccccMODULEePROCEDUREp,---io_un di _unit2 Zuriccccst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.I CH-80sUticlan cef! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�sIM 0#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�----lllllf#i CH-80s"ii/,---io��" #rror(NE�UBRl.error(NE�sIM.#eor(GLENE�sIM 1#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.error(NE�sIM.#eor(GLENE�sIM 2#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.error(NE�sIM.! P,'GLE_#eor(GLENE�sIM 3#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.error(NE�sIM.! P,'GLE_#eor(GLENE�sIM 4#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.error(NE�sIM.! P,'GLE_#eor(GLENE�sIM 5#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io��" #rror(NE�UBRl.error(NE�sIM .#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---do!o��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---do!o��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---do!o��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---do!o��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---do!o��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---do!o��" #rror(NE�UBRl.f#i CH-80s"ii/,---io_open.f" ##i CH-80s"ii/,---io_clost.f" ##i CH-80s"ii/,---io_inZu to.f" ##or(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io_read_ascii��" #i CH-80s"ii/,---io_read_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io_read_ascii��" #i CH-80s"ii/,---io_read_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io_read_ascii��" #i CH-80s"ii/,---io_read_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io_read_ascii��" #i CH-80s"ii/,---io_read_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io_read_ascii��" #i CH-80s"ii/,---io_read_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io_read_ascii��" #i CH-80s"ii/,---io_read_bina�u��" #rror(NE�UBRl.##or(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"ii/,---io_d---�_ascii��" #i CH-80s"ii/,---io_d---�_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"ii/,---io_d---�_ascii��" #i CH-80s"ii/,---io_d---�_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io_d---�_ascii��" #i CH-80s"ii/,---io_d---�_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�TEGElllS#i CH-80s"ii/,---io_d---�_ascii��" #i CH-80s"ii/,---io_d---�_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_s #eli_COMPLEXf#i CH-80s"ii/,---io_d---�_ascii��" #i CH-80s"ii/,---io_d---�_bina�u��" #rror(NE�UBRl.eor(GLENE�UBRliE�set_dcost_d #enO_COMPLEXf#i CH-80s"ii/,---io_d---�_ascii��" #i CH-80s"ii/,---io_d---�_bina�u��" #rror(NE�UBRl. #i CH-80s"ii/,---io_deleto.f" ##i CH-80s"ii/,---io_set_unit.f" ##i CH-80s"ii/,---io_un di _unit.f" #edserest iMODULEe 3d_ved_T__io ����������������nquir!����estimat 3d_ved_T__-PM)_and !�������������������������������������������������40540�dedeeee "util/p4�037415��������������04642���������������04������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������,'GLE_h, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�speep 3d_ved_T__-PM)_and ! ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral LesserMODULEe 3d_ved_T__-PM)_and ! ,'GLE_h!c s,maxved_T_ con itns s-PM) e Gucturheu! MEor(GLihe GNPublipln h9999c le MPRIVATE! abs 3d_vapit1)t_ane th! ME 3d_vapit1)t_loadn to estCimatPPM)(c)pln h9999c [NOTE] ,'GLE_h!c s,e variablheudeclle sser Gemaxved_T_s! but WIeI e I d toctly ac l,Ispeedsh!c e Pamic r. s,ey le Mmanag ssertITNEly e Pamiclceived�f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NUGULLgg- 3d_vapiUyp0_and ! f! P,'GLE_> NUGULLgg- 3d_ntocvt ot_and ! ,'GLE_LE_> NUGULLgg- 3d_n0sUSt ot_and ! f! P,'GLE_> NUGULLgg- 3d_n0sUSbuffer_snd ! f! P,'GLE_> NUGULLgg- 3d_buffer_set_and ! ff! P,'GLE_> NUGULushEMP_kinensh99-_> NULLgg- 3d_p0sUSbuffer_snd ! ! EO! P,'GLE_TEGElllushEMP_kinensh99-_> NULLgg- 3d_buffer2t1)t_and ! ! EOO! P,'GLE_TEGElllushEMP_kinensh99-_> NULLgg- 3d_itocvt ot_and ! ! EO! P,'GLE_TEGElllushEMP_kinensh99-_> NULLgg- 3d_i0sUSt ot_and ! ! EOO! P,'Gst iMODULEe 3d_ved_T__-PM)_and ! ����������������������������������������������������������������������������������������������nquir!����estimat 3d_ved_T__KI999cubeq_real�������������������������������������������������40540�de "util/p4�037415��������������05040�����������5����47�����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������ricccch, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�spe 3d_ved_T__KI999cubeq_real ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral Lesser General Public Lice !- along with P-PM)I -F OEII debug .GT. at Seic te ce f ne Ca. �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__KI999cubeq_real ,'GLE_h!nys,maxved_T_ s )ret�ss abs to estc Lesser !nyublicsolOUTcubR Aequahe GNPRPOSEreals totc�f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfacheuu absmc alGLE_logys to est(-8092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---KI999cubeq_real ,'GLE_LesserMODULEePROCEDUREp,---KI999cubeq_real_c LesserLesserMODULEePROCEDUREp,---KI999cubeq_real_,Ispeedserest i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan cef! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"KI99/,---KI999cubeq_real��" #rror(NE�UBRl.#eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"KI99/,---KI999cubeq_real��" #rror(NE�UBRl.#edserest iMODULEe 3d_ved_T__KI999cubeq_real ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_ved_T__KI999dbg�������������������������������������������������40540�dedeeeeee "util/p4�037415��������������04756�����������3���0140����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������,'GLE_h, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�spe 3d_ved_T__KI999dbg ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral Lesser General Public Lice !- along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral Module �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__KI999dbg ,'GLE_h!nys,maxved_T_ s )ret�ss abs to estc Lesser !nyublicsolOUTcubR Aequahe GNPRPOSEreals totc�f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfacheuu absmc alGLE_logys to est(-8092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---dbg_prpee LesserLesserMODULEePROCEDUREp,---dbg_prpee_c LesserLesserMODULEePROCEDUREp,---dbg_prpee_,Ispeedserest i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan cef! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"KI99/,---dbg_prpee��" #rror(NE�UBRl.#eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"KI99/,---dbg_prpee��" #rror(NE�UBRl.##edserest iMODULEe 3d_ved_T__KI999dbg ������������������nquir!����estimat 3d_ved_T__GLE_emetis_s2p�������������������������������������������������40540�ded "util/p4�037415��������������04773�����������3����314����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������,'GLE_h, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�sp 3d_ved_T__GLE_emetis_s2p ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesser Lesser General Public Lice !- along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral Module �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__GLE_emetis_s2p ,'GLE_h!nys,maxved_T_ s )ret�ss absdecomposihe Gn to estCimatPPM) deh, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu METIS-badi usub-to-s )c issignment2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---GLE_emetis_s2p ,'GLE_LesserMODULEePROCEDUREp,---GLE_emetis_s2p_c LesserLesserMODULEePROCEDUREp,---GLE_emetis_s2p_,Ispeedserest i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan ce.2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"GLE_/,---GLE_emetis_s2p��" #rror(NE�UBRl.#eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"GLE_/,---GLE_emetis_s2p��" #rror(NE�UBRl.#edserest iMODULEe 3d_ved_T__GLE_emetis_s2p �����nquir!����estimat 3d_ved_T__GLE_eTY; �������������������������������������������������40540�dedeeeee "util/p4�037415��������������04445�����������3���0355����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������ricccch, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�spe 3d_ved_T__GLE_eTY; ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesser Lesser General Public Lice !- along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesserle �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__GLE_eTY; ,'GLE_h!nys,maxved_T_ s )ret�ss abs to estcuu TY; wGLE_logyse Gucturhef! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfacheuu LE_logysTY; w to est2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---GLE_eTY; ,'GLE_LesserMODULEePROCEDUREp,---GLE_eTY; ,'GLE_Lesst i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan ce.2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#ei CH-80s"GLE_/,---GLE_eTY; ��" #edserest iMODULEe 3d_ved_T__GLE_eTY; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_ved_T__G (D_boxcost�������������������������������������������������40540�dedee "util/p4�037415��������������04766�����������5����0415���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������ricccch, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�speep 3d_ved_T__G (D_boxcost ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIral Lesser General Public Lice !- along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesserle �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__G (D_boxcost ,'GLE_h!nys,maxved_T_ s )ret�ss ab ,'GLE_h!ny to estiubliccomput�ss abscostid Dyn (DPboxtCimatPPM) deh, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfacheuu abs to est(-8092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---G (D_boxcost ,'GLE_LesserMODULEePROCEDUREp,---G (D_boxcost_c LesserLesserMODULEePROCEDUREp,---G (D_boxcost_,Ispeedserest i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan ce2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"G (D/,---G (D_boxcost��" #rror(NE�UBRl.#eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"G (D/,---G (D_boxcost��" #rror(NE�UBRl.#edserest iMODULEe 3d_ved_T__G (D_boxcost ����������nquir!����estimat 3d_ved_T__GLE_eTYst�������������������������������������������������40540�dedee�ee "util/p4�037415��������������04740�����������5�����������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������ricccch, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�spee 3d_ved_T__GLE_eTYst ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesser Lesser General Public Lice !- along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesserle �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__GLE_eTYst ,'GLE_h!nys,maxved_T_ s )ret�ss abssubdomc alTYstouplculahe Gn to estimatPPM) deh, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfachuu LE_logysTYsiccomputahe Gn to est2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---GLE_eTYst ,'GLE_LesserMODULEePROCEDUREp,---GLE_eTYst_c LesserLesserMODULEePROCEDUREp,---GLE_ecost_,Ispeedserest i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan ce.2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"GLE_/,---GLE_ecost��" #rror(NE�UBRl.#eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"GLE_/,---GLE_ecost��" #rror(NE�UBRl.#edserest iMODULEe 3d_ved_T__GLE_eTYst ��������������������������������nquir!����estimat 3d_ved_T__mkGLE_�������������������������������������������������40540�dedeeeeeede "util/p4�037415��������������05734�����������5��17657����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������ricccch, *- f90 e*-ic License along with PPa9999cd_alINUEpx,t�lh999L subscop('GLE_ ! and tthe GN ETH Zu���st iHroc�speep 3d_ved_T__mkGLE_ ,'GLE_h, E_ ! and -----------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Module : p module_map field !------------------------ginys,max,phys,mis,t�lEmax,t�lh999999x,t�lh999999I ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), I ! Center for Fluid Dynamics (DTU)I !I !I ! This file is part of the Pamics (DParticle Mesh Library (PPM).I !I ! PPM is free software: you can h999999x,t�lh999999I modify pyright (c)under thE Lab (ETH the GNU Lesser General Public License I ! as published by the Free Software Foundation, either I ! version 3 of the License, or (at your option) any later I ! version.I !I ! PPM is distributed in the hope that it will be useful,I ! but WITHOUT ANY WARRANTY; without even the implied warranty ofI ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theI ! GNU General Public License for more details.I !I ! You should have received a copy of cehe NU General Pu and -icenseI ! and the GNU Lesser General Public License along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesser Lesser General Public Lice !- along with PPr#ifPub__KI999==b__SINGLE_PRECIENSIralesserle �f !0sUyp092 Zurich, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.h' #eor(GLENE�set_dcost_s #eli 1#eor(GLENE�set_dcost_d #enO 2U LesserMODULEe 3d_ved_T__mkGLE_ ,'GLE_h!nys,maxved_T_ s )ret�ss abspeedtfachuu abs to estcuubliccred ! ,'GLE_h!c LE_logitCimatPPM) deh, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha. �f !0speedtfacheuu absmc alGLE_logys to est(-8092 Zuric_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_> NULFACEp,---mkGLE_ ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkt1)t_a ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkt1)t_d ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkfield_a ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkfield_d ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkgeom_a ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkgeom_d ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkG (D_a ,'GLE_LesserMODULEePROCEDUREp,---GLE_emkG (D_,Ispeedserest i> NULFACE f! P,'GLE_h, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ha.i CH-80sUticlan ce.2 Zuricccch, Switzerland !-----ng with PP#ifdefP__MPIpx,t�lhhINCLUDE 'mpif.f! P,'GLE_ve_!-F O.#eor(GLENE�UBRliE�set_dcost_s #elif#i CH-80s"GLE_/,---GLE_emkt1)t��" #i CH-80s"GLE_/,---GLE_emkfield��" #i CH-80s"GLE_/,---GLE_emkgeom��" #i CH-80s"GLE_/,---GLE_emkG (D��" #rror(NE�UBRl.#eor(GLENE�UBRliE�set_dcost_d #enOS#i CH-80s"GLE_/,---GLE_emkt1)t��" #i CH-80s"GLE_/,---GLE_emkfield��" #i CH-80s"GLE_/,---GLE_emkgeom��" #i CH-80s"GLE_/,---GLE_emkG (D��" #rror(NE�UBRl.#edserest iMODULEe 3d_ved_T__mkGLE_ ������������������������������������nquir!����estimatctrl/���������������������������������������������������������������������������������0755p4�037415��������������00000��������������14710� 5�����������������������������������������������������������������������������������������������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/t1)se_arg�������������������������������������������������40540�dedeeeeeeeeeee "util/p4�037415��������������04311��������������17021����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLE_Lesser_haf !dsmctral Pu annnnnnnnDO i=1,WRAP(DTYPE)_args_il Pu annnnnnnner_ha but�lflagl Pu annnnnnnner_ok = .FALrsil Pu annnnnnnner_IF (WRAP(DTYPE)_args(i)%flag_set) THEOS#ifror(NE�TEGElllS Pu annnnnnnner_LE_vALLaf !d_flag(WRAP(DTYPE)_args(i)%flag(1:2 !ok, valuwarerr) #elseS Pu annnnnnnner_LE_vALLaf !d_flag(WRAP(DTYPE)_args(i)%flag(1:2 !ok) #en S Pu annnnnnnner_st i>Fl Pu annnnnnnner_IF ((.NOT.!ok) .AND. (WRAP(DTYPE)_args(i)%AR P_flag_set)) THEOS Pu annnnnnnner_LE_! AR PUflagl#ifror(NE�TEGElllS Pu annnnnnnner_LE_vALLaf !d_flag(WRAP(DTYPE)_args(i) &S Pu annnnnnnner_LE______%AR P_flag(1:LEN_TRIM(WRAP(DTYPE)_args(i) &S Pu annnnnnnner_LE______%AR P_flag) !ok, valuwarerr) #elseS Pu annnnnnnner_LE_vALLaf !d_flag(WRAP(DTYPE)_args(i) &S Pu annnnnnnner_LE______%AR P_flag(1:LEN_TRIM(WRAP(DTYPE)_args(i) &S Pu annnnnnnner_LE______%AR P_flag) !ok) #en S Pu annnnnnnner_st i>Fl Pu annnnnnnner_IF (ok) THEOS#ifror(NE�TEGElllS Pu annnnnnnner_LE_!smctra fsh L - convet�lUticargS Pu annnnnnnner_LE_READ (valuwa*,IOSTAT=ios) WRAP(DTYPE)_args(i)%variablhS Pu annnnnnnner_LE_!scheckhe hofailurhS Pu annnnnnnner_LE_IF (ios .NE. 0) THEOS Pu annnnnnnner_LE____WRITE (cvar,*) 'Invalidcargument (', valuw(1:LEN_TRIM(valuw) !')he hoarg ', &S Pu annnnnnnner_LE_________WRAP(DTYPE)_args(i)%name(1:LEN_TRIM(WRAP(DTYPE)_args(i)%name))S Pu annnnnnnner_LE____info = 3d_error_fatal ,'GLE_LesserrrrrrrrrrrvALLa 3d_error( 3d_err_argument,oupller,ouvar,NE�TINE__,_info)S Pu annnnnnnner_LE____GOTO 9999S Pu annnnnnnner_LE_st i>Fl#elseS Pu annnnnnnner_LE_IF (WRAP(DTYPE)_args(i)%Uyp0 .EQV. enabli P_flag) THEOS Pu annnnnnnner_LE____WRAP(DTYPE)_args(i)%variablh = .TRUsil Pu annnnnnnner_LE_sLrsS Pu annnnnnnner_LE____WRAP(DTYPE)_args(i)%variablh = .FALrsil Pu annnnnnnner_LE_st i>Fl#en S Pu annnnnnnner____WRAP(DTYPE)_args(i)%clf_sup = .TRUsil Pu annnnnnnner_sLrs_IF (err) THEOS Pu annnnnnnner_LE_info = 3d_error_fatal ,'GLE_LesserrrrrrrrWRITE (cvar,*) 'Flag ', valuw(1:LEN_TRIM(valuw) !&S Pu annnnnnnner_LE______' haeuu bbssup RPOSEa valuw.'S Pu annnnnnnner_LE_vALLa 3d_error( 3d_err_argument,oupller,ouvar,NE�TINE__,_info)S Pu annnnnnnner_LE_GOTO 9999S Pu annnnnnnner_st i>Fl Pu annnnnnnnst iDO #rror(NDTYPE #rror(NE�TEGElllS�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/ctrl_comment�������������������������������������������������40540�dedeeeeeede "util/p4�037415��������������07272��������������17555����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLE_LDO j=1,WRAP(DTYPE)_args_ill Pu annnnnIF (WRAP(DTYPE)_args(j)%g,t�lh .EQ. k .AND. &S Pu annnnnnnneWRAP(DTYPE)_args(j)%g,t�l_i .EQ. i) THEOSS Pu annnnnnnnIF (WRAP(DTYPE)_args(j)%ctrl_name_set) THEOSS Pu annnnnnnner_WRITE (*,'(A,A15)',advance='no')h"# " !&S Pu annnnnnnner_LE___WRAP(DTYPE)_args(j)%name(1:LEN_TRIM(WRAP(DTYPE)_args(j)%name))S Pu annnnnnnner_in_lGLEN= .TRUsill Pu annnnnnnner_IF (WRAP(DTYPE)_args(j)%help_set) THEOSu annnnnnnner_LE___WRITE (*,'(A)',advance='no')h": "S Pu annnnnnnner_LE_vALLabreak_help(WRAP(DTYPE)_args(j)%helpr_LE_&S Pu annnnnnnner_LE______(1:LEN_TRIM(WRAP(DTYPE)_args(j)%help) !&S Pu annnnnnnner_LE______50,h"# " !6)S Pu annnnnnnner_LE_in_lGLEN= .FALrsil Pu annnnnnnner_st i>Fll Pu annnnnnnner_IF (WRAP(DTYPE)_args(j)%flag_set .OR. &S Pu annnnnnnneeeeeeeeWRAP(DTYPE)_args(j)%AR P_flag_set) THEOSu annnnnnnner_LE___IF (in_lGLE) THEOS Pu annnnnnnner_LE____WRITE (*,'(A)',advance='no')h": "S Pu annnnnnnner_LE_sLrsS Pu annnnnnnner_LE____WRITE (*,'(A)',advance='no')h"# "l Pu annnnnnnner_LE_st i>Fl Pu annnnnnnner_LE_in_lGLEN= .FALrsil Pu annnnnnnner_ r_IF (WRAP(DTYPE)_args(j)%flag_set) THEOS#ifEor(GLed(oftwY)S Pu annnnnnnner_LE____WRITE(*,'(A,A)',advance='no')h&S Pu annnnnnnner_LE_________WRAP(DTYPE)_args(j)%flag(1:2 !" {v1,v2,...}"l#elifE!or(GLed(E�TEGElll)S Pu annnnnnnner_LE____WRITE(*,'(A,A)',advance='no')h&S Pu annnnnnnner_LE_________WRAP(DTYPE)_args(j)%flag(1:2 !" {valuw}"l#elseS Pu annnnnnnner_LE____WRITE(*,'(A)',advance='no')h&S Pu annnnnnnner_LE_________WRAP(DTYPE)_args(j)%flag(1:2 l#en S Pu annnnnnnner____ r_IF (WRAP(DTYPE)_args(j)%AR P_flag_set) THEOSu annnnnnnner_LE___LE____WRITE (*,'(A)',advance='no')h', 'S Pu annnnnnnner_LE_ E_sLrsS Pu annnnnnnner_LE_______WRITE (*,*) ''S Pu annnnnnnner_LE_ E_st i>Fl Pu annnnnnnner_LE_st i>Fll Pu annnnnnnner_ r_IF (WRAP(DTYPE)_args(j)%AR P_flag_set) &S Pu annnnnnnner_LE______WRITE(*,*) WRAP(DTYPE)_args(j)%AR P_flag &S#ifEor(GLed(oftwY)S Pu annnnnnnner_LE______(1:(LEN_TRIM(WRAP(DTYPE)_args(j)%AR P_flag) !" {v1,v2,...}"l#elifE!or(GLed(E�TEGElll)S Pu annnnnnnner_LE______(1:(LEN_TRIM(WRAP(DTYPE)_args(j)%AR P_flag) !" {valuw}"l#elseS Pu annnnnnnner_LE______(1:(LEN_TRIM(WRAP(DTYPE)_args(j)%AR P_flag) #en S Pu annnnnnnner_st i>FlS#ifEor(GLed(__TEGElll) || or(GLed(E�TENGTEG) || or(GLed(E�set_dc) || or(GLed(E�set_dc)S Pu annnnnnnner_IF (WRAP(DTYPE)_args(j)%min_set .OR. &S Pu annnnnnnneeeeeeeeWRAP(DTYPE)_args(j)%max_set) THEOSu annnnnnnner_LE___IF (in_lGLE) THEOS Pu annnnnnnner_LE____WRITE (*,'(A)',advance='no')h": "S Pu annnnnnnner_LE_sLrsS Pu annnnnnnner_LE____WRITE (*,'(A)',advance='no')h"# "l Pu annnnnnnner_LE_st i>Fl Pu annnnnnnner_LE_in_lGLEN= .FALrsil Pu annnnnnnner_ r_IF (WRAP(DTYPE)_args(j)%min_set) THEOS Pu annnnnnnner_LE____WRITE (scrctra, *) WRAP(DTYPE)_args(j)%minS Pu annnnnnnner_LE____scrctraN= ADJUSTL(scrctra)S Pu annnnnnnner_LE____WRITE (*,'(A,A)',advance='no')hscrctra(1:LEN_TRIM(scrctra)) , ' <= 'S Pu annnnnnnner_LE_st i>Fl#ifor(NoftwYSu annnnnnnner_LE___WRITE (*,'(A)',advance='no')h'{v1,v2,...}'l#elseS Pu annnnnnnner_LE_WRITE (*,'(A)',advance='no')h'{valuw}'l#en S Pu annnnnnnner____IF (WRAP(DTYPE)_args(j)%max_set) THEOSu annnnnnnner_LE______WRITE (scrctra, *) WRAP(DTYPE)_args(j)%maxS Pu annnnnnnner_LE____scrctraN= ADJUSTL(scrctra)S Pu annnnnnnner_LE____WRITE (*,'(A,A)',advance='no')h' <= ',hscrctra(1:LEN_TRIM(scrctra))l Pu annnnnnnner_LE_st i>Fl Pu annnnnnnner_LE_WRITE(*,*) ''S Pu annnnnnnner_st i>Fl#en S Pu annnnnnnner_IF (in_lGLE) WRITE (*,*) ''S Pu annnnnnnnst i>Fl Pu annnnnnnnCYCLE comment_loop ,'GLE_Lessst i>Fl Pu annst iDO #rror(NDTYPE #rror(NE�TEGElll #rror(NE�TENGTEG #rror(NE�set_dc #rror(NE�set_dc #rror(NE�TEGElllS#rror(NE�sTRINGS��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/t1)se_ctrl�������������������������������������������������40540�dedeeeeeeeeee "util/p4�037415��������������01402��������������172115���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLE_LessDO i=1,WRAP(DTYPE)_args_il Pu annnnnnnnIF (WRAP(DTYPE)_args(i)%ctrl_name_set) THEOS Pu annnnnnnner_uvarN= WRAP(DTYPE)_args(i)%ctrl_name &S Pu annnnnnnneeeeeeee(1:LEN_TRIM(WRAP(DTYPE)_args(i)%ctrl_name))l Pu annnnnnnner_current_varN= uvarl Pu annnnnnnner_vALLaUpperCase(cvar, LEN_TRIM(cvar),_info)S Pu annnnnnnner_IF (carg .EQ. cvar) THEOSu annnnnnnner_LE___IF (.NOT.!WRAP(DTYPE)_args(i)%clf_sup ) THEOS#ifor(NE�sTRINGS Pu annnnnnnneeeeeeee_WRAP(DTYPE)_args(i)%variablh = ADJUSTL(cvaluw)l#elseS Pu annnnnnnner_LE____READ (cvaluwar*, IOSTAT=ios, ERR=300) WRAP(DTYPE)_args(i)%variablhS#en S Pu annnnnnnner____st i>Fl Pu annnnnnnner_LE_CYCLE var_loop ,'GLE_Lesser____st i>Fl Pu annnnnnnnst i>Fl Pu annnnnst iDO #rror(NDTYPE #rror(NE�sTRINGS��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/or(ault_func�������������������������������������������������40540�dedeeeeeede "util/p4�037415��������������01144��������������175165���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLDO i=1,WRAP(DTYPE)_args_il Pu annIF (WRAP(DTYPE)_args(i)%or(ault_func_set) THEOS Pu annnnnIF (.NOT.!WRAP(DTYPE)_args(i)%or(ault_func(WRAP(DTYPE)_args(i)%variablh)) THEOS Pu annnnnnnnIF (WRAP(DTYPE)_args(i)%or(ault_set) THEOS Pu annnnnnnner_WRAP(DTYPE)_args(i)%variablh = WRAP(DTYPE)_args(i)%or(aultl Pu annnnnnnnsLrsS Pu annnnnnnner_info = 3d_error_fatal ,'GLE_LesserrrrrvALLa 3d_error( 3d_err_argument,oupller,o&S Pu annnnnnnneeeeeeee'Error ap ying or(ault funche GN!',NE�TINE__,_info)S Pu annnnnnnner_GOTO 9999S Pu annnnnnnnst i>Fl Pu annnnnst i>Fl Pu annst i>Fl Pu st iDO #rror(NDTYPE ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/test/����������������������������������������������������������������������������0755p4�037415��������������00000��������������15667� 5�����������������������������������������������������������������������������������������������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/test/ 3d_ved_T__ctrl��u��0000644�0001752�0001753�00000035667�11616003525�02027 "util/p4�037415��������������60300��������������21565����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������test_suite 3d_ved_T__ctrl S#ifor(NE�MPIl Pu INCLUDE "mpif.h"S#en S speedgerPu annnnnnnn:: ior(ault,_iflag, spAR P_flag speedger(8)annnnnnnn:: gor(ault,_gflag, sgAR P_flag srealsssssssssssssss:: ror(ault,_rflag, srAR P_flag sreal(8)annnnnnnnsss:: dor(ault,_dflag, sdAR P_flag scharacter(len=256)s:: cor(ault,_cflag, scAR P_flag slogicalssssssssssss:: lor(ault,_leflag, leAR P_flag slogicalssssssssssss:: ldflag, ldAR P_flag scomplexssssssssssss:: por(ault,_pflag, spAR P_flag scomplex(8)annnnnnnn:: xor(ault,_xflag, sxAR P_flag speedger,ssssssssssssdimenyrig(3)s:: i very,_iaflag, ialflag speedger(8),sssssssssdimenyrig(3)s:: g very,_gaflag, galflag sreal,sssssssssssssssdimenyrig(3)s:: r very,_raflag, ralflag sreal(8),ssssssssssssdimenyrig(3)s:: d very,_daflag, dalflag scharacter(len=256),sdimenyrig(3)s:: c very,_caflag, calflag slogical,ssssssssssssdimenyrig(3)s:: l very,_laflag, lalflag scomplex,ssssssssssssdimenyrig(3)s:: p very,_paflag, palflag scomplex(8),sssssssssdimenyrig(3)s:: x very,_xaflag, xalflag scharacter(len=256)s:: valuw slogicalssssssssssss:: okS speedgerP:: info, ios, scf.##edsetup ,'GLvALLadisablh_ctrl E_ha.vALLaarg_g,t�l("IeedgerPTests") ule vALLaarg(ior(ault,_'ior(ault',sssss& ule flag = '-d',sssssssssssss& ule AR P_flag = '--ior(ault',sssss& ule ctrl_name =_'ior(ault',sssssss& ule or(ault = 42,sssssssssssssss& ule helpr_LE_ = "Test_ifspeedgerPor(aults work.") ulen dsetup ulte����wn ,'GLvALLareset ,'GLior(ault = 0 ,'GLiflag = 0 ,'GLiAR P_flag = 0 ,'GLgor(ault = 0 ,'GLgflag = 0 ,'GLgAR P_flag = 0 ,'GLror(ault = 0 ,'GLrflag = 0 ,'GLrAR P_flag = 0 ,'GLdor(ault = 0 ,'GLdflag = 0 ,'GLdAR P_flag = 0 ,'GLcor(ault = ''S Pu cflag = ''S Pu cAR P_flag = ''S Pu lor(ault = .falstimatPPleflag = .falstimatPPleAR P_flag = .falstimatPPldflag = .falstimatPPldAR P_flag = .falstimatPPpor(ault = (0,0)S Pu pflag = (0,0)S Pu pAR P_flag = (0,0)S Pu xor(ault = (0,0)S Pu xflag = (0,0)S Pu xAR P_flag = (0,0)S Pu valuw = ''S Pu ok = .falstimatPPinfo = 0 ,'en dte����wn ultest_prpeeing ,'GLvALLareset ,'GL! or(GLe somicargs ,'GLvALLadisablh_ctrl E_ vALLaarg(ior(ault,_'somi_pee',sssss& ullllllllflag = '-i',sssssssssssss& ullllllllAR P_flag = '--ieedger',ssssss& ullllllllctrl_name =_'somi_pee',sssssss& ullllllllor(ault = 42,sssssssssssssss& ullllllllmin = 0,ssssssssssssssss& ullllllllmax = 100,ssssssssssssss& ullllllllhelpr_LE_ = "Test_ifspeedgerPprpeeing works.") ul vALLaarg(ror(ault,_'somi_real',ssss& ullllllllflag = '-r',sssssssssssss& ullllllllAR P_flag = '--real',sssssssss& ullllllllctrl_name =_'somi_real',ssssss& ullllllllor(ault = 0.1337,sssssssssss& ullllllllmin = 0.0,ssssssssssssss& ullllllllmax = 1.0,ssssssssssssss& ullllllllhelpr_LE_ = "Test_ifsrealsprpeeing works.") ul vALLaarg_g,t�l("Secon dx,t�l") ul vALLaarg(cor(ault,_'somi_char',ssss& ullllllllflag = '-c',sssssssssssss& ullllllllAR P_flag = '--char',sssssssss& ullllllllctrl_name =_'somi_char',ssssss& ullllllllor(ault = 'hrkljus',ssssssss& ullllllllhelpr_LE_ = "Test_ifscharPprpeeing works.") ul vALLaarg(lor(ault,_'somi_bool',ssss& ullllllllflag = '-b',sssssssssssss& ullllllllAR P_flag = '--bool',sssssssss& ullllllllctrl_name =_'somi_bool',ssssss& ullllllllor(ault = .true.,sssssssssss& ullllllllhelpr_LE_ = "Test_ifsboolPprpeeing works.") ul vALLaarg(i very,_'pee_ very',ssssss& ullllllllflag = '-m',sssssssssssss& ullllllllAR P_flag = '--iee- very',ssss& ullllllllctrl_name =_'pee_ very',ssssss& ullllllllor(ault = (/1,2,3/),ssssssss& ullllllllmin = 0,ssssssssssssssss& ullllllllmax = 100,ssssssssssssss& ullllllllhelpr_LE_ = "Test_ifspeedgerP veryPprpeeing works.") ul vALLaarg(r very,_'real_ very',sssss& ullllllllflag = '-n',sssssssssssss& ullllllllAR P_flag = '--real- very',sss& ullllllllctrl_name =_'real_ very',sssss& ullllllllor(ault = (/1.1,2.2,3.3/),ss& ullllllllmin = 0.0,ssssssssssssss& ullllllllmax = 3.5,ssssssssssssss& ullllllllhelpr_LE_ = "Test_ifsreals veryPprpeeing works.") ul vALLaarg_g,t�l("Thir dx,t�l") ul vALLaarg(c very,_'char_ very',sssss& ullllllllflag = '-o',sssssssssssss& ullllllllAR P_flag = '--char- very',sss& ullllllllctrl_name =_'char_ very',sssss& ullllllllor(ault = (/'foo','bar','baz'/ !&S Pu annnnhelpr_LE_ = "Test_ifscharP veryPprpeeing works.") ul vALLaarg(l very,_'bool_ very',sssss& ullllllllflag = '-p',sssssssssssss& ullllllllAR P_flag = '--bool- very',sss& ullllllllctrl_name =_'bool_ very',sssss& ullllllllor(ault = (/.true.,.falsti,.true./ !&S Pu annnnhelpr_LE_ = "Test_ifsboolP veryPprpeeing works.") ul !ssup yUflagle vALLaadd_cmd('-h')le vALLaadd_cmd('--help')le vALLaadd_cmd('--prpee-ctrl') ul !st1)secargs ,'GLvALLat1)se_args(info)S Pu AITY t_Equal(info, 0) ulen dtest ultest_multi ({ior(ault: 1,_iflag: 2},S Pu annnnnnnnnnnnn{ior(ault: [2,3,4],_iflag: [1,3,5]})S Pu IF (ior(ault .EQ. 1) THEOS Pu annAITY t_Equal(iflag,2)S Pu st i>Fl Pu IF (ior(ault .EQ. 2) THEOS Pu annAITY t_True(iflag .eq. 1 .or. iflag .eq. 3 .or. iflag .eq. 5)S Pu st i>Fl Pu IF (ior(ault .EQ. 3) THEOS Pu annAITY t_True(iflag .eq. 1 .or. iflag .eq. 3 .or. iflag .eq. 5)S Pu st i>Fl Pen dtest ultest_arg_manipulahe G ul !saddcargs ,'GL!stlc alTmdcargS Pu vALLaadd_cmd('����t') ul !s but�lflagl Pu ! RPOSEvaluw s vALLaadd_cmd('-a', '1') s vALLaadd_cmd('-b',s'2') ul !stlc alTmdcargS Pu vALLaadd_cmd('peedt but�') s vALLaadd_cmd('-c',s'3') s vALLaadd_cmd('-d',s'4') ul !snoEvaluw s vALLaadd_cmd('-e') s vALLaadd_cmd('-f') s vALLaadd_cmd('-g') ul !stlc alTmdcargS Pu vALLaadd_cmd('middle') ul !sAR PUflagl Pu ! RPOSEvaluw s vALLaadd_cmd('--AR P-1', '1') s vALLaadd_cmd('--AR P-2',s'2') ul !stlc alTmdcargS Pu vALLaadd_cmd('peedtAR P') s vALLaadd_cmd('--AR P-3',s'3') s !snoEvaluw s vALLaadd_cmd('--AR P-4') s vALLaadd_cmd('--AR P-5') ul !stlc alTmdcargS Pu vALLaadd_cmd('(GLalize') s vALLaadd_cmd('stop')l ul !stoU Genublicargs work af9999info ,'GLvALLat1)se_args(info)S ul !scheckhelag funche G (atioof ornterhed befe tharg) s vALLaf !d_flag('-b',sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'2') ul vALLaf !d_flag('--AR P-3',sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'3') ul vALLaf !d_flag('-e' !ok) Pu AITY t_True(ok) annvALLaf !d_flag('-c',sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'3') ul vALLaf !d_flag('--AR P-1', ok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'1') ul vALLaf !d_flag('--AR P-5' !ok) Pu AITY t_True(ok) annvALLaf !d_flag('-a', ok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'1') ul vALLaf !d_flag('-d', ok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'4') ul vALLaf !d_flag('-f' !ok) Pu AITY t_True(ok) annvALLaf !d_flag('--AR P-2',sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'2') ul vALLaf !d_flag('-g' !ok) Pu AITY t_True(ok) annvALLaf !d_flag('--AR P-4' !ok) Pu AITY t_True(ok) ul !scheckhnumbterof args ,'GLAITY t_Equal(6,_arg_count()) ul !scheckharg funche G annvALLaf !d_arg(3,sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'middle') ul vALLaf !d_arg(2,sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'peedt but�') s vALLaf !d_arg(6,sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'stop')l s vALLaf !d_arg(4,sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'peedtAR P') s vALLaf !d_arg(1,sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'stat�') s vALLaf !d_arg(5,sok, valuw)S Pu AITY t_True(ok) annAITY t_Equal(valuwar'(GLalize') s l Pen dtest ultest_peedger_args ,'GL!sor(GLe ul vALLaarg(ior(ault,_ _'ior(ault',sssor(ault = 42 ) ul vALLaarg(iflag, s _ _'iflag',ssssssflag = '-f' ) ul vALLaarg(iAR P_flagar'pAR P_flag',sAR P_flag = '--flag') ul !ssup y s vALLaadd_cmd('-f',sssss'42') s vALLaadd_cmd('--flag',s'42') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(ior(ault,_ _42)S Pu AITY t_Equal(iflag, s _ _42)S Pu AITY t_Equal(iAR P_flagar42)S Pen dtest ultest_peedger_arery_args ,'GL!sor(GLe ul vALLaarg(i very,_r'p very',ssor(ault = (/1,2,3/)) ul vALLaarg(i flag, s'i flag',ssflag = '-f' ) ul vALLaarg(ialflagar'palflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'1,2,3' ) ul vALLaadd_cmd('--flag',s'1,s2,s3') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Arery_Equal(i very,_r(/1,s2,s3/)) ul AITY t_Arery_Equal(i flag, s(/1,s2,s3/)) ul AITY t_Arery_Equal(i lflagar(/1,s2,s3/)) ulen dtest ultest_AR P_args ,'GL!sor(GLe ul vALLaarg(gor(ault,_ _'gor(ault',sssor(ault = 42_8 ) ul vALLaarg(gflag, s _ _'gflag',ssssssflag = '-f' ) ul vALLaarg(gAR P_flagar'gAR P_flag',sAR P_flag = '--flag') ul !ssup y s vALLaadd_cmd('-f',sssss'42') s vALLaadd_cmd('--flag',s'42') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(gor(ault,_ _42)S Pu AITY t_Equal(gflag, s _ _42)S Pu AITY t_Equal(gAR P_flagar42)S Pen dtest ultest_AR P_arery_args ,'GL!sor(GLe ul vALLaarg(g very,_r'g very',ssor(ault = (/1_8,2_8,3_8/)) ul vALLaarg(g flag, s'g flag',ssflag = '-f' ) ul vALLaarg(galflagar'galflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'1,2,3' ) ul vALLaadd_cmd('--flag',s'1,s2,s3') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Arery_Equal(g very,_r(/1,s2,s3/)) ul AITY t_Arery_Equal(g flag, s(/1,s2,s3/)) ul AITY t_Arery_Equal(g lflagar(/1,s2,s3/)) ulen dtest ultest_single_args ,'GL!sor(GLe ul vALLaarg(ror(ault,_ _'ror(ault',sssor(ault = 0.1337 ) ul vALLaarg(rflag, s _ _'rflag',ssssssflag = '-f' ) ul vALLaarg(rAR P_flagar'rAR P_flag',sAR P_flag = '--flag') ul !ssup y s vALLaadd_cmd('-f',sssss'0.1337') s vALLaadd_cmd('--flag',s'0.1337') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(ror(ault,_ _0.1337)S Pu AITY t_Equal(rflag, s _ _0.1337)S Pu AITY t_Equal(rAR P_flagar0.1337)S Pen dtest ultest_single_arery_args ,'GL!sor(GLe ul vALLaarg(r very,_r'r very',ssor(ault = (/1.1,2.2,3.3/)) ul vALLaarg(r flag, s'r flag',ssflag = '-f' ) ul vALLaarg(ralflagar'ralflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'1.1,2.2,3.3' ) ul vALLaadd_cmd('--flag',s'1.1,s2.2,s3.3') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Arery_Equal(r very,_r(/1.1,s2.2,s3.3/)) ul AITY t_Arery_Equal(r flag, s(/1.1,s2.2,s3.3/)) ul AITY t_Arery_Equal(r lflagar(/1.1,s2.2,s3.3/)) ulen dtest ultest_double_args ,'GL!sor(GLe ul vALLaarg(dor(ault,_ _'dor(ault',sssor(ault = 0.1337_8 ) ul vALLaarg(dflag, s _ _'dflag',ssssssflag = '-f' ) ul vALLaarg(dAR P_flagar'dAR P_flag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'0.1337') s vALLaadd_cmd('--flag',s'0.1337') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(dor(ault,_ _0.1337_8)S Pu AITY t_Equal(dflag, s _ _0.1337_8)S Pu AITY t_Equal(dAR P_flagar0.1337_8)S Pen dtest ultest_double_arery_args ,'GL!sor(GLe ul vALLaarg(d very,_r'd very',ssor(ault = (/1.1_8,2.2_8,3.3_8/)) ul vALLaarg(d flag, s'd flag',ssflag = '-f' ) ul vALLaarg(dalflagar'dalflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'1.1,2.2,3.3' ) ul vALLaadd_cmd('--flag',s'1.1,s2.2,s3.3') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Arery_Equal(d very,_r(/1.1_8, 2.2_8, 3.3_8/)) ul AITY t_Arery_Equal(d flag, s(/1.1_8, 2.2_8, 3.3_8/)) ul AITY t_Arery_Equal(d lflagar(/1.1_8, 2.2_8, 3.3_8/)) ulen dtest ultest_stri P_args ,'GLvALLaarg(cor(ault,_ss'cor(ault',sssor(ault = 'hrkljus') ul vALLaarg(cflag, s _ _'cflag',ssssssflag = '-f') ul vALLaarg(cAR P_flagar'cAR P_flag',sAR P_flag = '--flag') ul !ssup y s vALLaadd_cmd('-f',sssss'hrkljus') ul vALLaadd_cmd('--flag',s'hrkljus') ul !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(cor(ault,_ss'hrkljus') ul AITY t_Equal(cflag, s _ _'hrkljus') ul AITY t_Equal(cAR P_flagar'hrkljus') ulen dtest ultest_stri P_arery_args ,'GL!sor(GLe ul vALLaarg(c very,_r'c very',ssor(ault = (/'foo','bar','baz'/ ) ul vALLaarg(c flag, s'c flag',ssflag = '-f' ) ul vALLaarg(calflagar'calflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'foo,bar,baz' ) ul vALLaadd_cmd('--flag',s'foo, bar, baz') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Arery_Equal(c very,_r(/'foo','bar','baz'/ ) ul AITY t_Arery_Equal(c flag, s(/'foo','bar','baz'/ ) ul AITY t_Arery_Equal(c lflagar(/'foo','bar','baz'/ ) ulen dtest ultest_ARgical_args ,'GLvALLaarg(lor(ault,_ss 'lor(ault',ssslor(ault = .true.) ul vALLaarg(leflag, sssss'leflag',ssssssor(ault = .falsti,!&S Pu annnnUyp0 = enabli P_flag,sflag = '-e') ul vALLaarg(leAR P_flag,s'leAR P_flag',sor(ault = .falsti,!&S Pu annnnUyp0 = enabli P_flag,sAR P_flag = '--enable') ul vALLaarg(ldflag, s _ _'ldflag',ssssssor(ault = .true.,ss&S Pu annnnUyp0 = disabli P_flag,sflag = '-d') ul vALLaarg(ldAR P_flag,s'ldAR P_flag',sor(ault = .true.,ss&S Pu annnnUyp0 = disabli P_flag,sAR P_flag = '--disablh') ul !ssup y s vALLaadd_cmd('-e' ) ul vALLaadd_cmd('--enable' ) ul vALLaadd_cmd('-d' ) ul vALLaadd_cmd('--disablh') ul !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_True( lor(ault )S Pu AITY t_True(Pleflag )S Pu AITY t_True(PleAR P_flag)S Pu AITY t_Falst(ldflag )S Pu AITY t_Falst(ldAR P_flag)S Pen dtest ultest_ARgical_arery_args ,'GL!sor(GLe ul vALLaarg(l very,_r'l very',ssor(ault = (/.true.,.falsti,.true./ ) ul vALLaarg(l flag, s'l flag',ssflag = '-f' ) ul vALLaarg(lalflagar'lalflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'T,F,T' ) ul vALLaadd_cmd('--flag',s'T, F, T') ul !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_LArery_Equal(l very,_r(/.true.,.falsti,.true./ ) ul AITY t_LArery_Equal(l flag, s(/.true.,.falsti,.true./ ) ul AITY t_LArery_Equal(l lflagar(/.true.,.falsti,.true./ ) ulen dtest ultest_complex_args ,'GL!sor(GLe ul vALLaarg(por(ault,_ss'por(ault',sssor(ault = (0,1) ) ul vALLaarg(pflag, s _ _'pflag',ssssssflag = '-f' ) ul vALLaarg(pAR P_flag,s'pAR P_flag',sAR P_flag = '--flag') ul !ssup y s vALLaadd_cmd('-f',sssss'(0,1)') ul vALLaadd_cmd('--flag',s'(0,1)') ul !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(por(ault,_ss(0,1)) ul AITY t_Equal(pflag, s _ _(0,1)) ul AITY t_Equal(pAR P_flag,s(0,1)) ulen dtest ultest_complex_arery_args ,'GL!sor(GLe ul vALLaarg(p very,_r'p very',ssor(ault = (/(1,0),(0,1),(-1,0)/ ) ul vALLaarg(p flag, s'p flag',ssflag = '-f' ) ul vALLaarg(palflagar'palflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'(1,0),(0,1),(-1,0)' ) ul vALLaadd_cmd('--flag',s'(1,0),s(0,1),s(-1,0)') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Arery_Equal(p very,_r(/(1,0),(0,1),(-1,0)/ ) ul AITY t_Arery_Equal(p flag, s(/(1,0),(0,1),(-1,0)/ ) ul AITY t_Arery_Equal(p lflagar(/(1,0),(0,1),(-1,0)/ ) ulen dtest ultest_dcomplex_args ,'GL!sor(GLe ul vALLaarg(xor(ault,_ss'xor(ault',sssor(ault = (0._8,1._8) ) ul vALLaarg(xflag, s _ _'xflag',ssssssflag = '-f' ) ul vALLaarg(xAR P_flag,s'xAR P_flag',sAR P_flag = '--flag') ul !ssup y s vALLaadd_cmd('-f',sssss'(0,1)') ul vALLaadd_cmd('--flag',s'(0,1)') ul !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(xor(ault,_ss(0,1)) ul AITY t_Equal(xflag, s _ _(0,1)) ul AITY t_Equal(xAR P_flag,s(0,1)) ulen dtest ultest_dcomplex_arery_args ,'GL!sor(GLe ul vALLaarg(x very,_r'x very',ssor(ault = (/(1._8,0._8),(0._8,1._8),(-1._8,0._8)/ ) ul vALLaarg(x flag, s'x flag',ssflag = '-f' ) ul vALLaarg(xalflagar'xalflag',sAR P_flag = '--flag' ) ul !ssup y s vALLaadd_cmd('-f',sssss'(1,0),(0,1),(-1,0)' ) ul vALLaadd_cmd('--flag',s'(1,0),s(0,1),s(-1,0)') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Arery_Equal(x very,_r(/(1_8,0_8),(0_8,1_8),(-1_8,0_8)/ ) ul AITY t_Arery_Equal(x flag, s(/(1_8,0_8),(0_8,1_8),(-1_8,0_8)/ ) ul AITY t_Arery_Equal(x lflagar(/(1_8,0_8),(0_8,1_8),(-1_8,0_8)/ ) ulen dtest ultest_ctrl_,phy ul TEGEllls:: r nkS#ifor(NE�MPIl Pu vALLaMPI_Comm_R nk(MPI_COMM_WORLD, r nk,_info)S#en S Pu ! auto enables_ctrl_,phy ul vALLareset ,'GL! or(GLe ul vALLaarg(ior(ault,_'ior(ault',sctrl_name =_'ior(ault') ul vALLaarg(iflag, s _' iflag',sctrl_name =_'iflag',sflag='-f') ul vALLaarg(gor(ault,_'gor(ault',sctrl_name =_'gor(ault') ul vALLaarg(ror(ault,_'ror(ault',sctrl_name =_'ror(ault') ul vALLaarg(dor(ault,_'dor(ault',sctrl_name =_'dor(ault') ul vALLaarg(cor(ault,_'cor(ault',sctrl_name =_'cor(ault') ul vALLaarg(lor(ault,_'lor(ault',sctrl_name =_'lor(ault') ul vALLaarg(por(ault,_'por(ault',sctrl_name =_'por(ault') ul vALLaarg(xor(ault,_'xor(ault',sctrl_name =_'xor(ault') ul vALLaarg(i very,_r_' p very',sctrl_name =_'i very') ul vALLaarg(g very,_r_' g very',sctrl_name =_'g very') ul vALLaarg(r very,_r_' r very',sctrl_name =_'r very') ul vALLaarg(d very,_r_' d very',sctrl_name =_'d very') ul vALLaarg(c very,_r_' c very',sctrl_name =_'c very') ul vALLaarg(l very,_r_' l very',sctrl_name =_'l very') ul vALLaarg(p very,_r_' p very',sctrl_name =_'p very') ul vALLaarg(x very,_r_' x very',sctrl_name =_'x very') ul ! openx,physe howrieing ,'GLscf = 123 ul TF (r nk .EQ. 0) THEOS Pu annOPEN(scf, FILE='imatctrl/test/__test_ctrl', IOSTAT=ios, ACTION='WRITE') ul l AITY t_Equal(ios, 0) ul l WRITE(scf,'(A)')_'ior(ault = 42' ul l WRITE(scf,'(A)')_'iflag = 42' ul l WRITE(scf,'(A)')_'gor(ault = 42' ul l WRITE(scf,'(A)')_'ror(ault = 0.1337' ul l WRITE(scf,'(A)')_'dor(ault = 0.1337' ul l WRITE(scf,'(A)')_'cor(ault = hrkljus' ul l WRITE(scf,'(A)')_'lor(ault = T' ul l WRITE(scf,'(A)')_'por(ault = (0,1)' ul l WRITE(scf,'(A)')_'xor(ault = (0,1)' ul l WRITE(scf,'(A)')_'i very = 1,_r_2,sss3' ul l WRITE(scf,'(A)')_'g very = 1,_r_2,sss3' ul l WRITE(scf,'(A)')_'r very = 1.1,s2.2,s3.3' ul l WRITE(scf,'(A)')_'d very = 1.1,s2.2,s3.3' ul l WRITE(scf,'(A)')_'c very = foo, bar, baz' ul l WRITE(scf,'(A)')_'l very = T,sssF,sssT' ul l WRITE(scf,'(A)')_'p very = (1,0),s(0,1),s(-1,0)' ul l WRITE(scf,'(A)')_'x very = (1,0),s(0,1),s(-1,0)' ul l CLOSE(scf) ul st i>Fl Pu !ssup yUargS Pu vALLaadd_cmd('�matctrl/test/__test_ctrl') ul vALLaadd_cmd('-f',s'1337') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(ior(ault,_ _42)S Pu AITY t_Equal(iflag, s _ _1337)_haflags overrior controlx,phys!S Pu AITY t_Equal(gor(ault,_ _42)S Pu AITY t_Equal(ror(ault,_ _0.1337)S Pu AITY t_Equal(dor(ault,_ _0.1337_8)S Pu AITY t_Equal(cor(ault,_ss'hrkljus') ul AITY t_True(lor(ault) ul AITY t_Equal(por(ault,_ss(0,1)) ul AITY t_Equal(xor(ault,_ss(0,1)) ul AITY t_Arery_Equal(i very,_(/1,s2,s3/)) ul AITY t_Arery_Equal(g very,_(/1,s2,s3/)) ul AITY t_Arery_Equal(r very,_(/1.1,s2.2,s3.3/)) ul AITY t_Arery_Equal(d very,_(/1.1_8, 2.2_8, 3.3_8/)) ul AITY t_Arery_Equal(c very,_(/'foo', 'bar', 'baz'/ ) ul AITY t_LArery_Equal(l very,_(/.true., .falsti,!.true./ ) ul AITY t_Arery_Equal(p very,_(/(1,0),s(0,1),s(-1,0)/ ) ul AITY t_Arery_Equal(x very,_(/(1_8,0_8), (0_8,1_8), (-1_8,0_8)/ ) ul ! cleanup ,'GLTF (r nk .EQ. 0) THEOS Pu annvALLaSYSTEM('/bin/rm �matctrl/test/__test_ctrl') ul st i>Fl Pen dtest ultest_dr(ault_funcsS#ifor(NE�F2003 s !strocedure_drcl vahe Gs ,'GLtrocedure(peedger_func)annnnnnnpee_or( ,'GLtrocedure(peedger_func)annnnnnnrevet�_on_fail ,'GLtrocedure(AR Ppee_func)annnnnnnl P_or( ,'GLtrocedure(single_func)annnnnnnafle_or( ,'GLtrocedure(double_func)annnnnnnadbl_or( ,'GLtrocedure(stri P_func)annnnnnnachr_or( ,'GLtrocedure(ARgical_func)annnnnnnloP_or( ,'GLtrocedure(complex_func)annnnnnncpx_or( ,'GLtrocedure(dcomplex_func)annnnnndcp_or( ,'GLtrocedure(peedger_arery_func)anpeea_or( ,'GLtrocedure(AR Ppee_arery_func)anl Pa_or( ,'GLtrocedure(single_arery_func)annflea_or( ,'GLtrocedure(double_arery_func)anndbla_or( ,'GLtrocedure(stri P_arery_func)annchra_or( ,'GLtrocedure(ARgical_arery_func)anloPa_or( ,'GLtrocedure(complex_arery_func)ancpxa_or( ,'GLtrocedure(dcomplex_arery_func)adcpa_or( ,'GL! or(GLe ul vALLaarg(ior(ault,_'ior(ault',sdr(ault_func = pee_or() ul vALLaarg(iflag, s _'iflag',ssssdr(ault_func = revet�_on_fail,o&S Pu annnnnnnnflag = '-f',sor(ault = 42)_haonsdr(ault_func fail,orevet�stoUdr(ault! ul vALLaarg(gor(ault,_'gor(ault',sdr(ault_func = l P_or() ul vALLaarg(ror(ault,_'ror(ault',sdr(ault_func = fle_or() ul vALLaarg(dor(ault,_'dor(ault',sdr(ault_func = dbl_or() ul vALLaarg(cor(ault,_'cor(ault',sdr(ault_func = chr_or() ul vALLaarg(lor(ault,_'lor(ault',sdr(ault_func = loP_or() ul vALLaarg(por(ault,_'por(ault',sdr(ault_func = cpx_or() ul vALLaarg(xor(ault,_'xor(ault',sdr(ault_func = dcp_or() ul vALLaarg(i very,_r_'p very',sssdr(ault_func = peea_or() ul vALLaarg(g very,_r_'g very',sssdr(ault_func = l Pa_or() ul vALLaarg(r very,_r_'r very',sssdr(ault_func = flea_or() ul vALLaarg(d very,_r_'d very',sssdr(ault_func = dbla_or() ul vALLaarg(c very,_r_'c very',sssdr(ault_func = chra_or() ul vALLaarg(l very,_r_'l very',sssdr(ault_func = loPa_or() ul vALLaarg(p very,_r_'p very',sssdr(ault_func = cpxa_or() ul vALLaarg(x very,_r_'x very',sssdr(ault_func = dcpa_or() ul !ssup y s vALLaadd_cmd('-f','51') s !st1)se ,'GLvALLat1)se_args(info)S Pu !dtest annAITY t_Equal(ior(ault,_42 ) ul AITY t_Equal(iflag, s _42 ) ul AITY t_Equal(gor(ault,_42 ) ul AITY t_Equal(ror(ault,_0.1337 ) ul AITY t_Equal(dor(ault,_0.1337_8 ) ul AITY t_Equal(cor(ault,_"hrkljus") ul AITY t_True(lor(ault) ul AITY t_Equal(por(ault,_(0,1) ) ul AITY t_Equal(xor(ault,_(0_8,1_8)) ul AITY t_Arery_Equal( i very,_(/1,s2,s3/)) ul AITY t_Arery_Equal( g very,_(/1,s2,s3/)) ul AITY t_Arery_Equal( r very,_(/1.1,s2.2,s3.3/)) ul AITY t_Arery_Equal( d very,_(/1.1_8, 2.2_8, 3.3_8/)) ul AITY t_Arery_Equal( c very,_(/'foo', 'bar', 'baz'/ ) ul AITY t_LArery_Equal(l very,_(/.true., .falsti,!.true./ ) ul AITY t_Arery_Equal( p very,_(/(1,0),(0,1),(-1,0)/ ) ul AITY t_Arery_Equal( x very,_(/(1_8,0_8),(0_8,1_8),(-1_8,0_8)/ ) #elseS Pu wriee(*,*) "WARNING: Dr(ault funche GN an dvalidatorN are_notssup orted!!!"S#en S Pen dtest en dtest_suite S#ifor(NE�F2003 logicalsfunche G pee_or((var) speedger,spopeedt,speednt(in)s:: varl PvarN= 42 nnpee_or( = .true. en dfunche G pee_or( logicalsfunche G revet�_on_fail(var) speedger,spopeedt,speednt(in)s:: varl Prevet�_on_fail = .falsti en dfunche G revet�_on_fail logicalsfunche G l P_or((var) speedger(8),spopeedt,speednt(in)s:: varl PvarN= 42 nnl P_or( = .true. en dfunche G l P_or( logicalsfunche G fle_or((var) sreal,spopeedt,speednt(in)s:: varl PvarN= 0.1337 nafle_or( = .true. en dfunche G fle_or( logicalsfunche G dbl_or((var) sreal(8),spopeedt,speednt(in)s:: varl PvarN= 0.1337_8 nadbl_or( = .true. en dfunche G dbl_or( logicalsfunche G chr_or((var) scharacter(len=*),spopeedt,speednt(in)s:: varl PvarN= "hrkljus" nachr_or( = .true. en dfunche G chr_or( logicalsfunche G loP_or((var) slogical,spopeedt,speednt(in)s:: varl PvarN= .true. nnloP_or( = .true. en dfunche G loP_or( logicalsfunche G cpx_or((var) scomplex,spopeedt,speednt(in)s:: varl PvarN= (0,1) nncpx_or( = .true. en dfunche G cpx_or( logicalsfunche G dcp_or((var) scomplex(8),spopeedt,speednt(in)s:: varl PvarN= (0_8,1_8) nndcp_or( = .true. en dfunche G dcp_or( logicalsfunche G peea_or((var) speedger,sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/1,2,3/) anpeea_or( = .true. en dfunche G peea_or( logicalsfunche G l Pa_or((var) speedger(8),sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/1,2,3/) anl Pa_or( = .true. en dfunche G l Pa_or( logicalsfunche G flea_or((var) sreal,sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/1.1,2.2,3.3/) nnflea_or( = .true. en dfunche G flea_or( logicalsfunche G dbla_or((var) sreal(8),sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/1.1_8,2.2_8,3.3_8/) nndbla_or( = .true. en dfunche G dbla_or( logicalsfunche G chra_or((var) scharacter(len=*),sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/'foo','bar','baz'/ nnchra_or( = .true. en dfunche G chra_or( logicalsfunche G loPa_or((var) slogical,sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/.true.,.falsti,.true./ anloPa_or( = .true. en dfunche G loPa_or( logicalsfunche G cpxa_or((var) scomplex,sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/(1,0),(0,1),(-1,0)/ ancpxa_or( = .true. en dfunche G cpxa_or( logicalsfunche G dcpa_or((var) scomplex(8),sdimenyrig(:),spopeedt,speednt(in)s:: varl PvarN= (/(1,0),(0,1),(-1,0)/ andcpa_or( = .true. en dfunche G dcpa_or( #en S��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/or(ault�������������������������������������������������40540�dedeeeeeeeeee�de "util/p4�037415��������������00276��������������16510����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLDO i=1,WRAP(DTYPE)_args_il Pu annIF (WRAP(DTYPE)_args(i)%or(ault_set) &S Pu annnnnnnWRAP(DTYPE)_args(i)%variablh = WRAP(DTYPE)_args(i)%or(aultl Pu st iDO #rror(NDTYPE S����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/validate�������������������������������������������������40540�dedeeeeeeeeee�d "util/p4�037415��������������01057��������������166������������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLE_LDO i=1,WRAP(DTYPE)_args_il Pu annnnnIF (WRAP(DTYPE)_args(i)%validator_set) THEOS Pu annnnnnnnIF (.NOT.!WRAP(DTYPE)_args(i)%validator(WRAP(DTYPE)_args(i)%variablh)) THEOS Pu annnnnnnn __WRITE (cvar,*) 'Argument ',hWRAP(DTYPE)_args(i)%name(1:LEN_TRIM(WRAP(DTYPE)_args(i)%name)),o&S Pu annnnnnnneeeeeeee' failsdvalidatorscheck!'S Pu annnnnnnner_info = 3d_error_fatal ,'GLE_LesserrrrrvALLa 3d_error( 3d_err_argument,oupller,ocvar, E�TINE__,_info)S Pu annnnnnnner_GOTO 9999S Pu annnnnnnnst i>Fl Pu annnnnst i>Fl Pu annst iDO #rror(NDTYPE ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/ctrl�������������������������������������������������40540�dedeeeeeeeeeeeeeeee "util/p4�037415��������������04050��������������160215���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLE_LDO j=1,WRAP(DTYPE)_args_il Pu annnnnIF (WRAP(DTYPE)_args(j)%g,t�lnnn.EQ. k .AND.o&S Pu annnnnnnneWRAP(DTYPE)_args(j)%g,t�l_in.EQ. i) THEOSS Pu annnnnnnnIF (WRAP(DTYPE)_args(j)%ctrl_name_set) THEOS Pu annnnnnnner_WRITE (scratch, *) g,t�l_max_len(k)S Pu annnnnnnner_WRITE (*,'(A' // scratch(1:LEN_TRIM(scratch)) // ')',advance='no') &S Pu annnnnnnnnnnnnnneWRAP(DTYPE)_args(j)%ctrl_name &S Pu annnnnnnneeeeeeee(1:LEN_TRIM(WRAP(DTYPE)_args(j)%ctrl_name))lS Pu annnnnnnneeeIF (WRAP(DTYPE)_args(j)%or(ault_set) THEOS#ifor(NE�sTRINGS#ifor(NARRAYS Pu annnnnnnneeeeeeWRITE (*,'(A)',advance='no') '= 'S Pu annnnnnnner_ _LDO l=LBOUND(WRAP(DTYPE)_args(j)%or(ault,1),s&S Pu annnnnnnneeeeeeeeeeeUBOUND(WRAP(DTYPE)_args(j)%or(ault,1)S Pu annnnnnnneeeeeeeeeWRITE (*,'(2A)',advance='no') &S Pu annnnnnnneeeeeeeeeee neWRAP(DTYPE)_args(j)%or(ault(l) &S Pu annnnnnnneeeeeeeeeee ne(1:LEN_TRIM(WRAP(DTYPE)_args(j)%or(ault(l))),o&S Pu annnnnnnneeeeeeeeeeeeee', 'S Pu annnnnnnneeeeeest iDO annnnnnnneeeeeeeeeWRITE (*,'(A)')_''l#elseS Pu annnnnnnner_LE_WRITE (*,*) "= ",hWRAP(DTYPE)_args(j)%or(aulto&S Pu annnnnnnneeeeeeeeeee(1:LEN_TRIM(WRAP(DTYPE)_args(j)%or(ault))S#en S#elseS#ifor(NARRAYS Pu annnnnnnneeeeeeDO l=LBOUND(WRAP(DTYPE)_args(j)%or(ault,1),s&S Pu annnnnnnneeeeeeeeeeeUBOUND(WRAP(DTYPE)_args(j)%or(ault,1)S Pu annnnnnnneeeeeeeeeWRITE(scratch,*) WRAP(DTYPE)_args(j)%or(ault(l)S Pu annnnnnnneeeeeeeeeWRITE (*,'(A)',advance='no') &S Pu annnnnnnneeeeeeeeeee nescratch(1:LEN_TRIM(scratch))S Pu annnnnnnneeeeeeeeeIF (ln.EQ. UBOUND(WRAP(DTYPE)_args(j)%or(ault,1)) THEOS Pu annnnnnnner_eeeeeeeeeWRITE (*,*) ''S Pu sLrsS Pu annnnnnnner_eeeeeeeeeWRITE (*,'(A)',advance='no') ', 'S Pu annnnnnnneeeeee nnst i>Fl Pu annnnneeeeee nnst iDO #elseS Pu annnnnnnner_LE_WRITE (scratch, *) WRAP(DTYPE)_args(j)%or(aultS Pu annnnnnnner_LE_scratch = ADJUSTL(scratch)S Pu annnnnnnner_LE_WRITE (*,*) "= ",hscratch(1:LEN_TRIM(scratch))S#en S#en S Pu nnneeeeee nnst i>Fl Pu annnnneeest i>Fll Pu annnnneeeCYCLEPvar_loopl Pu annnnnst i>Fl Pu annst iDO #rror(NDTYPE #rror(NE�sTRINGS����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/minmax�������������������������������������������������40540�dedeeeeeeeeeeeeee "util/p4�037415��������������03236��������������163545���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLDO i=1,WRAP(DTYPE)_args_il Pu annIF (WRAP(DTYPE)_args(i)%min_set) THEOS#ifor(NARRAYS#ifor(NE�sTRINGS Pu annnnnIF (ANY(LEN_TRIM(WRAP(DTYPE)_args(i)%variablh) .LT.!WRAP(DTYPE)_args(i)%min)) THEOS#elseS Pu annnnnIF (ANY(WRAP(DTYPE)_args(i)%variablh .LT.!WRAP(DTYPE)_args(i)%min)) THEOS#en S#elseS#ifor(NE�sTRINGS Pu annnnnIF (LEN_TRIM(WRAP(DTYPE)_args(i)%variablh) .LT.!WRAP(DTYPE)_args(i)%min) THEOS#elseS Pu annnnnIF (WRAP(DTYPE)_args(i)%variablh .LT.!WRAP(DTYPE)_args(i)%min) THEOS#en S#en S Pu nnneeeeeeWRITE (cvar,*) 'Argument ',hWRAP(DTYPE)_args(i)&S Pu annnnnnnneeeee&%name(1:LEN_TRIM(WRAP(DTYPE)_args(i)%name)),o&S Pu annnnnnnneeeee' failsdmin check!'S Pu annnnnnnninfo = 3d_error_fatal ,'GLE_LesserrvALLa 3d_error( 3d_err_argument,oupller,ocvar, E�TINE__,_info)S Pu annnnnnnnGOTO 9999S Pu annnnnst i>Fl Pu annst i>Fl Pu annIF (WRAP(DTYPE)_args(i)%max_set) THEOS#ifor(NARRAYS#ifor(NE�sTRINGS Pu annnnnIF (ANY(LEN_TRIM(WRAP(DTYPE)_args(i)%variablh) .GT.!WRAP(DTYPE)_args(i)%max)) THEOS#elseS Pu annnnnIF (ANY(WRAP(DTYPE)_args(i)%variablh .GT.!WRAP(DTYPE)_args(i)%max)) THEOS#en S#elseS#ifor(NE�sTRINGS Pu annnnnIF (LEN_TRIM(WRAP(DTYPE)_args(i)%variablh) .GT.!WRAP(DTYPE)_args(i)%max) THEOS#elseS Pu annnnnIF (WRAP(DTYPE)_args(i)%variablh .GT.!WRAP(DTYPE)_args(i)%max) THEOS#en S#en S Pu nnneeeeeeWRITE (cvar,*) 'Argument ',hWRAP(DTYPE)_args(i)&S Pu annnnnnnneeeee&%name(1:LEN_TRIM(WRAP(DTYPE)_args(i)%name)),o&S Pu annnnnnnneeeee' failsdmax check!'S Pu annnnnnnninfo = 3d_error_fatal ,'GLE_LesserrvALLa 3d_error( 3d_err_argument,oupller,ocvar, E�TINE__,_info)S Pu annnnnnnnGOTO 9999S Pu annnnnst i>Fl Pu annst i>Fl Pu st iDO #rror(NDTYPE #rror(NE�sTRINGS������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/help�������������������������������������������������40540�dedeeeeeeeeeeeeeeee "util/p4�037415��������������07164��������������160175���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'GLE_LDO j=1,WRAP(DTYPE)_args_il Pu annnnnIF (WRAP(DTYPE)_args(j)%g,t�ln.EQ. k .AND.o&S Pu annnnnnnneWRAP(DTYPE)_args(j)%g,t�l_in.EQ. i .AND.o&S Pu annnnnnnn(WRAP(DTYPE)_args(j)%flag_set .OR.nnneeeee&S Pu annnnnnnneWRAP(DTYPE)_args(j)%AR P_flag_set)) THEOS Pu annnnnnnnWRITE (*,'(A,A)',advance='no') " ",hWRAP(DTYPE)_args(j)%name(1:28)S Pu annnnnnnnIF (WRAP(DTYPE)_args(j)%help_set) THEOS Pu annnnnnnner_WRITE (*,'(A)',advance='no') " " ,'GLE_LesserrrrrvALLabreak_help(WRAP(DTYPE)_args(j)%helpeeeee&S Pu annnnnnnnennnnnnn(1:LEN_TRIM(WRAP(DTYPE)_args(j)%help)),o&S Pu annnnnnnneeeeeeee50, " ",h6)S Pu annnnnnnnsLrsS Pu annnnnnnner_WRITE (*,*) ''S Pu st i>Fl Pu annnnneeeIF (WRAP(DTYPE)_args(j)%flag_set)o&S Pu annnnnnnneeeeeWRITE (*,*) " Pu annnnnnnneeeee but�lflag : ",h&S#if or(GLed(ARRAY)S Pu annnnnnnner_LEWRAP(DTYPE)_args(j)%flag(1:2), " <v1,v2,...>"S#elif !or(GLed(E�TOGIvAL)S Pu annnnnnnner_LEWRAP(DTYPE)_args(j)%flag(1:2), " <valuw>"S#elseS Pu annnnnnnner_LEWRAP(DTYPE)_args(j)%flag(1:2)S#en S Pu nnneeeeeeIF (WRAP(DTYPE)_args(j)%AR P_flag_set)o&S Pu annnnnnnneeeeeWRITE (*,*) " Pu annnnnnnneeeeesAR PUflag : ",h&S#if or(GLed(ARRAY)S Pu annnnnnnner_LEWRAP(DTYPE)_args(j)%AR P_flag(1:(LEN_TRIM(WRAP(DTYPE)_args(j)%AR P_flag))),o&S Pu annnnnnnneeeee" <v1,v2,...>"S#elif !or(GLed(E�TOGIvAL)S Pu annnnnnnner_LEWRAP(DTYPE)_args(j)%AR P_flag(1:(LEN_TRIM(WRAP(DTYPE)_args(j)%AR P_flag))),o&S Pu annnnnnnneeeee" <valuw>"S#elseS Pu annnnnnnner_LEWRAP(DTYPE)_args(j)%AR P_flag(1:(LEN_TRIM(WRAP(DTYPE)_args(j)%AR P_flag)))S#en S Pu nnneeeeeeIF (WRAP(DTYPE)_args(j)%ctrl_name_set) &S Pu annnnnnnneeeeeWRITE (*,*) " Pu annnnnncontrolx,physname : ",h&S Pu annnnnnnner_LEWRAP(DTYPE)_args(j)%ctrl_name(1:LEN_TRIM(WRAP(DTYPE)_args(j)%ctrl_name)),h&S#ifor(NARRAYS Pu annnnnnnneeeee" = <v1,v2,...>"S#elseS Pu annnnnnnner_LE" = <valuw>"S#en S Pu nnneeeeeeIF (WRAP(DTYPE)_args(j)%or(ault_set) THEOSu annnnnnnneeeeeWRITE (*,'(A)',advance='no') " or(aultovaluw : "S#ifor(NE�sTRINGS#ifor(NARRAYS Pu annnnnnnneeeWRITE (*,'(A)',advance='no') ' 'S Pu annnnnnnneeeDO l=LBOUND(WRAP(DTYPE)_args(j)%or(ault,1),s&S Pu annnnnnnneeeeeeeeUBOUND(WRAP(DTYPE)_args(j)%or(ault,1)S Pu annnnnnnneeeeeeWRITE (*,'(2A)',advance='no') &S Pu annnnnnnneeeeeeeeeeeWRAP(DTYPE)_args(j)%or(ault(l) &S Pu annnnnnnneeeeeeeeeee(1:LEN_TRIM(WRAP(DTYPE)_args(j)%or(ault(l))),o&S Pu annnnnnnneeeeeeeeeee', 'S Pu annnnnnnneeest iDO annnnnnnneeeeeeWRITE (*,'(A)')_''l#elseS Pu annnnnnnner_WRITE (*,*) WRAP(DTYPE)_args(j)%or(aulto&S Pu annnnnnnneeeeeeee(1:LEN_TRIM(WRAP(DTYPE)_args(j)%or(ault))S#en S#elseS Pu annnnnnnner_WRITE(scratch, *) WRAP(DTYPE)_args(j)%or(aultS Pu annnnnnnner_scratch = ADJUSTL(scratch)S Pu annnnnnnner_WRITE(*,*) scratch(1:LEN_TRIM(scratch))S#en S annnnnnnneeest i>Fl#if or(GLed(__TEGElll) || or(GLed(E�TONGTEG) || or(GLed(E�SINGLE) || or(GLed(E�DOUBLE)S Pu nnneeeeeeIF (WRAP(DTYPE)_args(j)%min_set) THEOS Pu annnnnnnner_WRITE(scratch, *) WRAP(DTYPE)_args(j)%minS Pu annnnnnnner_scratch = ADJUSTL(scratch)S Pu annnnnnnner_WRITE (*,*) " Pu annnnnnnneeminimumovaluw : ",h&S Pu annnnnnnner_LE nescratch(1:LEN_TRIM(scratch))S Pu annnnnnnnst i>Fl Pu annnnneeeIF (WRAP(DTYPE)_args(j)%max_set) THEOS Pu annnnnnnner_WRITE(scratch, *) WRAP(DTYPE)_args(j)%maxS Pu annnnnnnner_scratch = ADJUSTL(scratch)S Pu annnnnnnner_WRITE (*,*) " Pu annnnnnnneemaximumovaluw : ",h&S Pu annnnnnnner_LE nescratch(1:LEN_TRIM(scratch))S Pu annnnnnnnst i>Fl#en S Pu nnneeeeeeWRITE(*,*) "" ,'GLE_LesserrCYCLEPg,t�l_loopl Pu annnnnst i>Fl Pu annst iDO #rror(NDTYPE #rror(NE�TEGElll #rror(NE�TONGTEG #rror(NE�sINGLE #rror(NE�DOUBLE #rror(NE�TOGIvAL #rror(NE�sTRINGS������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/oump�������������������������������������������������40540�dedeeeeeeeeeeeeeeee "util/p4�037415��������������01710��������������1602�����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� neeeeeeWRITE (*,'(A/)') ' 'S Pu annWRITE (*,*) "name : ",hWRAP(DTYPE)_args(i)%name(1:LEN_TRIM(WRAP(DTYPE)_args(i)%name))S#ifor(NE�sTRINGS Pu annWRITE (*,*) "valuw : ",hWRAP(DTYPE)_args(i)%variablh(1:LEN_TRIM(WRAP(DTYPE)_args(i)%variablh))S#elseS Pu annWRITE (*,*) "valuw : ",hWRAP(DTYPE)_args(i)%variablhl#en S Pu nnnWRITE (*,*) "flag : ",hWRAP(DTYPE)_args(i)%flag(1:LEN_TRIM(WRAP(DTYPE)_args(i)%flag))S Pu nnnWRITE (*,*) "AR P-flag : ",hWRAP(DTYPE)_args(i)%AR P_flag(1:LEN_TRIM(WRAP(DTYPE)_args(i)%AR P_flag))S Pu nnnWRITE (*,*) "ctrl-name : ",hWRAP(DTYPE)_args(i)%ctrl_name(1:LEN_TRIM(WRAP(DTYPE)_args(i)%ctrl_name))l Pu nnnWRITE (*,*) "or(aulto : ",hWRAP(DTYPE)_args(i)%or(aultS#ifror(NE�TOGIvAL #ifror(NE�sTRINGS Pu annWRITE (*,*) "min : ",hWRAP(DTYPE)_args(i)%minS Pu annWRITE (*,*) "max : ",hWRAP(DTYPE)_args(i)%maxS#en S#en S Pu nnnWRITE (*,*) "helpeeeee : ",hWRAP(DTYPE)_args(i)%help(1:LEN_TRIM(WRAP(DTYPE)_args(i)%help))S��������������������������������������������������������nquir!����estimatctrl/Uyp0�������������������������������������������������40540�dedeeeeeeeeeeeeeeee "util/p4�037415��������������12536��������������160475���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t S PTYPEhWRAP(DTYPE)_arg S#ifor(NARRAYSS#ifor(NE�TEGElll eeee TEGElll, DIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee TEGElll, DIMENSION(:),sALLOCATABLEs:: or(aultS#elif or(GLed(E�TONGTEG) eeee TEGElll( 3d_kind_int64),ssDIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee TEGElll( 3d_kind_int64),ssDIMENSION(:),sALLOCATABLEs:: or(aultS#elif or(GLed(E�SINGLE) eeee REAL( 3d_kind_single),ssssDIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee REAL( 3d_kind_single),ssssDIMENSION(:),sALLOCATABLEs:: or(aultS#elif or(GLed(E�DOUBLE)S Pu nREAL( 3d_kind_double),ssssDIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee REAL( 3d_kind_double),ssssDIMENSION(:),sALLOCATABLEs:: or(aultS#elif or(GLed(E�TOGIvAL)S Pu aTOGIvAL, DIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee TOGIvAL, DIMENSION(:),sALLOCATABLEs:: or(aultS#elif or(GLed(E�STRING) eeee CHARACGER(LEN= 3d_char),ssDIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee CHARACGER(LEN= 3d_char),ssDIMENSION(:),sALLOCATABLEs:: or(aultS#elif or(GLed(E�COMPLEX) eeee COMPLEX( 3d_kind_single),sDIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee COMPLEX( 3d_kind_single),sDIMENSION(:),sALLOCATABLEs:: or(aultS#elif or(GLed(E�DCOMPLEX) eeee COMPLEX( 3d_kind_double),sDIMENSION(:),sssssPOTEGERs:: variablh => NULL() eeee COMPLEX( 3d_kind_double),sDIMENSION(:),sALLOCATABLEs:: or(aultS#en SS#elseSS#ifor(NE�TEGElll eeee TEGElll, POTEGERs:: variablh => NULL() eeee TEGElll :: or(aultS#elif or(GLed(E�TONGTEG) eeee TEGElll( 3d_kind_int64),ss POTEGERs:: variablh => NULL() eeee TEGElll( 3d_kind_int64) :: or(aultS#elif or(GLed(E�SINGLE) eeee REAL( 3d_kind_single),ssss POTEGERs:: variablh => NULL() eeee REAL( 3d_kind_single) :: or(aultS#elif or(GLed(E�DOUBLE)S Pu nREAL( 3d_kind_double),ssss POTEGERs:: variablh => NULL() eeee REAL( 3d_kind_double) :: or(aultS#elif or(GLed(E�TOGIvAL)S Pu aTOGIvAL, POTEGERs:: variablh => NULL() eeee TOGIvAL :: or(aultS#elif or(GLed(E�STRING) eeee CHARACGER(LEN= 3d_char),ss POTEGERs:: variablh => NULL() eeee CHARACGER(LEN= 3d_char) :: or(aultS#elif or(GLed(E�COMPLEX) eeee COMPLEX( 3d_kind_single),s POTEGERs:: variablh => NULL() eeee COMPLEX( 3d_kind_single) :: or(aultS#elif or(GLed(E�DCOMPLEX) eeee COMPLEX( 3d_kind_double),s POTEGERs:: variablh => NULL() eeee COMPLEX( 3d_kind_double) :: or(aultS#en SS#en SS#ifor(NE�TEGElll eeee TEGElll :: minS Pu aTEGElll :: maxS#elif or(GLed(E�TONGTEG) eeee TEGElll( 3d_kind_int64) :: minS Pu aTEGElll( 3d_kind_int64) :: maxS#elif or(GLed(E�SINGLE) eeee REAL( 3d_kind_single) :: minS Pu aREAL( 3d_kind_single) :: maxS#elif or(GLed(E�DOUBLE)S Pu nREAL( 3d_kind_double) :: minS Pu aREAL( 3d_kind_double) :: maxS#elif or(GLed(E�STRING) ! TEGElll :: minS! TEGElll :: maxS#en S TOGIvAL :: min_set = .FALSE.S TOGIvAL :: max_set = .FALSE.S#if or(GLed(E�TOGIvAL) && !or(GLed(ARRAY)S Pu aTOGIvAL :: Uyp0 = .TRUE. ! enableS#en S TOGIvAL :: or(ault_set = .FALSE.S CHARACGER(LEN=256) :: nameS CHARACGER(LEN=2) :: flagS TOGIvAL :: flag_set = .FALSE.S CHARACGER(LEN=256) :: AR P_flagS TOGIvAL :: AR P_flag_set = .FALSE.S CHARACGER(LEN=256) :: ctrl_nameS TOGIvAL :: ctrl_name_set = .FALSE.S TOGIvAL :: settablh = .FALSE.S CHARACGER(LEN= 3d_char) :: helpS TOGIvAL :: help_set = .FALSE.S TOGIvAL :: clf_sup ied = .FALSE.S TEGElll :: g,t�lS TEGElll :: g,t�l_iS#ifor(NE�F2003 s TOGIvAL :: or(ault_func_set = .FALSE.S TOGIvAL :: validator_set = .FALSE.S PROCEDURE(WRAP(DTYPE)_func), POTEGER, NOPASS :: or(ault_func => NULL() eeee PROCEDURE(WRAP(DTYPE)_func), POTEGER, NOPASS :: validatorssss=> NULL() #en S st iTYPEhWRAP(DTYPE)_arg #rror(NE�TEGElll #rror(NE�TONGTEG #rror(NE�sINGLE #rror(NE�DOUBLE #rror(NE�TOGIvAL #rror(NE�sTRINGS#rror(NE�COMPLEX #rror(NE�DCOMPLEX #rror(NDTYPE ������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimatctrl/adder�������������������������������������������������40540�dedeeeeeeeeeeeeeee "util/p4�037415��������������25643��������������16150����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������eor(GLENWRAP(ax,t ,'SUBROUTINEhWRAP(DTYPE)_add_arg(variablh, name,sflag,sAR P_flag,sctrl_name,h&S Pu ann& or(ault, &l#if or(GLed(__TEGElll) || or(GLed(E�TONGTEG) || or(GLed(E�SINGLE) || or(GLed(E�DOUBLE)S Pu nnn& min, max, &S#elif or(GLed(E�STRING) ! nn& min, max, &S#en S#if or(GLed(E�TOGIvAL) && !or(GLed(ARRAY)S Pu aaaaaaaaaaaaaaaaaaaaaaaaaaaaaUyp0, &S#en S#ifor(NE�F2003 s or(ault_func, validator, &S#en S s help) !!! Adds a newaarg or(GLihe G.S !----------------------------------------------------------------------S ! ArgumentsS !----------------------------------------------------------------------S#ifor(NARRAYSS#ifor(NE�TEGElll eeee TEGElll, DIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee TEGElll, DIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�TONGTEG) eeee TEGElll( 3d_kind_int64),ssDIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee TEGElll( 3d_kind_int64),ssDIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�SINGLE) eeee REAL( 3d_kind_single),ssssDIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee REAL( 3d_kind_single),ssssDIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�DOUBLE)S Pu nREAL( 3d_kind_double),ssssDIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee REAL( 3d_kind_double),ssssDIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�TOGIvAL)S Pu aTOGIvAL, DIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee TOGIvAL, DIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�STRING) eeee CHARACGER(LEN=*),s DIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee CHARACGER(LEN=*),s DIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�COMPLEX) eeee COMPLEX( 3d_kind_single),sDIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee COMPLEX( 3d_kind_single),sDIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�DCOMPLEX) eeee COMPLEX( 3d_kind_double),sDIMENSION(:),sTARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee COMPLEX( 3d_kind_double),sDIMENSION(:),sOPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#en SS#elseSS#ifor(NE�TEGElll eeee TEGElll, TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee TEGElll, OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�TONGTEG) eeee TEGElll( 3d_kind_int64),ss TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee TEGElll( 3d_kind_int64),ss OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�SINGLE) eeee REAL( 3d_kind_single),ssss TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee REAL( 3d_kind_single),ssss OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�DOUBLE)S Pu nREAL( 3d_kind_double),ssss TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee REAL( 3d_kind_double),ssss OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�TOGIvAL)S Pu aTOGIvAL, TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee TOGIvAL, OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�STRING) eeee CHARACGER(LEN=*),s TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee CHARACGER(LEN=*),s OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�COMPLEX) eeee COMPLEX( 3d_kind_single),s TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee COMPLEX( 3d_kind_single),s OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#elif or(GLed(E�DCOMPLEX) eeee COMPLEX( 3d_kind_double),s TARGET,sssTEGENT(INsss)s:: variablhl!!! Global variablh to bin dto. eeee COMPLEX( 3d_kind_double),s OPTIONAL, TEGENT(INsss)s:: or(aultS!!! Dr(aultovaluw.S#en SS#en SS#ifor(NE�TEGElll eeee TEGElll, OPTIONAL, TEGENT(INsss)s:: minS!!! Minimumovaluw ofaarg. eeee TEGElll, OPTIONAL, TEGENT(INsss)s:: maxS!!! Maximumovaluw ofaarg. #elif or(GLed(E�TONGTEG) eeee TEGElll( 3d_kind_int64),ss OPTIONAL, TEGENT(INsss)s:: minS!!! Minimumovaluw ofaarg. eeee TEGElll( 3d_kind_int64),ss OPTIONAL, TEGENT(INsss)s:: maxS!!! Maximumovaluw ofaarg. #elif or(GLed(E�SINGLE) eeee REAL( 3d_kind_single),ssss OPTIONAL, TEGENT(INsss)s:: minS!!! Minimumovaluw ofaarg. eeee REAL( 3d_kind_single),ssss OPTIONAL, TEGENT(INsss)s:: maxS!!! Maximumovaluw ofaarg. #elif or(GLed(E�DOUBLE)S Pu nREAL( 3d_kind_double),ssss OPTIONAL, TEGENT(INsss)s:: minS!!! Minimumovaluw ofaarg. eeee REAL( 3d_kind_double),ssss OPTIONAL, TEGENT(INsss)s:: maxS!!! Maximumovaluw ofaarg. #elif or(GLed(E�STRING) ! TEGElll, OPTIONAL, TEGENT(INsss)s:: minS! !!! Minimumolength ofastri P. ! TEGElll, OPTIONAL, TEGENT(INsss)s:: maxS! !!! Maximumolength ofastri P. #en SS#if or(GLed(E�TOGIvAL) && !or(GLed(ARRAY)S Pu TOGIvAL, OPTIONAL, TEGENT(INsss)s:: Uyp0S!!! Typ0 ofaflag. Logicalsflags require_noovaluw to be sup ied.S!!! Instea dthe behavior orpen saonsthiN argument. On0 of:S!!! enabli P_flags:: Presenc0 ofaflag sets variablh to .TRUE.S!!! disabli P_flags:: Presenc0 ofaflag sets variablh to .FALSE.S#en S s CHARACGER(LEN=*),s TEGENT(INsss)s:: nameS!!! Name ofathe arg for use inathe auto generated usage messagetctrlx,phy.S s CHARACGER(LEN=2),s OPTIONAL, TEGENT(INsss)s:: flagS!!! Singlescharacteraflag (eg. _'-f'_).S s CHARACGER(LEN=*),s OPTIONAL, TEGENT(INsss)s:: AR P_flagS!!! LR PUflag (eg. _'--flag'_). Has to ����t with _'--'_!S s CHARACGER(LEN=*),s OPTIONAL, TEGENT(INsss)s:: ctrl_nameS!!! Controlx,physvariablh name.S s CHARACGER(LEN=*),s OPTIONAL, TEGENT(INsss)s:: helpS!!! Helpestri P for the auto generated usage messagetctrlx,phy.S#ifor(NE�F2003 s PROCEDURE(WRAP(DTYPE)_func), OPTIONAL :: or(ault_funcS!!! Dr(aultofunche G. s PROCEDURE(WRAP(DTYPE)_func), OPTIONAL :: validatorS!!! Validatorsfunche G. #en S s !----------------------------------------------------------------------S ! Local variablhsS !----------------------------------------------------------------------S TYPE(WRAP(DTYPE)_arg),sDIMENSION(:),sPOTEGERs :: tempS TYPE(WRAP(DTYPE)_arg)s :: or(S TEGElll :: lenS s !----------------------------------------------------------------------S ! BodyS s !----------------------------------------------------------------------S ! create or(aultog,t�lS IF (g,t�ls_in.EQ. -1) vALLaarg_g,t�l("General Ophe GN") ul ! allocate initial storageS IF (.NOT.!ASSOCIATED(WRAP(DTYPE)_args)) THEOS Pu annALLOCATE(WRAP(DTYPE)_args(1:di))l Pu nnnWRAP(DTYPE)_args_iN= 0l Pu st i>Fl Pu ! increment coueedt nnnWRAP(DTYPE)_args_iN= WRAP(DTYPE)_args_iN+ 1l Pu ! g,tw storage by di if neededS IF (WRAP(DTYPE)_args_iN.GT.!SIZE(WRAP(DTYPE)_args)) THEOS Pu annALLOCATE(temp(1:SIZE(WRAP(DTYPE)_args)+di))l Pu nnntemp(1:SIZE(WRAP(DTYPE)_args))N= WRAP(DTYPE)_argsl Pu nnnDEALLOCATE(WRAP(DTYPE)_args)l Pu nnnWRAP(DTYPE)_argss=> tempS st i>Fl Pu ! populate structureS or(%variablh s=> variablhl or(%name = nameS ! or(aultovaluwsS#ifor(NARRAYS Pu ALLOCATE(or(%or(ault(LBOUND(or(%variablh,1):UBOUND(or(%variablh,1)))S#en S annor(%or(ault = or(%variablhS annor(%flag = ''S Pu or(%AR P_flag = ''S Pu or(%ctrl_name = ''S Pu or(%helpeeeee = ''S#if or(GLed(__TEGElll) || or(GLed(E�TONGTEG) || or(GLed(E�SINGLE) || or(GLed(E�DOUBLE)S Pu or(%min = -HUGE(min)S Pu or(%max = HUGE(max)S#en S ann! sup iedovaluwsS IF (PRESENT(flag)) THEOS Pu annor(%flag = flagS nnor(%flag_set = .TRUE.S nnor(%settablh = .TRUE.S nng,t�l_has_arg(g,t�ls_i) = .TRUE.S st i>Fl Pu IF (PRESENT(AR P_flag)) THEOS Pu annor(%AR P_flag = AR P_flagS nnor(%AR P_flag_set = .TRUE.S nnor(%settablh = .TRUE.S nng,t�l_has_arg(g,t�ls_i) = .TRUE.S st i>Fl Pu IF (PRESENT(ctrl_name)) THEOS Pu annor(%ctrl_name = ctrl_nameS nnor(%ctrl_name_set = .TRUE.S nnor(%settablh = .TRUE.S nng,t�l_has_ctrl(g,t�ls_i) = .TRUE.S nnlen = LEN_TRIM(ctrl_name)S nnIF (len .GT.!g,t�l_max_len(g,t�ls_i)) g,t�l_max_len(g,t�ls_i) = len S st i>Fl Pu IF (PRESENT(help)) THEOS Pu annor(%helpeeeee = helpS nnor(%help_set = .TRUE.S st i>Fl Pu IF (PRESENT(dr(ault)) THEOS Pu annor(%or(ault = or(aultS Pu annor(%or(ault_set = .TRUE.S st i>Fl#ifor(NE�F2003 s IF (PRESENT(dr(ault_func)) THEOS Pu annor(%or(ault_func => or(ault_funcS Pu annor(%or(ault_func_set = .TRUE.S st i>Fl Pu IF (PRESENT(validator)) THEOS Pu annor(%validatorssss => validatorS Pu annor(%validator_set = .TRUE.S st i>Fl#en S#if or(GLed(__TEGElll) || or(GLed(E�TONGTEG) || or(GLed(E�SINGLE) || or(GLed(E�DOUBLE)S Pu IF (PRESENT(min)) THEOS Pu annor(%min = minS Pu annor(%min_set = .TRUE.S st i>Fl Pu IF (PRESENT(max)) THEOS Pu annor(%max = maxS Pu annor(%max_set = .TRUE.S st i>Fl#elif or(GLed(E�STRING) ! IF (PRESENT(min)) THEOS! nnor(%min = minS! nnor(%min_set = .TRUE.S! st i>Fl! IF (PRESENT(max)) THEOS! nnor(%max = maxS! nnor(%max_set = .TRUE.S! st i>Fl#en S#if or(GLed(E�TOGIvAL) && !or(GLed(ARRAY)S Pu IF (PRESENT(Uyp0)) THEOS Pu annor(%Uyp0 =aaUyp0S st i>Fl#en S !og,t�lS or(%g,t�lnnn =ag,t�ls_iS g,t�l_size(g,t�ls_i) = g,t�l_size(g,t�ls_i) + 1l Pu or(%g,t�l_iN =ag,t�l_size(g,t�ls_i) nnnWRAP(DTYPE)_args(WRAP(DTYPE)_args_i) = or( st iSUBROUTINEhWRAP(DTYPE)_add_arg #rror(NDTYPE #rror(NE�TEGElll #rror(NE�TONGTEG #rror(NE�sINGLE #rror(NE�DOUBLE #rror(NE�TOGIvAL #rror(NE�sTRINGS#rror(NE�COMPLEX #rror(NE�DCOMPLEX ���������������������������������������������������������������������������������������������nquir!����estimat 3d_module_mesh_alloc�������������������������������������������������40540�dedeeee "util/p4�037415��������������04501��������������204415���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_mesh_alloc !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S MODULE 3d_module_mesh_alloc !!! ThiN modulencontainsathe Interfach to 3d_mesh_alloc� !!! !!! [NOTE] !!! The terminology distinguishes betweenameshes andafields !!! (the oaha livi P onathe meshes). Several fields can use theS n!!! same mesh.sMeshes are or(GLed aN pr!�internal TYPES, whereas !!! fields are user-provided arrays.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_mesh_allocS n !----------------------------------------------------------------------S n TEGERFACE 3d_mesh_allocS n MODULE PROCEDURE 3d_mesh_alloc_equiS n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Include the sourceS n !----------------------------------------------------------------------S n CONTAINSSS#include "mesh/ 3d_mesh_alloc_equi.f" S nst iMODULE 3d_module_mesh_alloc �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_tree_alloc�������������������������������������������������40540�dedeeee "util/p4�037415��������������05551��������������2045�����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_tree_alloc !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dr(GLENUyp0s !-------------------------------------------------------------------------Seor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2Seor(GLENE�TREE 3Seor(GLENE�DECOMP 4S MODULE 3d_module_tree_alloc !!! ThiN modulenprovidesathe ,t�tines !!! that allocate tree oaha structures.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfachs to the ,t�tine(s)l Pu nnn !----------------------------------------------------------------------S n TEGERFACE 3d_tree_alloc MODULE PROCEDURE 3d_tree_alloc_ts MODULE PROCEDURE 3d_tree_alloc_td MODULE PROCEDURE 3d_tree_alloc_ds MODULE PROCEDURE 3d_tree_alloc_dd st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the sourceS n !----------------------------------------------------------------------S n CONTAINSSS#or(GLENE�TYPEhE�TREES#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "tree/ 3d_tree_alloc.f" #rror(NE�KIt S#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "tree/ 3d_tree_alloc.f" #rror(NE�KIt S#rror(NE�TYPE S#or(GLENE�TYPEhE�DECOMPS#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "tree/ 3d_tree_alloc.f" #rror(NE�KIt S#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "tree/ 3d_tree_alloc.f" #rror(NE�KIt S#rror(NE�TYPE S st iMODULE 3d_module_tree_alloc �������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_neighlist�������������������������������������������������40540�dedeeeee "util/p4�037415��������������07405�����������5��20331����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_neighlist !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dr(GLENUyp0s !-------------------------------------------------------------------------Seor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2S MODULE 3d_module_neighlist !!! ThiN modulenprovidesaneighborS Pu an!!! search ,t�tines (cell lists, Verlet lists).S nS n USE 3d_module_typ0or(, ONLY: 3d_t_clist nSS n TYPE( 3d_t_clist),sDIMENSION(:),sPOTEGERs :: 3d_clist n PRIVATE :: 3d_clist S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_clist_destroyS n !----------------------------------------------------------------------S n TEGERFACE 3d_clist_destroyS n MODULE PROCEDURE 3d_clist_destroyS n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_neighlist_MkNeighIdxS n !----------------------------------------------------------------------S n TEGERFACE 3d_neighlist_MkNeighIdxS n MODULE PROCEDURE 3d_neighlist_MkNeighIdxS n st i>EGERFACE S n TEGERFACE 3d_neighlist_clist n MODULE PROCEDURE 3d_neighlist_clist_d n MODULE PROCEDURE 3d_neighlist_clist_sS n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_neighlist_vlist n !----------------------------------------------------------------------S n TEGERFACE 3d_neighlist_vlist n MODULE PROCEDURE 3d_neighlist_vlist_d n MODULE PROCEDURE 3d_neighlist_vlist_sS n st i>EGERFACE S S n !----------------------------------------------------------------------S n ! include the source S n !----------------------------------------------------------------------S n CONTAINSSS#include "neighlist/ 3d_clist_destroy.f" S#include "neighlist/ 3d_neighlist_MkNeighIdx.f" S#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "neighlist/ 3d_neighlist_clist��" #rror(NNE�KIt SS#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "neighlist/ 3d_neighlist_clist��" #rror(NNE�KIt SS#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "neighlist/ 3d_neighlist_vlist��" #rror(NNE�KIt SS#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "neighlist/ 3d_neighlist_vlist��" #rror(NNE�KIt SS n st iMODULE 3d_module_neighlist �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_�til_qsort�������������������������������������������������40540�dedeeee "util/p4�037415��������������04711�����������3��2054�����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_�til_qsort !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S eor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2Seor(GLENE�TEGElll 3S MODULE 3d_module_�til_qsort !!! ThiN modulenprovidesathe �tility quicksort ,t�tines.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to the list sorti P ,t�tine n !----------------------------------------------------------------------S n TEGERFACE 3d_�til_qsort MODULE PROCEDURE 3d_�til_qsort_s MODULE PROCEDURE 3d_�til_qsort_d n MODULE PROCEDURE 3d_�til_qsort_iS n st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the sourceS n !----------------------------------------------------------------------S n CONTAINSS#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "�til/ 3d_�til_qsort.f" #rror(NE�KIt SS#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "�til/ 3d_�til_qsort.f" #rror(NE�KIt SS#or(GLENE�KIt iE�TEGElll #include "�til/ 3d_�til_qsort.f" #rror(NE�KIt SS n st iMODULE 3d_module_�til_qsort �������������������������������������������������������nquir!����estimat 3d_module_find_neigh�������������������������������������������������40540�dedeeee "util/p4�037415��������������04723��������������20434����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_find_neigh !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dr(GLENUyp0s !-------------------------------------------------------------------------Seor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2S MODULE 3d_module_find_neigh !!! ThiN modulenprovidesathe decomposihe G ,t�tines.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to neighbor findi P ,t�tine n !----------------------------------------------------------------------S n TEGERFACE 3d_find_neigh MODULE PROCEDURE 3d_find_neigh_s MODULE PROCEDURE 3d_find_neigh_d st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the source S n !----------------------------------------------------------------------S n CONTAINSSS#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "topo/ 3d_find_neigh.f" #rror(NE�KIt SS#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "topo/ 3d_find_neigh.f" #rror(NE�KIt SS st iMODULE 3d_module_find_neigh ���������������������������������������������nquir!����estimat 3d_module_�til_���t2sph�������������������������������������������������40540�dede "util/p4�037415��������������05uti��������������21120����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_�til_���t2sph !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dr(GLENUyp0s !-------------------------------------------------------------------------Seor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2S MODULE 3d_module_�til_���t2sph !!! ThiN modulenprovidesathe ,t�tines !!! that convert c��tesian to �phericalscoordi ates.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfachs to the ,t�tine(s)l Pu nnn !----------------------------------------------------------------------S n TEGERFACE 3d_�til_���t2sph MODULE PROCEDURE 3d_�til_���t2sph_s MODULE PROCEDURE 3d_�til_���t2sph_d st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the sourceS n !----------------------------------------------------------------------S n CONTAINSSS#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "�til/ 3d_�til_���t2sph��" #rror(NE�KIt SS#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "�til/ 3d_�til_���t2sph��" #rror(NE�KIt SS st iMODULE 3d_module_�til_���t2sph ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_map_connect�������������������������������������������������40540�dedeee "util/p4�037415��������������07412�����������3��20625����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_map_connect_distrib !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S MODULE 3d_module_map_connect !!! ThiN modulenprovidesathe mappi P ,t�tines forsconnecte GNS n !----------------------------------------------------------------------S n ! Work listsl Pu nnn !----------------------------------------------------------------------S n TEGElll, DIMENSION(:) ,sPOTEGERs:: id_senda=> NULL()S n TEGElll, DIMENSION(:) ,sPOTEGERs:: id_tempa=> NULL()S n TEGElll, DIMENSION(:) ,sPOTEGERs:: id_inv a=> NULL()S n TEGElll, DIMENSION(:) ,sPOTEGERs:: csenda a=> NULL()S n TEGElll, DIMENSION(:) ,sPOTEGERs:: crecva a=> NULL()S n TEGElll, DIMENSION(:) ,sPOTEGERs:: sendbuffrr => NULL()S n TEGElll, DIMENSION(:) ,sPOTEGERs:: recvbuffrr => NULL()S n TEGElll, DIMENSION(:) ,sPOTEGERs:: tempbuffrr => NULL()S n TEGElll, DIMENSION(:,:),sPOTEGERs:: cd_local a=> NULL()S n TEGElll, DIMENSION(:,:),sPOTEGERs:: psenda a a=> NULL()SS n PRIVATE :: id_send,id_temp,id_inv,csend,crecvS n PRIVATE :: sendbuffrr,recvbuffrr,tempbuffrrS n PRIVATE :: psend,cd_local S n !----------------------------------------------------------------------S n ! Dr(GLENinferfach to 3d_map_connect_distrib n !----------------------------------------------------------------------S n TEGERFACE 3d_map_connect_distrib n MODULE PROCEDURE 3d_map_connect_distrib n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_map_connect_prune n !----------------------------------------------------------------------S n TEGERFACE 3d_map_connect_prune n MODULE PROCEDURE 3d_map_connect_prune n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Dr(GLENintefach to 3d_map_connect_send n !----------------------------------------------------------------------S n TEGERFACE 3d_map_connect_send n MODULE PROCEDURE 3d_map_connect_send n st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the source S n !----------------------------------------------------------------------S n CONTAINSSS#include "map/ 3d_map_connect_distrib.f" S#include "map/ 3d_map_connect_prune.f" S#include "map/ 3d_map_connect_send.f" S nst iMODULE 3d_module_map_connect ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_sub����t�������������������������������������������������40540�dedeeeeee "util/p4�037415��������������04631�����������5��20210����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_sub����t !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dr(GLENUyp0s !-------------------------------------------------------------------------Seor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2S MODULE 3d_module_sub����t !!! ThiN modulenprovidesa�tility ,t�tines.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfachs to sub����t !----------------------------------------------------------------------S n TEGERFACE sub����t MODULE PROCEDURE sub����t_s MODULE PROCEDURE sub����t_d n st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the source S n !----------------------------------------------------------------------S n CONTAINSS S#or(GLENE�KIt iE�sINGLE_PRECISIONS#include "�til/sub����t��" #rror(NE�KIt SS#or(GLENE�KIt iE�DOUBLE_PRECISIONS#include "�til/sub����t��" #rror(NE�KIt SS n st iMODULE 3d_module_sub����t �������������������������������������������������������������������������������������������������������nquir!����estimat 3d_error.h������������������������������������������������������������������������ "util/p4�037415��������������34444�����������3�����315���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Module : 3d_error !-------------------------------------------------------------------------S !S ! Purpose :S !S ! Remarks : ThiN iN a F90 heaorr ,physandanotoa cpp heaorr ,physS ! s���e the latter would sim y do replachments basedoonS ! pattern matchi P andadoesanotorecognizENif somethi P isS ! a variablh name orsnot.S n!S n! Right nowathe de(ault error messages are stored inaaS n! fair y sizeablh array. Maybe there iN a betterS ! soluhe G?S n!S n! The de(ault error message here should report WHAT HASS n! HAPPENED. Where it happened, why andawhat the �srr canS n! do about it should be reported inathe error messageS ! stri P passedoto 3d_error(.). S !S ! Referenchs :S !S ! Revise Gs : !-------------------------------------------------------------------------S ! $Log: 3d_error.h,v $S ! Revise G 1.1.1.1 2007/07/13 10:18:54 ivosS ! CBL verse G ofathe PPMslibraryS !S ! Revise G 1.33 2005/06/23 18:26:19 ivosS ! Heaorr cosmetics.S n!S n! Revise G 1.32 2005/04/21 04:50:56 ivosS ! Added 609.S n!S n! Revise G 1.31 2004/10/28 12:38:19 davidchS ! Fixed numericalsbug inacell lists that resulted inarealsS ! partichys bei P treated aN ghostsl Pu nn! andavice versa. The new ranki P andacell list ,t�tines arel Pu nn! supposedoto be exact. Alll Pu nn! epsilons that were added to the domainsainaororr to reventsS ! the menhe Ged problhms wereS ! removedos���e they are no AR Prr needed.S ! ModifiedoFphys:S ! 3d_�til_rank2d.f 3d_�til_rank3d.f 3d_�til_sort2d.fS ! 3d_�til_sort3d.f 3d_find_duplicates.f 3d_neighlist_clist.fS ! 3d_error.hS n!S n! Revise G 1.30 2004/09/17 14:09:40 ivosS ! Added 608.S n!S n! Revise G 1.29 2004/09/17 12:05:44 ivosS ! Added 305, 704, 705.S n!S n! Revise G 1.28 2004/07/21 13:23:51 hiebersS ! Added 805S n!S n! Revise G 1.27 2004/07/20 16:43:17 ivosS ! Added 706.S n!S n! Revise G 1.26 2004/07/16 14:48:22 ivosS ! Added 903.S n!S n! Revise G 1.25 2004/07/16 14:05:50 ivosS ! Added 408 anda409.S n!S n! Revise G 1.24 2004/05/27 10:40:28 ivosS ! added 211.S n!S n! Revise G 1.23 2004/05/26 07:37:50 ivosS ! Added 210.S n!S n! Revise G 1.22 2004/05/13 11:39:31 ivosS ! Added error 209.S n!S n! Revise G 1.21 2004/05/11 14:51:53 ivosS ! Added ,physdelete errors.S n!S n! Revise G 1.20 2004/05/06 07:28:10 ivosS ! Added I/O error messages.S n!S n! Revise G 1.19 2004/03/31 10:46:57 ivosS ! added 304.S n!S n! Revise G 1.18 2004/03/02 16:24:07 ivosS ! added 703.S n!S n! Revise G 1.17 2004/02/25 13:55:27 ivosS ! Added 607.S n!S n! Revise G 1.16 2004/02/18 12:55:34 michaebeS ! Added 902 (,t�tineanotoready)S n!S n! Revise G 1.15 2004/02/17 16:09:27 ivosS ! Added 605.S n!S n! Revise G 1.14 2004/02/16 12:35:26 michaebeS ! Added enhry 605: bad kick off schhme plus cosmetics.S n!S n! Revise G 1.13 2004/02/16 11:42:05 michaebeS ! Added 901 -- 1000 anda���reased err_msg array size.S n!S n! Revise G 1.12 2004/02/12 14:45:40 ivosS ! Added 304.S n!S n! Revise G 1.11 2004/02/11 14:31:44 ivosS ! Added errors 802 th,t�gh 804.S n!S n! Revise G 1.10 2004/02/10 16:56:49 hiebersS ! added 3d_err_nofftwS n!S n! Revise G 1.9 2004/02/09 11:50:45 ivosS ! Added 702.S n!S n! Revise G 1.8 2004/02/04 17:17:45 ivosS ! Added 604.S n!S n! Revise G 1.7 2004/02/02 15:14:23 waltherS ! Added the error range 701 - 800.S n!S n! Revise G 1.6 2004/02/02 15:08:25 ivosS ! Added some errors.S n!S n! Revise G 1.5 2004/01/26 12:33:02 ivosS ! Added error 504 (used ina 3d_map_p��t��).S n!S n! Revise G 1.4 2004/01/23 15:18:46 ivosS ! Added a few errors.S n!S n! Revise G 1.3 2004/01/22 13:28:49 ivosS ! Added errors 403, 503 anda602.S n!S n! Revise G 1.2 2004/01/21 16:22:57 ivosS ! Renamed error categories accordi g to meeti P.S n!S n! Revise G 1.1 2004/01/19 11:52:28 ivosS ! Initialsim hmentahe G.S n!S n! !-------------------------------------------------------------------------S ! Parpllel PartichysMesh Library (PPM)S n! Institute ofaComputahe GalsScienchS n! ETH Zenhrum, Hirschhngraben 84S ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S CHARACTER(LEN=30),sDIMENSION(1100) :: 3d_err_mesgS !-------------------------------------------------------------------------S ! MPI errors: 001 -- 100 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_nompi = 001S DATA 3d_err_mesg(001) /"MPI hasanotobeen initialized"/S TEGElll, PARAMEGERs:: p3d_err_mpi_fail = 002S DATA 3d_err_mesg(002) /"MPI acte G failed"/S TEGElll, PARAMEGERs:: p3d_err_mpi_term = 003S DATA 3d_err_mesg(003) /"MPI acte G termi ated"/S !-------------------------------------------------------------------------S ! Memory allocate G errors: 101 -- 200 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_alloc = 101S DATA 3d_err_mesg(101) /"Memory allocate G failed"/S TEGElll, PARAMEGERs:: p3d_err_dealloc = 102S DATA 3d_err_mesg(102) /"Deallocate G failed"/S !-------------------------------------------------------------------------S ! Fphy I/O errors: 201 -- 300 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_open = 201S DATA 3d_err_mesg(201) /"Cannotoopen ,phy"/S TEGElll, PARAMEGERs:: p3d_err_close = 202S DATA 3d_err_mesg(202) /"Failed to close ,phy"/S TEGElll, PARAMEGERs:: p3d_err_unit_open = 203S DATA 3d_err_mesg(203) /"I/O-Unit alreadyoopen"/S TEGElll, PARAMEGERs:: p3d_err_no_unit = 204S DATA 3d_err_mesg(204) /"I/O-Unit notoopen"/S TEGElll, PARAMEGERs:: p3d_err_io = 205S DATA 3d_err_mesg(205) /"I/O Error"/S TEGElll, PARAMEGERs:: p3d_err_io_oaha = 206S DATA 3d_err_mesg(206) /"Daha sizENmissmatch"/S TEGElll, PARAMEGERs:: p3d_err_,phys = 207S DATA 3d_err_mesg(207) /"Fphysnotoforro"/S TEGElll, PARAMEGERs:: p3d_err_delete = 208S DATA 3d_err_mesg(208) /"Delete failed"/S TEGElll, PARAMEGERs:: p3d_err_outof_units = 209S DATA 3d_err_mesg(209) /"Out ofaI/O units"/S TEGElll, PARAMEGERs:: p3d_err_daha_miss = 210S DATA 3d_err_mesg(210) /"Missedodaha"/S TEGElll, PARAMEGERs:: p3d_err_read_eor = 211S DATA 3d_err_mesg(211) /"Read past endaofarecord"/S !-------------------------------------------------------------------------S ! Floati P point errors: 301 -- 400 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_div_zero = 301S DATA 3d_err_mesg(301) /"Divise G by zero"/S TEGElll, PARAMEGERs:: p3d_err_sqrt_neg = 302S DATA 3d_err_mesg(302) /"Sq�t ofanegative number"/S TEGElll, PARAMEGERs:: p3d_err_tol_warn = 303S DATA 3d_err_mesg(303) /"Unexpected toleranch"/S TEGElll, PARAMEGERs:: p3d_err_bad_sum = 304S DATA 3d_err_mesg(304) /"Bad sum detected"/S TEGElll, PARAMEGERs:: p3d_err_mat_si Pul = 305S DATA 3d_err_mesg(305) /"Matrix close to si Pular"/S !-------------------------------------------------------------------------S ! Topology andaMappi P errors: 401 -- 500 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_nomap = 401S DATA 3d_err_mesg(401) /"No mappi P or(GLEd"/S TEGElll, PARAMEGERs:: p3d_err_p��t_range = 402S DATA 3d_err_mesg(402) /"Partichys out ofarange forro"/S TEGElll, PARAMEGERs:: p3d_err_p��t_lost = 403S DATA 3d_err_mesg(403) /"Partichys lost"/S TEGElll, PARAMEGERs:: p3d_err_map_incomp = 404S DATA 3d_err_mesg(404) /"Incomplete mappi P"/S TEGElll, PARAMEGERs:: p3d_err_p��t_unass = 405S DATA 3d_err_mesg(405) /"UnassigGed partichys"/S TEGElll, PARAMEGERs:: p3d_err_topo_missm = 406S DATA 3d_err_mesg(406) /"Partichy-Topology missmatch"/S TEGElll, PARAMEGERs:: p3d_err_node_number = 407S DATA 3d_err_mesg(407) /"Invalidanode numberi P"/S TEGElll, PARAMEGERs:: p3d_err_buffrr_empt = 408S DATA 3d_err_mesg(408) /"Buffrr is empty"/S TEGElll, PARAMEGERs:: p3d_err_no_topo = 409S DATA 3d_err_mesg(409) /"No such topology"/S TEGElll, PARAMEGERs:: p3d_err_index_corr = 410S DATA 3d_err_mesg(410) /"Partichysrank corrected"/S !-------------------------------------------------------------------------S ! Invalidaargument: 501 -- 600 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_wrong_dim = 501S DATA 3d_err_mesg(501) /"Invalidadimense G"/S TEGElll, PARAMEGERs:: p3d_err_wrong_prec = 502S DATA 3d_err_mesg(502) /"Invalidaprecise G"/S TEGElll, PARAMEGERs:: p3d_err_argument = 503S DATA 3d_err_mesg(503) /"Invalidaargument"/S TEGElll, PARAMEGERs:: p3d_err_wrong_Uyp0 = 504S DATA 3d_err_mesg(504) /"WrongodahaNUyp0"/S !-------------------------------------------------------------------------S ! Algorithmic/conchptual errors: 601 -- 700 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_rhs_compat = 601S DATA 3d_err_mesg(601) /"RHS violates compatibility"/S TEGElll, PARAMEGERs:: p3d_err_sub_failed = 602S DATA 3d_err_mesg(602) /"Sub,t�tineacall failed"/S TEGElll, PARAMEGERs:: p3d_err_bad_mesh = 603S DATA 3d_err_mesg(603) /"Bad mesh specified"/S TEGElll, PARAMEGERs:: p3d_err_bad_meshop = 604S DATA 3d_err_mesg(604) /"Bad mesh operate G"/S TEGElll, PARAMEGERs:: p3d_err_no_oaha = 605S DATA 3d_err_mesg(605) /"No daha"/S TEGElll, PARAMEGERs:: p3d_err_bad_schko = 606S DATA 3d_err_mesg(606) /"Bad Kickoff schhme selected"/S TEGElll, PARAMEGERs:: p3d_err_rev_time = 607S DATA 3d_err_mesg(607) /"Goi P backward inatime"/S TEGElll, PARAMEGERs:: p3d_err_test_fail = 608S DATA 3d_err_mesg(608) /"Test failed"/S TEGElll, PARAMEGERs:: p3d_err_converge = 609S DATA 3d_err_mesg(609) /"Didanotoconverge"/S !-------------------------------------------------------------------------S ! Decomposihe G errors: 701 -- 800 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_sub�_map = 701S DATA 3d_err_mesg(701) /"Sub domainsanotoassigGed"/S TEGElll, PARAMEGERs:: p3d_err_mesh_miss = 702S DATA 3d_err_mesg(702) /"Mesh points missmatch"/S TEGElll, PARAMEGERs:: p3d_err_sub�_incomp = 703S DATA 3d_err_mesg(703) /"Subs andamesh incompatibhy"/S TEGElll, PARAMEGERs:: p3d_err_no_sub� = 704S DATA 3d_err_mesg(704) /"No subdomainsapresent"/S TEGElll, PARAMEGERs:: p3d_err_few_sub� = 705S DATA 3d_err_mesg(705) /"Not ent�gh subdomains"/S !-------------------------------------------------------------------------S ! Library errors: 801 -- 900 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_nofftw = 801S DATA 3d_err_mesg(801) /"FFTWanotoavailabhy"/S TEGElll, PARAMEGERs:: p3d_err_nometis = 802S DATA 3d_err_mesg(802) /"METISanotoavailabhy"/S TEGElll, PARAMEGERs:: p3d_err_nofishpack = 803S DATA 3d_err_mesg(803) /"CRAYFISHPACKanotoavailabhy"/S TEGElll, PARAMEGERs:: p3d_err_nohypre = 804S DATA 3d_err_mesg(804) /"HYPREanotoavailabhy"/S TEGElll, PARAMEGERs:: p3d_err_noMathKeisan = 805S DATA 3d_err_mesg(805) /"SX MathKeisan notoavailabhy"/S !-------------------------------------------------------------------------S ! Initializate G errors: 901 -- 1000 !-------------------------------------------------------------------------S TEGElll, PARAMEGERs:: p3d_err_multipleinit = 901S DATA 3d_err_mesg(901) /"Doublh Init attempted"/S TEGElll, PARAMEGERs:: p3d_err_notreadyo = 902S DATA 3d_err_mesg(902) /"Rt�tineanotoready"/S TEGElll, PARAMEGERs:: p3d_err_p3d_noinit = 903S DATA 3d_err_mesg(903) /"PPManotoinitialized"/S����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_topo_alloc�������������������������������������������������40540�dedeeee "util/p4�037415��������������05274��������������204775���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_topo_alloc !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dr(GLENUyp0s !-------------------------------------------------------------------------Seor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2S MODULE 3d_module_topo_alloc !!! ThiN modulencontainsathe topology allocate G andadeallocate G !!! sub,t�tines.S !----------------------------------------------------------------------S n ! Dr(GLENinterfachs to topology allocate G ,t�tine n !----------------------------------------------------------------------S n TEGERFACE 3d_topo_alloc MODULE PROCEDURE 3d_topo_alloc st i>EGERFACE S n !----------------------------------------------------------------------S n ! Dr(GLENinterfachs to topology deallocate G ,t�tine n !----------------------------------------------------------------------S n TEGERFACE 3d_topo_dealloc MODULE PROCEDURE 3d_topo_dealloc st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the source S n !----------------------------------------------------------------------S n CONTAINSSS#include "topo/ 3d_topo_alloc��"SS#include "topo/ 3d_topo_dealloc.f" S nst iMODULE 3d_module_topo_alloc ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_�til_�ommoph�������������������������������������������������40540�dedee "util/p4�037415��������������04322�����������5��210515���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_�til_�ommoph !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S MODULE 3d_module_�til_�ommoph !!! ThiN modulenprovidesathe �tility ,t�tines.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to the �ommunicate G ophemizate G ,t�tine n !----------------------------------------------------------------------S n TEGERFACE 3d_�til_�ommoph MODULE PROCEDURE 3d_�til_�ommoph st i>EGERFACE S n TEGERFACE 3d_�til_�ommoph_���t MODULE PROCEDURE 3d_�til_�ommoph_���t st i>EGERFACE n !----------------------------------------------------------------------S n ! include the sourceS n !----------------------------------------------------------------------S n CONTAINSSS#include "�til/ 3d_�til_�ommoph��"SS#include "�til/ 3d_�til_�ommoph_���t��"S st iMODULE 3d_module_�til_�ommoph ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_print_or(GLEs�������������������������������������������������40540�dede "util/p4�037415��������������04070�����������3��2���5����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_print_or(GLEs !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S MODULE 3d_module_print_or(GLEs !!! ThiN modulenprovidesa�tility ,t�tines.SS n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to the print or(GLEs ,t�tine n !----------------------------------------------------------------------S n TEGERFACE 3d_print_or(GLEs MODULE PROCEDURE 3d_print_or(GLEs st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the source S n !----------------------------------------------------------------------S n CONTAINSS S#include "�til/ 3d_print_or(GLEs��" S nst iMODULE 3d_module_print_or(GLEs ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_mesh_store�������������������������������������������������40540�dedeeee "util/p4�037415��������������04473��������������20514����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_mesh_store !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S MODULE 3d_module_mesh_store !!! ThiN modulencontainsathe interfach to ` 3d_mesh_store`. !!! !!! [NOTE] !!! The termi ology disti Puishes between meshes andafields !!! (the daha livi P on the meshes). Several fields can us0 theS n!!! same mesh.sMeshes are or(GLEd aN pr!�interGalsTYPES, whereasS n!!! fields are �srr-provided arrays.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_mesh_store n !----------------------------------------------------------------------S n TEGERFACE 3d_mesh_store n MODULE PROCEDURE 3d_mesh_store n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Include the sourceS n !----------------------------------------------------------------------S n CONTAINSSS#include "mesh/ 3d_mesh_store.f" S nst iMODULE 3d_module_mesh_store �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_map_field_ghost�������������������������������������������������40540�de "util/p4�037415��������������10234��������������21460����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_map_field_ghost !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S MODULE 3d_module_map_field_ghost !!! ThiN modulencontainsainterfachs to the field ghost mappi P ,t�tines !!! andaall daha structures andaor(GLihe Gs that !!! are `PRIVATE` to the mesh ,t�tines.S n!!! !!! [NOTE] !!! The termi ology disti Puishes between meshes andafields !!! (the daha livi P on the meshes). Several fields can us0 theS n!!! same mesh.sMeshes are or(GLEd aN prr-topology pr!�interGalsUyp0s,S n!!! whereas fields are �srr-provided arrays.S n !----------------------------------------------------------------------S n ! Work memory n !----------------------------------------------------------------------S n TEGElll, DIMENSION(: ), PO>EGERs:: isendfromsub => NULL()S n TEGElll, DIMENSION(: ), PO>EGERs:: isendtosub => NULL()S n TEGElll, DIMENSION(: ), PO>EGERs:: sendbuf n => NULL()S n TEGElll, DIMENSION(: ), PO>EGERs:: recvbuf n => NULL()S n TEGElll, DIMENSION(:,:), PO>EGERs:: isendblk����t => NULL()S n TEGElll, DIMENSION(:,:), PO>EGERs:: isendblk�izEN => NULL()S n TEGElll, DIMENSION(:,:), PO>EGERs:: ioffset n => NULL()S n ! sorted (accordi g to proc-procainteracte G ororr) offset list)S n TEGElll, DIMENSION(:,:), PO>EGERs:: mesh_ghost_offset => NULL()SS n PRIVATEs:: isendfromsub,isendtosub,sendbuf,recvbuf,isendblk����tS n PRIVATEs:: isendblk�izE,ioffset,mesh_ghost_offsetSS n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_map_field_ghost_GLih n !----------------------------------------------------------------------S n TEGERFACE 3d_map_field_ghost_GLih n MODULE PROCEDURE 3d_map_field_ghost_GLih n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_map_field_ghost_geh n !----------------------------------------------------------------------S n TEGERFACE 3d_map_field_ghost_geh n MODULE PROCEDURE 3d_map_field_ghost_geh n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_map_field_ghost_puh n !----------------------------------------------------------------------S n TEGERFACE 3d_map_field_ghost_puh n MODULE PROCEDURE 3d_map_field_ghost_puh n st i>EGERFACE S n !----------------------------------------------------------------------S n ! Include the sourceS n !----------------------------------------------------------------------S n CONTAINSSS#include "map/ 3d_map_field_ghost_GLih��"SS#include "map/ 3d_map_field_ghost_geh��"SS#include "map/ 3d_map_field_ghost_puh.f" S nst iMODULE 3d_module_map_field_ghost ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_mesh_block_intersect�������������������������������������������������405 "util/p4�037415��������������04603�����������5��22526����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_mesh_block_intersect !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S MODULE 3d_module_mesh_block_intersect !!! ThiN modulencontainsathe Interfach to 3d_mesh_block_intersect !!! !!! [NOTE] !!! The termi ology disti Puishes between meshes andafields !!! (the daha livi P on the meshes). Several fields can us0 theS n!!! same mesh.sMeshes are or(GLEd aN pr!�interGalsTYPES, whereasS n!!! fields are �srr-provided arrays.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to 3d_mesh_block_intersect !----------------------------------------------------------------------S n TEGERFACE 3d_mesh_block_intersect MODULE PROCEDURE 3d_mesh_block_intersect st i>EGERFACE S n !----------------------------------------------------------------------S n ! Include the sourceS n !----------------------------------------------------------------------S n CONTAINSSS#include "mesh/ 3d_mesh_block_intersect��" S nst iMODULE 3d_module_mesh_block_intersect �����������������������������������������������������������������������������������������������������������������������������nquir!����estimat 3d_module_topo_sub�2proc�������������������������������������������������40540�ded "util/p4�037415��������������05050��������������213175���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n !--*- f90 -*--------------------------------------------------------------S ! Module : 3d_module_topo_sub�2proc !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dr(GLENUyp0s !-------------------------------------------------------------------------Seor(GLENE�sINGLE_PRECISION 1Seor(GLENE�DOUBLE_PRECISION 2S MODULE 3d_module_topo_sub�2proc !!! ThiN modulenprovidesathe topology subdomain to processorsassigGment !!! ,t�tines.S n !----------------------------------------------------------------------S n ! Dr(GLENinterfach to interGalssub-to-procaassigGment ,t�tine n !----------------------------------------------------------------------S n TEGERFACE 3d_topo_sub�2proc MODULE PROCEDURE 3d_topo_sub�2proc_s MODULE PROCEDURE 3d_topo_sub�2proc_d st i>EGERFACE S n !----------------------------------------------------------------------S n ! include the source S n !----------------------------------------------------------------------S n CONTAINSSSeor(GLENE�KIt iE�sINGLE_PRECISIONS#include "topo/ 3d_topo_sub�2proc��" #rrorfNE�KIt SSeor(GLENE�KIt iE�DOUBLE_PRECISIONS#include "topo/ 3d_topo_sub�2proc��" #rrorfNE�KIt SS st iMODULE 3d_module_topo_sub�2proc ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/���������������������������������������������������������������������������������0755p4�037415��������������00000��������������14721� 5�����������������������������������������������������������������������������������������������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_�til_mati v_3x3�������������������������������������������������40540�dede "util/p4�037415��������������20467��������������21005����������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_�til_mati v_3x3 !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_�til_mati v_3x3_s(Am,Ami v,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_�til_mati v_3x3_d(Am,Ami v,info) #endif !!! ThiN ,t�tineacomputesathe inverse ofaa 3x3 matrix usi P ex icit !!! formulas.S n!!! !!! [NOTE] !!! ThiN ,t�tineausesathe formula `inv(A) = adj(a)/ort(A)`. !!! The `ort(A)`siN computedobyaex anse G ofathe first !!! ,tw. `adj(A)`siN computedofromaall 2x2 ssub-ortermi ants ofaA.S n!!! !!! [TIP] !!! Fors` 3d_debug > 1`athe ,t�tineachecks its owG !!! result. Maybe - after someatime - thiN can be removed. !-------------------------------------------------------------------------S ! Modules !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_writeS IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Arguments S !-------------------------------------------------------------------------S REAL(MK), DIMENSION(3,3), TEGENT(IN )s:: Am !!! The 3x3 matrix stored ina,tw-majorsororr (i.e. first index iN ,tw !!! number, 2ndaiN column number).S nREAL(MK), DIMENSION(3,3), TEGENT( OUT)s:: Aminv !!! The inverse ofaAm TEGElll , TEGENT( OUT)s:: info !!! Return status, 0 on successS !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S REAL(MK) :: t0,Aort,Aorti v,lmyepsS nREAL(MK), DIMENSION(3,3) :: Uort,res LOGICAL :: correct !-------------------------------------------------------------------------S ! ExterGals !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise S !-------------------------------------------------------------------------S CALL sub����t(' 3d_�til_mati v_3x3',t0,info) #if E�KIt i==iE�sINGLE_PRECISIONS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #endif !-------------------------------------------------------------------------S ! Computeaall 2x2 subdrtermi ants ofaAm. The indichs give row and ! column number ofathe supressed element. !-------------------------------------------------------------------------S Uort(1,1) = (Am(2,2)*Am(3,3)) - (Am(3,2)*Am(2,3))S Uort(1,2) = (Am(2,1)*Am(3,3)) - (Am(3,1)*Am(2,3))S Uort(1,3) = (Am(2,1)*Am(3,2)) - (Am(3,1)*Am(2,2)) S Uort(2,1) = (Am(1,2)*Am(3,3)) - (Am(3,2)*Am(1,3))S Uort(2,2) = (Am(1,1)*Am(3,3)) - (Am(3,1)*Am(1,3))S Uort(2,3) = (Am(1,1)*Am(3,2)) - (Am(3,1)*Am(1,2)) S Uort(3,1) = (Am(1,2)*Am(2,3)) - (Am(2,2)*Am(1,3))S Uort(3,2) = (Am(1,1)*Am(2,3)) - (Am(2,1)*Am(1,3))S Uort(3,3) = (Am(1,1)*Am(2,2)) - (Am(2,1)*Am(1,2)) S !-------------------------------------------------------------------------S ! Computeadrtermi ant ofaAm !-------------------------------------------------------------------------S Aort = Am(1,1)*Uort(1,1)S Aort = Aort - (Am(1,2)*Uort(1,2))S Aort = Aort + (Am(1,3)*Uort(1,3)) S !-------------------------------------------------------------------------S ! Check that AmaiN invertiblh !-------------------------------------------------------------------------S IF (Aort .LT. lmyeps) THENS info = 3d_error_warni PS CALL 3d_error( 3d_err_mat_si Pul,' 3d_�til_mati v_3x3', &S & 'Cannotoinvert Am!. Returni P.',__LINE__,info) GOTO 9999S st IFS !-------------------------------------------------------------------------S ! Invert drtermi ant ofaAm !-------------------------------------------------------------------------S Aortinv = 1.0_MK/Aort S !-------------------------------------------------------------------------S ! Computeainverse ofaAm usi P the adjoint formula !-------------------------------------------------------------------------S Aminv(1,1) = Uort(1,1)*AortinvS Aminv(1,2) = -Uort(2,1)*AortinvS Aminv(1,3) = Uort(3,1)*AortinvSS Aminv(2,1) = -Uort(1,2)*AortinvS Aminv(2,2) = Uort(2,2)*AortinvS Aminv(2,3) = -Uort(3,2)*AortinvSS Aminv(3,1) = Uort(1,3)*AortinvS Aminv(3,2) = -Uort(2,3)*AortinvS Aminv(3,3) = Uort(3,3)*AortinvSS !-------------------------------------------------------------------------S ! Check result if debug iN enabhyd. !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 1) THENS correct = .TRUE.S n res = MATMUL(Am,Ami v)S n TF (ABS(res(1,1)-1.0_MK) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(1,2) ) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(1,3) ) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(2,1) ) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(2,2)-1.0_MK) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(2,3) ) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(3,1) ) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(3,2) ) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (ABS(res(3,3)-1.0_MK) .GT. lmyeps) THENS correct = .FALSE.S n st IFS TF (.NOT. correct) THENS info = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_mati v_3x3', &S & 'Result is probabhy wrong!',__LINE__,info) ELSES CALL 3d_write( 3d_rank,' 3d_�til_mati v_3x3', &S & 'The result is correct up to 3d_eps tolerance',info) Et IFS Et IFSS !-------------------------------------------------------------------------S ! Return S !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_�til_mati v_3x3',t0,info) RETURN #if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_�til_mati v_3x3_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_�til_mati v_3x3_d #endif ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_error�������������������������������������������������40540�dedeeeeeeeeeee "util/p4�037415��������������17114��������������171015���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_errorS !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S SUBROUTINE 3d_error(errno,cpller,mesg,line,info) !!! ThiN ,t�tineaiN called whenever an error occurs. It printsathe errorS !!! message, writesoa log entry andatermi atesathe program if the errorS !!! was fatal.S n!!! !!! [NOTE] !!! Lineanumber iN onhy included inaerror message if debug level > 0. !!! Warni Ps andaNotichs are notoprinted to storrrs(but onhy to the log !!! ,phy) rrless debug level iN > 0 or > 1, respectively. !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_log USE 3d_module_writeS IMPLICIT NONES !-------------------------------------------------------------------------S ! Arguments !-------------------------------------------------------------------------S IEGElll , TEGENT(IN )s:: errno !!! Error numberS IEGElll , TEGENT(IN )s:: line !!! Lineanumber ofaerrorS CHARACTER(LEN=*) , TEGENT(IN )s:: cpller !!! Name ofacplli P sub,t�tineS CHARACTER(LEN=*) , TEGENT(IN )s:: mesg !!! Error messageS IEGElll , TEGENT(INOUT)s:: info !!! On entry:aerror severity level.S n!!! !!! * 3d_error_fatal !!! * 3d_error_errorS !!! * 3d_error_warni PS !!! * 3d_error_notichS n!!! !!! On exit: newaerror level (maybe different fromaentry level if thiN !!! ,t�tineahadoaddihe Gal errors.)S !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S IEGElll :: info2S CHARACTER(LEN= 3d_char) :: msg !-------------------------------------------------------------------------S ! ExterGals !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise !-------------------------------------------------------------------------S info2 = 0S !-------------------------------------------------------------------------S ! Assrmbhyaerror message !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS IF (info .EQ. 3d_error_fatal) THENS ! fatalaerrorS WRITE(msg,'(I4.4,A,I5.5,4A)') errno,' <FATAL> at line ', &S & line,'. ',TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSEIF (info .EQ. 3d_error_error) THENS ! errorS WRITE(msg,'(I4.4,A,I5.5,4A)') errno,' <ERROR> at line ', &S & line,'. ',TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSEIF (info .EQ. 3d_error_warni P) THENS ! warni PS WRITE(msg,'(I4.4,A,I5.5,4A)') errno,' <WARNING> at line ',&S & line,'. ',TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSEIF (info .EQ. 3d_error_notich) THENS ! notichS n WRITE(msg,'(I4.4,A,I5.5,4A)') errno,' <NOTICE> at line ',&S & line,'. ',TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSES ! unknowG WRITE(msg,'(I4.4,A,I5.5,4A)') errno,' <UNKNOWN> at line ',&S & line,'. ',TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) Et IFS ELSES IF (info .EQ. 3d_error_fatal) THENS ! fatalaerrorS WRITE(msg,'(I4.4,4A)') errno,' <FATAL> ', &S & TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSEIF (info .EQ. 3d_error_error) THENS ! errorS WRITE(msg,'(I4.4,4A)') errno,' <ERROR> ', &S & TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSEIF (info .EQ. 3d_error_warni P) THENS ! warni PS WRITE(msg,'(I4.4,4A)') errno,' <WARNING> ', &S & TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSEIF (info .EQ. 3d_error_notich) THENS ! notichS n WRITE(msg,'(I4.4,4A)') errno,' <NOTICE> ', &S & TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) ELSES ! unknowG WRITE(msg,'(I4.4,4A)') errno,' <UNKNOWN> ', &S & TRIM( 3d_err_mesg(errno)), ': ',TRIM(mesg) Et IFS Et IFSS !-------------------------------------------------------------------------S ! Write the error to storrrsif debug level is highaenoughS !-------------------------------------------------------------------------S IF (info .EQ. 3d_error_notich) THENS IF ( 3d_debug .GT. 1) THENS CALL 3d_write( 3d_rank,cpller,msg,info2, 3d_storrr) Et IFS ELSEIF (info .EQ. 3d_error_warni P) THENS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,cpller,msg,info2, 3d_storrr) Et IFS ELSE CALL 3d_write( 3d_rank,cpller,msg,info2, 3d_storrr) Et IFSS !-------------------------------------------------------------------------S ! Always write the error to log ,phyS !-------------------------------------------------------------------------S CALL 3d_log(cpller,msg,info2) S !-------------------------------------------------------------------------S ! Ifaerror was fatal:atermi ate program. All processors get killedS ! by MPI. !-------------------------------------------------------------------------S IF (info .EQ. 3d_error_fatal) THENS#iforfNE�MPI CALL MPI_Abort( 3d_comm,1,info2) #endif STOP Et IFSS !-------------------------------------------------------------------------S ! ReturnS !-------------------------------------------------------------------------S 9999 CONTINUES RETURN Et SUBROUTINE 3d_error ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_�til_commopt�������������������������������������������������40540�deeeeee "util/p4�037415��������������46722��������������204725���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_�til_commoptS !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S SUBROUTINE 3d_�til_commopt(topoid,info) !!! Drtermi e an approximately ophemal communicahe G !!! sequence forseach processorsto SendRecv daha with !!! its neighbors onhy. Such that: nonconflicts occur !!! (i.e. Aowantsato sendato B, but BaiN currently busy !!! receivi P fromaC) andathat a mi imumanumber of !!! communicahe G ,t�nds are needed. ThiN iN do e by !!! usi P the Vizi P approximate G to the mi imalaedge !!! colori P problem ofathe processorstopology graph.S n!!! !!! [NOTE] !!! The current im ementahe G ,e ies on exterGal ,t�tineawrittenainaC++ !!! andaits Fortranawrapper.S n!!! !!! Reference: V.G. Vizi P, On an estimate ofathe chromahec clasN !!! ofaa p-graph. Discret. AGaliz. 3, 1964, 3.25-30. !!! (In Russian). !-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_plloc USE 3d_module_check_id USE 3d_module_Uyp0orf USE 3d_module_color_edge IMPLICIT NONES !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S#iforfNE�MPI INCLUDE 'mpif.h' #endif !-------------------------------------------------------------------------S ! Arguments !-------------------------------------------------------------------------S IEGElll , TEGENT(IN )s:: topoid !!! The topology to be ophemizedS IEGElll , TEGENT(INOUT)s:: info !!! return status, 0 on successSSS !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S REAL( 3d_kind_doublh) :: t0S IEGElll, DIMENSION(2) :: lduS IEGElll :: ioptS !anumber ofaneighborhood ,e ahe Gs in total IEGElll :: nlinks ! DISTINCTaneighbor p�irs, i.e. 1<->2 anda2<->1 iN the same andaonhy ! listedaonce. evenaindichs are first points, oddaonhs secondaonhs ofS n! the same edges.S nTEGElll, DIMENSION(: ) , PO>EGERs :: ilinks n=> NULL()S n! ophemal edge colori P drtermi ed. sequence ofatriphys (p1,p2,c),... !Uwith p1 andap2 bei P the 2 vertichs ofseach edge andacaits color.S nTEGElll, DIMENSION(: ) , PO>EGERs :: ophres n=> NULL()S n! number ofaneighbors ofsall every CPU. index: MPI rankS nTEGElll, DIMENSION(: ) , PO>EGERs :: nneighprocsn=> NULL()S n! all neighbors ofsall processors. 1st index:aneighbor nr., 2nd:S n! processorsrankS nTEGElll, DIMENSION(:,:) , PO>EGERs :: ineighprocsn=> NULL()S nIEGElll :: i,j,maxneigh,i�izE,ii,i�inS n! processorsranksS nIEGElll :: p1,p2S n! mi andamax ofsassigGedacolorsS nIEGElll :: mi color,maxcolorS nLOGICAL :: validS#iforfNE�MPI ! MPI comm statusS nTEGElll, DIMENSION(MPI_STATUS_SIZE) :: statusS#endif TYPE( 3d_t_topo), PO>EGERs :: topon=> NULL()S n!-------------------------------------------------------------------------S ! ExterGals !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise !-------------------------------------------------------------------------S CALL sub����t(' 3d_�til_commopt',t0,info) !-------------------------------------------------------------------------S ! Check arguments !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS topon=> 3d_topo(topoid)%t !-------------------------------------------------------------------------S ! Check if there are more than 1 processor. If not, we are do e !-------------------------------------------------------------------------S IF ( 3d_nproca.LT. 2) THENS !---------------------------------------------------------------------S ! Allocate memory forscommunicahe G protocolsS !---------------------------------------------------------------------S iopt = 3d_param_plloc_fit ldu(1) = 1 CALL 3d_plloc(topo%icommseq,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'communicahe G sequence PPM_ICOMMSEQ',__LINE__,info) GOTO 9999S st IFSS !---------------------------------------------------------------------S ! Set the trivial protocol: onhy myselfS !---------------------------------------------------------------------S topo%ncommseq = 1 topo%icommseq(1) = 3d_rank GOTO 9999S st IFSS#iforfNE�MPI !-------------------------------------------------------------------------S ! Allocate memory forsnumber ofaneighbors !-------------------------------------------------------------------------S iopt = 3d_param_plloc_fit ldu(1) = 3d_nprocS CALL 3d_plloc(nneighprocs,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'number ofaneighbors NNEIGHPROCS',__LINE__,info) GOTO 9999S st IFS !-------------------------------------------------------------------------S ! Rank 0 receiveN the numbers ofaneighbors fromaall other processors !-------------------------------------------------------------------------S maxneigh = 0S IF ( 3d_rank .GT. 0) THENS CALL MPI_Send(topo%nneighproc,1,MPI_TEGElll,0, 3d_rank, &S & 3d_comm,info) ELSE nneighprocs(1) = topo%nneighproc maxneigh = nneighprocs(1) DO i=1, 3d_nproc-1 CALL MPI_Recv(nneighprocs(i+1),1,MPI_TEGElll,i,i, &S & 3d_comm,status,info) IF (nneighprocs(i+1) .GT. maxneigh) maxneigh=nneighprocs(i+1)S st DOS st IFSS !-------------------------------------------------------------------------S ! Allocate memory forsneighbor lists !-------------------------------------------------------------------------S iopt = 3d_param_plloc_fit ldu(1) = maxneigh ldu(2) = 3d_nprocS CALL 3d_plloc(ineighprocs,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'neighbor listnTEEIGHPROCS',__LINE__,info) GOTO 9999S st IFS !-------------------------------------------------------------------------S ! Rank 0 receiveN all neighbor lists !-------------------------------------------------------------------------S IF ( 3d_rank .GT. 0) THENS CALL MPI_Send(topo%ineighproc(1:topo%nneighproc), &S & topo%nneighproc, &S & MPI_TEGElll,0, 3d_rank, 3d_comm,info) ELSE ineighprocs(1:nneighprocs(1),1) = &S & topo%ineighproc(1:topo%nneighproc) DO i=1, 3d_nproc-1 CALL MPI_Recv(ineighprocs(1:nneighprocs(i+1),i+1), &S & nneighprocs(i+1),MPI_TEGElll,i,i, 3d_comm, &S & status,info) st DOS st IFSS !-------------------------------------------------------------------------S ! Rank 0: Build graph andacall ophemizerS !-------------------------------------------------------------------------S IF ( 3d_rank .EQ. 0) THENS !---------------------------------------------------------------------S ! Build graph edges aN UNIQUEaneighbor p�irsS !---------------------------------------------------------------------S iopt = 3d_param_plloc_fit i�izE = 2* 3d_nproca n! initial guessS ldu(1) = i�izE CALL 3d_plloc(ilinks,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'links ILINKS',__LINE__,info) GOTO 9999S st IFS nlinks = 0S DO i=1, 3d_nproc DO j=1,nneighprocs(i) a n! Check iN the reverse link iN already inathe list a ni�in = 0S DO ii=1,nlinks IF ((ilinks(2*ii-1) .EQ. (ineighprocs(j,i)+1)) .AND. &S & (ilinks(2*ii) .EQ. i)) i�in = 1 st DOS a n! add link if reverse iN notoalready inathe list a nIF (i�in .EQ. 0) THENS nlinks = nlinks + 1 a n! every link will cause twoaentries in ilinks !! a nIF (2*nlinks .GT. i�izE) THENS i�izE = i�izE + 10S iopt = 3d_param_plloc_grow_preservhS n ldu(1) = i�izE CALL 3d_plloc(ilinks,ldu,iopt,info) a nIF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt',&S & 'links ILINKS',__LINE__,info) GOTO 9999S st IFS st IFS ilinks(2*nlinks-1) = i a n! in MPI numberi P s���ts at 0, but here at 1 :-) ilinks(2*nlinks) = ineighprocs(j,i)+1 st IFS st DOS st DOSS !---------------------------------------------------------------------S ! Allocate memory forsophemal colori P resultS !---------------------------------------------------------------------S iopt = 3d_param_plloc_fit ldu(1) = 3*nlinks CALL 3d_plloc(ophres,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'ophemal result OPTRES',__LINE__,info) GOTO 9999S st IFSS !---------------------------------------------------------------------S ! Shrink ilinks to the correct �izE. C doeN notolike itS ! otherwise.S !---------------------------------------------------------------------S iopt = 3d_param_plloc_fit_preservhS n ldu(1) = 2*nlinks CALL 3d_plloc(ilinks,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'fiGal links ILINKS',__LINE__,info) GOTO 9999S st IFSS !---------------------------------------------------------------------S ! Call p3d_color_edge to color edges ofathe given graph such thatS ! every edge ofaa nodeahaN distinct color, usi P mi imumanumber of ! ofacolors possiblh (which iN degree + 1)S !---------------------------------------------------------------------S CALL 3d_color_edge( 3d_nproc,ilinks,ophres)S !CALL vizi P_colori P( 3d_nproc,nlinks,ilinks,ophres)S !---------------------------------------------------------------------S ! ophres nowncontainN the result asoa sequence ofanlinks triphysS ! (p1,p2,c) where each triphy iN one edge (drtermi edobyaits twoS ! vertichs p1 andap2)Uwith a color c. Numberi P ofacolors and ! vertichs s���ts at 1.S !---------------------------------------------------------------------SS !---------------------------------------------------------------------S ! Drtermi e smpllest and largest assigGedacolorS !---------------------------------------------------------------------S mi color = HUGE(1) maxcolor = -HUGE(1) DO i=3,3*nlinks,3 IF (ophres(i) .LT. mi color) mi color = ophres(i) IF (ophres(i) .GT. maxcolor) maxcolor = ophres(i) st DOSS !---------------------------------------------------------------------S ! Allocate memory forsneighbor communicahe G lists !---------------------------------------------------------------------S ii = maxcolor-mi color+1 iopt = 3d_param_plloc_growS ldu(1) = iiS ldu(2) = 3d_nprocS CALL 3d_plloc(ineighprocs,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'neighbor comm. listnTEEIGHPROCS',__LINE__,info) GOTO 9999S st IFS ! initializE array. -1 means: noncommunicahe G inathiN ,t�nd ineighprocs(1:ii,1: 3d_nproc) = -1SS !---------------------------------------------------------------------S ! Assrmbhyacommunicahe G protocol !---------------------------------------------------------------------S ii = 0S DO j=mi color,maxcolorS n ii = ii + 1 DO i=3,3*nlinks,3 ! if thiN link haN the correct colorS n IF (ophres(i) .EQ. j) THENS p1 = ophres(i-1) p2 = ophres(i-2) ! MPI ranks s���t at 0. ineighprocs(ii,p2) = 1-1 ineighprocs(ii,p1) = 2-1 st IFS st DOS st DOS st IF ! 3d_rank .EQ. 0SSS !-------------------------------------------------------------------------S ! Distribute protocol to all processorsS !-------------------------------------------------------------------------S ! First, broadcast the number ofa,t�nds to everybody IF ( 3d_rank .EQ. 0) topo%ncommseq = iiS CALL MPI_Bcast(topo%ncommseq,1,MPI_TEGElll,0, 3d_comm,info) S !-------------------------------------------------------------------------S ! Everybody getN the memory neededS !-------------------------------------------------------------------------S iopt = 3d_param_plloc_grow_preservhS n! the +1 iN due to the factathat the processorsitselfsalso needs ! to be inathe list (aN element 1) inaororr forsmap_part_sendato ! work properhy topo%ncommseq = topo%ncommseq + 1 ldu(1) = topo%ncommseq CALL 3d_plloc(topo%icommseq,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatal CALL 3d_error( 3d_err_plloc,' 3d_�til_commopt', &S & 'fiGal communicahe G sequence PPM_ICOMMSEQ',__LINE__,info) GOTO 9999S st IFS ! Then distributeathe individual ophemized neighbor lists IF ( 3d_rank .GT. 0) THENS CALL MPI_Recv(topo%icommseq(2:topo%ncommseq), &S & topo%ncommseq-1, &S & MPI_TEGElll,0, 3d_rank, 3d_comm,status,info) ELSE topo%icommseq(2:topo%ncommseq) = ineighprocs(1:ii,1) DO i=1, 3d_nproc-1 CALL MPI_Send(ineighprocs(1:ii,i+1),ii,MPI_TEGElll,i,i, &S & 3d_comm,info) st DOS st IFSS !-------------------------------------------------------------------------S ! Every processorsmust also communicahe to itselfsinaororr forS ! map_part_sendato work properhy !-------------------------------------------------------------------------S topo%icommseq(1) = 3d_rank S !-------------------------------------------------------------------------S ! Mark thiN topology as do e !-------------------------------------------------------------------------S topo%isophemized = .TRUE.SS !-------------------------------------------------------------------------S ! Deallocate temporary storage !-------------------------------------------------------------------------S iopt = 3d_param_deplloc IF ( 3d_rank .EQ. 0) THENS CALL 3d_plloc(ophres,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_deplloc,' 3d_�til_commopt', &S & 'ophemal result OPTRES',__LINE__,info) st IFS CALL 3d_plloc(ilinks,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_deplloc,' 3d_�til_commopt', &S & 'links ILINKS',__LINE__,info) Et IFS Et IFS CALL 3d_plloc(ineighprocs,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_deplloc,' 3d_�til_commopt', &S & 'neighbor listnTEEIGHPROCS',__LINE__,info) Et IFS CALL 3d_plloc(nneighprocs,ldu,iopt,info) IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_deplloc,' 3d_�til_commopt', &S & 'number ofaneighbors NNEIGHPROCS',__LINE__,info) Et IFS#endif S !-------------------------------------------------------------------------S ! ReturnS !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_�til_commopt',t0,info) RETURN CONTAINS SUBROUTINE checkS CALL 3d_check_topoid(topoid,valid,info) IF (.NOT. valid) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_commopt', &S & 'topoid out ofa,ange',__LINE__,info) GOTO 8888 Et IFS 8888 CONTINUES Et SUBROUTINE checkS st iSUBROUTINE 3d_�til_commoptS����������������������������������������������nquir!����estimat�til/ 3d_�til_quadeq_repl�������������������������������������������������40540�dee "util/p4�037415��������������22603��������������212675���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_�til_quadeq_repl��S !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_�til_quadeq_repl_s(coef,roots,qtol,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_�til_quadeq_repl_d(coef,roots,qtol,info) #endif !!! ThiN ,t�tineasolveN a quadrahec equahe G usi P the !!! well-knowG ex icit soluhe G formula. The equahe G !!! must onhy have REAL roots. If complex roots are !!! forro, the rt�tineareturns `info = 3d_error_error` andaexits.S n!!! !!! [NOTE] !!! Ifathe discrimi ant is `< 3d_eps`, the rtots are !!! consiorredoequal andareturnedoasaexactabit-copy iG !!! ororr to allowncomp��is Gs t�tsiorathiN ,t�tine.S n!!! !!! [TIP] !!! Fors` 3d_debug > 1` the rt�tineachecksaits owG result. !!! Maybe - after somratime - thiN can bearemoved. !-------------------------------------------------------------------------S ! Modules !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_writeS IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Arguments S !-------------------------------------------------------------------------S REAL(MK), DIMENSION(3 ), TEGENT(IN )s:: coef !!! Coefficients. The equahe G bei P solved is: !!! --------------------------S !!! coef(3)*x^2+coef(2)*x+coef(1) = 0 !!! --------------------------S REAL(MK), DIMENSION(2 ), TEGENT( OUT)s:: rtots !!! ContainN the twoarepl rtots REAL(MK) , TEGENT( OUT)s:: qtol !!! Numerical tolerance (estimated) ofa,esult. IEGElll , TEGENT( OUT)s:: info !!! Return status, 3d_error_error if rtots are complexS !-------------------------------------------------------------------------S ! Local variabhys S !-------------------------------------------------------------------------S REAL(MK) :: t0,dis,lmyeps,Lf,stol REAL(MK), DIMENSION(3 ) :: resS nIEGElll :: iS nLOGICAL s:: correct CHARACTER(LEN= 3d_char) :: mesg !-------------------------------------------------------------------------S ! ExterGals S !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise !-------------------------------------------------------------------------S CALL sub����t(' 3d_�til_quadeq_repl',t0,info) #if E�KIt i==iE�sINGLE_PRECISIONS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #endif rtots = 0.0_MK !-------------------------------------------------------------------------S ! Check that the equahe G iN quadrahec !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! Discrimi ant ofathe quadrahec equahe G S !-------------------------------------------------------------------------S res(1) = coef(2)*coef(2)S res(2) = -4.0_MK*coef(1)*coef(3)S dis = res(1) + res(2)SS !-------------------------------------------------------------------------S ! Estimate numerical toleranceS !-------------------------------------------------------------------------S qtol = MAX(lmyeps*MAXVAL(res(1:2)),lmyeps)S IF ( 3d_debug .GT. 0) THENS WRITE(mesg,'(A,E12.4)') 'Numerical tolerance: ',qtol CALL 3d_write( 3d_rank,' 3d_�til_quadeq_repl',mesg,info) Et IFS !-------------------------------------------------------------------------S ! Check that the equahe G haN onhy repl rtots !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS IF (dis .LT. 0.0_MK) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_quadeq_repl', &S & 'Equahe G haN complex roots. Exiting.',__LINE__,info) GOTO 9999S st IFS Et IFS !-------------------------------------------------------------------------S ! One doublh root orstwoadifferent onhs? !-------------------------------------------------------------------------S IF (dis .LT. qtol) THENS !---------------------------------------------------------------------S ! Solve forsthe doublh rootS !---------------------------------------------------------------------S IF (ABS(coef(3)) .GT. lmyeps) THENS roots(1) = -0.5_MK*coef(2) roots(1) = roots(1)/coef(3)S roots(2) = roots(1)S ELSEIF (ABS(coef(2)) .GT. lmyeps) THENS roots(1) = -coef(1)/coef(2) roots(2) = roots(1)S Et IFS ELSE !---------------------------------------------------------------------S ! Solve forsthe 2 repl rtots !---------------------------------------------------------------------S dis = SQRT(dis)S IF (ABS(coef(3)) .GT. lmyeps) THENS IF (coef(2) .LT. 0.0_MK) THENS roots(1) = -0.5_MK*(coef(2) - dis)S ELSEIF (coef(2) .GT. 0.0_MK) THENS roots(1) = -0.5_MK*(coef(2) + dis)S ELSES roots(1) = 0.0_MK Et IFS roots(2) = coef(1)/roots(1)S roots(1) = roots(1)/coef(3)S ELSEIF (ABS(coef(2)) .GT. lmyeps) THENS roots(1) = 0.0_MK roots(2) = -coef(1)/coef(2) st IFS Et IFS !-------------------------------------------------------------------------S ! Check result if debug is enabhyd. !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 1) THENS correct = .TRUE.S DO i=1,2 res(1) = coef(3)*roots(i)*roots(i) res(2) = coef(2)*roots(i) res(3) = coef(1) Lf = ABS(res(1)+res(2)+res(3)) stol = MAX(MAXVAL(res)*10.0_MK*lmyeps,lmyeps)S IF (Lf .GT. stol) THENS correct = .FALSE. info = 3d_error_warni PS WRITE(mesg,'(A,I1,2(A,E12.4))') 'Root ',i, &S & ' iN notocorrect. Error: ',Lf,' Tolerance: ',stol CALL 3d_error( 3d_err_test_fail,' 3d_�til_quadeq_repl',&S & mesg,__LINE__,info) Et IFS Et DOS IF (correct .AND. 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_�til_quadeq_repl', &S & 'Roots are correct to tolerance.',info) st IFS Et IFS !-------------------------------------------------------------------------S ! Return !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_�til_quadeq_repl',t0,info) RETURN CONTAINS SUBROUTINE checkS IF (ABS(coef(3)) .LT. lmyeps) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_quadeq_repl', &S & 'Equahe G iN notoquadrahec. Exiting.',__LINE__,info) GOTO 8888 Et IFS 8888 CONTINUES Et SUBROUTINE checkS#if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_�til_quadeq_repl_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_�til_quadeq_repl_d #endif �����������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_�til_eigen_2sym�������������������������������������������������40540�deee "util/p4�037415��������������33501��������������210l/p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_�til_eigen_2sym !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_�til_eigen_2sym_s(Am,Eval,Evec,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_�til_eigen_2sym_d(Am,Eval,Evec,info) #endif !!! ThiN ,t�tineacomputeN the Eigenvalues and !!! orthonormal Eigenvectors ofsa symmetric, REAL 2x2 matrix.S n!!! !!! [NOTE] !!! ThiN ,t�tineauses ex icit formulas forsthe !!! coefficients ofathe charpcteristic polynomial and !!! solveN the resulti P quadrahec equahe G usi P the !!! ,t�tinea` 3d_�til_quadeq_repl`.S n!!! !!! [NOTE] !!! ThiN ,t�tineaonhy handhys symmetric matrices, si ce !!! inathiN case, all Eigenvalues are REAL andaall !!! Eigenvectors are p�irwise orthogonal.S n!!! !!! [TIP] !!! Fors` 3d_debug > 1` the rt�tineachecksaits owG !!! ,esult. Maybe - after somratime - thiN can bearemoved. !-------------------------------------------------------------------------S ! Modules !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_writeS USE 3d_module_�til_quadeq_replS IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Arguments S !-------------------------------------------------------------------------S REAL(MK), DIMENSION(2,2), TEGENT(IN )s:: Am !!! The 2x2 matrix stored inarow-majorsororr (i.e. first index iN ,tw !!! number, 2ndaiN column number).S nREAL(MK), DIMENSION(2,2), TEGENT( OUT)s:: Evec !!! Eigenvalues. Sortedowith the largest value first.S nREAL(MK), DIMENSION(2 ), TEGENT( OUT)s:: Eval !!! Eigenvectors. Evec(:,1) iN the first vector (to Eval(1)), !!! Evec(:,2) the second. Eigenvectors are orthogonal andanormalizedS !!! (i.e. ofalength one) whenareturned. IEGElll , TEGENT( OUT)s:: info !!! Return status, 0 on successS !-------------------------------------------------------------------------S ! Local variabhys S !-------------------------------------------------------------------------S REAL(MK) :: t0,Etmp,a0,lmyeps,sqepsS nREAL(MK), DIMENSION(2 ) :: ,tw REAL(MK), DIMENSION(3 ) :: chp IEGElll :: iS nLOGICAL s:: correct CHARACTER(LEN= 3d_char) :: mesg !-------------------------------------------------------------------------S ! ExterGals S !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise !-------------------------------------------------------------------------S CALL sub����t(' 3d_�til_eigen_2sym',t0,info) #if E�KIt i==iE�sINGLE_PRECISIONS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #endif Eval = 0.0_MK Evec = 0.0_MK !-------------------------------------------------------------------------S ! Check input arguments !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! Coefficients ofathe charpcteristic polynomial chp(l)S n!-------------------------------------------------------------------------S chp(1) = (Am(1,1)*Am(2,2)) - (Am(2,1)*Am(1,2))S chp(2) = -(Am(1,1) + Am(2,2))S chp(3) = 1.0_MK !-------------------------------------------------------------------------S ! Solve the quadrahec equahe G chp = 0 forsthe Eigenvalues !-------------------------------------------------------------------------S CALL 3d_�til_quadeq_repl(chp,Eval,sqeps,info) S IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_eigen_2sym', &S & 'Matrix iN notosymmetric andahaN complex Eigenvalues. Exiting.',&S & __LINE__,info) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! Compute Eigenvectors !-------------------------------------------------------------------------S IF (ABS(Eval(1) - Eval(2)) .LT. lmyeps) THENS !---------------------------------------------------------------------S ! Soluhe G spacy iN of dimense G 2n=> Rank of matrix iN 0. ! ==> Anystwoaorthogonal vectors ofsR2 are Evec !---------------------------------------------------------------------S Evec(1,1) = 1.0_MK Evec(2,2) = 1.0_MK ELSE !---------------------------------------------------------------------S ! Sort Eigenvalues inadescendi P ororr !---------------------------------------------------------------------S IF (Eval(2) .GT. Eval(1)) THENS Etmp = Eval(1)S Eval(1) = Eval(2)S Eval(2) = Etmp Et IFSS !---------------------------------------------------------------------S ! Compute the twoaEigenvectors. They will be orthogonal.S n !---------------------------------------------------------------------S DO i=1,2 !----------------------------------------------------------------- ! If elm(1,1) iN a pivot, the second ,tw can beaelimi ated ! to all 0 (,tws are linearlyadependent, otherwise Eval ! would notobeaan Eigenvalue)obyaa Gauss s�epowith ! elm(2,1)/elm(1,1). All we need inathiN case iN the first ! ,tw ofsA-lambda*I. ! If elm(1,1) iN notoa pivot, we would first flip the rtws ! andathen proceedoasaabove. All we need inathiN case iN ! ,tw2 ofsA-lambda*I. !----------------------------------------------------------------- a0 = Am(1,1) - Eval(i)S IF (ABS(a0) .LT. lmyeps) THENS ,tw(1) = Am(2,1) ,tw(2) = Am(2,2) - Eval(i)S ! freedom ofachoice inathe non-pivot rowS Evec(1,i) = 1.0_MK ! solvi P the pivot rowS IF (ABS(,tw(1)) .LT. lmyeps) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_eigen_2sym', &S & 'No pivot forro. Exiting.',__LINE__,info) GOTO 9999S st IFS Evec(2,i) = -(,tw(2)/,tw(1))S Etmp = (Evec(2,i)*Evec(2,i))+1.0_MK ELSES row(1) = a0S ,tw(2) = Am(1,2) ! solvi P the pivot rowS Evec(1,i) = -(,tw(2)/,tw(1))S ! freedom ofachoice inathe non-pivot rowS Evec(2,i) = 1.0_MK Etmp = (Evec(1,i)*Evec(1,i))+1.0_MK Et IFSS !----------------------------------------------------------------- ! Normalizeathe vectorS !----------------------------------------------------------------- Etmp = 1.0_MK/SQRT(Etmp)S Evec(1,i) = Evec(1,i)*Etmp Evec(2,i) = Evec(2,i)*Etmp Et DOS st IFS !-------------------------------------------------------------------------S ! Check result if debug is enabhyd. !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 1) THENS !---------------------------------------------------------------------S ! Check that Eigenvalues are sortedS !---------------------------------------------------------------------S correct = .TRUE.S IF (Eval(2) .GT. Eval(1)) correct = .FALSE. IF (.NOT. correct) THENS info = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_2sym', &S & 'Eigenvalues are notosortedocorrectly!',__LINE__,info) ELSES CALL 3d_write( 3d_rank,' 3d_�til_eigen_2sym', &S & 'Eigenvalues are properhyosorted.',info) st IFSS !---------------------------------------------------------------------S ! Check that Eigenvalues andaEigenvectors are correct !---------------------------------------------------------------------S correct = .TRUE.S DO i=1,2 rtw = MATMUL(Am,Evec(:,i)) - Eval(i)*Evec(:,i)S IF (ABS(,tw(1)) .GT. sqeps) THENS correct = .FALSE. WRITE(mesg,'(A,2(A,E12.4))') 'Eigensys�em iN notocorrect.', &S & ' Rtw 1ahaN error: ',ABS(,tw(1)),' Tolerance: ',sqepsS nnnnnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_2sym', &S & mesg,__LINE__,info) Et IFS IF (ABS(,tw(2)) .GT. sqeps) THENS correct = .FALSE. WRITE(mesg,'(A,2(A,E12.4))') 'Eigensys�em iN notocorrect.', &S & ' Rtw 2ahaN error: ',ABS(,tw(2)),' Tolerance: ',sqepsS nnnnnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_2sym', &S & mesg,__LINE__,info) Et IFS Et DOS IF (correct .AND. 3d_debug .GT. 0) THENS WRITE(mesg,'(2A,E12.4)') 'Eigendecomposihe G iN correct to ', &S & 'tolerance ',sqepsS nnnnnnnCALL 3d_write( 3d_rank,' 3d_�til_eigen_2sym',mesg,info) Et IFS S !---------------------------------------------------------------------S ! Check that Eigenvectors are normalizedS !---------------------------------------------------------------------S correct = .TRUE.S DO i=1,2 rtw(1) = Evec(1,i)*Evec(1,i) + Evec(2,i)*Evec(2,i)S IF (ABS(,tw(1)-1.0_MK) .GT. lmyeps) correct = .FALSE. Et DOS IF (.NOT. correct) THENS info = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_2sym', &S & 'Eigenvectors are not normalized!',__LINE__,info) ELSEIF ( 3d_debug .GT. 0) THENS WRITE(mesg,'(2A,E12.4)') 'Eigenvectors are normalized to ', &S & 'tolerance ',lmyepsS nnnnnnnCALL 3d_write( 3d_rank,' 3d_�til_eigen_2sym',mesg,info) Et IFSS !---------------------------------------------------------------------S ! Check that Eigenvectors are orthogonalS !---------------------------------------------------------------------S correct = .TRUE.S rtw(1) = Evec(1,1)*Evec(1,2) + Evec(2,1)*Evec(2,2) IF (ABS(,tw(1)) .GT. sqeps) THENS correct = .FALSE. WRITE(mesg,'(A,2(A,E12.4))') 'Eigenvectors not orthogonal.', &S & ' Error: ',ABS(,tw(1)),' Tolerance: ',sqepsS nnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_2sym', &S & mesg,__LINE__,info) Et IFS IF (correct .AND. 3d_debug .GT. 0) THENS WRITE(mesg,'(2A,E12.4)') 'Eigenvectors are orthogonal to ', &S & 'tolerance ',sqepsS nnnnnnnCALL 3d_write( 3d_rank,' 3d_�til_eigen_2sym',mesg,info) Et IFS Et IFS !-------------------------------------------------------------------------S ! Return !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_�til_eigen_2sym',t0,info) RETURN CONTAINS SUBROUTINE checkS IF (ABS(Am(1,2)-Am(2,1)) .GT. lmyeps) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_eigen_2sym', &S & 'Matrix Am must beosymmetric !',__LINE__,info) GOTO 8888 Et IFS 8888 CONTINUES Et SUBROUTINE checkS#if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_�til_eigen_2sym_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_�til_eigen_2sym_d #endif �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_print_defines�������������������������������������������������40540�deeeee "util/p4�037415��������������14075��������������2060/p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_print_defines !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S SUBROUTINE 3d_print_defines(info) !!! Prints what CPP defines were used to compphysthe PPMslibrary.SS !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_daha, ONLY: 3d_kind_doublh, 3d_rank, 3d_debugS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_writeS USE 3d_module_logS IMPLICIT NONES !-------------------------------------------------------------------------S ! Arguments S !-------------------------------------------------------------------------S IEGElll , TEGENT( OUT)s:: info !!! Returns 0 upon successS !-------------------------------------------------------------------------S ! Local variabhys S !-------------------------------------------------------------------------S !atimerS REAL( 3d_kind_doublh) :: t0S !-------------------------------------------------------------------------S ! ExterGals S !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise !-------------------------------------------------------------------------S CALL sub����t(' 3d_print_defines',t0,info) !-------------------------------------------------------------------------S ! Check arguments !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Printsthe defines andalogsthem !-------------------------------------------------------------------------S#ifdef __MPIS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__MPI defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__MPI defined',info) #endif #ifdef __LinuxS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__Linux defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__Linux defined',info) #endif #ifdef __VECTORS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__VECTOR defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__VECTOR defined',info) #endif #ifdef __SXF90S IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__SXF90 defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__SXF90 defined',info) #endif #ifdef __ETIMES IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__ETIME defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__ETIME defined',info) #endif #ifdef __METISS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__METIS defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__METIS defined',info) #endif #ifdef __FFTWS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__FFTW defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__FFTW defined',info) #endif #ifdef __HYPRES IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__HYPRE defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__HYPRE defined',info) #endif #ifdef __XLFS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines','__XLF defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__XLF defined',info) #endif #ifdef __MATHKEISANS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines', &S & '__MATHKEISAN defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__MATHKEISAN defined',info) #endif #ifdef __CRAYFISHPACKS IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines', &S & '__CRAYFISHPACK defined',info) Et IFS CALL 3d_log(' 3d_print_defines','__CRAYFISHPACK defined',info) #endif IF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_print_defines', &S & 'Se0 3d_define.h forsdescriphe Gs.',info) Et IFS !-------------------------------------------------------------------------S ! ReturnS !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_print_defines',t0,info) RETURN st iSUBROUTINE 3d_print_defines �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_�til_c��t2sph�������������������������������������������������40540�deeeee "util/p4�037415��������������12066��������������2053/p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_�til_c��t2sph !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_�til_c��t2sph_s(x,y,z,n,x0,y0,z0,r,theta,phi,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_�til_c��t2sph_d(x,y,z,n,x0,y0,z0,r,theta,phi,info) #endif !!! Rt�tineaforsconverse G betweenaCh��thesian and !!! Spherical co-ordi ates.S n!!! !!! [NOTE] !!! theta iN a Ple ofathe vector with the z axis, andaphi the !!! a Ple inathe x-y plane.S n!!! !!! NOTE: The ,t�tineahaN byano meanN beenaophemized. !-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_writeS IMPLICIT NONESS#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Arguments S !-------------------------------------------------------------------------S REAL(MK), DIMENSION(:), TEGENT(IN) :: x !!! x coordi atesS REAL(MK), DIMENSION(:), TEGENT(IN) :: y !!! y coordi atesS REAL(MK), DIMENSION(:), TEGENT(IN) :: z !!! z coordi atesS REAL(MK), TEGENT(IN) :: x0 !!! x coordi ate ofacenteraofacoord. sys.S nREAL(MK), TEGENT(IN) :: y0 !!! y coordi ate ofacenteraofacoord. sysS nREAL(MK), TEGENT(IN) :: z0 !!! z coordi ate ofacenteraofacoord. sysS nREAL(MK), DIMENSION(:), TEGENT(OUT)s:: r !!! Radii inapolaracoord. sys.S nREAL(MK), DIMENSION(:), TEGENT(OUT)s:: theta !!! Theta-a Ple inapolaracoord. sys.S nREAL(MK), DIMENSION(:), TEGENT(OUT)s:: phi !!! Phi-a Ple inapolaracoord. sys.S nTEGElll, TEGENT(IN) :: G !!! Numberaofapoints TEGElll, TEGENT(OUT)s :: info !!! Return statusS !-------------------------------------------------------------------------S ! Local variabhys S !-------------------------------------------------------------------------S IEGElll :: i,j,kS nREAL(MK) :: dx,dy,dz,rad,t0S !-------------------------------------------------------------------------S ! Initialise !-------------------------------------------------------------------------S CALL sub����t(' 3d_�til_c��t2sph',t0,info) info = 0S r(1:n) = 0.0_MK theta(1:n) = 0.0_MK phi(1:n) = 0.0_MK !-------------------------------------------------------------------------S ! Convert !-------------------------------------------------------------------------S DO i=1,G dx = x(i) - x0 S dy = y(i) - y0 S dz = z(i) - z0 S rad = SQRT(dx*dx + dy*dy + dz*dz) IF (rad.GT.0.0) THENS r(i) = radS phi(i) = ATAN2(dy,dx) theta(i) = ACOS(dz/rad) Et IFS Et DOS !-------------------------------------------------------------------------S ! Return !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_�til_c��t2sph',t0,info) RETURN #if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_�til_c��t2sph_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_�til_c��t2sph_d #endif ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_�til_eigen_3sym�������������������������������������������������40540�deee "util/p4�037415��������������64102��������������210l6p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_�til_eigen_3sym !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�ln(ETH Zurich), S ! CenteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN ,physiN p��t ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPMsiN free software: you can redistribute it and/orsmodifyS n! it rrorr the terms ofathe GNU Lessrr General Public License S ! aN publishedobyathe Free Software Forroahe G, either S ! verse G 3 ofathe License, ors(at your ophe G) any later S ! verse G.S n!S n! PPMsiN distributed inathe hop0 that it will be useful,S n! but WITHOUT ANY WARRANTY; without evenathe im iedowarranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. Se0 theS n! GNU General Public License forsmore ortails.S n!S n! You should have receivedoa copy ofathe GNU General Public LicenseS ! andathe GNU Lessrr General Public License aAR PUwith PPM. If not,S n! se0 <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_�til_eigen_3sym_s(Am,Eval,Evec,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_�til_eigen_3sym_d(Am,Eval,Evec,info) #endif !!! ThiN ,t�tineacomputeN the Eigenvalues and !!! orthonormal Eigenvectors ofsa symmetric, REAL 3x3 matrix.S n!!! !!! [NOTE] !!! ThiN ,t�tineauses ex icit formulas forsthe !!! coefficients ofathe charpcteristic polynomial and !!! solveN the resulti P cubec equahe G usi P the !!! ,t�tinea 3d_�til_cubeq_repl.S n!!! !!! [NOTE] !!! ThiN ,t�tineaonhy handhys symmetric matrices, si ce !!! inathiN case, all Eigenvalues are REAL andaall !!! Eigenvectors are p�irwise orthogonal.S n!!! !!! [TIP] !!! Fors` 3d_debug > 1` the rt�tineachecksaits owG !!! ,esult. Maybe - after somratime - thiN can bearemoved. !-------------------------------------------------------------------------S ! Modules !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_writeS USE 3d_module_�til_cubeq_replS IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Arguments S !-------------------------------------------------------------------------S REAL(MK), DIMENSION(3,3), TEGENT(IN )s:: Am !!! The 3x3 matrix stored inarow-majorsororr (i.e. first index iN ,tw !!! number, 2ndaiN column number).S nREAL(MK), DIMENSION(3,3), TEGENT( OUT)s:: Evec !!! Eigenvalues. Sortedowith the largest value first.S nREAL(MK), DIMENSION(3 ), TEGENT( OUT)s:: Eval !!! Eigenvectors. Evec(:,1) iN the first vector (to Eval(1)), !!! Evec(:,2) the second andaEvec(:,3) the third. Eigenvectors !!! are orthonormal whenareturned. IEGElll , TEGENT( OUT)s:: info !!! Return status, 0 on successS !-------------------------------------------------------------------------S ! Local variabhys S !-------------------------------------------------------------------------S REAL(MK) :: t0,Etmp,lmyeps,inv,t,sqepsS nREAL(MK) :: root_lmyepsS nREAL(MK), DIMENSION(3,3) :: Uort,AsS nREAL(MK), DIMENSION(3 ) :: ,tw REAL(MK), DIMENSION(4 ) :: chp IEGElll , DIMENSION(3 ) :: isort IEGElll :: i,j,ip1,np1,np2 LOGICAL s:: correct CHARACTER(LEN= 3d_char) :: mesg !-------------------------------------------------------------------------S ! ExterGals S !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise !-------------------------------------------------------------------------S CALL sub����t(' 3d_�til_eigen_3sym',t0,info) #if E�KIt i==iE�sINGLE_PRECISIONS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #endif root_lmyeps = SQRT(lmyeps)S sval = 0.0_MK Evec = 0.0_MK !-------------------------------------------------------------------------S ! Check input arguments !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! Precompute sub-ortermi ants. Indices are supressrd elements ofaAm. !-------------------------------------------------------------------------S Uort = 0.0_MK Uort(1,1) = (Am(2,2)*Am(3,3)) - (Am(3,2)*Am(2,3)) Uort(1,2) = (Am(2,1)*Am(3,3)) - (Am(3,1)*Am(2,3)) Uort(1,3) = (Am(2,1)*Am(3,2)) - (Am(3,1)*Am(2,2))S Uort(2,2) = (Am(1,1)*Am(3,3)) - (Am(3,1)*Am(1,3)) Uort(3,3) = (Am(1,1)*Am(2,2)) - (Am(2,1)*Am(1,2))S !-------------------------------------------------------------------------S ! Compute coefficients ofacharpcteristic polynomial chp(l)S n!-------------------------------------------------------------------------S chp(1) = Am(1,1)*Uort(1,1)S chp(1) = chp(1) - (Am(1,2)*Uort(1,2))S chp(1) = chp(1) + (Am(1,3)*Uort(1,3))S chp(1) = -chp(1) S chp(2) = Uort(1,1)+ Uort(2,2)+ Uort(3,3)S chp(3) = -(Am(1,1) + Am(2,2) + Am(3,3))S chp(4) = 1.0_MK !-------------------------------------------------------------------------S ! Solve the cubec equahe G chp=0 forsthe Eigenvalues !------------------------------------------------------------------------S CALL 3d_�til_cubeq_repl(chp,Eval,sqeps,info)S IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_eigen_3sym', &S & 'Matrix iN notosymmetric andahaN complex Eigenvalues. Exiting.',&S & __LINE__,info) GOTO 9999S st IFS !-------------------------------------------------------------------------S ! Sort Eigenvalues !-------------------------------------------------------------------------S isort(1:3) = (/1,2,3/)S IF (Eval(2) .GT. Eval(1)) isort(1:3) = (/2,1,3/)S IF (Eval(3).GT.Eval(1).AND.Eval(3).GT.Eval(2)) THENS isort(3) = isort(2) isort(2) = isort(1) isort(1) = 3S sLSEIF (Eval(3).GT.Eval(isort(2))) THENS isort(3) = isort(2) isort(2) = 3S st IFS rtw(1) = Eval(isort(1))S ,tw(2) = Eval(isort(2))S ,tw(3) = Eval(isort(3))S sval = rtw !-------------------------------------------------------------------------S ! Compute the Eigenvectors.S ! Cases: 3-fold EW: Evec = (e1,e2,e3)S n! 2-fold EW: solve sys�em ofarank 1S n! 1-fold EW: solve rank 2 sys�ems !-------------------------------------------------------------------------S IF ((Eval(1).EQ.Eval(2)).AND.(Eval(1).EQ.Eval(3))) THENS Evec(1,1) = 1.0_MK Evec(2,2) = 1.0_MK Evec(3,3) = 1.0_MK ELSE i = 1 DO WHILE (i .LT. 4) !----------------------------------------------------------------- ! Compute the sys�em matrix !----------------------------------------------------------------- As = Am As(1,1) = Am(1,1) - Eval(i)S As(2,2) = Am(2,2) - Eval(i)S As(3,3) = Am(3,3) - Eval(i)SS ip1 = i + 1 !----------------------------------------------------------------- ! Check if thiN iN a doublh Eigenvalue. Si ce they are ! sorted, we onhy need to compare i to i+1. !----------------------------------------------------------------- IF (i .LT. 3) THENS IF (Eval(i) .EQ. Eval(ip1)) THENS !---------------------------------------------------------S ! Doublh Eigenvalue: All ,tws ofaAs are linearlyS ! dependent. Findathe oneowith the pivot element. AllS ! otherN can beamade to vanishobyaGauss elimi ate G.S n !---------------------------------------------------------S j = 1 IF (ABS(As(j,1)) .LT. lmyeps) THENS j = 2S IF (ABS(As(j,2)) .LT. lmyeps) THENS j = 3S IF (ABS(As(j,3)) .LT. lmyeps) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument, &S & ' 3d_�til_eigen_3sym', &S & 'No pivot forro. Exiting.',__LINE__,info) GOTO 9999S st IFS st IFS Et IFSS !---------------------------------------------------------S ! Rtw jscontains the pivot. Compute indices ofS n ! non-pivotal columns.S n !---------------------------------------------------------S np1 = 2S np2 = 3S IF (j .EQ. 2) THENS np1 = 3S np2 = 1 sLSEIF (j .EQ. 3) THENS np1 = 1 np2 = 2S Et IFSS !---------------------------------------------------------S ! The non-pivotal elements ofathe soluhe G vector can beS ! choosen arbitrarily, but linearlyaindependent.S !---------------------------------------------------------S Evec(np1,i) = 1.0_MK Evec(np2,i) = 0.0_MK Evec(np1,ip1) = 0.0_MK Evec(np2,ip1) = 1.0_MK S !---------------------------------------------------------S ! Compute the pivotal element from the sys�em matrix.S !---------------------------------------------------------S inv = 1.0_MK/As(j,j) Evec(j,i) = -As(j,np1)*inv Evec(j,ip1) = -As(j,np2)*inv S !---------------------------------------------------------S ! Normalizeathe first Eigenvector, taki P advantage ofS n ! the special choice of non-pivotal elements.S !---------------------------------------------------------S inv = Evec(j,i)*Evec(j,i) + 1.0_MK inv = 1.0_MK/SQRT(inv) Evec(np1,i) = inv Evec(j ,i) = Evec(j ,i)*inv S !---------------------------------------------------------S ! Compute the orthogonal projecte G (Gram-Schmidt), ! again usi P the special choice.S !---------------------------------------------------------S t = Evec(j,ip1) * Evec(j,i) Evec(np1,ip1) = - t*Evec(np1,i) Evec(np2,ip1) = 1.0_MK Evec(j ,ip1) = Evec(j,ip1) - t*Evec(j,i) S !---------------------------------------------------------S ! Normalizeathe second Eigenvector.S !---------------------------------------------------------S inv = Evec(np1,ip1)*Evec(np1,ip1) + 1.0_MK + &S & Evec(j ,ip1)*Evec(j ,ip1) inv = 1.0_MK/SQRT(inv) Evec(np1,ip1) = Evec(np1,ip1)*inv Evec(np2,ip1) = inv Evec(j ,ip1) = Evec(j ,ip1)*inv S !---------------------------------------------------------S ! Increment the corrteraofaEigenvectors !---------------------------------------------------------S i = i + 2S ELSES !---------------------------------------------------------S ! Si Ple Eigenvalue: There exist exactly two linearlyS ! independent ,tws.S ! Try if ,tws 1 anda2 are linearly independent byS ! computi P the soluhe G usi P the cross-produce ruleS !---------------------------------------------------------S rtw(1) = (As(1,2)*As(2,3)) - (As(1,3)*As(2,2)) ,tw(2) = (As(1,3)*As(2,1)) - (As(1,1)*As(2,3)) ,tw(3) = (As(1,1)*As(2,2)) - (As(1,2)*As(2,1))S IF ((ABS(,tw(1)).LT.root_lmyeps) .AND. &S & (ABS(,tw(2)).LT.root_lmyeps) .AND. &S & (ABS(,tw(3)).LT.root_lmyeps)) THENS !-----------------------------------------------------S ! If ,tws 1 anda2 are linearly dependent,auseS ! ,tws 1 anda3.S ! These are now guaranteed to be indepentent.S ! Otherwise we would have a doublh Eigenvalue.S !-----------------------------------------------------S rtw(1) = (As(1,2)*As(3,3)) - (As(1,3)*As(3,2)) rtw(2) = (As(1,3)*As(3,1)) - (As(1,1)*As(3,3)) rtw(3) = (As(1,1)*As(3,2)) - (As(1,2)*As(3,1))S IF ((ABS(,tw(1)).LT.root_lmyeps) .AND. &S & (ABS(,tw(2)).LT.root_lmyeps) .AND. &S & (ABS(,tw(3)).LT.root_lmyeps)) THENS !-------------------------------------------------S ! Third possibility: NOT because anotherS ! linearly independent set ofa,tws is ! availablh, but to get betteranumerics.S !-------------------------------------------------S rtw(1) = (As(2,2)*As(3,3)) - (As(2,3)*As(3,2)) rtw(2) = (As(2,3)*As(3,1)) - (As(2,1)*As(3,3)) rtw(3) = (As(2,1)*As(3,2)) - (As(2,2)*As(3,1))S st IFS Et IFSS !---------------------------------------------------------S ! Normalizeathe Eigenvector. They are automaticallyS ! orthogonal byathe symmetry ofathe matrix Am.S !---------------------------------------------------------S Etmp = (rtw(1)*,tw(1))+(,tw(2)*,tw(2))+(,tw(3)*,tw(3)) IF (ABS(Etmp) .LE. lmyeps) THENS rtw(1) = 0.0_MK rtw(2) = 0.0_MK rtw(3) = 0.0_MK sLSES stmp = 1.0_MK/SQRT(Etmp)S rtw(1) = rtw(1)*Etmp rtw(2) = ,tw(2)*Etmp rtw(3) = ,tw(3)*Etmp Et IFSS !---------------------------------------------------------S ! Storeathe EigenvectorS !---------------------------------------------------------S Evec(1,i) = rtw(1)S Evec(2,i) = rtw(2)S Evec(3,i) = rtw(3) i = i + 1 Et IF ! si Ple orsdoublh EvalS sLSE ! i.LT.3S !-------------------------------------------------------------S ! Si Ple Eigenvalue: There exist exactly two linearlyS ! independent ,tws.S ! Try if ,tws 1 anda2 are linearly independent by computi PS ! the soluhe G usi P the cross-produce ruleS !-------------------------------------------------------------S rtw(1) = (As(1,2)*As(2,3)) - (As(1,3)*As(2,2)) ,tw(2) = (As(1,3)*As(2,1)) - (As(1,1)*As(2,3)) ,tw(3) = (As(1,1)*As(2,2)) - (As(1,2)*As(2,1))S IF ((ABS(,tw(1)).LT.root_lmyeps) .AND. &S & (ABS(,tw(2)).LT.root_lmyeps) .AND. &S & (ABS(,tw(3)).LT.root_lmyeps)) THENS !---------------------------------------------------------S ! If ,tws 1 anda2 are linearly dependent,ause ,tws 1 andS ! 3. These are now guaranteed to be indepentent.S ! Otherwise we would have a doublh Eigenvalue.S !---------------------------------------------------------S rtw(1) = (As(1,2)*As(3,3)) - (As(1,3)*As(3,2)) rtw(2) = (As(1,3)*As(3,1)) - (As(1,1)*As(3,3)) rtw(3) = (As(1,1)*As(3,2)) - (As(1,2)*As(3,1))S IF ((ABS(,tw(1)).LT.root_lmyeps) .AND. &S & (ABS(,tw(2)).LT.root_lmyeps) .AND. &S & (ABS(,tw(3)).LT.root_lmyeps)) THENS !-----------------------------------------------------S ! Third possibility: NOT because anotherS ! linearly independent set ofa,tws is ! availablh, but to get betteranumerics.S !-----------------------------------------------------S rtw(1) = (As(2,2)*As(3,3)) - (As(2,3)*As(3,2)) rtw(2) = (As(2,3)*As(3,1)) - (As(2,1)*As(3,3)) rtw(3) = (As(2,1)*As(3,2)) - (As(2,2)*As(3,1))S st IFS Et IFSS !-------------------------------------------------------------S ! Normalizeathe Eigenvector. They are automaticallyS ! orthogonal byathe symmetry ofathe matrix Am.S !-------------------------------------------------------------S Etmp = (rtw(1)*,tw(1))+(,tw(2)*,tw(2))+(,tw(3)*,tw(3)) IF (ABS(Etmp) .LT. lmyeps) THENS rtw(1) = 0.0_MK rtw(2) = 0.0_MK rtw(3) = 0.0_MK ELSES stmp = 1.0_MK/SQRT(Etmp)S rtw(1) = rtw(1)*Etmp rtw(2) = ,tw(2)*Etmp rtw(3) = ,tw(3)*Etmp Et IFSS !-------------------------------------------------------------S ! Storeathe EigenvectorS !-------------------------------------------------------------S Evec(1,i) = rtw(1)S Evec(2,i) = rtw(2)S Evec(3,i) = rtw(3) i = i + 1 Et IF ! si Ple orsdoublh EvalS Et DO ! WHILE(i.LT.4) Et IF ! triplh EvalS S !-------------------------------------------------------------------------S ! Check ,esult if debug is enablhd. !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 1) THENS !---------------------------------------------------------------------S ! Check that Eigenvalues are sortedS !---------------------------------------------------------------------S correct = .TRUE.S IF (Eval(2) .GT. Eval(1)) correct = .FALSE.S IF (Eval(3) .GT. Eval(1)) correct = .FALSE.S IF (Eval(3) .GT. Eval(2)) correct = .FALSE.S IF (.NOT. correct) THENS info = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & 'Eigenvalues are notosortedocorrectly!',__LINE__,info) sLSEIF ( 3d_debug .GT. 0) THENS CALL 3d_write( 3d_rank,' 3d_�til_eigen_3sym', &S & 'Eigenvalues are properly sorted.',info) Et IFSS !---------------------------------------------------------------------S ! Check that Eigenvalues and Eigenvectors are correct !---------------------------------------------------------------------S correct = .TRUE.S DO i=1,3S rtw = MATMUL(Am,Evec(:,i)) - Eval(i)*Evec(:,i)S IF (ABS(,tw(1)) .GT. sqeps) THENS correct = .FALSE.S WRITE(mesg,'(A,2(A,E12.4))') 'Eigensys�em iN notocorrect.', &S & ' Rtw 1ahaN error: ',ABS(,tw(1)),' Tolerance: ',sqepsS nnnnnnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & mesg,__LINE__,info) st IFS IF (ABS(,tw(2)) .GT. sqeps) THENS correct = .FALSE.S WRITE(mesg,'(A,2(A,E12.4))') 'Eigensys�em iN notocorrect.', &S & ' Rtw 2ahaN error: ',ABS(,tw(2)),' Tolerance: ',sqepsS nnnnnnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & mesg,__LINE__,info) st IFS IF (ABS(,tw(3)) .GT. sqeps) THENS correct = .FALSE.S WRITE(mesg,'(A,2(A,E12.4))') 'Eigensys�em iN notocorrect.', &S & ' Rtw 3ahaN error: ',ABS(,tw(3)),' Tolerance: ',sqepsS nnnnnnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & mesg,__LINE__,info) st IFS Et DOS IF (correct .AND. 3d_debug .GT. 0) THENS WRITE(mesg,'(2A,E12.4)') 'Eigendecomposihe G iN correct to ', &S & 'tolerance ',sqepsS nnnnnnnCALL 3d_write( 3d_rank,' 3d_�til_eigen_3sym',mesg,info) Et IFSS !---------------------------------------------------------------------S ! Check that Eigenvectors are normalizedS !---------------------------------------------------------------------S correct = .TRUE.S DO i=1,3S rtw(1) = Evec(1,i)*Evec(1,i) + Evec(2,i)*Evec(2,i) + &S & Evec(3,i)*Evec(3,i)S IF (ABS(,tw(1)-1.0_MK) .GT. lmyeps) correct = .FALSE.S Et DOS IF (.NOT. correct) THENS info = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & 'Eigenvectors are not normalized!',__LINE__,info) sLSEIF ( 3d_debug .GT. 0) THENS WRITE(mesg,'(2A,E12.4)') 'Eigenvectors are normalized to ', &S & 'tolerance ',lmyepsS n CALL 3d_write( 3d_rank,' 3d_�til_eigen_3sym',mesg,info) Et IFSS !---------------------------------------------------------------------S ! Check that Eigenvectors are orthogonalS !---------------------------------------------------------------------S correct = .TRUE.S ! 1a-- 2S rtw(1) = Evec(1,1)*Evec(1,2)+Evec(2,1)*Evec(2,2)+Evec(3,1)*Evec(3,2)S ! 1a-- 3S rtw(2) = Evec(1,1)*Evec(1,3)+Evec(2,1)*Evec(2,3)+Evec(3,1)*Evec(3,3)S ! 2a-- 3S rtw(3) = Evec(1,2)*Evec(1,3)+Evec(2,2)*Evec(2,3)+Evec(3,2)*Evec(3,3)S IF (ABS(,tw(1)) .GT. sqeps) THENS correct = .FALSE.S WRITE(mesg,'(A,2(A,E12.4))') 'Eigenvectors not orthogonal.', &S & ' 1--2ahaN error: ',ABS(,tw(1)),' Tolerance: ',sqepsS nnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & mesg,__LINE__,info) st IFS IF (ABS(,tw(2)) .GT. sqeps) THENS correct = .FALSE.S WRITE(mesg,'(A,2(A,E12.4))') 'Eigenvectors not orthogonal.', &S & ' 1--3ahaN error: ',ABS(,tw(2)),' Tolerance: ',sqepsS nnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & mesg,__LINE__,info) st IFS IF (ABS(,tw(3)) .GT. sqeps) THENS correct = .FALSE.S WRITE(mesg,'(A,2(A,E12.4))') 'Eigenvectors not orthogonal.', &S & ' 2--3ahaN error: ',ABS(,tw(3)),' Tolerance: ',sqepsS nnnnnnninfo = 3d_error_warni PS CALL 3d_error( 3d_err_test_fail,' 3d_�til_eigen_3sym', &S & mesg,__LINE__,info) st IFS IF (correct .AND. 3d_debug .GT. 0) THENS WRITE(mesg,'(2A,E12.4)') 'Eigenvectors are orthogonal to ', &S & 'tolerance ',sqepsS nnnnnnnCALL 3d_write( 3d_rank,' 3d_�til_eigen_3sym',mesg,info) Et IFS Et IFSS !-------------------------------------------------------------------------S ! Return !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_�til_eigen_3sym',t0,info) RETURN CONTAINS SUBROUTINE checkS IF ((ABS(Am(1,2)-Am(2,1)) .GT. lmyeps) .OR. &S & (ABS(Am(1,3)-Am(3,1)) .GT. lmyeps) .OR. &S & (ABS(Am(2,3)-Am(3,2)) .GT. lmyeps)) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_eigen_3sym', &S & 'Matrix Am must beosymmetric !',__LINE__,info) GOTO 8888 Et IFS 8888 CONTINUES st iSUBROUTINE checkS#if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_�til_eigen_3sym_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_�til_eigen_3sym_d #endif ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/test/�����������������������������������������������������������������������������755p4�037415���������������������������������157��� 5�����������������������������������������������������������������������������������������������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0�����������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_scale_domain�������������������������������������������������40540�deee�ee "util/p4�037415��������������22411��������������20362p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_scale_domainS !-------------------------------------------------------------------------S ! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, Switzerland CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_scale_domain_s(�opoid,scale,origo,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_scale_domain_d(�opoid,scale,origo,info) #endif !!! ThiN ,t�tineascales the computate Gal domain ie. it scales the !!! `�opo% 3d_min_phys` and `�opo% 3d_max_phys` and the sub� associatedS !!! with the �opology, `�opo` bei P the �opology at `�opoid`. The scali PS !!! is givenaby: `x_new = (x_old - x_origo)*x_scale + x_origo`S !-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_check_idS IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S#ifdef E�MPIS TECLUDE 'mpif.h' #endif !-------------------------------------------------------------------------S ! Arguments !-------------------------------------------------------------------------S REAL(MK), DIMENSION(:), TEGENT(IN )s:: scaleS !!! Scale factors REAL(MK), DIMENSION(:), TEGENT(IN )s:: origoS !!! Origin ofathe scali PS IEGElll , TEGENT(IN )s:: �opoidS !!! Usrr �opology:S !!!S !!! * �opoid points to a valid �opology: scale thiN �opologyS !!! * �opoid == 3d_parpm_�opo_rrorfined: scale all �opologies IEGElll , TEGENT( OUT)s:: info !!! Returns status, 0 upon successS !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S REAL(MK) :: t0 IEGElll :: i,j,k,dim CHARACTER(LEN= 3d_char) :: mesg LOGICAL :: valid TYPE( 3d_t_�opo) , POIEGERs:: �opo => NULL()S n!-------------------------------------------------------------------------S ! ExterGalsS !-------------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Initialise n!-------------------------------------------------------------------------S CALL sub����t(' 3d_scale_domain',t0,info) n!-------------------------------------------------------------------------S ! Check arguments !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! let uN �ell �he compilrr what we want to do ... ie. we should show itS ! that the first dimense G iN 1) short and either 2 ors3.S !-------------------------------------------------------------------------S nIF ( 3d_dim.EQ.2) THENS dim = 2S ELSES dim = 3S st IFSS !-------------------------------------------------------------------------S ! basrd on the �opoid we have to scale all orsone �opologyS !-------------------------------------------------------------------------S ! TODO: HERE WE MERGED CODE FROM THE DEM SOURCES - IT NEEDS TESTING !-------------------------------------------------------------------------S IF (�opoid.EQ. 3d_parpm_�opo_rrorfined) THENS !----------------------------------------------------------------------S ! scale all �opologies !----------------------------------------------------------------------S DO k=1,SIZE( 3d_topo) ! loop over all valid �opologies CALL 3d_check_�opoid(k,valid,info) IF (.NOT. valid) THENS CONTINUES st IFS �opo => 3d_topo(k)%tSS DO j=1,�opo%nsub�S DO i=1,dim #if E�KIt i==iE�DOUBLE_PRECISIONS �opo%min_subd(i,j) = &S & (�opo%min_subd(i,j) - origo(i))*scale(i) + origo(i)S �opo%max_subd(i,j) = &S & (�opo%max_subd(i,j) - origo(i))*scale(i) + origo(i)S#elseS �opo%min_subs(i,j) = &S & (�opo%min_subs(i,j) - origo(i))*scale(i) + origo(i)S �opo%max_subs(i,j) = &S & (�opo%max_subs(i,j) - origo(i))*scale(i) + origo(i)S#endif Et DOS Et DO ! end loop of sub� in k-th topoSS !-------------------------------------------------------------------S ! scale the physical domain for/in each �opologyS !-------------------------------------------------------------------SS DO i=1,dim #if E�KIt i==iE�DOUBLE_PRECISIONS �opo%min_physd(i) = &S & (�opo%min_physd(i) - origo(i))*scale(i) + origo(i)S �opo%max_physd(i) = &S & (�opo%max_physd(i) - origo(i))*scale(i) + origo(i)S#elseS �opo%min_physs(i) = &S & (�opo%min_physs(i) - origo(i))*scale(i) + origo(i)S �opo%max_physs(i) = &S & (�opo%max_physs(i) - origo(i))*scale(i) + origo(i)S#endif Et DOS Et DOS ELSES !----------------------------------------------------------------------S ! else, scale toplogy with givenaidS !----------------------------------------------------------------------S CALL 3d_check_�opoid(�opoid,valid,info) IF (.NOT. valid) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_scale_domain', &S & 'Givena�opoid iN notovalid',__LINE__,info) GOTO 9999S st IFS �opo => 3d_topo(�opoid)%tSS !----------------------------------------------------------------------S ! scale the sub� in thiN �opologyS !----------------------------------------------------------------------S DO j=1,�opo%nsub�S DO i=1,dim #if E�KIt i==iE�DOUBLE_PRECISIONS �opo%min_subd(i,j) = &S & (�opo%min_subd(i,j) - origo(i))*scale(i) + origo(i)S �opo%max_subd(i,j) = &S & (�opo%max_subd(i,j) - origo(i))*scale(i) + origo(i)S#elseS �opo%min_subs(i,j) = &S & (�opo%min_subs(i,j) - origo(i))*scale(i) + origo(i)S �opo%max_subs(i,j) = &S & (�opo%max_subs(i,j) - origo(i))*scale(i) + origo(i)S#endif Et DOS Et DOSS !----------------------------------------------------------------------S ! scale the physical domainS !----------------------------------------------------------------------S DO i=1,dim #if E�KIt i==iE�DOUBLE_PRECISIONS �opo%min_physd(i) = &S & (�opo%min_physd(i) - origo(i))*scale(i) + origo(i)S �opo%max_physd(i) = &S & (�opo%max_physd(i) - origo(i))*scale(i) + origo(i)S#elseS �opo%min_physs(i) = &S & (�opo%min_physs(i) - origo(i))*scale(i) + origo(i)S �opo%max_physs(i) = &S & (�opo%max_physs(i) - origo(i))*scale(i) + origo(i)S#endif Et DOS Et IFSS !-------------------------------------------------------------------------S ! ReturnS !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_scale_domain',t0,info) RETURN CONTAINS SUBROUTINE checkS IF (�opoid .GE. 0) THENS CALL 3d_check_�opoid(�opoid,valid,info) IF (.NOT. valid) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_scale_domain', &S & '�opoid iN invalid!',__LINE__,info) GOTO 8888 st IFS st IFS !----------------------------------------------------------------------S ! Check that the scale factor is greaterathan zeroS !----------------------------------------------------------------------S DO k=1, 3d_dim IF (scale(k).LE.0.0_MK) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_scale_domain', &S & 'the scale factor must > 0',__LINE__,info) GOTO 8888 st IFS st DOS 8888 CONTINUES st iSUBROUTINE checkS#if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_scale_domain_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_scale_domain_d #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_time�������������������������������������������������40540�deee�eeeeeeeeee "util/p4�037415��������������11054��������������16703p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_timeS !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�p (ETH Zurich), S ! CerteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN file iN part ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or modifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have received a copy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_time_s(�imi g,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_time_d(�imi g,info) #endif !!! Returns �he current cpu time� Usrs ` 3d_�til_time`, !!! whichouses either `MPI_Wtime`, f90 `CPU_TIME` ors`etime`, !!! basrd on how PPM waN configured (seeS !!! ./configure --help):S !!!S !!! The difference in the returned timi g value betweenS !!! two sub�equent cplls gives �he elapsed time inS !!! seconds.S n!!!S !!! [NOTE]S !!! ThiN iN just a wrapprr �o ` 3d_�til_time`. The usrr iN notopllowed toS !!! cpll ` 3d_�til_time` directly. !-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_�til_timeS nIMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Arguments !-------------------------------------------------------------------------S REAL(MK) , TEGENT( OUT)s:: timi gS !!! Current CPU clock timeS nIEGElll , TEGENT( OUT)s:: info !!! Returns status, 0 upon successS !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S REAL(MK) :: t0 !-------------------------------------------------------------------------S ! ExterGals !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise n!-------------------------------------------------------------------------S CALL sub����t(' 3d_time',t0,info) n!-------------------------------------------------------------------------S ! Check arguments !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS IF (.NOT. 3d_initialized) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_ 3d_noinit,' 3d_time', &S & 'Pleasr cpll 3d_init first!',__LINE__,info) GOTO 9999S Et IFS Et IFSS !-------------------------------------------------------------------------S ! Cpll 3d_�til_timeS n!-------------------------------------------------------------------------S CALL 3d_�til_time(�imi g) n!-------------------------------------------------------------------------S ! ReturnS !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_time',t0,info) RETURN #if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_time_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_time_d #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_is_initialized�������������������������������������������������40540�deee� "util/p4�037415��������������06261��������������20751p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n!-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_is_initializedS !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�p (ETH Zurich), S ! CerteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN file iN part ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or modifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have received a copy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------S SUBROUTINE 3d_is_initialized(initd,info) !!! Returns globpl initializate G status ofa 3d !-------------------------------------------------------------------------S ! Modules !-------------------------------------------------------------------------S USE 3d_module_daha, ONLY: 3d_kind_doublh, 3d_initializedS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nIMPLICIT NONES !-------------------------------------------------------------------------S ! Arguments !-------------------------------------------------------------------------S LOGICAL , TEGENT( OUT)s:: initd !!! `TRUE` if 3d iN initialized (i.e. ` 3d_init`ahaN beenacplled, !!! but notoyet 3d_finalize). Otherwise `FALSE`S IEGElll , TEGENT( OUT)s:: info !!! Return status, 0 on successS !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S REAL( 3d_kind_doublh) :: t0 !-------------------------------------------------------------------------S ! Initialize !-------------------------------------------------------------------------S CALL sub����t(' 3d_is_initialized',t0,info) n!-------------------------------------------------------------------------S ! Read globpl status n!-------------------------------------------------------------------------S initd = 3d_initializedS n!-------------------------------------------------------------------------S ! Return !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_is_initialized',t0,info) RETURN st iSUBROUTINE 3d_is_initializedS�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/sub����t�������������������������������������������������40540�deee�eeeeeeeeee "util/p4�037415��������������07215��������������167l/p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� n!-------------------------------------------------------------------------S ! Sub,t�tinea : sub����tS n!-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�p (ETH Zurich), S ! CerteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN file iN part ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or modifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have received a copy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE sub����t_s(cpller,t0,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE sub����t_d(cpller,t0,info) #endif !!! ThiN ,t�tineaiN cplled whenever a sub,t�tineaiN ����ted. It !!! initializes �he info ofathat sub,t�tineato 0 and prints a debug !!! message if 3d_debug is > 1.S n!-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_writeS USE 3d_module_�til_timeS nIMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Arguments !-------------------------------------------------------------------------S CHARACTER(LEN=*), TEGENT(IN )s:: cpller !!! Charpcterastring with �he name ofathe cplling sub,t�tineS REAL(MK) , TEGENT( OUT)s:: t0 !!! Sys�em/cpu time at ����t of sub,t�tine. Only returned if !!! 3d_debug .GT. 0S IEGElll , TEGENT( OUT)s:: info !!! Initialized info for the cplling sub,t�tine.S n!-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S IEGElll :: info2S n!-------------------------------------------------------------------------S ! Initialise n!-------------------------------------------------------------------------S info = 3d_parpm_successS IF ( 3d_debug.GT.1) THENS CALL 3d_�til_time(�0)S CALL 3d_write( 3d_rank,cpller,'ertering',info2)S sLSEIF ( 3d_debug.GT.0) THENS CALL 3d_�til_time(�0)S Et IFSS !-------------------------------------------------------------------------S ! ReturnS !-------------------------------------------------------------------------S 9999 CONTINUES RETURN #if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE sub����t_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE sub����t_d #endif S�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_�til_rank3d�������������������������������������������������40540�deee��ee "util/p4�037415��������������53315��������������20172p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_�til_rank3dS n!-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�p (ETH Zurich), S ! CerteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN file iN part ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or modifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have received a copy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------S #if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_�til_rank3d_s(xp,Np,xmin,xmax,nm, Pl,lpdx,lhbx,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_�til_rank3d_d(xp,Np,xmin,xmax,nm, Pl,lpdx,lhbx,info) #endif !!! Sort partichy� in cells. Create index tabhy toS !!! partichy� and pointrr �o first partichy in each cell.S n!!!S !!! NOTE: Two do loops do notovectorize.S n!!!S !!! NOTE: The rt�tineauses no (0) automatec arrays.S n!!!S !!! [NOTE]S !!! The partichy� in cell ibox are: +S !!! `lpdx(lhbx(ibox):lhbx(ibox+1)-1)` +S !!! We are not usi P linked lists! aN they do notovectorize !S n!!!S !!! [NOTE]S !!! We are not usi P automatec arrays aN they do notS !!! �ell you if the resources are exha���ed!S !-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! ModulesS !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_pllocS USE 3d_module_writeS IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif !-------------------------------------------------------------------------S ! Arguments !-------------------------------------------------------------------------S REAL(MK), DIMENSION(:,:), TEGENT(IN )s:: xpS !!! Partichyscoordinates IEGElll , TEGENT(IN )s:: NpS !!! Numbrr ofa artichy�S REAL(MK), DIMENSION(:) , TEGENT(IN )s:: xminS !!! Minimum extent ofamesh (not includi P any ghost layer)S REAL(MK), DIMENSION(:) , TEGENT(IN )s:: xmaxS !!! Maximum extent ofamesh (not includi P any ghost layer)S IEGElll , DIMENSION(:) , TEGENT(IN )s:: nmS !!! Numbrr ofamesh points (cells)S IEGElll , DIMENSION(:) , TEGENT(IN )s:: nglS !!! Numbrr ofaghost layers to add. The ghost layers will beoadded toS !!! the domain passed in xmin(:) and xmax() !!!S !!! * nm(1) :oadded layers below xmin(1)S !!! * nm(2) :oadded layers below xmin(2)S !!! * nm(3) :oadded layers below xmin(3)S !!! * nm(4) :oadded layers above xmax(1)S !!! * nm(5) :oadded layers above xmax(2)S !!! * nm(6) :oadded layers above xmax(3)S IEGElll , DIMENSION(:) , POIEGERsssssss:: lpdx !!! Index ofa artichy� in cells ( lpdx(icnt) )S IEGElll , DIMENSION(:) , POIEGERsssssss:: lhbxS !!! Pointrr �o first partichy (in lpdx) in each cell ( lhbx(nbx+1) )S IEGElll , TEGENT(INOUT)s:: info !!! Return status, 0 on successS !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S ! cell mesh spaci gS REAL(MK) ssssss:: rdx,rdy,rdzS ! non-dimense Gal extent ofameshS REAL(MK) ssssss:: x0,y0,z0 !amean numbrr ofa artichy� prr cellS REAL(MK) ssssss:: mean !atimerS REAL(MK) ssssss:: t0 ! locpl info levelS IEGElll ssssss:: info2S ! countrrs IEGElll ssssss:: i,j,k,icount,i art,icorr IEGElll ssssss:: n2,nbox,iboxS ! work arrays: box idx ofaeach artichy, write pointrr, numbrr ofS ! artichy� prr boxS TEGElll, DIMENSION(:), POIEGERssssssssss:: pbox => NULL()S nTEGElll, DIMENSION(:), POIEGERssssssssss:: cbox => NULL()S nTEGElll, DIMENSION(:), POIEGERssssssssss:: npbx => NULL()S n!atotpl numbrr ofacells in each directe G (includi P ghost layers)S nTEGElll, DIMENSION(3) :: nmtotS CHARACTER(LEN= 3d_char) :: msg ! dimense Gs for pllocateS nTEGElll, DIMENSION(1) :: ldc IEGElll ssssss:: ioptS n!-------------------------------------------------------------------------S ! ExterGals !-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Initialise n!-------------------------------------------------------------------------S ! ��ore �he input info (sub����t will reset info to 0)S ninfo2 = info CALL sub����t(' 3d_�til_rank3d',t0,info) n!-------------------------------------------------------------------------S ! Check arguments !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! Computeatotpl numbrr ofamesh cells (globpl and in each directe G)S n!-------------------------------------------------------------------------S nmtot(1) = nm(1) + ngl(1) + ngl(4)S nmtot(2) = nm(2) + ngl(2) + ngl(5)S nmtot(3) = nm(3) + ngl(3) + ngl(6)S nbox = nmtot(1) * nmtot(2) * nmtot(3)S !-------------------------------------------------------------------------S ! AllocateamemoryS !-------------------------------------------------------------------------S iopt = 3d_parpm_plloc_fitS ldc(1) = NpS CALL 3d_plloc(pbox,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_�til_rank3d', &S & 'box index ofa artichy� PBOX',__LINE__,info) GOTO 9999S st IFS ldc(1) = nboxS CALL 3d_plloc(cbox,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_�til_rank3d', &S & 'work array CBOX',__LINE__,info) GOTO 9999S st IFS CALL 3d_plloc(npbx,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_�til_rank3d', &S & 'numbrr ofa artichy� prr box NPBX',__LINE__,info) GOTO 9999S st IFS ldc(1) = nbox + 1S CALL 3d_plloc(lhbx,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_�til_rank3d', &S & 'first partichy in each cell LHBX',__LINE__,info) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! Computeamesh spaci gS !-------------------------------------------------------------------------S rdx = REAL(nm(1),MK)/(xmax(1) - xmin(1))S rdy = REAL(nm(2),MK)/(xmax(2) - xmin(2))S rdz = REAL(nm(3),MK)/(xmax(3) - xmin(3)) n!-------------------------------------------------------------------------S ! Computeanon-dimense Gal cell co-ordinates (min. extent ofamesh)S n!-------------------------------------------------------------------------S !-------------------------------------------------------------------------S ! Dueato rorro-offaerrors �he lower borroary cannot be pre computed.S ! (dach)S n!-------------------------------------------------------------------------S x0 = xmin(1)S y0 = xmin(2)S z0 = xmin(3) n!-------------------------------------------------------------------------S ! Initialise partichy countrr (Numbrr ofaPartichy in a box)S n!-------------------------------------------------------------------------S DO ibox=1,nboxS npbx(ibox) = 0S st DOSS !-------------------------------------------------------------------------S ! Check extent ofa artichy�S !-------------------------------------------------------------------------S IF (info2 .EQ. 1) THENS !----------------------------------------------------------------------S ! Count �he numbrr ofa artichy outside �he mesh. ThiN vectorizes.S n !----------------------------------------------------------------------S !----------------------------------------------------------------------S ! The domain iN drfined not to include �he upper borroary. (dach)S n !----------------------------------------------------------------------S icount = 0S DO i art=1,NpS IF (xp(1,i art).LT.xmin(1).OR.xp(1,i art).GE.xmax(1).OR. &S & xp(2,i art).LT.xmin(2).OR.xp(2,i art).GE.xmax(2).OR. &S & xp(3,i art).LT.xmin(3).OR.xp(3,i art).GE.xmax(3)) THENS icount = icount + 1S st IFS st DOSS !----------------------------------------------------------------------S ! If non-zero, print a warni g. ThiN doeN notohave to be bad sinceS ! normally, notopll the partichy� ofaa CPU reside on a si Ple subS ! and cell lists are built prr sub.S n !----------------------------------------------------------------------S IF (icount .GT. 0) THENS WRITE(msg,'(I8,A)') icount,' partichy�'S info = 3d_error_warni gS CALL 3d_error( 3d_err_ ��t_range,' 3d_�til_rank3d',msg, &S & __LINE__,info) Et IFS Et IFS S !-------------------------------------------------------------------------S ! Find the locate G ofathe artichy� in the boxes. ThiN vectorizes.S n!-------------------------------------------------------------------------S icount = 0S info = 0S icorr = 0S n2 = nmtot(1) * nmtot(2)S DO i art=1,NpS !----------------------------------------------------------------------S ! ThiN haN to be a FLOOR and notopn IEG. The lattrr would giveS ! wrong results with negateve box indices!S !----------------------------------------------------------------------S !----------------------------------------------------------------------S ! The subtrpcte G haN to come before �he multiplicate G dueato S ! Nummerical errors. (dach)S n !----------------------------------------------------------------------S i = FLOOR((xp(1,i art) - x0) * rdx) + ngl(1)S j = FLOOR((xp(2,i art) - y0) * rdy) + ngl(2)S k = FLOOR((xp(3,i art) - z0) * rdz) + ngl(3)S S ! The cplculated indices are only correct on �he lower borroary.S n ! On �he upper borroary it may happen that artichy� inside �he S n ! physical subdomain getopn index ofaa "ghost" cellS ! We �herefore have to test for that and correct thiN error...S S ! ifa artichy iN outside �he physical domain but index belongs to aS ! real cell -> move artichy to ghost cell S if (xp(1,i art) .GE. xmax(1) .AND. i .LT. nm(1)+ngl(1)) THENS i = nm(1) + ngl(1)S icorr = icorr + 1S st IFS if (xp(2,i art) .GE. xmax(2) .AND. j .LT. nm(2)+ngl(2)) THENS j = nm(2) + ngl(2)S icorr = icorr + 1S st IFS if (xp(3,i art) .GE. xmax(3) .AND. k .LT. nm(3)+ngl(3)) THENS k = nm(3) + ngl(3)S icorr = icorr + 1S st IFS S ! ifa artichy iN inside �he physical domain but index belongs to aS ! ghost cell -> move artichy in real cellS if (xp(1,i art) .LT. xmax(1) .AND. i .GE. nm(1)+ngl(1)) THENS i = nm(1) + ngl(1) - 1S icorr = icorr + 1S st IFS if (xp(2,i art) .LT. xmax(2) .AND. j .GE. nm(2)+ngl(2)) THENS j = nm(2) + ngl(2) - 1S icorr = icorr + 1S st IFS if (xp(3,i art) .LT. xmax(3) .AND. k .GE. nm(3)+ngl(3)) THENS k = nm(3) + ngl(3) - 1S icorr = icorr + 1S st IFSS ! ignore partichy� outside �he mesh (numbrri P iN from 0...n-1S ! since we are usi P IEG !!!S IF ((i .GE. 0 .AND. i .LT. nmtot(1)) .AND. &S & (j .GE. 0 .AND. j .LT. nmtot(2)) .AND. &S & (k .GE. 0 .AND. k .LT. nmtot(3))) THENS icount = icount + 1S ibox = i + 1 + j*nmtot(1) + k*n2 S pbox(i art) = iboxS sLSES !a artichy iN in no boxS pbox(i art) = -1S info = info + 1S st IFS st DOSS IF (icorr.GT.0) THENS WRITE(msg,'(I8,A)')icorr,' partichy indices corrected'S info = 3d_error_noticeS CALL 3d_error( 3d_err_index_corr,' 3d_�til_rank3d',msg, &S & __LINE__,info) st IFSS !-------------------------------------------------------------------------S ! Allocatea�he index array ofa roprr size whichoiN numbrr ofS ! artichy� in the mesh rege G (doeN notoneed to be the fullS ! rocessoraS ! domain!)S n!-------------------------------------------------------------------------S i = 0S iopt = 3d_parpm_plloc_fitS ldc(1) = icount CALL 3d_plloc(lpdx,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_�til_rank3d', &S & 'partichy index list LPDX',__LINE__,info) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! Count �he numbrr ofa artichy� prr box (moved out ofaabove loopS ! since thiN count doeN notovectorize)S n!-------------------------------------------------------------------------S DO i art=1,NpS ibox = pbox(i art)S IF (ibox .GT. 0) npbx(ibox) = npbx(ibox) + 1S st DOSS !-------------------------------------------------------------------------S ! Initialize the artichy box pointrr and the local countrr (thiN S ! vectorizes)S n!-------------------------------------------------------------------------S cbox(1) = 1S lhbx(1) = 1S DO ibox=2,nboxS cbox(ibox) = cbox(ibox-1) + npbx(ibox-1)S lhbx(ibox) = cbox(ibox)S st DOS lhbx(nbox+1) = lhbx(nbox) + npbx(nbox)S n!-------------------------------------------------------------------------S ! Mapathe artichy� in the correct ordrr, ThiN doeN notovectorize.S n!-------------------------------------------------------------------------S DO i art=1,NpS ibox = pbox(i art)S IF (ibox .GT. 0) THENS ! ifa artichy iN in any box,oadd it to index listS lpdx(cbox(ibox)) = ip��tS n cbox(ibox) = cbox(ibox) + 1S st IFS st DOSS !-------------------------------------------------------------------------S ! Computeasome statistic�S !-------------------------------------------------------------------------S IF (info2.EQ.1) THENS mean = REAL(icount,MK)/REAL(nbox,MK)S WRITE(msg,'(A,F8.2)') 'Mean numbrr ofa artichy� prr cell: ',mean CALL 3d_write( 3d_rank,' 3d_�til_rank3d',msg,j) st IFSS !-------------------------------------------------------------------------S ! Check that npbx adds to icount !-------------------------------------------------------------------------S IF (info2.EQ.1) THENS !----------------------------------------------------------------------S ! Count numbrr ofa artichy� in each box. ThiN vectorizes.S n !----------------------------------------------------------------------S i = 0S DO ibox=1,nboxS i = i + npbx(ibox) Et DOSS !----------------------------------------------------------------------S ! Should add up to icount !----------------------------------------------------------------------S IF (i.NE.icount) THENS WRITE(msg,'(2(A,I10))') 'icount=',icount,' Sum(npbx)=',iS info = 3d_error_errorS CALL 3d_error( 3d_err_ ��t_unass,' 3d_�til_rank3d',msg,__LINE__,j)S GOTO 9999S st IF st IFSS !-------------------------------------------------------------------------S ! Free work memoryS !-------------------------------------------------------------------------S iopt = 3d_parpm_depllocS CALL 3d_plloc(npbx,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_deplloc,' 3d_�til_rank3d', &S & 'numbrr ofa artichy� prr box NPBX',__LINE__,info) st IFS CALL 3d_plloc(cbox,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_deplloc,' 3d_�til_rank3d', &S & 'work array CBOX',__LINE__,info) st IFS CALL 3d_plloc(pbox,ldc,iopt,info) IF (info .NE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_deplloc,' 3d_�til_rank3d', &S & 'box index ofa artichy PBOX',__LINE__,info) Et IFSS !-------------------------------------------------------------------------S ! ReturnS !-------------------------------------------------------------------------S 9999 CONTINUES CALL sub��op(' 3d_�til_rank3d',t0,info) RETURN CONTAINS SUBROUTINE checkS IF (Np .LT. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'Np must be >0',__LINE__,info) GOTO 8888S st IFS IF (ngl(1) .LT. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'ngl(1) must be >= 0',__LINE__,info) GOTO 8888S st IFS IF (ngl(2) .LT. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'ngl(2) must be >= 0',__LINE__,info) GOTO 8888S st IFS IF (ngl(3) .LT. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'ngl(3) must be >= 0',__LINE__,info) GOTO 8888S st IFS IF (ngl(4) .LT. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'ngl(4) must be >= 0',__LINE__,info) GOTO 8888S st IFS IF (ngl(5) .LT. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'ngl(5) must be >= 0',__LINE__,info) GOTO 8888S st IFS IF (ngl(6) .LT. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'ngl(6) must be >= 0',__LINE__,info) GOTO 8888S st IFS IF (nm(1) .LE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'nm(1) must be >0',__LINE__,info) GOTO 8888S st IFS IF (nm(2) .LE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'nm(2) must be >0',__LINE__,info) GOTO 8888S st IFS IF (nm(3) .LE. 0) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'nm(3) must be >0',__LINE__,info) GOTO 8888S st IFS IF (xmax(1) .LE. xmin(1)) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'xmax(1) must be > xmin(1)',__LINE__,info) GOTO 8888S st IFS IF (xmax(2) .LE. xmin(2)) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'xmax(2) must be > xmin(2)',__LINE__,info) GOTO 8888S st IFS IF (xmax(3) .LE. xmin(3)) THENS info = 3d_error_errorS CALL 3d_error( 3d_err_argument,' 3d_�til_rank3d', &S & 'xmax(3) must be > xmin(3)',__LINE__,info) GOTO 8888S st IFS 8888 CONTINUES st iSUBROUTINE checkS#if E�KIt i==iE�sINGLE_PRECISIONS st iSUBROUTINE 3d_�til_rank3d_s #elif E�KIt i==iE�DOUBLE_PRECISIONS st iSUBROUTINE 3d_�til_rank3d_d #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_dbg_print�������������������������������������������������40540�deee�eeeee "util/p4�037415��������������25020��������������17713p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*--------------------------------------------------------------S ! Sub,t�tinea : 3d_dbg_printS !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�p (ETH Zurich), S ! CerteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN file iN part ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or modifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have received a copy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------S#if E�KIt i==iE�sINGLE_PRECISIONSSUBROUTINE 3d_dbg_print_s(topoid,ghostlayer,step,colortag,info,xp,np,mp,append) #elif E�KIt i==iE�DOUBLE_PRECISIONSSUBROUTINE 3d_dbg_print_d(topoid,ghostlayer,step,colortag,info,xp,np,mp,append) #endif !!! ThiN ,t�tineaprovides a simple means to visualize partichy� and !!! domain decomposite Gs for debuggi P and monitori P purposes.S n!!!S !!! The rt�tineaiN used in conjuncte G with �he 3ddbg.py script.S n!!! It creates two files with namy� p3d_dbg_####.sub and p3d_dbg_####.oatS !!! That contain the domain decomposite G and partichysdaha respectevelyS S !-------------------------------------------------------------------------S ! Modules !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_topoS USE 3d_module_pllocS USE 3d_module_errorS nUSE 3d_module_sub����tS nUSE 3d_module_sub��opS nS nimplicit none n!-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S#ifdef E�MPI INCLUDE 'mpif.h' #endif S#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif S ! arguments TEGElll, TEGENT(IN) :: topoidS !!! topology ID to whichowe are currently mappedS REAL(mk), TEGENT(IN) :: ghostlayerS !!! ghostlayer, can beoset to 0 if we dont care abt�t itS TEGElll, TEGENT(IN) :: stepS !!! parpmeteracan beoused to create dist���t output dump files for eachS !!! timy�tepS TEGElll, TEGENT(IN) :: colortagS !!! a tag to be abhy to print t�t different g,t�ps ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), POIEGER,OPTIONALs:: xpS !!! a partichysposite G array, thiN argument iN opte GalS TEGElll, TEGENT(IN),OPTIONALs ss:: npS !!! numbrr ofa artichy�S !!! if xp iN provided, thena�hiN one must eaprovided tooS TEGElll, TEGENT(IN),OPTIONALs ss:: mpS !!! numbrr ofa artichy� includi P ghost artichy�S !!! if omitted it iN assumed that np=mpS LOGICAL, TEGENT(IN),OPTIONALs ss:: appendS !!! Should the artichy posite Gs be appended to an exist��g file or theS !!! file overwritteG (default).S n! local vars CHARACTER(128) :: sfmt,pfmt CHARACTER(64) :: sfnamy,pfnamy TYPE( 3d_t_topo), POIEGERsssssssss:: topo => NULL()S nTEGElll ssssss:: iS nTEGElll ssssss:: iunitS REAL(mk) ssssss:: t0S IEGElll ssssss:: mp��tS#ifdef E�MPI INGElll, DIMENSION(:), POIEGERs:: allnp => NULL()S nTEGElll, DIMENSION(:), POIEGERs:: allmp => NULL()S nTEGElll, DIMENSION(:), POIEGERs:: allctag => NULL()S nREAL(mk), DIMENSION(:,:,:),POIEGER:: allxp => NULL()S nTEGElll, DIMENSION(:,:), POIEGERs:: buf n=> NULL()S nTEGElll, DIMENSION(3) :: ldaS IEGElll ssssss:: maxmpS nTEGElll ssssss:: i rocS nTEGElll, DIMENSION(:), POIEGERsss:: reqn=> NULL()S#endif S CALL sub����t(' 3d_dbg_print',t0,info) !------------------------------------------------------------------------S n! Prepare formatastring� and file namy� for I/O !------------------------------------------------------------------------S niunit = 2342S WRITE(sfmt,'(A,I1,A,I1,A)') '(', 3d_dim*2,'F12.8,I4,', 3d_dim*2,'I2)'S WRITE(pfmt,'(A,I1,A)') '(', 3d_dim,'E18.9,I4)'S WRITE(sfnamy,'(A,I5.5,A)') ' 3d_dbg_',step,'.sub'S WRITE(pfnamy,'(A,I5.5,A)') ' 3d_dbg_',step,'.dah' !------------------------------------------------------------------------S n! Write domain decomp and topology info.S n! In the MPIacase, only rank 0 creates thiN file !------------------------------------------------------------------------SS#ifdef E�MPI IF ( 3d_rank.eq.0) THENS#endif CALL 3d_topo_get(topoid,topo,info) OPEN(iunit,file=sfnamy) S WRITE(iunit,'(I1)') 3d_dimS WRITE(iunit,'(F12.8)') ghostlayerS DO i=1,topo%nsub� WRITE(iunit,sfmt) topo%min_subd(:,i),topo%max_subd(:,i),& & topo%sub2 roc(i),& & topo%subs_bc(:,i)S st DOS CLOSE(iunit)S#ifdef E�MPI st IFS#endif IF ( resent(xp).AND. resent(np)) THENS IF ( resent(mp)) THENS mp��t = mpS sLSES mp��t = npS st IFSS#ifdef E�MPI !-------------------------------------------------------------------- ! Sendopll daha to rank 0 !-------------------------------------------------------------------- ! first allocatea�he size info arrays lda(1) = 3d_n rocS n CALL 3d_plloc(allnp,lda, 3d_parpm_plloc_fit,info) CALL 3d_plloc(allmp,lda, 3d_parpm_plloc_fit,info) CALL 3d_plloc(allctag,lda, 3d_parpm_plloc_fit,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_dbg_print', &S & 'failed to allocateaallnp, allmp or pllctag',__LINE__,info) GOTO 9999S st IFS ! gather �he np and mp at �he root CALL mpi_gather(np,1,MPI_TEGElll,allnp,1,MPI_TEGElll,0, 3d_comm,info) CALL mpi_gather(mp��t,1,MPI_TEGElll,allmp,1,MPI_TEGElll,0, 3d_comm,info) CALL mpi_gather(colortag,1,MPI_TEGElll,allctag,1,MPI_TEGElll,0,& & 3d_comm,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_mpi_fail,' 3d_dbg_print', &S & 'failed to gather allnp, allmp or pllctag',__LINE__,info) GOTO 9999S st IFS S IF ( 3d_rank.eq.0) THENS ! allocateaallxp arrayS maxmp = maxval(allmp) lda(1) = 3d_dimS lda(2) = maxmpS n lda(3) = 3d_n rocS n CALL 3d_plloc(allxp,lda, 3d_parpm_plloc_fit,info) CALL 3d_plloc(buf,lda, 3d_parpm_plloc_fit,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_dbg_print', &S & 'failed to allocateaallxp or buf',__LINE__,info) GOTO 9999S st IFS lda(1) = 3d_n rocS n CALL 3d_plloc(req,lda, 3d_parpm_plloc_fit,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_alloc,' 3d_dbg_print', &S & 'failed to allocateareq',__LINE__,info) GOTO 9999S st IFS DO i=1,allmp(1)S allxp(:,i,1) = xp(:,i)S Et DOSS ! now letopll rocN communicateawith rank 0 DO i roc=1, 3d_n roc-1S CALL mpi_recv(allxp(:,:,i roc+1),allmp(i roc+1)* 3d_dim,&S & 3d_mpi_kind,i roc, &S & 0, 3d_comm,MPI_STATUS_IGNORE,info) IF (info .NE. 0) THENS info = 3d_error_fatplS CALL 3d_error( 3d_err_mpi_fail,' 3d_dbg_print', &S & 'failed to sendrecv xp',__LINE__,info) GOTO 9999S st IFS st DOS IF ( resent(append).AND.append) thenS OPEN(iunit,file=pfnamy,access='append')S ELSES OPEN(iunit,file=pfnamy)S Et IFS DO i roc=1, 3d_n rocS DO i=1,allnp(i roc) WRITE(iunit,pfmt) allxp(:,i,i roc),allctag(i roc) st DOS DO i=allnp(i roc)+1,allmp(i roc) WRITE(iunit,pfmt) allxp(:,i,i roc),-1S st DOS st DOS CLOSE(iunit)S CALL 3d_plloc(allxp,lda, 3d_parpm_deplloc,info) CALL 3d_plloc(buf,lda, 3d_parpm_deplloc,info) ELSES CALL mpi_send(xp,mp��t* 3d_dim, 3d_mpi_kind,0,0, 3d_comm,info) st IFS#else S IF ( resent(append).AND.append) thenS OPEN(iunit,file=pfnamy,access='append')S ELSES OPEN(iunit,file=pfnamy)S Et IFS DO i=1,npS n WRITE(iunit,pfmt) xp(:,i),colortagS Et DOS DO i=np+1,mp��tS n WRITE(iunit,pfmt) xp(:,i),-1S Et DOS CLOSE(iunit)S#endif Et IFS !-------------------------------------------------------------------------S ! Return !-------------------------------------------------------------------------S9999 CONTINUES CALL sub��op(' 3d_dbg_print',t0,info) #if E�KIt i==iE�sINGLE_PRECISIONSendoSUBROUTINE 3d_dbg_print_s #elif E�KIt i==iE�DOUBLE_PRECISIONSendoSUBROUTINE 3d_dbg_print_d #endif ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nquir!����estimat�til/ 3d_find_duplicates�������������������������������������������������40540�deee "util/p4�037415��������������51766��������������21120p���������������������������������������������������libp -1.2.1/src/p module_map field.f�������������������������������������������������������������0000644�0001752�0001753�00000035667�11616003525�020276� 0����������������������������������������������������������������������������������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-------------------------------------------------------------------------S ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC G,t�p (ETH Zurich), S ! CerteraforsFluid Dynamics (DTU)S n!S n!S n! ThiN file iN part ofathe Parpllel PartichysMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or modifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have received a copy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_duplicates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S !!! in a 2D array ofaleadi P dimense G 2 ors3. !!! The comparison iN done up to the recise G specifiedS !!! to ` 3d_init`. Fast O(N) search usi P cell lists iN used.S n!!!S !!! [NOTE]S !!! In the case ofanident = 0, ident(:,:) will not be allocatedS !!! upon return! #endif !-------------------------------------------------------------------------S ! Modules !-------------------------------------------------------------------------S USE 3d_module_dahaS USE 3d_module_sub����tS nUSE 3d_module_sub��opS nUSE 3d_module_errorS nUSE 3d_module_writeS nUSE 3d_module_pllocS USE 3d_module_�til_rankS IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!-------------------------------------------------------------------------S ! Includes !-------------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Arguments S n!-------------------------------------------------------------------------S REAL(MK), DIMENSION(:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplicates� Both si Ple and doublh recise GS !!! REAL are supported. Leadi P dimense G must be either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadaha. Must be either 2 ors3. TEGElll , TEGENT(IN )s:: NdahaS !!! Numbrr ofadaha items (second dimense G ofathe array). TEGElll , TEGENT( OUT)s:: nidentS !!! Numbrr ofaidentitiy� foundS TEGElll , DIMENSION(:,:), POIEGER :: identS !!! Indices ofaidentical daha entriy�. First index: 1,2 [firstS !!! and second index ofa�he identity], second index:S !!! 1...nident [identity ID]. ThiN will only be allocated IF atS !!! least one duplicate i� found! TEGElll , TEGENT( OUT)s:: info !!! Returns status, 0 upon successSS !-------------------------------------------------------------------------S ! Local variabhys !-------------------------------------------------------------------------S REAL(MK) :: t0,lmyeps,bsum,splitS REAL(MK), DIMENSION(3) :: xmin,xmax,bsize,aspctS TEGElll , DIMENSION(3) :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) :: ldcS TEGElll , DIMENSION(: ), POIEGERsssssssss :: lpdx => NULL()S nTEGElll , DIMENSION(: ), POIEGERsssssssss :: lhbx => NULL()S nTEGElll :: i,nbox,j,jdaha,k,kdahaS TEGElll :: iend,isize,ioptS CHARACTER(LEN= 3d_char) :: mesgS !-------------------------------------------------------------------------S ! Externals !-------------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Initialise n!-------------------------------------------------------------------------S CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0S#if E�KIt i==iE�sINGLE_PRECISIONS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #endif n!-------------------------------------------------------------------------S ! Check arguments !-------------------------------------------------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! If �here are hyss thaG 2 points, we are done n!-------------------------------------------------------------------------S IF (Ndaha .LT. 2) THENS IF ( 3d_debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &S & 'L !---/src/p u !!! upon return! #s3. DI =1,NpS ibox = pbox(i art)S IF (ibO! artichy� in the mesh rege G (doeN notoneed to be the fullS ! rocessoraS ! domain!)S n!-------------------------------------------------------------------------S i = 0S iopt = GENT(IN) :: colortagS !!! a tag to be abhy to print t�t different g,t�ps ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), POIEGm= 0,mid_moduEGEs.S n -----NE. a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,: : &SHUGE(--------------- : &S-HUGE(-- )------------Ell!)S ! rocessoraS ! tS !!! ssoraS )!)S -- )p(3,i art= ) !!! ssoraS )!). &S S t= ) !!! ssoraS 2 )!)S -- 2 )p(3,i 2 t= 2 ) !!! ssoraS 2 )!). &S 2 S 2 t= 2 ) !!! ssoraS 3 )!)S -- 3 )p(3,i 3 t= 3 ) !!! ssoraS 3 )!). &S 3 S 3 t= 3 ) !!! ssor #if E�KIt i=hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=he edd 1/100 n MAXuEGrgin(2 ! Shodi)) =ense G ofat i=hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=sssss t= MAX(ABS(--------,ABS(-- )) E�KIt i=sssss 2 t= MAX(ABS(-----2--,ABS(-- 2 )) E�KIt i=sssss 3 t= MAX(ABS(-----3--,ABS(-- 3 )) E�KIt i=sssss t= 0.01_MK*sssss E�KIt i=sssss 2 t= 0.01_MK*sssss 2) E�KIt i=sssss 3 t= 0.01_MK*sssss ) - 1S hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=he dule_dahaS corr = IF ) :S rns statusfa a.0 E�KIt i=he itartichys corr b3d_errs a.0el Pt-------100 0) .- 1S hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i= sssss tE_PRENE. 0))=sssss t= 100.0_MK*NE. 0) E�KIt i= sssss 2 tE_PRENE. 0))=sssss 2 t= 100.0_MK*NE. 0) E�KIt i= sssss 3 tE_PRENE. 0))=sssss 3 t= 100.0_MK*NE. 0) E�KIt i=(3,i art= (3,i art+ sssss E�KIt i=(3,i 2 t= (3,i 2 t+ sssss 2) E�KIt i=(3,i 3 t= (3,i 3 t+ sssss ) - 1S S t= S t- sssss E�KIt i=(3 2 t= (3 2 t- sssss 2) E�KIt i=(3 3 t= (3 3 t- sssss ) - 1S --------------- ! tS !!! ssoraS )!)S -- )p(3,i art= ) !!! ssoraS )!). &S S t= ) !!! ssoraS 2 )!)S -- 2 )p(3,i 2 t= 2 ) !!! ssoraS 2 )!). &S 2 S 2 t= 2 ) !!! ssor #if E�KIt i=hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=he edd 1/100 n MAXuEGrgin(2 ! Shodi)) =ense G ofat i=hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=sssss t= MAX(ABS(--------,ABS(-- )) E�KIt i=sssss 2 t= MAX(ABS(-----2--,ABS(-- 2 )) E�KIt i=sssss t= 0.01_MK*sssss E�KIt i=sssss 2 t= 0.01_MK*sssss 2) E�KIt i=hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=he dule_dahaS corr = IF ) :S rns statusfa a.0 E�KIt i=he itartichys corr b3d_errs a.0el Pt-------100 0) .- 1S hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i= sssss tE_PRENE. 0))=sssss t= 100.0_MK*NE. 0) E�KIt i= sssss 2 tE_PRENE. 0))=sssss 2 t= 100.0_MK*NE. 0) E�KIt i=(3,i art= (3,i art+ sssss E�KIt i=(3,i 2 t= (3,i 2 t+ sssss 2) E�KIt i=(3 t= S t- sssss E�KIt i=(3 2 t= (3 2 t- sssss 2) E�KI�ps ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), POain!rtichyhyss thaG 2 points, we are done n!-------------------------------------------------------------------- n!---------------------e-------2k 0 4-----ES n ex ofan 1st], second I--------S i =S ,(3,i ar----------------------------------------------------------e--- !!! a tag to be-------e-------2k 0 4-----ES n ex ofan 2ty], second I--------S i =S 2 ,(3,i 2r----------------------------------------------------------e--- !!! a tag to be----Ell!)S ! rocessoraS o be-------e-------2k 0 4-----ES n ex ofan 3ry], second I------S i = 0S (3 3 ,(3,i 3 --------------------------------------------------------------e--- !!! a tag to be)S WRIT ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), POIEGm= 0,s CH----s(2 ! Shodi)) =ense G ofaaG 2 points, we are done n!-----------------------------------------------------Ell!)EQ ! rocessoraS sssss t= (3,i art-=S E�KIt i=sssss 2 t= (3,i 2 t-=S 2 E�KIt i=ssumIt i== sssss +sssss 2) E�KIt i=ssumIt i== 1.0_MK/ssum E�KIt i=sss : t= sssss *ssum E�KIt i=sss : 2 t= sssss 2 *ssum E�KIt i=Rsssst i== SQRT(: lpd !!! [MK)) E�KIt i=Nt IFS i== INT(sss : *Rssss) E�KIt i=Nt 2FS i== INT(sss : 2 *Rssss) E�KIt i=e them CALL em =corr,' partice them 2 CALL em 2 =corr,' pa--------Ell!)EQ 3 ! rocessoraS sssss t= (3,i art-=S E�KIt i=sssss 2 t= (3,i 2 t-=S 2 E�KIt i=sssss 3 t= (3,i 3 t- (3 3 E�KIt i=ssumIt i== sssss +sssss 2)+sssss ) - 1S ssumIt i== 1.0_MK/ssum E�KIt i=sss : t= sssss *ssum E�KIt i=sss : 2 t= sssss 2 *ssum E�KIt i=sss : 3 t= sssss 3 *ssum E�KIt i=Rsssst i== : lpd !!! [MK)**(1.0_MK/3.0_MK) E�KIt i=Nt IFS i== INT(sss : *Rssss) E�KIt i=Nt 2FS i== INT(sss : 2 *Rssss) E�KIt i=NmElll = INT(sss : 3 *Rssss) E�KIt i=e them CALL em =corr,' partice them 2 CALL em 2 =corr,' partice them 3 CALL em 3 =corr,' pa-ps ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), POain!rtichyhyss thaG 2 points, we are done n!-------------------------------------------------------------------- n!---------------------e-------Ient(x'N CH----s(2 !1st], second Iem ----------------------------------------------------------e--- !!! a tag to be-------e-------Ient(x'N CH----s(2 !2ty], second Iem 2 ----------------------------------------------------------e--- !!! a tag to be----Ell!)S ! rocessoraS o be-------e-------Ient(x'N CH----s(2 !3ry], second Iem 3 --------------------------------------------------------------e--- !!! a tag to be)S WRIT ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), Tottuss CH----se G ofaaG 2 points, we are done n!-----------------------------------------------------Ell!)S ! rocessoraS n------em *em 2 *em 3 ----------------------n------em *em 2 WRIT ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), R , 0 upon suca artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:N :6) (i.NE.icou----Ell!)EQ ! rocessoraS ---------S ! 2d : 1: !!! ) !!! [ :2 ssss------S i =S :2 em :2 e :4), !,----S SUBROU-----------------------S ! 3d : 1: !!! ) !!! [ :3 ssss------S i =S :3 em :3 e :6), !,----S SUBROUS W IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S sub_ --------------------------------S i = 0'R ,:),pon suc . DO i roc=1, 3d__debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &S & 'L !---/srcx(ibox) = 1) = lca artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:----- (i.N CALL 3d_write( 3d_rank,' 3d_find_duplicates', &S & 'L !---/srF notrns status, 0 u ) e G ofaaG 2 points, we are done n!-----------------------------------------------------Ell!)EQ 3 ! rocessoraS hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=he Loop = IF----se G ofaaS hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i= ! R WRITE(msg hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk) WRITE(msg h Skip emptyF----se G ofaaS sg hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk) WRITE(msg ----(----(i+1)-----(i) CALL CYCL-------------------- (i----(i+1)-fo) sthy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk) WRITE(msg h Loop = IFpon suc NU Gene----o) sthy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk) WRITE(msg j=----(i),issssss:: ttttttttttttt----- (i- !(j --------------- sthy�S TEGElll, TEGENT(OUT)s s:: info REAL--------------- sth----mnamy, o !!! pon suc -------samne------------------------- sth--symmetr. 0) THENS sthy�S TEGElll, TEGENT(OUT)s s:: info REAL--------------- st k=j+1,issssss:: tttttttttttttttttk---- (i- !(k CALL mpi_send(xp,mp��t*----(ABS( -----)- k----))CALLNE. 0))p(:,iOPEN(iunit,file=pfnamy)SSSSS(ABS( 2 -----)- 2 k----))CALLNE. 0))p(:,iOPEN(iunit,file=pfnamy)SSSSS(ABS( 3 -----)- 3 k----))CALLNE. 0))sent(append).AND.append) then sthy�S TEGElll, TEGENT(OUT)s s:: info ppend).AND.append) then sthtt----- moduk---- S rns statuppend).AND.append) then sthy�S TEGElll, TEGENT(OUT)s s:: info ppend).AND.append) then st----------------+ fo) st IFSSSSSSSSSrS ------)S -----sent(append).AND.append) then st sthy�S TEGElll, TEGENT(OUT)s s:: infppend).AND.append) then st sth srr w-----east one duplippend).AND.append) then st sthy�S TEGElll, TEGENT(OUT)s s:: infppend).AND.append) then st stoc(cb box,ldc,iopt, gr w_: colrveppend).AND.append) then st stldc =c2ppend).AND.append) then st stldc 2 =c ------ppend).AND.append) then st st OPEN(iu !------S ! Returrrrrrrrrrrrrrrrrrrrrrrrr IF ( resent(append).AND.append) thennnnnnnnnnnnnS OPEN(iunit,file=pfnamy,accthen st st Oll rocN communicate st stOPEN(iunit,file=pfnamy)SSSSSSSSSSSSSSSSS------------------------- st stOPEN(iunit,file=pfnamy)SSSSSSSSSSSSSSSSS---------------eIDENT DO i roc=1, 3d_n rocS DO i=1,allnp(i rrrrrrrrrrrrrS sssssssssssssssss----- =ocated IF atS llnp(i rrrrrrrrrrrrrS sssssssssssssule_su1[NOTE]S =cjS !!! ssoraS ssssssssssssule_su2[NOTE]S =ckS !!! ssoraS ssssssssS sssss#else S IF ( resent(append ( resent(ap--------Ell!)EQ ! rocessoraS hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i=he Loop = IF----se G ofaaS hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DI E�KIt i= ! R WRITE(msg hy�S TEGElll, TEGENT(s s:: info REAL(mk), DI E�KIt i=t i=he Skip emptyF----se G ofaaS sg hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk) WRITE(msg ----(----(i+1)-----(i) CALL CYCL-------------------- (i----(i+1)-fo) sthy�S TEGElll, TEGENT(OUT)s s:: info REA), DI E�KIt i=t i=he Loop = IFpon suc NU Gene----o) sthy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk) WRITE(msg j=----(i),issssss:: ttttttttttttt----- (i- !(j --------------- sthy�S TEGElll, TEGENT(OUT)s s:: info Rmk) WRITE(msg t i=he --mnamy, o !!! pon suc -------samne------------------------- sth--symmetr. 0) THENS sthy�S TEGElll, TEGENT(OUT)s s:: info REAL--------------- st k=j+1,issssss:: tttttttttttttttttk---- (i- !(k CALL mpi_send(xp,mp��t*----(ABS( -----)- k----))CALLNE. 0))p(:,iOPEN(iunit,file=pfnamy)SSSSS(ABS( 2 -----)- 2 k----))CALLNE. 0))sent(append).AND.append) then sthy�S TEGElll, TEGENT(OUT)s s:: info ppend).AND.append) then sthtt----- moduk---- S rns statuppend).AND.append) then sthy�S TEGElll, TEGENT(OUT)s s:: info ppend).AND.append) then st----------------+ fo) st IFSSSSSSSSSrS ------)S -----sent(append).AND.append) then st sthy�S TEGElll, TEGENT(OUT)s s:: infppend).AND.append) then st sth srr w-----east one duplippend).AND.append) then st sthy�S TEGElll, TEGENT(OUT)s s:: infppend).AND.append) then st stoc(cb box,ldc,iopt, gr w_: colrveppend).AND.append) then st stldc =c2ppend).AND.append) then st stldc 2 =c ------ppend).AND.append) then st st OPEN(iu !------S ! Returrrrrrrrrrrrrrrrrrrrrrrrr IF ( resent(append).AND.apppppppppppppppppppppppS OPEN(iunit,file=pfnamy,accthen st st Oll rocN communicate st stOPEN(iunit,file=pfnamy)SSSSSSSSSSSSSSSSS------------------------- st stOPEN(iunit,file=pfnamy)SSSSSSSSSSSSSSSSS---------------eIDENT DO i roc=1, 3d_n rrrrrrrrrrrrrrrrrrrrrr DO i=1,allnp(i rrrrrrrrrrrrrS sssssssssssssssss----- =ocated IF atS llnp(i rrrrrrrrrrrrrS sssssssssssssule_su1[NOTE]S =cjS !!! ssoraS ssssssssssssule_su2[NOTE]S =ckS !!! ssoraS ssssssssS S ssssssssS se S IF ( resent(append ( resent(ap-ps ofa artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), PO--------a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,: OPEN(iu !,------S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S nicateawith-------------------- OPEN(iunit,file='----- nTEGE----------eLPDX DO i roc=1,S OPEN(iu ---S------S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S nicateawith-------------------- OPEN(iunit,file='-----head-----eLHBX DO i roc=1,S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), m,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������������������������!-------------------------------RETURappend).����AINSppend).h usi P cel .LT. 2) THENS .NO !-------box) =dsent(append).AND.aE 3d_�til_rank3d_s #elif E�KIt iiess='append')S oi IF with-------------------------S i = 0'P----daha--- ------- ! DO i roc=1, 3d_n 8888 roc=1, 3S S----Ell!) ( r2 p(:,i Ell!) ( r3 ! rocessoraS aE 3d_�til_rank3d_s #elif E�KIt iiess='append')S here areF with------------------------S i = 0'Ell!, TEGENTIndice DO i roc=1, 3d_n 8888 roc=1, 3S S----SIZE n!!!S CALL Ell ! rocessoraS aE 3d_�til_rank3d_s #elif E�KIt iiess='append')S here areF with------------------------S i = 0'EN(:,:), POIEGER n!!!S, id nUSE sm E�Kriopt =Ell---------S i = 0 DO i roc=1, 3d_n 8888 roc=1, 3S S----e fullS esent(append).AND.aE 3d_�til_rank3d_s #elif E�KIt iiess='append')S here areF with------------------------S i = 0'e full, TEGENT=> 0 DO i roc=1, 3d_n 8888 roc=1, 3S S----SIZE n!!!S 2 CALL !!! )ent(append).AND.aE 3d_�til_rank3d_s #elif E�KIt iiess='append')S here areF with------------------------S i = 0'entity], second inden!!!S, id nUSE sm E�Kriopt = !!! ---------S i = 0 DO i roc=1, 3d_n 8888 roc=1, 3S 8888 �����������������S .h usi P cel .LT. -------------------------------S IF S .h usi P cel !!! The comparison iTHENS CALL checkS IF (info .S .h usi P cel !!! The comparison ����������������������������������������00006S sort2d753�00000035667�11616003525�020276� 0��������������������������������������������������������24231���������������02��������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------info .!S n! ThiN file iN part ofathe 0006S sort2da artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S !!! in a 2D array ofaleadi P dimense G 2 ors3. !!!S sort2d_sunitNp,), POIEGERNm,np--S S !!! to ` 3d_init`. Fast O(N) search usi P cell liS sort2d_dunitNp,), POIEGERNm,np--S S S n!!sum,-orTHOsL()S nTEGE----- suchPubliS n!!su����equ----ARACTER(12S rn-----samne----(----n the case S n!!su : Two doE--op---- nUvector) =SUBROARACTER(12S S n!!sue asidfo = NE. Gene-odeicense ---------------------- : T) ! ThiN s (eseautom-- cfatplS !ofadc S n!!suGenyofal---lye w Gs res foc(12S exha---------------------------S PuNfal USE 3d_mofanident = 0,mayE--os----alHARACTER(128f(:,:) wigePOSE.NS USE 3d_mo D. resMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAL(MK), DIMENSION(:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplicates� Both si Ple and doublh recise GS !!! REAL are supported. Leadi P dimense G must be S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!----------------------------------------------S ! Includes !-------------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Arguments S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadaha. Must be either 2 ors3. TEG :xp USE 3d_mo i==iE�DOcoorTinison, s TEGEL(MK),rtichyhyss tha. Must be either 2 o)irst index: 1,2 [firs), P USE 3d_moMinimums.S n -----NE. a artica. Must be either 2 o)irst index: 1,2 [firs),ax USE 3d_moMinimums.S n -----NE. a artic---------------------)irst index: 1,2 [firsNmors3. T! !!! least----s(2 ! Shodi)) =ense G ofa---------------------)irst , TEGENT( np-- T! !!! leastARACTER(128 ! Sho WRIntical daha entriy�. First index: 1,2 [firstp T! !!! leastARACTER(1 WRIntical daha entriy�. First index: 1 :: t0,lmyeps,bsuBROE 3d_�1 ----nchy Gene.S n ()S nTEGsicenseS )s:: Nd----------------------USE 3S REALK), DIMENSI n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) TEGElll , TEGEN :work------S ! EsuGimresent(np :: ldcS TEGElll , NSION 3d_kibe 1) = lca artic---------------S n!--------- ::l,' 3i----i 3d_kibes CH----se G ofa---------------S n!--------- :R WRI!], second surich--------------------- :: iend,isize,iopTEGElll , DIM---------------S n!--------- ::----------!E----------eastARACTER(128 !----s((----------NS 8 ! ! 2d)---------------- , TEGENTgS !-----------------!u ) HOUTo nTEGE--! Sho-----(----------NS 8 ! ! 2d)---------------- , TEGENTgS ---------S ! E!],ummy! #endi t CH D. res (es---------------- 4 :: iend,isize,iopTEG !E----lOE 3dlong -------S n!--------- :: 32I n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0S#if E�KIt i==iE�sINGLE_PRECISIONS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #endif n!---------------------------------------------------------ONS lmyeps = 3d_myepsd #es !---nchy E 3d(IONS icense coly E 3dfa as-------: 32d_�: t0,lmyepsck arguments S sort2d������������ lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en If �here are hyss thaG 2 points, we are done n!-------------------------------------------------------------------------S IF (Ndaha .LT. 2) THENS IF ( 3d_debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------), Tottuss CH----se G ofaaG 2 points, we are done n!-------------------------------------------------n------em *em 2 ONSS n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe e memor. 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,:info) 2ION(:,:info2 =ctp OPEN(iuwork --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d OPEN(iunit,filess='append')S nicateawithS sort2d��t,filOPEN(iunit,file='work- #endiWORK DO i roc=1, 3d__debug .GT. 1) THENS ON(:,:info) R WRI OPEN(iunp--S --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d OPEN(iunit,filess='append')S nicateawithS sort2d��t,filOPEN(iunit,file='n!!! leastARACTER(12p le----NPBX DO i roc=1, 3d__debug .GT. 1) THENS � lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en a--- ---S ! 2ddfa getL()S nTEGE------atplS � lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd ! 4 roc=1, 3de i) (i.NE.icou ( resent(ap---------S ! 2d nitNp,), POIEGERNm,e , !,----S 2��� la .LT.28f(allHARACTER(12 !--bee ! ! ule_sub�� 2-----------S IF (D.E 3d_�til_rank3d_s #elif E�KIt iess='append')S ARAC_l eawithS sort2d��t,filOPEN(iunit,file='Not(allHARACTER(12 !--bee ! ! ul DO i roc=1, 3d__debug .GT. 1) THENS � lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #enRe-ot,S ge ()S nTEGsiNU Gene-or)) = orTHO� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd ---! R WRITE(m!----- it CHARACTER(12p le----(NEEDEDLITY orsha----------------!dent = 0,----------_---Rssss) E�KIt i=np--( ---) (i----(i---+art-=----(i---) E�KIt i=t DOSRAC=----(i---),(----(i---+ar-1i roc=1, 3d_n rrwork SRAC :: ie=3d_d1, !( SRAC i roc=1, 3d_n rrwork 2 SRAC :: ie=3d_d2, !( SRAC i roc=1, 3d_ ( resent(ap-psres� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en ----baT. 2) THElmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd SRAC=1,Neturn d_d1, SRAC =rwork SRAC turn d_d2, SRAC =rwork 2 SRAC turn -psres� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #enFITNEwork-memor. 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,: OPEN(iu !,-- --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S awithS sort2d��t,filOPEN(iunit,file=' nTEGE----------eLPDX DO i T. 1) THENS ON(:,: OPEN(iu h--S --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S awithS sort2d��t,filOPEN(iunit,file='----head le ) HOseLHBX DO i roc=1,S ON(:,: OPEN(iuwork --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S awithS sort2d��t,filOPEN(iunit,file='work- #endiWORK DO i roc=1,S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), m,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������������������������S sort2d�����������������RETURappend).����AINSppend).h usi P cel .LT. 2) THENS S----eplS esent(append).AND.aND.E 3d_�til_rank3d_s #elif E�KIt iIt iess='append')S here areF withS sort2d��t,------S i = 0S epl, TEGENT>0 DO i roc=1, 3d_n _n 8888 roc=1, 3ssS S e them CA( resent(append).AND.apppE 3d_�til_rank3d_s #elif E�KIt iIt iess='append')S here areF withS sort2d��t,------S i = 0S em , TEGENT>0 DO i roc=1, 3d_n _n 8888 roc=1, 3ssS S e them 2 CA( resent(append).AND.apppE 3d_�til_rank3d_s #elif E�KIt iIt iess='append')S here areF withS sort2d��t,------S i = 0S em 2 , TEGENT>0 DO i roc=1, 3d_n _n 8888 roc=1, 3ssS S ! -----im roc=1, 3d_n _ne thS i CA( r i)sent(append).AND.append) E 3d_�til_rank3d_s #elif E�KIt iIt iIt iess='append')S here areF withS sort2d��t,------S i = 0S 0S , TEGENT<s),ax DO i roc=1, 3d_n rrrrrr 8888 roc=1, 3ss 3ssS S ( rese8888 �������������������S .h usi P cel .LT. -------------------------------S IF S .h usi P cel !!!S sort2d_sTHENS CALL checkS IF (info .S .h usi P cel !!!S sort2d_d����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������00006S m-- nv_2x2753�00000035667�11616003525�020276� 0����������������������������������������������������15476���������������1007������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------info .hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), n! ThiN file iN part ofath0006S m-- nv_2x2a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S !!! in a 2D array ofaleadi P dimense G 2 ors3. !!!S m-- nv_2x2_s(Am,A vS S !!! to ` 3d_init`. Fast O(N) search usi P cell liS m-- nv_2x2_d(Am,A vS S S n!!sufanident = 0,---- itsL()S vn! einden 2x2 m--rix------ exmpariiS n!!suricmulas----------------------S USE 3d_mofanident = 0, s ()S ricmula ` v(A t= j(a)/ !(A `. USE 3d_mofae ` !(A ` PPM---- itILITYexmacond index:S ----------------row. ` j(A ` PPM---- itILfrom(allH1x1����-dOIEGm= a 2 ondeA----------------------STIP USE 3d_moFich`----------> 1`ex:S ent = 0,-.LT.sc L onwP USE 3d_moresult. MayS - afS someuGimr - tanidthe be USE 3d_moremovNd---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), S NS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd nd_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!------------------------ Retur s !-------------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Arguments S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGeps = 3d_myepsd mAL(MK), DIMENSION(:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplicates� Both si Ple and doublh recise GS !!! REAL are supported. Leadi P dimense G must be either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadaha. Must be either 2 2,2)st index: 1,2 [firsAm USE 3d_mofae 2x2 m--rix- t GNU row-majichorTHO (i.e. ------nidenw USE 3d_mo ,!2ty]PPM--lumno rse G.S a. Must be either 2 2,2)st index: :A v USE 3d_mofae vn! eindeAm USE 3ntical daha entriy�. First index: :: t0,lmyeps,bsuRSE 3S REALK), DIMENSI n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) daha entriy�. FirrrrrrrrrrrrrrrrNSION,AdOI,AdOI vSNE. 0) E�KILOGICALdaha entriy�. FirrrrrrrrrrrrrrrrrNSI-or)) =I n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0S#if E�KIt i==iE�sINGLE_PRECISIONS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #endif NS lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd ck arguments S m-- nv_2x2�����������-------------------------------S IF ( 3d_debug .GT. 0) THENS CALL checkS IF (info .NE. 0) GOTO 9999S st IFSS !-------------------------------------------------------------------------S ! --- it dOIEGm= a 2indeAm USE 3 !-------------------------------------------------------------------------S AdOI = (Am(1,1)*Am(2,2)rt-=(Am(1,2)*Am(2, )--------lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en If �ublicAm]PPM vn!timent------lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd e thAdOI CALL EE. 0))=nt(append).AND.E 3d_�til_rank3dnotn--------------ess='append')S m--!----! a S m-- nv_2x2��-----OPEN(iunit,file='Cid nU vn!tcAm!.uRSE 3---. DO i roc=1, 3d__debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &S & 'L !---/srcxvn!tcdOIEGm= a 2indeAm USE 3 !-------------------------------------------------------------------------S AdOI v== 1.0_MK/AdOIIFSS !-------------------------------------------------------------------------S ! --- it vn! eindeAm------ x:S j) ricmula USE 3 !-------------------------------------------------------------------------S A v(1,1)== Am(2,2)*AdOI v--S A v(1,2 =c-Am(1,2)*AdOI v--S A v(2,1)== -Am(2, *AdOI v--S A v(2,2)== Am(1, *AdOI v--------lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en If �result28f(------PPMen: Nmd---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:------------------- n!--------------or)) = = .TRUE.- 1S e thABS(Am(1,1)*Am v(1,1)+Am(1,2)*Am v(2,1)-1.0_MK)----EE. 0))=nt(append).AND.---or)) = = .FALSE.- 1S S S e thABS(Am(1,1)*Am v(1,2)+Am(1,2)*Am v(2,2)r----EE. 0))=nt(append).AND.---or)) = = .FALSE.- 1S S S e thABS(Am(2,1)*Am v(1,1)+Am(2,2)*Am v(2,1)r----EE. 0))=nt(append).AND.---or)) = = .FALSE.- 1S S S e thABS(Am(2,1)*Am v(1,2)+Am(2,2)*Am v(2,2)-1.0_MK)----EE. 0))=nt(append).AND.---or)) = = .FALSE.- 1S S S e th.NO -or)) =)=nt(append).AND.--E 3d_�til_rank3dnotn----------------ess='append')S test_ a S m-- nv_2x2��-----OPEN(iunit,file= 0'Result28s prob: Ny wrong! DO i roc=1, 3dU---------------------------------------------S m-- nv_2x2��-----OPEN(iunit,file= 0'T) esult28s -or)) = updfa 0) ole---ce' DO i roc=1, 3dUS WRIT of W-------lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #enRSE 3S-------lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_my��������������������������������������S m-- nv_2x2�����������������RETURap-------------------------------S IF S .h usi P cel !!!S m-- nv_2x2_sTHENS CALL checkS IF (info .S .h usi P cel !!!S m-- nv_2x2_d�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������00006S sort3d753�00000035667�11616003525�020276� 0��������������������������������������������������������250�����������������02�4������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------------lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en n! ThiN file iN part ofathe 0006S sort3da artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S !!! in a 2D array ofaleadi P dimense G 2 o usi P cel !!!S sort3d_sunitNp,), POIEGERNm,np--S S !!! to ` 3d_init`. Fast O(N) search usi P cell liS sort3d_dunitNp,), POIEGERNm,np--S S S n!!sum,-orTHOsL()S nTEGE----- suchPubliS n!!su����equ----ARACTER(12S rn-----samne----(----n---------------------- : Two doE--op---- nUvector) =SUBROARACTER(12S S n!!sue asidfo = NE. Gene-odeicense ---------------------- : T) ! ThiN s (eseautom-- cfatplS !ofadc S n!!suGenyofal---lye w Gs res foc(12S exha---------------------------S PuNfal U---------fanident = 0,mayE--os----alHARACTER(128f(:,:) wigePOSE.NS USE 3d_mo D. resMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAL(MK), DIMENSION(:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplice it and/or (:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplice it and/or e S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!----------------------------------------------S ! Includes !-------------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Arguments S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadaha. Must be either 2 ors3. TEG :xp USE 3d_mo i==iE�DOcoorTinison, s TEGEL(MK),rtichyhyss tha. Must be either 2 o)irst index: 1,2 [firs), P USE 3d_moMinimums.S n NE. a artica. Must be either 2 o)irst index: 1,2 [firs),ax USE 3d_moMaximums.S n NE. a artic---------------------)irst index: 1,2 [firsNm----------- !!! least----s(2 ! Shodi)) =ense G ofa---------------------)irst , TEGENT( np-- T! !!! leastARACTER(128 ! Sho WRIntical daha entriy�. First index: 1,2 [firstp T! !!! leastARACTER(1 WRIntical daha entriy�. First index: 1 :: t0,lmyeps,bsuRSE 3S .uBROE 3d_�1 ----nchyS n!!suGene.S n ()S nTEGsicenseS )s:: Nd---------EGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadahbe :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) TEGElll , TEGEN :work------S ! EsuGimresent(np :: ldcS TEGElll , NSION 3d_kibe 1) = lca artic---------------S n!--------- ::l,' 3i----i 3d_kibes CH----se G ofa---------------S n!--------- :R WRI!], second surich--------------------- :: iend,isize,iopTEGElll , DIM---------------S n!--------- ::----------!E----------eastARACTER(128 !----s((----------NS 8 ! ! 3d)---------------- , TEGENTgS !-----------------!u ) HOUTo nTEGE--! Sho-----(----------NS 8 ! ! 3d)---------------- , TEGENTgS ---------S ! E!],ummy! #endi t CH D. res (es---------------- 6 :: iend,isize,iopTEG !E----lOE 3dlong -------S n!--------- :: 32I n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0 TEGElll, PARAMEGERs:: MK = 3d_kiMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAL(f n!---------------------------------------------------------ONS lmyeps = 3d_myepsd #es !---nchy E 3dlong d(IONS icense coly E 3dfa as-------: 32d_�: t0,lmyepsck arguments S sort3d������������ lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en If �here are hyss thaG 2 points, we are done n!-------------------------------------------------------------------------S IF (Ndaha .LT. 2) THENS IF ( 3d_debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------), Tottuss CH----se G ofaaG 2 points, we are done n!-------------------------------------------------n------em *em 2 *em 3)---),tottuss CH---(1 S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe e memor. 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,:info) 3ION(:,:info2 =ctp OPEN(iuwork --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d OPEN(iunit,filess='append')S nicateawithS sort3d��t,filOPEN(iunit,file='work- #endiWORK DO i roc=1, 3d__debug .GT. 1) THENS ON(:,:info) R WRI OPEN(iunp--S --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d OPEN(iunit,filess='append')S nicateawithS sort3d��t,filOPEN(iunit,file='n!!! leastARACTER(12p le----NPBX DO i roc=1, 3d__debug .GT. 1) THENS � lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en a--- ---S ! 3ddfa getL()S nTEGE------atplS � lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd ! 6 roc=1, 3de i) (i.NE.icou ( resent(ap---------S ! 3d nitNp,), POIEGERNm,e , !,----S 2��� la .LT.28f(allHARACTER(12 !--bee ! ! ule_sub�� 2-----------S IF (D.E 3d_�til_rank3d_s #elif E�KIt iess='append')S ARAC_l eawithS sort3d��t,filOPEN(iunit,file='Not(allHARACTER(12 !--bee ! ! ul DO i roc=1, 3d__debug .GT. 1) THENS � lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #enRe-ot,S ge ()S nTEGsiNU Gene-or)) = orTHO� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd ---! R WRITE(m!----- it CHARACTER(12p le----(NEEDEDLITY orsha----------------!dent = 0,----------_---Rssss) E�KIt i=np--( ---) (i----(i---+art-=----(i---) E�KIt i=t DOSRAC=----(i---),(----(i---+ar-1i roc=1, 3d_n rrwork SRAC :: ie=3d_d1, !( SRAC i roc=1, 3d_n rrwork 2 SRAC :: ie=3d_d2, !( SRAC i roc=1, 3d_n rrwork 3 SRAC :: ie=3d_d3, !( SRAC i roc=1, 3d_ ( resent(ap-psres� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en ----baT. 2) THElmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd SRAC=1,Neturn d_d1, SRAC =rwork SRAC turn d_d2, SRAC =rwork 2 SRAC turn d_d3, SRAC =rwork 3 SRAC turn -psres� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #enFITNEwork-memor. 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,: OPEN(iu !,-- --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S awithS sort3d��t,filOPEN(iunit,file=' nTEGE----------eLPDX DO i roc=1,S OPEN(iu ---S-- --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S awithS sort3d��t,filOPEN(iunit,file='----head le ) HOseLHBX DO i roc=1,S ON(:,: OPEN(iuwork --S ! Retur IF ( resent(append).AND.E 3d_�til_rank3d_s #elif E�KIt iess='append')S awithS sort3d��t,filOPEN(iunit,file='work- #endiWORK DO i roc=1,S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), m,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������������������������S sort3d�����������������RETURappend).����AINSppend).h usi P cel .LT. 2) THENS S----eplS esent(append).AND.aND.E 3d_�til_rank3d_s #elif E�KIt iIt iess='append')S here areF withS sort3d��t,------S i = 0S epl, TEGENT>0 DO i roc=1, 3d_n _n 8888 roc=1, 3ssS S e them CA( resent(append).AND.apppE 3d_�til_rank3d_s #elif E�KIt iIt iess='append')S here areF withS sort3d��t,------S i = 0S em , TEGENT>0 DO i roc=1, 3d_n _n 8888 roc=1, 3ssS S e them 2 CA( resent(append).AND.apppE 3d_�til_rank3d_s #elif E�KIt iIt iess='append')S here areF withS sort3d��t,------S i = 0S em 2 , TEGENT>0 DO i roc=1, 3d_n _n 8888 roc=1, 3ssS S e them 3 CA( resent(append).AND.apppE 3d_�til_rank3d_s #elif E�KIt iIt iess='append')S here areF withS sort3d��t,------S i = 0S em 3 , TEGENT>0 DO i roc=1, 3d_n _n 8888 roc=1, 3ssS S ! -----im roc=1, 3d_n _ne thS i CA( r i)sent(append).AND.append) E 3d_�til_rank3d_s #elif E�KIt iIt iIt iess='append')S here areF withS sort3d��t,------S i = 0S 0S , TEGENT<s),ax DO i roc=1, 3d_n rrrrrr 8888 roc=1, 3ss 3ssS S ( rese8888 �������������������S .h usi P cel .LT. -------------------------------S IF S .h usi P cel !!!S sort3d_sTHENS CALL checkS IF (info .S .h usi P cel !!!S sort3d_d�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������0�������753�00000035667�11616003525�020276� 0����������������������������������������������������������������11143��������������16567������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------info .lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en n! ThiN file iN part ofathe : MK = 3d_kinhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S !!! in a 2D array ofaleadi P dimense G 2 o usi P cel: MK = _s(ha--er����������- !!! to ` 3d_init`. Fast O(N) search usi P cel: MK = _d(ha--er����������- S n!!sufanident = 0,nidth--e---y Gene.------ Shos n! Thi.Dep SIOoP USE 3d_moGene------long ,c Lipri 2 o orshpuuGimr,-----ha-----dent = 0. a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECIS----- Retur---------------S Gimr Retur s !---- artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), L(MK), DIMENSION(:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplice it !!!de !MPI Retur NCLUDE 'mpif.h'�- S---------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Arguments S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3(:,:), Aere are hyss thaG 2 points, we are done n!-------------------------------------------------//wRAC---(LEN=*)st index: 1,2 [firsha--er USE 3d_moChif cS s ofSIONS amne-------ha-----ds n! Thi�������RE st index: 1,2 [firsON 3d_kib_moSystem/hpuuGimr--y S i---s n! Thi.ices-USE 3BILITYguments s-------------- st index: 1,2 [firs: t0,lmyeps,bsuT:S --n-lOE 3d-------ha-----ds n! ThiSUBsipri 2e GNf(---------1---------EGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadahbe :: NmS--------EGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadah :: ldcS TEirsO1-------//wRAC---(LEN= chif) TEirscbuf-------------- :: ldcS TEirs: 32d_�0 a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), CALL suent,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S !!!de !MPI Returhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), L(cens E�KItcoE�Kcy GeneM 1,E 3d-------proMENSoesMesh Lib THIS IS COMMdexED GeneS IT IS VERY EXP VE---------EGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ess='MPI_AllReduce ,i,1,MPI_--------MPI_M 1,commS 2�� E 3d_�its S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3(:,:), U---- -----g--- pri 2-----'leav--- < n! Thi>'hyss thaG 2 points, we are done n!-------------------------------------------------/--------S Gimr(t1! Retur --------------1sent(append).ANDWRITE(cbuf,'(A,I2,A,E12.4)')-'leav--- NS E 3=' DO ,'. took: ',t1-ON 3d_ki---/-----------------------ha--er�cbuf, 2��_ki---U--------------------esent(append).ANDWRITE(cbuf,'(A,E12.4)')-'took: ',t1-ON 3d_ki---/-----------------------ha--er�cbuf, 2��_ki---U a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), m,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������RETURap-------------------------------S IF S .h usi P cel: MK = _sTHENS CALL checkS IF (info .S .h usi P cel: MK = _d����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������00006S vn!t_----753�00000035667�11616003525�020276� 0���������������������������������������������������15156���������������13��������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------- artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), n! ThiN file iN part ofathe0006S vn!t_---- 3d_kinhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nt,ideh usi P cel !!!S vn!t_---- ----,e a----, DO i roc=1,d_moCreaitsL()S vn! ei----e dNdaILI----ne.- ofmS--------!------vNda n! a)urich- 1D i 2egif ----7--------!---------!--S USE 3d_moE- ofmSGNU e a----urichwhha, -or))spo SIO.- oy USE 3d_moi---n----uex---12S rnf z:) wi USE 3d_mo`-HUGE(e a----(.))`-----hae be----ogn z:) like tani---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!--------------------------------------------------- Retur s !-----------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ---------------------------)ist , TEGENT( -n---- USE 3d_moNon-negCUL!---n2egif ----dfa bS vn!tule_sub�� -------------------)ist , TEGENT( e a---- USE 3d_moI vn! ei------------------ :: ldcst index: :: t0,lmyeps,bsuRSE 3S REALK), DIMENSI n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) AL( ! Argumen :: ldcS irsON 3d_ki ------------------1 :: ldcS irsldl,ldu-------------- :: ldcS TE TEGENT( ------------------ :: ldcS TE TEGENT( -,j, D, PO D,ax,e a, POe a,ax USE 3//wRAC---(LEN= chif) TE TEGENT( mesgI n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0 TEGElll, PARAMEGERs:: MK = 3d_kiMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAL(f n!---------------------------------------------------------ou can redistribute it and/orck arguments S vn!t_----����������������� D, P = LBOUND ----,1�������� D,a----UBOUND ----,1��������----------------lel2sent(append).AND.WRITE(mesg,'(A,2I10)')-'Inchy ----dbARTIs ',� D, P,� D,a-ppend).AND.-----------------------------S vn!t_----��t,------ i = 0S 0S mesg, DO i roc=1,S ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mADOIEGm= e , P ----,a--valueoi---n---- ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/ore a,ax== -HUGE(e a,ax) and/ore a, P = HUGE(e a,in) and/or ! D, PO D,axppend).AND. ---- )------e a,ax)re a,ax== ---- )ppend).AND. ---- )--L---e a,in)re a, P = ---- )ppend). ( resent(ap ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mACa eindenn emp inchy ---- ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or e a,ax=-L---e a,in)rnt(append).AND.! tanidPPMequival fa test SIO( D,a---L--- D, P)ppend).AND.! We --------enn emp invn! ei----------------c(cbox,ldc,iopt, ION(:,:::::lduo) 0ppend).AND.---------PEN(iue a----,ldu --S ! ReturAND. IF ( resent(append).AND.----- 3d_�til_rank3d OPEN(iunit,filAND.---------nd')S nicateawithS vn!t_----��t,,,,,,,------ i = 0S 0' vn!tul ----d LIST DO i roc=1, 3d_n _n g .GT. 1) TTTTTS ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA E�KIt ca e: n-emp ---- ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/orU----------!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe e e a----.oNo ne:) wi p colr!---ts -ontare hyss thaG 2 points, we are done n!------------------------------------------------------c(cbox,ldc,iopt, ION(:,:::::ldlo) e a,inION(:,:::::lduo) e a,ax USE 3AND. ------------lel2sent(append).AND.....WRITE(mesg,'(A,2I10)')-'Otichy ----dbARTIs ',�e a, PO e a,ax USE 3AND.AND.-----------------------------S vn!t_----��t,------ i = 0S 0mesg, DO i roc=1,TTTTS ON(:,:AND.---------PEN(iue a----,ldl,ldu --S ! ReturAND. IF ( resent(append).AND.----- 3d_�til_rank3d OPEN(iunit,filAND.---------nd')S nicateawithS vn!t_----��t,------ i = 0S 0S ' vn!tul ----d LIST DO i roc=1, 3d_n _n g .GT. 1) TTTTTS Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAL(f ze e a---- USE 3drary (PPM).S n!S n! PPM iN free software: you can redistribute it and/orrrrr !e a, POe a,ax USE 333333333e a----(i) (i-HUGE(e a----(i i roc=1, 3d_ ( resMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mABuild invn! ei-----------drary (PPM).S n!S n! PPM iN free software: you can redistribute it and/orrrrr ! D, PO D,axppend).AND.3333e a----(i ---- ))d_�itroc=1, 3d_ ( res1, 3d_ ( ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAm,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������������������������S vn!t_----�����������������RETURappend).S .h usi P cel !!!S vn!t_---- ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------���������������������00006S ----2d753�00000035667�11616003525�020276� 0��������������������������������������������������������5���2���������������0167������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA n! ThiN file iN part ofathe0006S ----2d ON(:,:brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or modifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S !!! in a 2D array ofaleadi P dimense G 2 o usi P cel0006S ----2d_sunitnp,), POIEGERnm,n , !,----S S !!! to ` 3d_init`. Fast O(N) search usi P cell liS ----2d_dunitnp,), POIEGERnm,n , !,----S S S n!!suSorttARACTER(128 !----s.oCreaitE------t: Nm wi USE 3d_moARACTER(12S--- ) HOUTo nTEGE--! Sho-------------------------- : Two doE--op---- nUvector) =S--------------------- : T) ! ThiN s (eseautom-- cfatplS 7--------!---------!--S USE 3d_moT)S nTEGsiNU -----i--- butedddddddddddddddddddddddddddddddddddddd+ USE 3d_mo` !(----(i---):----(i---+ar-1i`dddddddddddddddddddddddddddddddddddd+ USE 3d_moWe - nU----- li! uli----sn! MEGenyo-- nUvector) = !--------!---------!--S USE 3d_moWe - nU----- autom-- cfatplS ! MEGenyo-- n USE 3d_mot---- in i------res foc(12S exha-----!ent,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nt,idenmAL(MK), DIMENSION(:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplice it and/or (:,:), TEGENT(IN )s:: adahaS !!! Daha to be checked for duplice it and/or e S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMr duplice it and/ornd_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!--------------------------------------------------- Retur s !-------------------------------------------------------------------------S n!-------------------------------------------------------------------------S ! Arguments S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d/or e either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G ofadaha. Must be either 2 ors3. TEG 2 [firs)p USE 3d_mo i==iE�DOcoorTinison--------------ddddddddddddddddd. TEG 2 [firsnp T! !!! leastARACTER(1 WRIa. Must be either 2 o)irst index: 1,2 [firs), P USE 3d_moMinimums.S n NE. ( nU MK),--- aail D. re) WRIa. Must be either 2 o)irst index: 1,2 [firs),ax USE 3d_moMaximums.S n NE. ( nU MK),--- aail D. re) WRI---------------------)irst index: 1,2 [firsnm----------- !!! leastNE. ) s-(----s) WRI---------------------)irst index: 1,2 [firsn !--- !!! least D. res To add.oT)S D. res censeS add:) wi tichysMesh ---dom-i(censse GNU :)2S---S i roc=1,d_mhysMesh ---*snmo) : add:) D. res below 1)hysMesh ---*snmo2 : add:) D. res below 2)hysMesh ---*snmo3 : add:) D. res abo!--S 1)hysMesh ---*snmo4 : add:) D. res abo!--S 2) WRI---------------------)irst , TEGENT( !hysMesh ---I-----astARACTER(128 !----s(( !( cnC i roc=1,---------------------)irst , TEGENT( h-- T! P) HOUTo nTEGE(8 ! !)E--! Sho-----(----(nb-+ars-------------- dddddddd. TEG :: t0,lmyeps,bsuRSE 3S REALK), DIMENSI n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) !o-----NE. spac---------- :: ldcS TEGElll , :r !,rdS n! b n-, second .S n NE. a artica. Must :: ldcS TEGElll , :x0,yN 3d_kibemean CHARACTER(12p le----a artica. Must :: ldcS TEGElll , :mean 3d_kibeGimresent(np :: ldcS TEGElll , NSION 3d_kibe----lOE 3dlong -------S n!---------- :: 32I n! 1) = lca artic---------------S n!---------T( -,j, 1) =,:l,' 3i-or)a artic---------------S n!---------T( n----i WRI!]work- #ends:e----idx---- ShoARACTER(, ------ ) HO, C WRI!]ARACTER(12p le------------------- , TEGENTgST( p----------S ! E--------- , TEGENTgST( c----------S ! E--------- , TEGENTgST( np---------S ! E),tottuss CH----s(2 ! Shodi)) =ensE(8 MK),--- D. res ! E--------- :: iend,isize,iopfirsnmt n USE 3//wRAC---(LEN= chif) TE TEGENT :msgI n!], second surich-----a-- Retur ------------------1 :: ldcS irsldca artic---------------S n!---------T( -----------!Elll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) !o CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0 TEGElll, PARAMEGERs:: MK = 3d_kiMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAL(f n!--------------------------------------------------------you can redistribute it and/or m t -nchy E 3d(IONS icense coly E 3dfa as-------: 32d_�: t0,lmyepsck arguments S ----2d������������ lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en If �here are hyss thaG 2 points, we are done n!-------------------------------------------------------------------------S IF (Ndaha .LT. 2) THENS IF ( 3d_debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------), C--- it tottuss CHNE. ----s((globtusS---2 ! Shodi)) =ens) CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------nmt no) Rmo) +sn o) +sn o3)-------nmt no2 Rmo2 +sn o2 +sn o4)-------n-------nmt no) *nmt no2 S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe e memor. 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,:inco) Rp OPEN(iup---,inc --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d OPEN(iunit,fi---------nd')S nicateawithS ----2d��it,fiOPEN(iunit,file='----i-----astARACTER(12PBOX DO i roc=1, 3d_debug .GT. 1) THENS ON(:,:inco) R WRI OPEN(iuc---,inc --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d OPEN(iunit,fi---------nd')S nicateawithS ----2d��it,fiOPEN(iunit,file='work- #endiCBOX DO i roc=1, 3d_debug .GT. 1) THENS ON(:,: OPEN(iunp--S c --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d OPEN(iunit,fi---------nd')S nicateawithS ----2d��it,fiOPEN(iunit,file='n!!! leastARACTER(12p le----NPBX DO i roc=1, 3d_debug .GT. 1) THENS ON(:,:inco) R +s1 ON(:,: OPEN(iu ---S--c --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d OPEN(iunit,fi---------nd')S nicateawithS ----2d��it,fiOPEN(iunit,file=' nTEGE--! Sho-----LHBX DO i roc=1, 3d_debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------), C--- it NE. spac---------- CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------r ! ---- Rmo) , /(S 1) - 1))-------r y ---- Rmo2 , /(S 2) - 2)��� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en --- it n-, second -----co-orTinison ( . .S n NE. ) CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mADut to !nd-of-- d')SsL()S low le--RTICry the nUb--pre----- itd--------- (d Sh) CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------x0 ---- 1)hysMeshy0 ---- 2 S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe L(f nTEGE1) = l ( !!! leastP nTEGE--!a ---) E�KIlmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd ---! R WRITE(np--( ---) (i.NE.icou ( res� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #en If �.S n ARACTER(1 WRIaG 2 points, we are done n!----------------------------------------------------- 2--EQ. 1sent(append).ANDaG 2 points, we are done n!---------------------------------------ppend).ANDaen -u 2-----n!!! leastARACTER(3e asid NE. .G 3 ofvector) = 7-------ANDaG 2 points, we are done n!---------------------------------------ppend).ANDaG 2 points, we are done n!---------------------------------------ppend).ANDa oT)S dom-i(cPPMoefi3BIL nUto 8 MK), upp le--RTICry. (d Sh) ANDaG 2 points, we are done n!---------------------------------------ppend).AND 1) = 0ppend).AND SRAC=1,neturn -------d_d1, SRAC -L-- 1).OR.d_d1, SRAC -GE.S 1).OR.,------S i = 0d_d2, SRAC -L-- 2).OR.d_d2, SRAC -GE.S 2)sent(append).AND.appen 1) = 1) = +s1 ON(:,:E.icou ( ON(:,:AND ( res� ANDaG 2 points, we are done n!---------------------------------------ppend).ANDa oBROUTn-zero, pri 2-a notn---.G 3 ofdo s t !--fa bS bad s8 Meppend).ANDa onormnicy, t allH()S nTEGsinden CPUe coid o-!a ------rgumppend).ANDa o----h----l---12S built2p legum7-------ANDaG 2 points, we are done n!---------------------------------------ppend).AND---- 1) = ----------S IF (D...WRITE(msg,'(I8,A)') 1) =,' nTEGs' IF (D...- 3d_�til_rank3dnotn--- IF (D...ess='append')S ARAC_,S geeawithS ----2d��msg,t,------S i = 0 DO i roc=1, 3d ( ON(:,: ( ON(:,� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #enFi------- ensEn ()S nTEGsiNU Gene---(1.G 3 ofvector) = 7-------hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-1) = 0ppend).- 3d 0ppend).i-or) 0ppend). SRAC=1,neturn aG 2 points, we are done n!---------------------------------------ppend).ANDa oT)i12 s-fa bS a FLOORo---- t anc---.oT)S lat= l wS giveppend).ANDa owrISIO coultsONS negCUL!------i--ices!turn aG 2 points, we are done n!---------------------------------------ppend).ANDaG 2 points, we are done n!---------------------------------------ppend).ANDa oT)S gumtf cSensE s-fa ---nebef multipli ensEdut to ppend).ANDa o !!meri--lO d')Ss. (d Sh) ANDaG 2 points, we are done n!---------------------------------------ppend).AND FLOOR(-d_d1, SRAC - ---*-r ! +sn o) ppend).ANDj FLOOR(-d_d2, SRAC - y---*-r y +sn o2 s� ANDaoT)S --lculahe GNU-ices2S onlye-or)) = onL()S low le--RTICry7-------ANDa On upp le--RTICryc LimayE pp nPublic nTEGsiNUsid -------ANDa physi--lOgumdom-i(cgetLan-i-----asta " "e----a articANDa W ref !--fa testurichublic----hor)) = tanid d')S..7-------ANDa articANDa istARACTER(3nide asid physi--lOdom-i(cbhy E ----belongs To aa articANDa re ------> mo!--ARACTER(3fa g -----ppend).AND f--d_d1, SRAC ---lelS 1) .AND.D -L---Rmo) +n o) ----S IF (D...i Rmo) +sn o) IF (D...i-or) i-or) +s1 ON(:,:E.i ( ON(:,:AND f--d_d2, SRAC ---lelS 2) .AND.Dj -L---Rmo2 +n o2)sent(append).AND.apj Rmo2 +sn o2 IF (D...i-or) i-or) +s1 ON(:,:E.i ( ON(:,:ANDa articANDa istARACTER(3nidNUsid physi--lOdom-i(cbhy E ----belongs To aa articANDa g ------> mo!--ARACTER(3in re ----ppend).AND f--d_d1, SRAC --L---S 1) .AND.D --lelRmo) +n o) ----S IF (D...i Rmo) +sn o) - 1 IF (D...i-or) i-or) +s1 ON(:,:E.i ( ON(:,:AND f--d_d2, SRAC --L---S 2) .AND.Dj --lelRmo2 +n o2)sent(append).AND.apj Rmo2 +sn o2 - 1 IF (D...i-or) i-or) +s1 ON(:,:E.i ( ON(:,:ANDa articANDa ign nTEGsin asid NE. (n!!! l--- PPM iom 0..7nmt no:)-1a articANDa s8 Me we - ----- FLOORod_mhysMesh ND----( --lel0 .AND.D -L---Rmt no) ) .AND.D,------S i (j --lel0 .AND.Dj -L---Rmt no2)s----S IF (D...i1) = 1) = +s1 ON(:,:E.icoui--- +s1 +sj*Rmt no) ON(:,:E.icoup---( SRAC := i WRITE(U----------ticANDa ARACTER(3nidNU WRITE(moup---( SRAC = -1 ON(:,:E.icoui 3d 3d+s1 ON(:,:E.i ( ON(:,: ( resent(ap ON(:,:----------- -or)----esent(append).ANDWRITE(msg,'(I8,A)') 1)rr,' nTEGGNU-ices2hor)) =ed' IF (D- 3d_�til_rank3d tiMeppend).ANDess='append')S E ---_1)rr,'withS ----2d��msg,t,------S i = 000000000 DO i roc=1,S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), e -n----atplSeastArop leg) = whha, nid C WRI!] nTEGsiNU GeneNE. regensE(do s t ne:) wi b fullHAroMENSoeicense S dom-i(!) E�KIlmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd -c(cbox,ldc,iopt, ION(:,:inco) 1) = d).ANDess='appePEN(iu !,--c --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d OPEN(iunit,fi---------nd')S nicateawithS ----2d��it,fiOPEN(iunit,file=' nTEGE----------eLPDX DO i roc=1, 3d_debug .GT. 1) THENS CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------), C-u 2-----n!!! leastARACTER(12p le----(mo!-din a-astabo!----op-------), s8 Me tanid1) = do s t vector) =) E�KIlmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd SRAC=1,neturn i--- =up---( SRAC ppend).AND---- --- --------np--( ---) (inp--( ---) +s1 ON(:,: ( res� lmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd #enL(f ze ()S nTEGe---- ) HOUa------- lE1) = l (tanidmyepsd #envector) = ) E�KIlmyeps = 3d_myepss #elif E�KIt i==iE�DOUBLE_PRECISIONS lmyeps = 3d_myepsd c---o) 1 ON(:,:----() 1 ON(:,: ---!2 R WRITE(c---o ---) (ic---o ----) +snp--( ----) ON(:,:E.i----(i---) (ic---o ---)ppend). ( resent(ap----(nb--+ar ----(nb-- +snp--(nb-- a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), Sap ()S nTEGsiNU Gene-or)) = order.G 3 ofdo s t vector) =S--------y�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,: SRAC=1,neturn i--- =up---( SRAC ppend).AND---- --- ----------S IF (D...a istARACTER(3nidNU aail---, addc Lito 8 -------- IF (D... !(c---o ---) p TEGElWRITE(c---o ---) (ic---o ---)d+s1 ON(:,:E.i ( ON(:,: ( res CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------), C--- it s--ne ---ic1 WRIaG 2 points, we are done n!----------------------------------------------------- 2-EQ.1sent(append).ANDmean -- 1) =, / R---, ppend).ANDWRITE(msg,'(A,F8.2)')-'Mean CHARACTER(12p le----: ',mean 3d_ki D.-----------------------------S ----2d��msg,ji roc=1,S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), If �ublicnp---adds To 1) = d).ANDaG 2 points, we are done n!----------------------------------------------------- 2-EQ.1sent(append).ANDaG 2 points, we are done n!---------------------------------------ppend).ANDaen -u 2- CHARACTER(12--! Sho---.G 3 ofvector) = 7-------ANDaG 2 points, we are done n!---------------------------------------ppend).ANDi 0ppend).AND ---! R WRITE(ANDi i +snp--( ---i roc=1, 3d ( res� ANDaG 2 points, we are done n!---------------------------------------ppend).ANDa oSdS addcup To 1) = (n!!! l CHARACTER(12--!GeneNE. - a) ANDaG 2 points, we are done n!---------------------------------------ppend).AND---- F ( 1) =----S IF (D...WRITE(msg,'(2(A,I10))')-' 1) ==' 1) =,' Sumunp--)=' ON(:,:E.icoui 3d_�til_rank3d_s #elif E�KIt iItess='append')S ARAC_unass------S ----2d��msg, j ON(:,:E.icou g .GT. 1) TTTTS roc=1,S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), FITNEwork-memor. 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt,de------------ OPEN(iunp--S c --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d_s #elif E�KIt ess='append')S de-----eawithS ----2d��it,fiOPEN(iunit,file='n!!! leastARACTER(12p le----NPBX DO i roc=1,HENS ON(:,: OPEN(iuc---,inc --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d_s #elif E�KIt ess='append')S de-----eawithS ----2d��it,fiOPEN(iunit,file='work- #endiCBOX DO i roc=1,HENS ON(:,: OPEN(iup---,inc --S ! Retur IF ( resent(append).AND- 3d_�til_rank3d_s #elif E�KIt ess='append')S de-----eawithS ----2d��it,fiOPEN(iunit,file='----i-----astARACTER(2PBOX DO i roc=1,U a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), m,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������������������������S ----2d�����������������RETURappend).����AINSppend).h usi P cel .LT. 2) THENSr np -L--------S IF (D...i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'np musnUb-->0 DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr n o) -L--------S IF (D...i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'n o) musnUb--> 0 DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr n o2 -L--------S IF (D...i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'n o2 musnUb--> 0 DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr n o3 -L--------S IF (D...i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'n o3 musnUb--> 0 DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr n o4 -L--------S IF (D...i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'n o4 musnUb--> 0 DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr nmo) -L( resent(append).AND.--i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'nmo) musnUb-->0 DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr nmo2 -L( resent(append).AND.--i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'nmo2 musnUb-->0 DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr S 1) .LlelS 1))ent(append).AND.--i 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'S 1) musnUb-->lS 1) DO i roc=1, 3d_n 8888 ON(:,:E.i ( ON(:,:NSr S 2) .LlelS 2)sent(append).AND.api 3d_�til_rank3d_s #elif E�KIt iItess='append')S here areeawithS ----2d��it------S i = 00'S 2) musnUb-->lS 2) DO i roc=1, 3d_n 8888 ON(:,:E.i ( O8888 iIte��������������S .h usi P cel .LT. -------------------------------S IF S .h usi P cel0006S ----2d_sTHENS CALL checkS IF (info .S .h usi P cell liS ----2d_d�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������00006S coE�apse_----753�00000035667�11616003525�020276� 0�������������������������������������������������30450���������������1640������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------info .brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA n! ThiN file iN part ofath0006S coE�apse_----a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nt,ideh usi P cel !!!S coE�apse_---- ----,n POe a----,ne a DO ,id-) E�KIl!! E�KIson a-----ewhosne.- ofmS - -niqueM iom a-----e n! see <h!!--n2egif vectori---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!----------------------------------------------S qso TEGEl s !-----------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P dimense G TEGEl -------- ,-)ist , TEGENT( -n---- USE 3d_moOyS i ----e n n-plet 7--------!---------!--1sy E ---: 1..7n + USE 3d_mo2---2 ---: 1..7niu should -------- ,-)ist , TEGENT( e a---- USE 3d_moCoE�apsed ----e n n-plet 7oT)S l---ePPMso ----ndE s-f)S gamchysMesh ---LBOUND! ME-n---- should ------ st index: 1,2 [firsn P USE 3d_moLeng n -n---- should -------- 2 [fst ,, OPT ALT( - !hysMesh ---I----- #endisuchPublice a----(i) (ii ---- !( rs-------------- dddddddd. T :ne a USE 3d_moLeng n e a----, i.e.-UBOUND = LBOUND +sne al- 1.-------------- dddddddd. T :: t0,lmyeps,bsuRSE 3S REALK), DIMENSI n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) AL( ! Argumen :: ldcS irsON 3d_ki ------------------ :: iend,isize,ioirsldl,ldu-------------- :: ldcS TE TEGENT( ----,l1,u1-------------- :: ldcS TE TEGENT( -,j,tmp, PO D, PO D,axppend).------- :: ldcS TE TEGENT( tmp,ax,tmpfact,prevd------------------- , TEGENTg( - ors-----S ! E--------- , TEGENTg( so rs-----S ! E--------- , TEGENTg( spanss-----S ! E--------- , TEGENTg( , Ps-------S ! E)Elll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) !o CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0 TEGElll, PARAMEGERs:: MK = 3d_kiMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAL(f zCULARMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/orck arguments S coE�apse_----�����������������Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA If �here are hyss thaG 2 points, we are done n!-------------------------------------------------------------------------S IF (Ndaha .LT. 2) THENS IF ( 3d_debug .GT. 1) THENS ������Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mADOIEGm= e geometry n -n----Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or D, P = LBOUND ----,2 IF D,a---- D, P +sn P - 1 IFl1 IF= LBOUND ----,1��������u1 IF= UBOUND ----,1��������Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mALn -n---- -onta Ps-onlyeo e ele aree we - do ehyss thaG 2 points, we are done n!-----------------------------------------------------n P -L---2sent(append).AND.ne al=sn P USE 3 IF c(cbox,ldc,iopt, ION(:,:::::ldlo) l1ION(:,:::::lduo) u1ION(:,:::::ldlo2)--- D, PION(:,:::::lduo2)--- D, P +sne al- 1ION(:,:::::---------PEN(iue a----,ldl,ldu --S ! ReturAND. IF ( resent(append).AND.----- 3d_�til_rank3d OPEN(iunit,filAND.---------nd')S nicateawithS coE�apse_----��,filAND.------S i = 000'coE�apsed ----e LIST DO i roc=1, 3d_n _n g .GT. 1) TTTTTS ON(:,:::::e a---- (ii ---- ReturAND. PRES Tid-)sent(append).AND.-----c(cbox,ldc,iopt, ION(:,:::::::::ldlo1)--- D, PION(:,:::::::::lduo1)--- D, P +sne al- 1ION(:,:::::AND.---------PEN(iui !,--l,ldu --S ! ReturAND.AND. IF ( resent(append).AND.--------- 3d_�til_rank3d OPEN(iunit,filAND.AND.---------nd')S nicateawithS coE�apse_----��,fil------S i = 0000000'PEGmut ensEi-----IDX DO i roc=1, 3dddddddddd g .GT. 1) TTTTTTTTTS ON(:,:::::----- !( D, P)--- D, PION(:,:::::S ON(:,::::: g .G roc=1,S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), e work-memor. 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,:inlo1)--- D, PION(:,:lduo1)--- D,a WRI OPEN(iu- ,--l,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d OPEN(iunit,fil---------nd')S nicateawithS coE�apse_----��,filAND.------S i ='NU-ices2---- IDS DO i roc=1, 3dd_debug .GT. 1) THENS ON(:,:inlo) l1ION(:,:lduo) u1ION(:,: OPEN(iuspans,--l,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d OPEN(iunit,fil---------nd')S nicateawithS coE�apse_----��,filAND.------S i ='spanss---- SPANS DO i roc=1, 3dd_debug .GT. 1) THENS ON(:,: OPEN(iu, Ps,--l,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d OPEN(iunit,fil---------nd')S nicateawithS coE�apse_----��,filAND.------S i =', Ps----- MINS DO i roc=1, 3dd_debug .GT. 1) THENS ON(:,:Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mADOIEGm= e GeneN P ----,a--valuesoi---n---- ON(:,:b o----h--- it t)S gpanss-------values, ne:):) wi g E�KIso -niqueMkey hyss thaG 2 points, we are done n!-------------------------------------------------DO j=l1,u1-----------tmp,axd_�MAXV ---- j,: i roc=1, 3d_tmp, Pd_�MINV ---- j,: i roc=1, 3d_, Ps(j tmp, P roc=1, 3d_gpans(j tmp,ax-tmp, P+1 ON(:,: ( resON(:,:Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mASetcup T)S l---efa -arry u2-----so ---------- CALL 3d_write( 3d_rank,' 3d_find_duplicates', &--------------------------- --)i(ii ---- l1,:)-, Ps(l1��������tmpfacti(igpans(l1��������DO j=l1+1,u1------------- --)i(ii --)i+�tmpfacti* ---- j,: -, Ps(j i roc=1, 3dddtmpfacti(itmpfacti* gpans(j ON(:,: ( resON(:,:Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAQuickso r----ID hyss thaG 2 points, we are done n!----------------------------------------------------------S qso u- ,so ! Retur IF ( resent(append).AND.- 3d_�til_rank3d_s #elif E�KIt i---------nd')S subd iledeawithS coE�apse_----��,filAND.------S i ='qso s---IDS iled DO i roc=1, 3dd_debug .GT. 1) THENS ON(:,:Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA --- it eweg) =Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/orprevd---i(ii -so uLBOUND ,1) i roc=1,ne al=s1 ON(:,: F= LBOUND ,1)+1,UBOUND ,1) ReturAND. -so ui))F ( prevd---sent(append).AND.----ne al=sne al+s1 ON(:,:E.icouorprevd---i(ii -so ui i roc=1, 3d_ ( ON(:,: ( resent(ap ON(:,:hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), e ewecoE�apsed ----e 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:-c(cbox,ldc,iopt, ION(:,:inlo1)---l1ION(:,:lduo) u1ION(:,:ldlo2)--- D, PION(:,:lduo2)--- D, P +sne al- 1ION(:,:---------PEN(iue a----,ldl,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d OPEN(iunit,fil---------nd')S nicateawithS coE�apse_----��,filAND.------S i ='coE�apsed ----e LIST DO i roc=1, 3d__debug .GT. 1) THENS ON(:,:Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mAe ----------eif ne:):)hyss thaG 2 points, we are done n!-----------------------------------------------------PRES Tid-)sent(append).AND. c(cbox,ldc,iopt, ION(:,:::::ldlo) D, PION(:,:::::lduo1)--- D, P +sne al- 1ION(:,:::::---------PEN(iui !,--l,ldu --S ! ReturAND. IF ( resent(append).AND.----- 3d_�til_rank3d OPEN(iunit,filAND.---------nd')S nicateawithS coE�apse_----��,filAND.------S i = 000'PEGmut ensEi-----IDX DO i roc=1, 3dddddd g .GT. 1) TTTTTS ON(:,:S a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), Fense ewecoE�apsed ---- 0) THEhy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:- D, PION(:,:jF= LBOUND so 1) Reture a----(:,i) (ii ---- :,so (j i roc=1,prevd---i(ii -so uj i roc=1, T. 1) TTTT----( - D, P+1)-EQ.ne a) EXITT. 1) TTTTjF= j+1T. 1) TTTT----i -so uj iF ( prevd---sent(append).AND.---- +1 ON(:,:E.icouoe a----(:,i) (ii ---- :,so (j i roc=1,1) TTTT----PRES Tid-)sent(append).AND.---- --- !( ::= so (j ppend).AND.---S ON(:,:::::---prevd---i ::= i -so uj i roc=1, d_ ( ON(:,: ( resent(ap ON(:,:hy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), De-----a-- stuf S n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d/or-c(cbox,ldc,iopt,de------------ OPEN(iu- ,--l,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d_s #elif E�KIt i---------nd')S de-----eawithS coE�apse_----��,filAND.------S i ='NU-ices2---- IDS DO i roc=1,HENS ON(:,: OPEN(iuspans,--l,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d_s #elif E�KIt i---------nd')S de-----eawithS coE�apse_----��,filAND.------S i ='spanss---- SPANS DO i roc=1,HENS ON(:,: OPEN(iu, Ps,--l,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d_s #elif E�KIt i---------nd')S de-----eawithS coE�apse_----��,filAND.------S i =', Ps----- MINS DO i roc=1,U a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), m,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������������������������S coE�apse_----�����������������RETURappend).����AINSppend).h usi P cel .LT. 2) THENSrr .NOT.ASSOCIATED ----)sent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='append')S here areeawithS coE�apse_----��,f------S i = 000'-n---- musnUb--associahe /-----a--d DO i roc=1, 3dddddd 8888 ON(:,:E.i-S ON(:,::::: SIZE ----,2 -L---R P)-nt(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='append')S here areeawithS coE�apse_----��,f------S i = 000'-n---- musnUb--at lea--e n leng R P DO i roc=1, 3dddddd 8888 ON(:,:E.i-S O8888 iItte��������������S .h usi P cel .LT. ������S .h usi P cel0006S coE�apse_----a����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������00006S Gimr753�00000035667�11616003525�020276� 0����������������������������������������������������������10277��������������17746������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------������brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA n! ThiN file iN part ofathhhhh0006S Gimra artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S -------------------------------S IF h usi P cel0006S Gimr_s(Giming)THENS CALL checkS IF (info .h usi P cel0006S Gimr_d(Giming)THE�����nt,iden!suRSE 3s-f)S curr cpueGimr. Ua,n `0006S Gimr`,�nt,iden!suwhha, ua,n URPOSE.`MPI_WGimr`, f90 `CPU_TIME`g/li`eGimr`,�nt,iden!subased nsE ow n! waid1)nfiguhop (d_d�nt,iden!su./1)nfiguho --help):�nt,iden!s�nt,iden!su[NOTE]�nt,iden!sueGimr PPMhe C--n2rNUsic --f)us NOTS TICrdurict,S 7--------!- W ref also ------iy E smnic let= l 7--------!---------!--[ PuN---]�nt,iden!su 3 of n! ThiNndS nUb--c E�KILITY ors n! c. I = dong op l. Ua,�nt,iden!su`0006Gimr`dNUstead---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), I MK), hyss thaG 2 points, we are done n!--------------------------------------------------s !----------INCLUDE ',ldc,iopt.h' ---de MPI-------INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!-------------------------------------------------a oTyl P ! �nt,idenG 2 points, we are done n!--------------------------------------------------------------------------S IF --------- n!AME , :: MKd_�til_ ! A------THENS CALL checkS IF (info .--------- n!AME , :: MKd_�til_ ! Argumen -E�����nt,idenG 2 points, we are done n!-------------------------------------------------a oAere are hyss thaG 2 points, we are done n!------------------------------------------------- AL(MK). T :Giming�nt,iden!suCurr CPU/wnic c---k Gimra artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:), :: NmS�nt,idenG 2 points, we are done n!----------------------------------------------de ETIME------- AL(MK) : #endo2 IF)Elll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) !o CALL suhyss thaG 2 points, we are done n!------------------------------------------------- AL(MK). EX , ALT( eGimr -E����� ---de MPI-------brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA allH()S MPI funcSensEMPI_WGimr-------brary (PPM).S n!S n! PPM iN free software: you can redistribute it and/orGimingd_�MPI_WGimr()THEN n!--------------------------------------------------------you can redistribute it and/or mA allH()S Cf n! Thi eGimr wi g r----cpueGimr�nt,idenG 2 points, we are done n!----------------------------------------------de ETIME-------Gimingd_�eGimr( #end)THEN n!-----ess='CPU_TIME(Giming)THE�����-E����� !--------------------------------------------------------you can redistribute it and/or mAm,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO��������������������RETURap-------------------------------S IF S .h usi P cel0006S Gimr_sTHENS CALL checkS IF (info .S .h usi P cell liS Gimr_d��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������00006S qso 753�00000035667�11616003525�020276� 0���������������������������������������������������������35424���������������0���������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-----------------------------------------------------------------------------------------------------------------------------------------!--------------------------------------------------------you can redistribute it and/or mA n! ThiN file iN part ofathh0006S qso a artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S n!S n! You should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONS SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S -------------------------------S IF h usi P cell liS qso _s ----,e a----, DO i HENS CALL checkS IF (info .h usi P cel0006S qso _d ----,e a----, DO i HENS CALL c-------(info .h usi P cel0006S qso _i ----,e a----, DO i HE�����nt,iden!suFiom a-----e n-valuesog E�KIson a-so spEGmut ensE---- USE 3d_m�nt,iden!su[NOTE]�nt,iden!suFiom LeonCrduJ. MosRRANTSLAC: + USE 3d_moHerr PPMh hybrftwQuickSo sIowrItS a n!!! leasti yearPMhgo7--------!- I-ePPMbased nsEsugges enssoi--Knut,ldVolumr 3, nident,iden!- pEGricARRmuchPbet= lPubl-!a puho QuickSo snsEsho a artich!- ichARACTnicy ordere GNUp al #ends. + USE 3d_moSORTRX ua,n h hybrftwQuickSo salgorS m,Mbased ns USE 3d_mosongr-lOgugges enssoi--Knut,ldVolumr 3, SecSensE5���27--------!- IntARACTEular, ()S ivotMkey [myNY WA]urichdividing�nt,iden!su Sho����eque Me nid1hosnn wi b mopeasEn ()S ifatrst,�nt,iden!sula--, ----,iddl--valuesR(3e asi]--------)S ifatrst,n h hybrft���e---(mf whePUe cen!su Sho�so 9 a afewerichdividing�-onlyesiden!se ctra(:,:)iaharlumr i -val----i W re Gichdividing= ordn---- -val---e n n-NDa owt���eomCLUDbmo!--Aet= lPichdividing=aharlumr [mySE yuickSodere GNiden!sSE yufa !--ichdividingSE yu IngW re Goftd_moARAC 12sulcro-sec/�-onlyenlye-orichdividing3081K [my re Gofd_m10Kg�-onlyes). 7------ r m,Mbased ns ubjlic--oARACTEoa arnt,ideaSho�-- e lPubl-!a puho Qlumr 3, nidetich!- ichARACTnii Plmr`dNUstead---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), I MK), hyss thaG 2 points, we are done n!--------------------------------r`dNUstead---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S nd_:,:), S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!--------------------------------s ------------------------------------------S IF --------- n!AME , :: MKd_�til_ ! A------THENS CALL checkS IF (info .--------- n!AME , :: MKd_�til_ ! Argumen -E�����nt,idenG 2 points, we are done n!----------------------------------iy�S nd_:,:), either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS !!! Leadi P------------------ CALL c--- IF (info E--------- ,-)ist , TEGENimr( #end)TH---------- E--------- ,-)ist , TEGENim--, DO i HE����Letcup TbeT)S l--LL c--- IF (info E--------- ,-)ist , TEGENT( e a----Pon a-so spEGmut ensED,axppend).------- --- AL(M. T :: t0,lmyeps,bsuRSE 3S REALK), DIMENSI n!-------------------==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) AL( ! Argumen :: ldcS irsON 3d_ki -------1---------- :: iend,isize,ioirsldl,ldu-------------- :: ldcS TE TEl Public Libl-!a puhoCuto----a-- st Libl-tibl-!a puh-E---whePUe cen!su Sho�ALn -n---M a afewerichdividivi�-onlyesden!sfin n-(mf -- m--GLE_PRctra(:,:)iaharlumr .ichdividiviAcchARE---p Tes ensso.3tARACTLicemum ----,�-- ave rarESS 9 n -n---- shoul .-------- :: ldcS TmME 9oirsldl,ldu-------------- :: ldcS Tstkt lea-, dnLL c--- IF (info E--------- ,lstkNTg( spanss-----S ! E--------- ,rstkNTg( spanss-----S ----------- :: ldcS TE,j,n,l,r,p,Gmuk�apse_--se_-------------------------------------------& PEGmutp,GGmutt,----------&e_-------------------------------------------& PEGEGmuu,PEGEGmulP---------------- CALL c--- IF (in------------------------------- Ti PlpNimr( #end)TH-------------------------------------- Ti PlpNim--, ------ ------ ------S ! E)Elll , DIMENSION(6) :: NglS TEGElll , DIMENSION(2) !o CALL sub����t(' 3d_find_duplicates',t0,info) nident = 0 TEGElll, PARAMEGERs:: MK = 3d_kiMesh Library (PPM).S n!S n! PPM iN free software: you canARAMEGERs:: e it and/or mAL(f zCULARMesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/orck arguments el000E�apse_----�����������������Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute it and/or mA If �here are hyss thaG 2 points, we are done n!-------------------------------------------------------------------------S IF (N ----------) THENS IF ( 3d_debug .GT. 1) THENS ��EGEGmul IFl1 IF= LBOUND ---EGEGmuu������u1 IF= UBOUND ---n a----(:,u-EGEGmulND.---- MENSION(:,:-c(cbox,ldc,iopt, ION(:,:EGmulP, u ION(:,:EGmuustribute it ON(:,:---------PEN(iue a----,ldl,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d OPEN(iunit,fil---------nd')S nicatel000E�k3d OPE-��,filAND.------S i ='NUapsed ----e LIST DO i roc=1, 3d__debug .GT. 1) THENS ONl=s1 ON,:EGmul,,:EGmuustribut disuchPublice ad__debug . ON(:,:�����������Mesh Library (PPM).S n!S n! PPM iN free software: you can redistribute C:,:b o----hlog�-- ='NUt lea-, itistARACpfacta bESS [my lea-stribute dl--valutand/e geo) v !o CALL suhyss thaG 2 points, we are done n!--------------------------------------stkt lea- roc=1,ne adn a-nENS ONl= DO i !dn( - 0+1)-EQ.ne a) EXIadn a-ISHFT!dn,+snp--( ----)-stkt lea- rostkt lea- + 1 1) THENS ON( ON(:,: stkt lea- ro2*stkt lea--r`dNUstead---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate entriy�S t and/or -valutand/e geo) v !o CALL suhyss thaG 2 points, we are done n!--------------------------------------MENSION(:,:-c(cbox,ldc,iopt, ION(::inlo1)---l1ION(:stkt lea--nlo1)-e it ON(:,:----lstkN(iue a----,ldl,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d OPEN(iunit,fil---------nd')S nicatel000E�k3d OPE-��,filAND.------lef----- i ='NULSTKs---- SPANS DO i roc=1, 3dd_debug .GT. 1) THENS ON(:,: rstkN(iue a----,ldl,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d OPEN(iunit,fil---------nd')S nicatel000E�k3d OPE-��,filAND.------r(:,:)ia- i ='NURSTKs---- SPANS DO i roc=1, 3dd_debug .GT. 1) THntriy�S Ifsh ---I7oT)ckSo, skip,n h hybrftwS go diiNU ly-p ntriy�S -valutra(:,:)iaharlumr .ic --S !n Sm IF00-r`dNUstead---------t,info) !!! ThiN ,t�tineacan beoused to find duplicate e 1) THntriy�S n h hybrfntriy�S ntriy�S n n-Qn:��eorrespoS rESghly-p luteptARACAQuickSo Q,ntriy�S es ensso.3tAPP.116-117,t willialues,s�-octhosnn wi b ntriy�S dl--valsEn (,�nt,iden!sula--, �-onlyesdesARACTEularntriy�S ()S(ugges ensr FOR A PK). 7A r willialues,leaventriy�S i PlARACplaho�en!sproduho�en ON(:,::h ---I(----:apsed -). 7ToHntriy�S salongfy�eomnlyesidlet- Ied -[I]= Ied -------PE(I)S ! ntriy�S Q1 :it and/or ed warranistkNTend).ANDilN(:,:EGmulP, rN(:,:EGmuustributstr200IMENSIO�����ntriy�S Q2: Sor mAQuicen!su Sho� Ied -[L].. Ied -[R]a,Ndaha,nident,ideeeeeA mAQG 3 oiyeo Ied -[l] <= Ied -[m] <= Ied -[rey [my---iy < L,ntriy�S r > Riden!sL <= m <= R. 7(FEn f n! ThrESgh,------I7oTnontriy�S DATAy [myy < L a ar > R.)ic --S i=lP, j=r ! ntriy�S Q2.5: S�-octhEular, (),Ndaha,nident,ideeeeeL eGimr EulartAP,id1hosnn id oiye dl--v7oT)en!su Sho,ntriy�S P=(L+R)/2;hosnbuteh PPMgedisuchPubL isuchPubP)iden!sisuchPubR)ntriy�S soARACTeorrespoS E--- Ied - ----,idsFIT,a--vcteh_�tichARAC.ntriy�S n n-Eular, (), DATAP,iishosnbuDATA[P].ic --S p=(l+r)/2-r`dNUstEGmutp=isuchPubp)ntriy�Si Plp=a----(i)Gmutp)ic --S !a----(iisuchPubl))------i Plp IF ( resent(isuchPubp)=isuchPubl) ( resent(isuchPubl)=)Gmutp ( resent(EGmutp=isuchPubp)ntriy�Sy�Si Plp=a----(i)Gmutp)iccccccg .GT. --S !i Plp------a----(iisuchPubr)ATED ----)sent( !a----(iisuchPubl))------a----(iisuchPubr)ATED ----)sent(nt(isuchPubp)=isuchPubl) ( resent(nt(isuchPubl)=isuchPubr) ( resent(ELSE----)sent(nt(isuchPubp)=isuchPubr) ( resent(EON(:,:E.i-S isuchPubr)=)Gmutp ( resent(EGmutp=isuchPubp)ntriy�Sy�Si Plp=a----(i)Gmutp)iccccccg .GT. --S Now e eswlp-----,idbetweicense r(:,:)en!slef--sides that i --S move DATAP unicay---i----- <h!---,idsFITlye-orslef--en!sell --S IngW<h!---,idsFITlye-orsr(:,:. 7NARTICUL--- <h!--:RTI EPdeofathe GNor -vnlumr 3, nidetyet;`eGirS n n-ofathe G-- <h!--:RTI ed -t eitNT( posite deta-- 3EGmuustributsttttt 3 ! narchar, ()atumIngW:. 7N>= n n--[L].. Ied -[R]a,Ndaha,nident,ideeee DATAL-[l] n n-sFIWe n!ICrdurict,istri s nnvotMkey [myey [mup--ewhoLaloookidsFm] <=o.3tARA>= n n- (osnn i n!nn guaenseee - baseedistk), Dior mwGNori Qlumr �S d n n- nnarimr Eula (,�of - biy�S Q2: Sor )iishosnbuDTI e=iQ.ne a) EXITT. 1)uchPubl))-----,1) LT.suchPubS 3EGishos4EGmuustributs 4 ! narchar, ()atumIngW-,idbe<= n n--[L].. Ied -[R]a,Ndaha,nident,ideeee DATAR]A>= n n-sFIWe n!ICrdurict,istri s nnvotMkey [myey [mdown--ewhoRaloookidsFm] <=o.3tARA<= n n- (osnn i n!nn guaenseee - baseedistk), Dior mwGNori Qlumr �S d n n- nnarimr Eula (,�of - biy�S Q2: Sor )iishosnbuDTI j=j-.ne a) EXITT. 1)uchPubl))----- j+1GT.suchPubS 400ne a) EXIT !H2 Zuousefwo i ns), DIPded?p=a----(i)Gmut LT.j---(iisu 6:GT.,Nor -vchR)/2; DATAI-[l-->; DATAJ]--value nuene a) EXIT!PRINT *, ' ! -vchR)/2;'suchPubr)=)Gmutt=l))-----,1N,:EGmul,,:EGmuustri=l))----- jN,:EGmul,,:EGmuustj.i-S D. c(cbox,lS 3EGisssssshPubr) 7: Y-- i17,t win D�S Q2: Sor m6-11iy�S n h hybrfntriya,nident,ideeeeeA>= J--val DATAl-[l] n nAI-[== n n- l] n nAr]-v7oT)en!su Sm] <= I S I--valJ r > Riden. 1boturichdividing ef--sides that reiden!-M�nt,iden!sif , pushstributn --SGichngW<h!-S t as enssoi--Ksoi--p,nb t a6-1I7oT)ckSo,<h!-SS Ier;nd/ond/or mALentt reiden!-Mnssoi--Ksoi--nt,iden!sif , p,nb t a-val-----)S ifat;`oICrdwi thepop anssoi--Ksoi--S Q2: Sor mlyes<h!-S t as el-----)S ifat.ne a) EXIT!PRINT *, ' TEGEiICULA'ne a) EXITT. 1r-j---Eiis-l .ANDiis-l .-(iimNSr S 2) .Llelnd/=lnd/--sent(append).!Unne,bsulif -----ARACpfactS t aposite dsent(append).!)Gmutnd/o.-(iiinlo1)---NSr S 2) .LleKsoi----R P)-nt(append).AND.----- 3d_�tKsoi-�til_rank3d OPEN(iunitwrf _dim--------nd')S nicatel000E 3d_�tKsoi-�k3d OPE-orrKAy rrKLENGTHnUb--at lea--e n leng R P Ksoi- DO i roc=1, 3ddddd! ::= so (j ppend-e iutnd/)=j--sent(append).re iutnd/)=D.----- 3d_�tr=i-.ne a) EXIThPubi)Gmut-l .-(iir-j--ANDiir-j---(iimNSr S 2) .Llelnd/=lnd/--sent(append).! Unne,bsulif -----ARACpfactS t aposite dsent(append).!)Gmutnd/o.-(iiinlo1)---NSr S 2) .LleKsoi----R P)-nt(append).AND.----- 3d_�tKsoi-�til_rank3d OPEN(iunitwrf _dim--------nd')S nicatel000E 3d_�tKsoi-�k3d OPE-orrKAy rrKLENGTHnUb--at lea--e n leng R P Ksoi- DO i roc=1, 3ddddd! ::= so (j ppend-e iutnd/)=lsent(append).re iutnd/)=i-.ne a) EXITend-=j--sent(appenhPubi)Gmur-j---(iimNSr S 2) .Lle-=j--sent(appenhPubi)Gmus-l .-(iimNSr S 2) .Ller=i-.ne a) EXIThPub 8: PoppfactS t he eedistk), -----)S ifaf empty S 2) .Lle)Gmutnd/ LT.1--S !nS 2) .Lle-=-e iutnd/) S 2) .Ller=re iutnd/) S 2) .Llelnd/=lnd/-.ne a) EXITh ::= so (j ppS 2EGisssssshi)Gmutp)i9EGmuustributstr200IMEN IF00-r`dNUstead---------t,info) !!! ThiN ,t�tineacan beoused to S n h hybrfnQ9 ! p ntriy�I -valutra(:, _debug .GT. = ---n a--ONl=s1 ON,:EGmul,,T. 1)uchPubl))-----,-1a----(iisuchPubl))-----ia----(iisuchPubr)ATED)Gmutp ( resenti) S 2) .LlehPubp)ntriy�Sy�Si Plp=a----------p=i-.ne 920-------uustributstttttttttttttt( resent(+ON(::( resent(EGmutp=isuc------p=p-end).AND.----ne --------(i1)uchPul-1a--urAND.AND. IF ( T. 1)uchPubl))-----pj+1GT.suchPubS 920D.AND. IF ::= so (j ppend( resent(+ON(::-S isuchPubr)= ::= so (j 1 1) r200IMEN IF00-r`dNUstead---------t,info) !!! ThiN ,t�tineacan beoused to S n REAL(mk), riy�S t and/or -valutand/e geo) v !o CALL suhyss thaG 2 points, we are done n!--------------------------------------MK = 3d/or-c(cbox,ldc,iopt,de-e it ON(:,:----lstkN(iue a----,ldl,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d_s #elif E�KIt i---------nd')S)S nicatel000E�k3d OPE-��,filAND.------lef----- i ='NULSTKs---- S roc=1, 3dd_debug .GT. 1) THENS ON(:,: rstkN(iue a----,ldl,ldu --S ! Retur IF ( resent(append).AND.- 3d_�til_rank3d_s #elif E�KIt i---------nd')S)S nicatel000E�k3d OPE-��,filAND.------r(:,:)ia- i ='NURSTKs---- S roc=1, 3dd_debug .G===================================================================S n h hybrfntriya Is-onl_TIME(Giming)THE�����-E����� !--------------------------------------------------------you can redistribute it and/or mAm,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO����������������/orck arguments el000E�apse_----�����������������RETURappend).����AINSppend).h usi P cel .LT. 2) THENSrr .NOT.ASSOCIATED ----)sent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='append')S )S awithS coE�apse_----��,f------S i = 000'-n---- musnUb--associahe /-----a--d DO i roc=1, 3dddddd 8888 ON(:,:E.i-S O8888 iItte����������������������������RETURap-------------------------------S IF .h usi P cel0006S Gimr_sTHENS CALL checkS IF (inf(info .so _d ----,e a----, DO i HENS LL checkS IF (inf(info i-------- TP cell liS Gimr_d��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������S r_ca��������������00006S qso 753�00000035667�11616003525�02������������������������������40076���������������1477���35424���������������0���������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !--------------------------------------------------------------------------------------------------------------IME(Giming)THE�����-E����� !--------------------------------------------------------you can redistribute it and/or mA n���������S r_ca��TIME(Giming)THE�����-E����� !--------------------------------------------------------you c REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISIONyou c SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fiates_dh usi P cel .LT. ����� r_ca��(���oidociahe /----- n redistrin!- pproximic /or s en---�� unics:: e it and/!SION: Sor mibraWA]urpro,bsu eo/>.ndRecveaventE�KI it and/!SI-t eneL(mbor and/os/>3, nPPMo:sINiden!fint eoccuen!sSE yufa (i.e.//wwaen!s6-117n). 7AB,c LicBfatrst /orbus-val----i W rich, idsFmewhoC)-------aa-, istenssohybrftwQuval----i W �� unics:: e ---- Ir mAe .e G, e re Gichb-val----i W u,idsF----VizidsF pproximic: e based nisten---edgeval----i W ��loridsFproblemEoa arnt,ro,bsu eop�logy grapho ------iy E smnic letTIP------!---------!--[ PuN---]�nt, GNU GtARACpca��es Me dee n osite ds ------iy E smnic letE---- USE 3d_m�TTHE�����nt, Pub,idens:: e _den!n elll , D!--[ PuN-----ted - C+nicy ordere -----t eFNUsic --- ppa--vcteh_�ty E smnic le.Referding E smnic le*******************************************************E smnic le- V.G.-Vizids, Ot an d nsmic Eoa arntchewhs::c clas E smnic leoa a p-grapho Discret.//niy�S.ugge1964,l ..25-30t,ldVolumr 3(In Russ Me).E smnic le*******************************************************E smnicadaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fIONyou cicate entriy�S nd_:,:), S IMPLICIT NONES#if E�KIt i==iE�sINGLE_PRECISIONS TEGElll, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISION-----= 3d_kind_si Ple #elif E�K TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif n!----d_doublh #endif�����_iLetcup Tb-------------etcup TbL checkS IF (info .--------- n!AME smnicadaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fIONyou cicate entriy�S nd_:,:), I MK), hyss thaG 2 points, we are done n!---------------------INCLUDE ',ldc,iopt.h' ---de MPI-------INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!----------------------------------iy�S nd_:,:), either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS tcup TbL chec end).----IN ----- ��oid USE 3d_m�TTHEeop�logy DO i H s eniz�Letcup TbeT)S l end).----IN-------- AL(M. rT :: t0,lmyeps,bsuR----INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!-------------------------PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS Tg( spanss-----S 3,8( #end)TH------- coordtriy�S LOGICALanss-----S ! E--------- i�����GtA ,lstkNTg( spanss-----S 3 3d_ki -------1-----coordt, coordt2 el000E�aENimr( # nss-----S 3,26)-------1-----ou plS Tg( spanss-----S 3,26,8( #end)TH-------commON: Sor el000E�aENimr( # nss-----S 3,3 3d_ki ---- otxy, otyz el000E�aENimr( # nss-----S 3 3d_ki ------ ou pl,d plc el000E�aENimr( # nss-----S 4 3d_ki ------ a!AMEsetcup TbeT)S l _ki -------1-----idir,icpu,ia!AME,ja!AME,lic ketcup TbeT)S l _ki -------1-----idirect,lidir= 3d_kibe :: NmS TEGElll , DIMENSION(6) el000E�aENimr( _ki -------1-----rgumen :: ldcS irsO2 3d_ki -------1------- :: iend,isize,ioirsldl,ldu-------------- :: ldcS hybrftwQuineL(mborhood ans USE 3tond).AND.- d,isize,ioirsldl,ldu-------------- nlinktriy�S ldSP cCTineL(mbor pairt, i.e./1<->2 ----2<->1ular, ( sam i nd/oriy�S ��,fftwQuce./r GenAND.---- Iy�S t,ideet, odtwQu---see ntwQu---long with P, ( sam edge n! ETHTg( spanss-----S -- ! E-------- linktn! ETH ,lstkN!r s en---edge ��loridsFd redistr .eQ2: Sor mly trip MK (p1,p2,c),..-vcteh_�tiE�KItp1 i P2 i idsF----2r mot.----ly WA]uredge -valu--t e��lor n! ETHTg( spanss-----S -- ! E-------- s retn! ETH ,lstkN!rhybrftwQuineL(mbor--ly = Ie !--CPU.:-S :ributic ketcup TbeT)S lanss-----S -- ! E-------- nneL(m,ro,sH ,lstkN!raEAL(mL(mbor--ly = I,ro,bsu s./1st:-S :rneL(mbor nr., 2nd,iden!su.t,ro,bsu ic ketcup TbeT)S lanss-----S , (info E------------ eL(m,ro,sH ,lstkNTg( spanss-----S ----------- ::max eL(m,ite i,ii,iten,kiden!su.t,ro,bsu ic ksetcup TbeT)S l _ki -------1-----p1,p2,isb,jsb,ksbiden!su.t D, valsEax-ly =ss gtr e��lorsetcup TbeT)S l _ki -------1----- D,��lor:max��lorriy�S LOGICAL _ki -------1-----viy�d. EX , ALT( eGimr -ributcomm ::etcup TbeT)S lanss-----S striSTATUS_:,:E --- ::etcup TLOGICALanss-----S 3 3d_ki -------1-----pa-iod:etcup TbeT)S lanss-----S 3 3d_ki -------1-----ND.ms MPI-------INCTYPEf E�Kt_eop�) ni! E--------- eop�H ,lstkN----����H C---(len=256-----mesg= 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E canARAMEGE/orGimingd_�MPI_WGimr()THEN n!--------------------------------------------------------you can redistribute it and�� r_ca�� arguments = 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E can redistribute it and/or mA If �here are hyss thaG 2 points, we are done n!-------------------------------------------------------------------------S IF (N ----------) THENS IFS eop�H E�Ktop�(���oid)%�TIME(Giming)THE�����-E����� !--------------------------------------------------------you can rediif f n! It reiden!-1t,ro,bsu =iE�sINGLmwGN Is-onlt and/or mA If �here are hyss thaG 2 points, we are done n!------------------------------n,ro,N(:,::2 .NOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocan redistrmet ryARACpc� unics:: e ,roto��lsOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIAT----- ------------MENSIONgrow_pretervene a) EXIT ION(:::::lduo1)--- D, P +sne al- ���o%icommON::::::---------PEN(iui !,--l,ldu --S ! ReturAND. IF ( resent(append).AND.----- 3d_�til_rank3d OPEN(iunit,filAND.---------nd')S r_ca�� a_�tilawithS coE�apse_--c� unics:: e Q2: Sor mPPM_ICOMMSEQ= 000'PEGmut ensEi-----IDX DO i roc=1, 3ddddd OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocaS,nidenttrivial ,roto��l:ond/ormyselfOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIAT���o%ncommON:(:::::lduo1)---���o%icommON:ION(::----ic ketcup T DO i rocLL cddd EX , ALT( = 3d_kibe :: NmS TEGElll , DIMENSION(6) el000EocaG,ni GNUcoordstk),s---------hybrftwQuicpus-pa--oubuts: e it and/ (r mA special c-- IefSGichna arntoub.ularadn a-ISHibe :: NmS TEGElll , DIMENSION(6) el000E_rankstriCART_GETiunitcomm,uggeND.ms,-pa-iod:,-coordt, tkN(iue a----,ld---------------2 .NOT.ASSOCIAWRITE (mesg, '(A,3I3,A,3I3,A)') 'llH((mL(mbor--RACpstr-coordstk),s-',awithS coE�apse_coordt, ' (rD.ms(::'geND.ms,-')'ne a) EXIT_rank3d -----(----ic k--------nd')S r_ca�� amesg,URSTKs---- S roc=1, 3dd_debug .Gbe :: NmS TEGElll , DIMENSION(6) el000Eocaicate entriy������GtA i -val----ibe :: NmS TEGElll , DIMENSION(6) el000E----- ------------MENSION(:,:-c(cbox,uION(::----n,ro, el000E_rankdc,iopt,de-�����Gt(:,: rstkN(iue a----,ldl,ldu --S ! Retur F ( resent(append).AND.----- 3d_rank3d OPEN(iunit,filAND.---------nd')S r_ca�� a_�tilawithS coE�apse_---�����GtA i -= 000'PEGmut ensEi-----ID DO i roc=1, 3dd_debug .Gbe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E-f n!:::::lduo1DO k=1,2sEi-----IDDO j=1,2sEi-----ID .GT. =1,2sEi-----ID .cboxcoordt ,-f nN(::(/i-1,j-1,k-1/EGmutp=isuc-------f n!::-f n!+ end).AND.----nLL ce adn a-nENSLL ce adn a-nLL ce adn a-n ou pl a-n::(/1.0,0.0,0.0/EGmutp=ia!AMEsION(::0.0Gmutp=ia!AMEsI2N(::0.25 *------i_dGmutp=ia!AMEsI3N(::0.5 *------i_dGmutp=ia!AMEsI4N(::0.75 *------i_dGmutp=iidiror ed warraDO ja!AME=1,4sEi-----IDDO ia!AME=1,4sEi-----IDa-n otxy ,1N(::(/ DCOS(a!AMEsIja!AME)( #eSIN(a!AMEsIja!AME)( 0.0_MK/EGmutp=isuc--- otxy ,2N(::(/-eSIN(a!AMEsIja!AME)( DCOS(a!AMEsIja!AME)( 0.0_MK/EGmutp=isuc--- otxy ,3N(::(/ 0.0_MK, 0.0_MK, 1.0_MK /EGmutp=isuc--- otyz ,1N(::(/ 1.0_MK, 0.0_MK, 0.0_MK /EGmutp=isuc--- otyz ,2N(::(/0.0_MK, DCOS(a!AMEsIia!AME)( eSIN(a!AMEsIia!AME)(/EGmutp=isuc--- otyz ,3N(::(/0.0_MK,-eSIN(a!AMEsIia!AME)(,DCOS(a!AMEsIia!AME)(/EGmutp=isuc---d plcedisATMUL(sATMUL( otyz, otxy), ou pl) S 2) .Lleldiror ldiro+ end).AND.----nIF(ldir(:,:4N(CYCLutstttttttttttou pl ,2*(ldir-3)-1N(::d plc el000Ettttttou pl ,2*(ldir-3) --= -d plc el000EtttLL ce adn a-nLL ce adn a-nGbe :: NmS TEGElll , DIMENSION(6) el000Eocatrune end warraDO ldir=1,26sEi-----IDDO i=1,3nd).AND.----nIF(ABS(ou pl i,ldir1) LT.0.05--urAND.AND. IFou pl i,ldir1(::0.0Gmutp=idn a-nLL c:= so (j ppLL ce adn a-nLL ce adn a-nGbe :: NmS TEGElll , DIMENSION(6) el000Eoca #end end warraDO lf n=1,8sEi-----IDDO idir=1,26sEi-----ID -idirect(:::::lduo1)----nIF(ND.msION----1--ANDiiABS(ou pl 1,ldir1) GT.0.0--urAND.AND. IFidirect(:::::lduo1)----nLL c:= so (j pp--nIF(ND.msI2N----1--ANDiiABS(ou pl 2,ldir1) GT.0.0--urAND.AND. IFidirect(::2::lduo1)----nLL c:= so (j pp--nIF(ND.msI3N----1--ANDiiABS(ou pl 3,ldir1) GT.0.0--urAND.AND. IFidirect(::3::lduo1)----nLL c:= so (j pp--nIF(MOD(xcoordt idirect,-f nN,2N 1--urAND.AND. IFIF(ou pl 1,ldir1 LT.0.0--urAND.AND. IF ( commON: Sor 1,ldir,-f nN(::-end).AND.----ne -hPubIF(ou pl 1,ldir1 GT.0.0--urAND.AND. IF ( commON: Sor 1,ldir,-f nN(:: end).AND.----ne -hPubD.AND. IF ( commON: Sor 1,ldir,-f nN(:: 0D.AND. IF :c:= so (j pp--n IFIF(ou pl 2,ldir1 LT.0.0--urAND.AND. IF ( commON: Sor 2,ldir,-f nN(::-end).AND.----ne -hPubIF(ou pl 2,ldir1 GT.0.0--urAND.AND. IF ( commON: Sor 2,ldir,-f nN(:: end).AND.----ne -hPubD.AND. IF ( commON: Sor 2,ldir,-f nN(:: 0D.AND. IF :c:= so (j pp--n IFIF(ou pl 3,ldir1 LT.0.0--urAND.AND. IF ( commON: Sor 3,ldir,-f nN(::-end).AND.----ne -hPubIF(ou pl 3,ldir1 GT.0.0--urAND.AND. IF ( commON: Sor 3,ldir,-f nN(:: end).AND.----ne -hPubD.AND. IF ( commON: Sor 3,ldir,-f nN(:: 0D.AND. IF :c:= ::lduo1)----nLPubD.AND. IFIF(ou pl 1,ldir1 LT.0.0--urAND.AND. IF ( commON: Sor 1,ldir,-f nN(:: end).AND.----ne -hPubIF(ou pl 1,ldir1 GT.0.0--urAND.AND. IF ( commON: Sor 1,ldir,-f nN(::-end).AND.----ne -hPubD.AND. IF ( commON: Sor 1,ldir,-f nN(:: 0D.AND. IF :c:= so (j pp--n IFIF(ou pl 2,ldir1 LT.0.0--urAND.AND. IF ( commON: Sor 2,ldir,-f nN(:: end).AND.----ne -hPubIF(ou pl 2,ldir1 GT.0.0--urAND.AND. IF ( commON: Sor 2,ldir,-f nN(::-end).AND.----ne -hPubD.AND. IF ( commON: Sor 2,ldir,-f nN(:: 0D.AND. IF :c:= so (j pp--n IFIF(ou pl 3,ldir1 LT.0.0--urAND.AND. IF ( commON: Sor 3,ldir,-f nN(:: end).AND.----ne -hPubIF(ou pl 3,ldir1 GT.0.0--urAND.AND. IF ( commON: Sor 3,ldir,-f nN(::-end).AND.----ne -hPubD.AND. IF ( commON: Sor 3,ldir,-f nN(:: 0D.AND. IF :c:= D. IF :c:= D. LL ce adn a-nLL ce adn a-nGbe :: NmS TEGElll , DIMENSION(6) el000EocamwGN92 Zugonidentbaidenpaent,n now el000Eocamnow e.3tAastribuRACpfa--!-c ketcup T_rankstriCART_COORDSiunitcomm,----ic k-3,coordt,ciahe /----- be :: NmS TEGElll , DIMENSION(6) el000Ei�����GtA .FAPub.FS eop�%ncommON:(::MIN(27,----n,ro, IFl1 I---- ------------MENSIONgrow_pretervene a) Ex,uION(::eop�%ncommON: el000E_rankdc,iopt,de���o%icommON::::::---------PEN(iui -,ldl,ldu --S ! Retur F ( resent(append).AND.----- 3d_rank3d OPEN(iunit,filAND.---------nd')S r_ca�� a_�tilawithS coE�ap'itNT( c� unics:: e Q2: Sor mPPM_ICOMMSEQ= 000'PEGmut ensEi-----ID DO i roc=1, 3dd_Gbe :: NmS TEGElll , DIMENSION(6) el000EocawPMopys my lf n el000E-f n!:::*MOD(coordt 1N,2N+2*MOD(coordt 2N,2N+4*MOD(coordt 3N,2N+1S eop�%icommON:ION(::----ic ketcup Ti�����Gt(----ic k+ON(::.TRUE n! ETHlldiror :::lduo1DO idir=1,26sEi-----ID coordt2or coordto+ commON: Sor :,ldir,-f nNsEi-----ID!WRITE(mesg,*)_coordt,'/', coordt2 el000E-ID!_rank3d -----(----ic k--)S r amesg,URSTKs---- S-ID ic k(::-end).AND.--_rankstriCART_RANKiunitcomm, coordt2,lic k,URSTKs---- S-ID!WRITE(mesg,*)_'ic k(:>',lic k,'(',URST,')'ne a) EXIT!_rank3d -----(----ic k--)S r amesg,URSTKs---- S-IDIF(l�����Gt(lic k+ONN(CYCLutstttttttteop�%icommON:Illdir+ON(::lic ketcup T l�����Gt(lic k+ON(::.TRUE n! ETHETHlldiror lldiro+ end).ANDLL ce adn a-neop�%ncommON:(::lidir= 3d_kiDIF(----ic k D ! rr Generpl WRITE(mesg,*)_'----ncommON:(is-',----ncommON:(���oid),lidir=rr Generpl _rank3d -----(----ic k--------nd')S r_ca�� amesg,URSTKsrr Generpl DO idir=1,----ncommON:(���oid) rr Generpl PubWRITE(mesg,*)_'umr ry-',----icommON:Ildir,���oid) rr Generpl Pub_rank3d -----(----ic k--------nd')S r_ca�� amesg,URSTKsrr Generpl LL ce a!enerpl LL c:= ::lduo1! Is-onlt and/or mA If �here are hyss thaG 2 points, we are done lt and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) el000EocaE !-bodyallHsillialut ryAr mAe lt and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) !enerpl WRITE(mesg,*)_'----icommON:-',----icommON:I1:9,���oid) rr Gener_rank3d -----(----ic k--)S r amesg,URSTKs!enerpl WRITE(mesg,*)_'----icommON:-',----icommON:I10:18,���oid) rr Gener_rank3d -----(----ic k--)S r amesg,URSTKs!enerpl WRITE(mesg,*)_'----icommON:-',----icommON:I19:27,���oid) rr Gener_rank3d -----(----ic k--)S r amesg,URSTKs GenerwithS lt and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) el000EocaMarkpfa--!eop�logy asIs-onlt and/or mA If �here are hyss thaG 2 points, we are done n!----------------------eop�%is s eniz�L(::.TRUE lt and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) el000Eoca REAL(mk), rempoelif stoelgnlt and/or mA If �here are hyss thaG 2 points, we are done n!--------------------------------------MK = 3d/or-c(cbox,ldc,iopt,de-�����Gt(:,: rstkN(iue a----,ldl,ldu --S ! Retur F ( resent(append).AND.----- 3d_rank3d OPEN(iunit,filAND.---------nd')S r_ca�� a_�tilawithS coE�apse_--hybrftwQuicS . ---- PPM_NCOMMSEQ= 000'PEGmut ensEi-----ID DO i roc=1 MPI----lt and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) el000Eocan redistribute it and/or mAm,splia artichy�S TEGElll, TEGENT(OUT)s s:: info REAL(mk), DIMENSIO������������������ r_ca�� arguments mk), D�apse_-(mk), DI�������������RETURappend).����AINSppend)._rank3d �����_���oid(���oidoviy�d-----PEN(iui !,--l,ldi P c-viy�d .NOT.ASSOCIATED ----)sent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='append')S )S r_ca�� a_�awithS coE�apse_--���oidd( rwQui+R)/2usnUb--associahe /-----a--d DO i roc=1, 3dddddd 8888 ON(:,:E.i-S O8888 iItte�������� S O8888 iItte�����������S r_ca��T------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------�������������������������������Subeq_r = ������������00006S qso 753�00000035667�11616003525�0202������������������������������25545���������������1������35424���������������0���������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !--------------------------------------------------------------------------------------------------------------t and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) el000Eocan redistribute it and/or mA ���������Subeq_r = ��lt and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) el000Eoc REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fi��������������������RETURap--------------888 iItte�����������Subeq_r = _s(coef,roots,qtolociahe h usi P cel0006S Gimr_sTHENS CA888 iItte�����������Subeq_r = _d(coef,roots,qtolociahe h st , TEGENi----!--[ PuN--olv,s-- Sub---equs:: e u,idsF--- , TEGENiexublcy o-olu:: e --oAulandS C---anoordn--equs:: e , TEGENi-----nd/or92 Zu�aEN roots=iE�se n lex roots ef--sideENifTABI---p T--[ PuN-rT s ----)sent(append).AND-----exit n! ETH y E smnic letE---- USE 3d_m�Two roots --aa-, (Pclo----togee-orsr( n!ent(aps ef--sideENiconEPdeidetequsl-----rT Swits-exlea-bit-erlanie , TEGENi3, ni DO AND.wse n aris USE-[ EPdeot---!--[ PuN n! ETH y E smnic letE---- USE 3d_m�For p--------------1--p T--[ PuN-�����s--t eowe , TEGENiresult. May GN- afc Liso<= R <= -ot---! n!bN-rTt i d-vcteh_�ty E smnic le.Referding E smnic le*********************************************************************E smnic le- SUBmathworld.wolfram.e n/Cub--Equs:: e.htmlE smnic le*********************************************************************E smnicadaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fION00Eocicate en lt and/or mA If �here are hyss thaG 2 points, we are done DIMENSION(6) el000El, PARAMEGERs:: MK = 3d_kind_si Ple #elif E�KIt i==iE�DOUBLE_PRECISIONf E�K TEGElll, PARAMEGERs:: MK = 3d_kind_doublh #endif-----= 3d_kb-------------��������������������RETURap--------------bL checkS IF (info .---------,idsle h usi P cel0006S Gimr_sTHENS CAbL checkS IF (info .--------- n!AME MPI-------INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!-------------------------cate entriy�S nd_:,:), I MK), hyss thaG 2 points, we are done n!-------------------INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!----------------------------------iy�S nd_:,:), either 2 ors3. TEGElll , TEGENT(IN )s:: ldaS tcup T�aENimr( #ss-----S 4 )end).----IN -----coefE smnic leCoefflcy----ordn--equs:: e i idsF-olv,havs:E smnic le-ne n!-----------------------ENicoef(4)*x^3+coef(3)*x^2+coef(2)*x+coef(ON(::0E smnic le-ne n!----------------------�aENimr( #ss-----S 3 )end).---- --------rootsE smnic leCoe cen!sousefh r = -rootsE smni�aENimr( end).---- --------qtolE smnic leN---NE = -tol---or m(d nsmic d)wi b result. CAbL chec end).---- -------- AL(M. RT :: tent(append).AND-si y ohasse n lex roots----INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!-------------------------PARAMEGERs:: MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS �aENimr( _ki -------1-------rg,ou ,a0,a1,a2,lmyaps,stolE smni�aENimr( _ki -------1-------SpT,SpTi2,sqrt3,Q,RE smni�aENimr( _ki -------1-------Lf,ota2,rootstmp tcup T�aENimr( #ss-----S 4 )_ki -------1-------rntriy�S CO---EXimr( _ki -------1---- qrtD,S,T,SmT CAbL chec _ki -------1---- disuchLOGICAL _ki -------1-------correct tcup T�aENimr( # IF _ki -------1-------one_t--rL(::1.0_MK/3.0_MKriy�S CH C---(LEN=3d ��ar 3d_ki -------1-----mesg= 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caElll , DK = 3d_kibe :: NmS TEGElll , DIMENSION(6) :: NglS ----INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!-------------------------caRAMEGE/o ----INCLUDE 'mpif.h' -E�����nt,idenG 2 points, we are done n!---------------------- can redistribute it and�ubeq_r = arguments ��������������������RETURap--------------lmyapso .----myaps .h usi P cel0006S Gimr_sTHENS CAlmyapso .----myapsd MPI-------INCroots = 0.0_MK = 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E can redi--aa-tn--equs:: e atrstb--= 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000El,ldABS(coef(4))N(:,::lmyaps ! Retur F ( resent(append).AND.----- 3d_rank3d_s #elif E�KIt iItItess='append')S )ubeq_r = a- 3dtel000E�k3d OPE-Equs:: e atrnotrstb--.aElRAMng.= 000'PEGmut ensEi-----ID DO i roc=1 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caN-oAiy�S tn--equs:: e , TEGbe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000El,ldcoef(4)u --S 1.0_MK ! Retur ou (::1.0_MK/coef(4) Retur a0 or coef(ON*ou Retur a1 or coef(2N*ou Retur a2 or coef(3N*ou Retur hPubD.AND. a0 or coef(ON Retur a1 or coef(2N Retur a2 or coef(3N DO i roc=1 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caSolv,triy��ub---equs:: e x^3 + a2*x^2 + a1*x + a0(::0E smnicbe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000EQ or 3.0_MK*a1 - (a2*a2N Retur Q or Q/9.0_MKriy�S R or 9.0_MK*a2*a1 - 27.0_MK*a0 - 2.0_MK*a2*a2*a2riy�S R or R/54.0_MKriy�S rEsION(::Q*Q*Qriy�S rEsI2N(::R*R1 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caE nsmic En---NE = -tol---or 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000Eou (::rEsION(+ rEsI2N el000EqtoledisAXimAXVENirEsIO:2))*lmyaps,lmyaps el000El,ld------------------------------- WRITE(mesg,'(A,E12.4)') 'N---NE = -tol---or : ',qtolE smni ub_rank3d -----(----ic k--------nd')ubeq_r = amesg,URSTKs---- S roc=1= 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E can redi--aa-tn--equs:: e hassnd/orr = -rootsE smniGbe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000El,ldou (-----qtol ! Retur F ( resent(append).AND.----- 3d_rank3d_s #elif E�KIt iItItess='append')S )ubeq_r = a- 3dtel000E�k3d OPE-Equs:: e hasse n lex roots.aElRAMng.= 000'PEGmut ensEi-----ID DO i roc=1 DO i 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caSolv,triy��ub---equs:: e x^3 + a2*x^2 + a1*x + a0(::0E smnicbe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E qrtD or SQRT(C---Xdou 0.0_MK,MK nsEi----SEi----= (R + qrtD)**one_t--rLsEi----TEi----= (R - qrtD)**one_t--rLs el000E qrt3 or SQRT(3.0_MKnsEi----SpT----= �aENiS+T,MKnsEi----SpTi2 or 0.5_MK*SpTsEi----SmT----= S - TsEi----Lf ----= �aENi(0.0_MK,0.5_MK)* qrt3*SmT,MKnsEi----ota2---= -one_t--rL*a2riy�S rootsION(::ota2-+ SpTsEi----rootsI2N(::ota2---SpTi2 +-LfsEi----rootsI3N(::ota2---SpTi2 --Lfs= 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E can redisi wGN92 Zumultip M roots nd s,nidenm DO exlea-bit-erlintriy�S isi so (DO AND.wse n aris USE-[ EPdeot---!--[ PuN).e G, e re n!S caschna ou =0.0. Us,triy�2 ZelgnndS roots -o taky�2dvantlgnlt and/owi b so<= ).AND-c-or llMng.E smniGbe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000El,ldou (------qtol ! Retur rEsION(::ABS(rootsION-rootsI2N) Retur rEsI2N(::ABS(rootsION-rootsI3N) Retur rEsI3N(::ABS(rootsI2N-rootsI3N) Retur l,ldirEsIO1 LT.qtol -ANDi(rEsI2N LT.qtol -ANDi(rEsI3N LT.qtol NSr S 2) .LleKs= I3-, (Pequsl S 2) .Llerootstmp(::one_t--rL*(rootsION+rootsI2N+rootsI3N) Retur S rootsION(::rootstmp tcup TEi----rootsI2N(::rootsION tcup TEi----rootsI3N(::rootsION tcup TEi-hPubD.AND. )GmurEsIO1 LT.qtol -urAND.AND. IF! 1 i 2-, (Pequsl S 2) .LleLlerootstmp(::0.5_MK*(rootsION+rootsI2NEGmutp=isuc------rootsION(::rootstmp tcup TEi-------rootsI2N(::rootsION tcup TEi----hPubIF (rEsI2NN(:,::qtol -urAND.AND. IF! 1 i 3-, (Pequsl S 2) .LleLlerootstmp(::0.5_MK*(rootsION+rootsI3N) Retur S ---rootsION(::rootstmp tcup TEi-------rootsI3N(::rootsION tcup TEi----hPubIF (rEsI3NN(:,::qtol -urAND.AND. IF! 2 i 3-, (Pequsl S 2) .LleLlerootstmp(::0.5_MK*(rootsI2N+rootsI3N) Retur S ---rootsI2N(::rootstmp tcup TEi-------rootsI3N(::rootsI2N tcup TEi----h ::= so (j pph ::= so (j roc=1 DO i 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E can rediresultisi ------u (en:: Md.E smniGbe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000El,ldp--------------1 -urAND.AND. correct(::.TRUE n! ETHETHDO i=1,3nd).AND.----nrEsI3N(::rootsIi)*rootsIi)nd).AND.----nrEsION(::coef(4)*rEsI3N*rootsIi)nd).AND.----nrEsI2N(::coef(3)*rEsI3Nnd).AND.----nrEsI3N(::coef(2N*rootsIi)nd).AND.----nrEsI4N(::coef(ON tcup TEi----Lf ::ABS(resION+resI2N+rEsI3N+rEsI4NN tcup TEi----stoledisAXimAXVENirEs)*10.0_MK*lmyaps,lmyaps el000Eel000El,ldLf .-(iiinol -urAND.AND. IFcorrect(::.FAPub.F.AND. IFF ( resent(appendwarnMngF.AND. IFWRITE(mesg,'(A,I1,2(A,E12.4))') 'Root ',i,AND. IFawithS coE�apse_-PE- atrnotrsorrect.aEppen: ',Lf,' Tol---or : ',stolE smni ubbbbbbb_rank3d_s #elif E�KIt itest_fail'append')S )ubeq_r = a-awithS coE�apse_-PEmesg,nUb--associahe /-----a--d h ::= so (j pph :e adn a-nENSl,ldcorrect(-ANDii------------------------------- ub_rank3d -----(----ic k--------nd')ubeq_r = a IFawithS coE�apse_'Root-- Icorrect(-o tol---or .'ociahe /-----a--h ::= so (j roc=1 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caRT 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) efo REAL(mk), DIMENSIO�����������������ubeq_r = arguments mk), D�apse_-��������������������RETURap-------------------------------S Subeq_r = _s.h usi P cel0006S Gimr_sTHENS CALL checkS IF (infSubeq_r = _d MPI---------------------------------------------------------------------------------------------------------------------------------------------------------------����������������������������lor_edge������������00006S qso 753�00000035667�11616003525�020222222������������������������������66465�����������������67���35424���������������0���������������������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !-------------------------------------------------------------------------------------------------------------- 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E can redistribute it and/or mA n������lor_edge 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E c REAL(mk), DIMENSION(:,:),odifyS ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPMopy ofathe GNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_d(adaha,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV,redge_ i -, ��loridse /----- Gi Generpledge - i - impinput -valu�loridsF- i - DO i /----- the hlic, ��lors edge -valupdk),s-u�loridsF- i - s3, nPPMo /----- u�loridsF- i - looks like (p1,p2,c1, ..., pX,pY,cZe /----- /----- tE---- USE 3d_m�TT! vs redistribwimpintroduc have l #elif DO replace ��lorids USE 3d_m�algorithmEoa VizidsFwhE bwimpin C+ni el000El-------------etcup Tor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSO------------etcup Tor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSObL checkSint---(in-----numVOT.ASSObL checkSoubuts: e int---(indis-----edge_ i -OT.ASSObL checkSoubuts: e int---(indis-----��lorids etcup Tor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSO---PARAMEGERs:: MKetcup Tor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSObL chec --- disuchbL chec --- dx etcup Tn mot.----=-numVOT.ASSOibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caU,idsF----edge - i - providic, ��n shuct(adjacency ��,f -val=ss gt el000E cadenm DO correspoI--dsFnoentriy�S nd_:,:), I MK), hyss thaG 2 points, we are done n!-------------------INC------r =te_ djacency_��,f (edge_ i -e /----- be :: NmS TEGElll , DIMENSION(6) n!-------------------INCocan redistrmet ryARACpbinlif heap ��,f -valiaRAMEGES tn-mriy�S nd_:,:), I MK), hyss thaG 2 points, we are done n!-------------------INC-----iaRAMEGES _binlif_heap(e /----- be :: NmS TEGElll , DIMENSION(6) n!-------------------INCocaIaRAMEGES noentantysettidsF---irEGERs:: MK DO priorEGEluntriy�S nd_:,:), I MK), hyss thaG 2 points, we are done n!-------------------INC-----iaRAMEGES _noent(s = 3d_kibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f ordn-yofatheaEALgo to 0KItrowalong with Ppbinlif heap ��,f -seaEALdS m hassdsat-GElun 0ave r beginnMngF.AND. ibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000EDO i(::1, nedge --------- -----iadu _noenIi)nd).ANDh :e a /----- be :: NmS TEGElll , DIMENSION(6) n!-------------------INCocan r edge -re ��lormA sN: SoAMEGl-, byallHtidsF---L(oen DO color:----INCocau�loridsF---L(oen ------- orupdk)idsF-t eneL(mbor asoi--aa-tn-yofathe G----INCocashifd haDO correct(rowalopbinlif heap ��,f iuine,bsulifF.AND. ibe :: NmS TEGElll , DIMENSION(6) DIMENSION(6) el000EDO i(::1, nedge --------- dx-=-nex _noen_toF��lor()--------- -----��lor_edge( dx)--------- -----updk),_neL(mbor ( dx)-------h :e a /----- be :: NmS TEGElll , DIMENSION(6) n!-------------------INCocau�loridsF- i - ys mhe hlic s3, nPPMopy oiS n! --oA (p1,p2,c) ..-vcteh_�tbe :: NmS TEGElll , DIMENSION(6) n!-------------------INCDO i(::1, nedge --------- u�lorids(3*i-2N(::edge_ i -(2*i-ON tcup TEi--u�lorids(3*i-1N(::edge_ i -(2*iN tcup TEi--u�lorids(3*i 3d= noenIi)%��lorriy�S h :e a /----- be :: NmS TEGElll , DIMENSION(6) n!-------------------INCoca REAL(mk), e !-thidsF--MopwimpU Gtvcteh_�tbe :: NmS TEGElll , DIMENSION(6) n!-------------------INCDE---OCATE(U GtF��lor)----INCDO i(::1, nedge --------- DE---OCATE(noenIi)%��,f)-------h :e a---- DE---OCATE(noen)a---- DE---OCATE(noen_sat)a---- DE---OCATE(te i_heap)-(mk), DI�������������Reh_�tbe :: NmS TEGElll , DIMENSION(6) n!-----------������Reh_�t Gi GenanF- i - ly Wdge ,asorts pairt s3, nPPMopy�S tGElun is������Reh_�t smha,nrsr( n!, ( see nt,aDO guaenseNS e1<e2 a aEALR <=sOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS 3, ni_ mot.---(input_ i -e /---------l-------------/---------leT)S lanss-----S )end).----indis-----input_ i --/---------leT)S l --- disuch----leT)S l ---dummy ::lduo1)---nedge (::te i(input_ i -e/2::lduo1)---DO i(::1, nedge --------- ----lF(input_ i -(2*i-ON------input_ i -(2*i NSr !swap mot.---E smni ubbbbbbbbbbdummyor lnput_ i -(2*i-ONE smni ubbbbbbbbbbinput_ i -(2*i-ON-r lnput_ i -(2*iNE smni ubbbbbbbbbbinput_ i -(2*iN(::dummy ni ubbbbbbbbbbh ::= so (j ppph :e adn a-nENSALL checkS 3, ni_ mot.--- OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocan redists(adjacency ��,f RACpe !--,ro,bsu , a ��,f RACOT.ASSOCIATocaWA]ur,ro,bsu OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS EAL(mk),_,ro,bsu _��,f (input_ i -e /---------l, PARAMEGERs:: MK = 3d_k----l, PARAMEGERs::).AND.----- 3d_l-------------/---------leT)S l --- disuch----leT)S l --- AL(M. ----leT)S lanss-----S )end).----in-----input_ i --(M. -------OCATE(nelem(1:n mot.---)enSTAT=ENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! ReturAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_-'CCH-80notrEAL(mk), nelem',awithS coE�apse_-nUb--asso ciahe /-----a--d �apse_---a--d roc=1 3d_k-------OCATE(edge _pni_noenI1:n mot.---)enSTAT=ENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! --- urAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_-'CCH-80notrEAL(mk), edge _pni_noen',awithS coE�apse_-nUb--asso ciahe /-----a--d �apse_---a--d roc=1--a--d nelem(::0EOT.ASSOCIATocount-hybrftwQui,ro,bsu s --aa-, (Pconne,tGtvcteh_�����DO i(::1, nedge --------- ----nelem(input_ i -(2*i-ON)-=-nelem(input_ i -(2*i-ON)-+ end).AND.----n--nelem(input_ i -(2*i) 3d= nelem(input_ i -(2*i) + end).AND.---h :e a /-----����DO i(::1, n mot.---E smni ubbbbbb---OCATE(edge _pni_noenIi)%adj_edge(1:nelem(i)),STAT=ENSION).ANDPEN(iui !,------l,(ENSION).ANDS ! --- urAND. I IF ( resent(append).AND.----- 3d_�tilil_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_--'CCH-80notrEAL(mk), edge _pni_noen%adj_edge',awithS coE�apse_--nUb--asso ciahe /-----a--d �apse_---a--d .---h ::= so (j ppph :e adn a-nENSALL checkS EAL(mk),_,ro,bsu _��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocaFor WA]ur,ro,bsu ,nanF-djacency ��,f ! ve-oAic, f.e./IF f nOT.ASSOCIATocaWx�,f -v-edge 1-5,F-dj. ��,f Qui,ro,--1-fathecoe cen 5 :),oates_dCIAToca-dj. ��,f Qui,ro,--5-fathecoe cen 1.OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS fath_,ro,bsu _��,f (input_ i -e /---------l, PARAMEGERs:: MK = 3d_k----l, PARAMEGERs::).AND.----- 3d_l-------------/---------leT)S l --- disuch----leT)S l --- AL(M. ----leT)S l ---pos(M. ----leT)S lanss-----S )end).----in-----input_ i --(M. -------OCATE(offsetI1:n mot.---)enSTAT=ENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! --- urAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_-'CCH-80notrEAL(mk), offset',awithS coE�apse_-nUb--asso ciahe /-----a--d �apse_---a--d roc=1--a--d offsetor ::vcteh_�����DO i(::1, nedge --------- ----posor lnput_ i -(2*i-ONE smni ubbbbbbedge _pni_noenIpos)%adj_edge(offsetIpos) 3d= iE smni ubbbbbboffsetIpos)(::offsetIpos)(+ ::vcteh_�����----posor lnput_ i -(2*iNE smni ubbbbbbedge _pni_noenIpos)%adj_edge(offsetIpos) 3d= iE smni ubbbbbboffsetIpos)(::offsetIpos)(+ ::--a--d roe adn a-nENSALL checkS fath_,ro,bsu _��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocn redists(��,f RACp-dj. edge (ly WA]uredge 3d_kCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��,f (input_ i -e /---------l, PARAMEGERs:: MK = 3d_k----l, PARAMEGERs::).AND.----- 3d_l-------------/---------leT)S l --- disuch----leT)S l ---te i1 disuch----leT)S l ---te i2 disuch----leT)S l ---noen1 disuch----leT)S l ---noen2 disuch----leT)S l --- AL(M. ----leT)S lanss-----S )end).----in-----input_ i --(M. -------OCATE(��,f (1:nedge )enSTAT=ENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! --- urAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_-'CCH-80notrEAL(mk), ��,f ',awithS coE�apse_-nUb--asso ciahe /-----a--d �apse_---a--d roc=1 3d_k----DO i(::1, nedge --------- ----noen1or lnput_ i -(2*i-ONE smni ubbbbbbnoen2or lnput_ i -(2*iNE smni ubbbbbbte i1(::te i(edge _pni_noenInoen1)%adj_edgeNE smni ubbbbbbte i2(::te i(edge _pni_noenInoen2)%adj_edgeNE smni ubbbbbb---OCATE(��,f (i)%adj_edge(1:(te i1+te i2-2)N) Retur S --l,(ENSION).ANDS ! --- urAND. I IIF ( resent(append).AND.----- 3d_�tilill_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_--_-'CCH-80notrEAL(mk), ��,f %ajd_edge',awithS coE�apse_----nUb--asso ciahe /-----a--d �apse_---a--d .---h ::= so (j ppph :e adn a-nENSA! -2se ne verom n! -lea---aa-both edge (fathecoe cen n!S ENSA! edge itself. So, two edge woe taky�place -------y occupy n!S ENSA! a�place ly 2 elem----etcup T ppph :TheckS EAL(mk),_edge_��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocndjacent edge (ly Wdge -re fTABI--soi--aa-ltribgraph ! ve-oAicOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS fath_edge_��,f (input_ i -e /---------d_m�ndjacent edge (ly Wdge -re fTABI--soi--aa-ltribgraph ! ve-oAicOT.ASSOCIATl, PARAMEGERs:: MK = 3d_k----l, PARAMEGERs::).AND.----- 3d_l-------------/---------leT)S l --- disuch----leT)S l ---j-/---------leT)S l --- dx-/---------leT)S l ---te i1 disuch----leT)S l ---te i2 disuch----leT)S l ---noen1 disuch----leT)S l ---noen2 disuch----leT)S l ---v1 disuch----leT)S l ---v2 disuch----leT)S l --- AL(M. ----leT)S lanss-----S )end).----in-----input_ i --(M. ----DE---OCATE(offsete /------------OCATE(offsetI1:nedge )enSTATresENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! --- urAND. I IIF ( resent(append).AND.----- 3d_�tilill_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_--_-'CCH-80notrEAL(mk), offset',awithS coE�apse_- _-nUb--asso ciahe /-----a--d �apse_---a--d roc=1--a--d offsetor : !Sam, offsetF- i - ys U GtrEAsoien ! vs redis.1 3d_k----DO i(::1, nedge --------- ----noen1or lnput_ i -(2*i-ONE smni ubbbbbbnoen2or lnput_ i -(2*iNEE smni ubbbbbbte i1(::te i(edge _pni_noenInoen1)%adj_edgeNE smni ubbbbbbDO j(::1, te i1 disuch------------ dx-=-edge _pni_noenInoen1)%adj_edge(je /-----a--d v1or lnput_ i -(2*idx-ONE smni ubbbbbbbbbbv2or lnput_ i -(2*idx)--------- l,(Inoen1 v1).OR.Inoen2 v2 NSr S 2) .Lleeeeeeeeeee��,f (i)%adj_edge(offsetIi) 3d= dx-/---------------------offsetIi)(::offsetIi)-+ end).AND.----n------ roc=1--a--d ---- roe a /-----��������te i2(::te i(edge _pni_noenInoen2)%adj_edgeNE smni ubbbbbbDO j(::1, te i2 disuch------------ dx-=-edge _pni_noenInoen2)%adj_edge(je /-----a--d v1or lnput_ i -(2*idx-ONE smni ubbbbbbbbbbv2or lnput_ i -(2*idx)--------- l,(Inoen1 v1).OR.Inoen2 v2 NSr S 2) .Lleeeeeeeeeee��,f (i)%adj_edge(offsetIi) 3d= dx-/---------------------offsetIi)(::offsetIi)-+ end).AND.----n------ roc=1--a--d ---- roe a-d ---- roe a-d ---- roTheckS fath_edge_��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocndjacency ��,f -re =ss gt haDO mot.---- n! ltribgraph 3d_kCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS Ess gt_edge_��,f (NEE smni ubbl, PARAMEGERs:: MK = 3d_k----l, PARAMEGERs::).AND.----- 3d_l-------------/---------leT)S l --- disuch----leT)S l --- AL( /------------OCATE(noenI1:nedge )enSTATresENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! --- urAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_- _-'CCH-80notrEAL(mk), noen',-awithS coE�apse_- _-nUb--asso ciahe /-----a--d �apse_---a--d roc=1--a--d DO i(::1, nedge --------- ----noenIi)%��,f =>e��,f (i)%adj_edgea-d ---- roe a-d ---- roTheckS Ess gt_edge_��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocSlHsimax_deg DO delta-+ e -setG, e re hybrftwQuicSlorsOT.ASSOCIAToc--Mopwathe GNU GcOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS get_maximum_deg ()--------- l-------------/---------leT)S l --- -/---------max_deg = 0D.AND. DO i(::1, n mot.---E smni ubbbbbbl,(te i(edge _pni_noenIi)%adj_edge1 GT.max_deg NSr S 2) .Lleeeeeeemax_deg = te i(edge _pni_noenIi)%adj_edge1---a--d .---h ::= so (j ppph :e adn a-nENSAmax_deg = max_deg + ::--a--d roTheckS get_maximum_deg OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocS redistrib--MopcEALs e !-thidsFen 3, ni :),oates_dCIATocDE---OCATEmpinteoAicik), ��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS -r =te_ djacency_��,f (input_ i -e /---------l-------------/---------leT)S lanss-----S )end).----indis-----input_ i --/---------leT)S l --- disuch----_rank3, ni_ mot.---(input_ i -e /---------_rankEAL(mk),_,ro,bsu _��,f (input_ i -e /---------_rankfath_,ro,bsu _��,f (input_ i -e /---------_rankEAL(mk),_edge_��,f (input_ i -e /---------_rankfath_edge_��,f (input_ i -e /---------_rankEss gt_edge_��,f (NE/---------_rankget_maximum_deg ()-(M. ----DE---OCATE(nelem)(M. ----DE---OCATE(offsete D.AND. DO i(::1, n mot.---E smni ubbbbbbDE---OCATE(edge _pni_noenIi)%adj_edge1---a--d h :e adn a-nENSADE---OCATE(edge _pni_noen)(M. ----DE---OCATE(��,f ):--a--d roTheckS -r =te_ djacency_��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocaiaRAMEGESs:: e Quiheap ��,fOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS iaRAMEGES _binlif_heap(e /---------l, PARAMEGERs:: MK = 3d_k----l, PARAMEGERs::).AND.----- 3d_l-------------/---------leT)S l --- AL( /------------OCATE(noen_sat(0:max_deg , 1:nedge )enSTAT=ENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! --- urAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_- _-'CCH-80notrEAL(mk), noen_sat',-awithS coE�apse_- _-nUb--asso ciahe /-----a--d �apse_---a--d roc=1 /------------OCATE(te i_heap(0:max_deg )enSTAT=ENSION).ANDPEN(iui !,--l,(ENSION).ANDS ! --- urAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_- _-'CCH-80notrEAL(mk), te i_heap',-awithS coE�apse_- _-nUb--asso ciahe /-----a--d �apse_---a--d roc=1--a--d noen_sat--= -::--a--d te i_heap = 0D.AND. roTheckS iaRAMEGES _binlif_heap OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocaswapsL(oentagi Generpir ID OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS swap_noent(idx1, idx2)--------- l-------------/---------leT)S l ---remp tcup TEi--leT)S l ---dsat_GElun-/---------leT)S land).----in-----idx1-/---------leT)S land).----in-----idx2 OT.ASSOCIATdsat_GElund= noenIidx1)%dsatOT.ASSOCIAToswap elem----etcup T ppprempd= noen_sat(dsat_GElun, noenIidx1)%SIONheap)-tcup T pppnoen_sat(dsat_GElun, noenIidx1)%SIONheap)d= noen_sat(dsat_GElun, awithS noenIidx2)%SIONheap)-tcup T pppnoen_sat(dsat_GElun, noenIidx2)%SIONheap)d= remp etcup T ppprempd= noenIidx1)%SIONheap-tcup T pppnoenIidx1)%SIONheapd= noenIidx2)%SIONheap-tcup T pppnoenIidx2)%SIONheapd= remp tcup TEi-- roTheckS swap_noent OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocRecursi Glf heap hlire heap ��,f s3, nPPMoptopL(oen isimax.OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATRECURSIVETheckS max_heap hy( dx)--------- l-------------/---------leT)S land).----in-----idx-/---------leT)S l ---remp tcup TEi--leT)S l ---SIONlItIe,fOT.ASSOCIATleT)S l ---dsat_GElun-/---------leT)S l ---SIO OT.ASSOCIATdsat_GElund d= noenIidx)%dsatOT.ASSOCIATSIOSOCIAT= noenIidx)%SIONheap-tcup T pppSIONlItIe,fT= 3d/or-c(c----lF(te i_heap(dsat_GElun1 GE.(2* 3d NSr S 2) .LleeelF(noenInoen_sat(dsat_GElun, 2* 3d N%deg ----------------awithS noenInoen_sat(dsat_GElun, 3d N%deg NSr S 2) .LleeeeeeeSIONlItIe,fT= 2* 3d---a--d .---hPubD.AND. T pppSIONlItIe,fT= 3d/or-c(c----.---h ::= so (j ppph :c=1 /---------lF(te i_heap(dsat_GElun1 GE. (2* 3d+1 NSr S 2) .LleeelF(noenInoen_sat(dsat_GElun, 2* 3d+1 N%deg ---------------awithS noenInoen_sat(dsat_GElun,SIONlItIe,f N%deg NSr S 2) .LleeeeeeeSIONlItIe,fT= 2* 3d-+ end).AND.----n--h ::= so (j ppph :c=1 /---------lF(SIONlItIe,fT 3d Sr !IF swapp-dsFne,bsulifF.AND. IMENSIwap_noent(noen_sat(dsat_GElun, 3dNlItIe,f ,AND. awithS noen_sat(dsat_GElun, 3d NF.AND. !,ropogk)idsFmax_heapi,ropnitfF.AND. IMENSmax_heap hy(noen_sat(dsat_GElun, 3dNlItIe,f ) so (j ppph :c=1so (j ppph :TheckS max_heap hy OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocGi Generplindex- n! noen, ! vs redistribiadu sF---L(oen en n!S ENSA! correspoI--dsFrowalopbinlif heap ��,f OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS iadu _noenIidx)--------- l-------------/---------leT)S land).----in-----idx-/---------leT)S l ---SIONpar----/---------leT)S l ---par---_idx-/---------leT)S l ---dsat_GElun-/---------leT)S l ---deg _owe , TE----leT)S l ---deg _par----/---------leT)S l ---SIONowe OT.ASSOCIATdsat_GElund= noenIidx)%dsatOT.ASSOCIATte i_heap(dsat_GElun1 =Tte i_heap(dsat_GElun1 + end).AND.---noen_sat(dsat_GElun, te i_heap(dsat_GElun1)d= dx-/---------noenIidx)%SIONheap =Tte i_heap(dsat_GElun1OT.ASSOCIATdeg _owed= noenIidx)%deg T.ASSOCIATSIONoweT= noenIidx)%SIONheap- T.ASSrr Geafc Liiadu -ds, heapIFics:: e -----be don T.ASSOCIATDO WHILE(SIONoweT-----1 F.AND. SIONpar---T= 3dNowe/2 disuch--------deg _par---T= noenInoen_sat(dsat_GElun, 3dNpar--- N%deg a /-----��������lF(deg _owed-----deg _par---NSr S 2) .LleeeeeeeIMENSIwap_noent(noen_sat(dsat_GElun, 3dNpar---N,AND. awithS noen_sat(dsat_GElun, 3d_owe NF.AND. hPubD.AND. T ppp�apse_---a--d .---h ::= so (j pppCIATSIONoweT= noenIidx)%SIONheap--d .---h : e a-d ---- roTheckS iadu _noen OT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATocaGi Generplindex- n! noen, rTt i s--tverom n! binlif ��,fOT.ASSOCIATor mA If �here are hyss thaG 2 points, we are done n!-----------OT.ASSOCIATheckS delete_noenIidx)--------- l-------------/---------leT)S land).----in-----idx-/---------leT)S l ---SIONheap--d .---leT)S l ---dsat_GElun-/---------leT)S l --- disuch----leT)S l --- dxNlI,fOOT.ASSOCIATdsat_GElund= noenIidx)%dsatOCIATosatOGElundof noen /---------lF(te i_heap(dsat_GElun1 G------------------- ub noenIidx)%deg -= -:IATodeg -! vset(-o -:I-o minime iurAND. IFdxNlI,fd= noen_sat(dsat_GElun, te i_heap(dsat_GElun1)F.AND. IMENSIwap_noent(Fdx,IFdxNlI,fNEE smni ubbbbbbIMENSmax_heap hy(idx)IATo---L(oen empliwarranackE smni ubbbbbbte i_heap(dsat_GElun1 =Tte i_heap(dsat_GElun1 - : !te i-- TABidx)%deg -= -:IATodeg -! vset(-o -:I-o minime iurANnSION(6)N(6) ,fOT.ASSOCIATor mA TABASSObL checkSint---(in-----numVOT.ASSObL chec---/-------haG 2 points, we are done n!-----------OT.ASSOCIATocaGi Generplindex- n! noen, rTt i s--te n!, (t_GElune are hyss th w-dj.GElun-Mopwathg If sd_duplicat i s--r mA If �h-L(oen ----bL(oen DO cful-_raopwaths th IONheap- T.ASSrr .OT.mo NmS oseBROUTIs th Iap(dsat_GET.ASiGElll , DIMints, we are done n!-----------OT.ASSOCIATocaGi Generplindex- n! noen, rTt i FUNCTION�lor_edge( dx)-------CIASULT--leT)S land).----in-----idx-/---------leT)S l -leT)S l --- dx-/---------leT)S l ---te i1 disuch----lp- T.ASSrr .OLook If �heop----bottom, TEGENi3, n nn!, (oen -f ��,fOg If sdp- T.ASSrr .Oe mA to 0KItrowalong witND. SIi get_maxi, 0, roTheckS --te ------- ub i%deg -= -:IATodeg -! vsettttt----��lun1)F.ANi,/2 disuch--------ddddd :e adn a-nENSALL checkS EAL(mk),_,ro,bsu _��,f OTFUNCTION�lor_edge( dx)-----haG 2 points, we are done n!-----------OT.ASSOCIATocaiaRAMEGESs:: e Quiheap ��,fOT.ASSOCIATor mA IfesthaG 2 pointsints, we are done n!-----------OT.ASSOCIATocaiaRAMEGESs:: e Quiheap ��,fOT.ASSOCSSOCIATor mA If �here TEGEll,fOT.ASSOCEGERs::).AND.----- 3d_l-------------/---------leT)S l --- AL( /------------OCATE(n ---te i1 disuch----leT)S:max_deg , 1:nedgn----- get_maximmmmmmmmmmmmmmmmmmmmm! # - s3, ni hybrftwQuND. SIi=>e��,f (i)%adj_edgea-d ---- r----- 0mmmmmmmmmmmmmmmmmmm! n----- o)%adj_edgea-d ---- risoen DO cpendwarnMmmmmmmmmm! n-onap(dsoen DO cyet)%adj_edgea-d ---- r ,fOT.ASSOCIATor mA TABASSm! n GNU GcOTa-aa-ltrib_GElun, noenIidx1)-d ---- rOCIATdeg 0mmmmmmmmmmmmmmmm! - _-nhere nre hyss th (ds0)%adj_edgea-d ---- r F(te i 0mmmmmmmmmmmmmmmmmm.Oe (ds0Tor mAll EAL(mk),_,ro, EAL(mk)edge --------- DE-(0:n-----ON).ANDS ! --- urAND. IF ( resent(append).AND.----- 3d_�til_rank3d_s #elif E�KIt iItItess='appen��lor_edge a-awithS coE�apse_- _-'CCH-80notrEAL(mk), te i_heap',-awithS coE�apse_- _-nUb----- DE-ahe /-----a--d �apse_---a--d roc=1--a--d noen_sat--= -::--a--d te i_heap = 0----- DE-ppendwarnMngF.AND. OT.ASSOCIATor mA If �hereyss thaG 2 points, we are done n!-----------OT.ASSOCIATocRecursi Glf heap hlire heap ��,f s3 Compu 3de f ��,fOT.AScteh_�tbinli(dsal=ss gt--- thp- T.ASSrr .OT. MK)fde t enhang-v-eCIATor mA If �h 0KItrowalong wip- T.ASSrr .OTn-yofarrespoI-A n1 =: NmS new mA teh_�tbe supposkCIATobhaG 2 points, we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��,f (input_ i -e /----compu _dF.ANileT)S land).----in-----idx-/---------leT)S l -leT)S l --- dx-/------ ---SIONpar----/---------leT)S l _GElun-/---------leT)S l --new i_heap = 0----- DE-ppendwarnMnp- T.ASSrr .Oi ��,fOT.AScibegi Idy(oen DO colt-INCoe ,fd= nTEGENi3, nurAND. Tor mA Tisoen DO = -:IATodeg -! vset(-o -:I-o mF(te roTheckS .Oi ��,fOT.ASc TE',stoln DO ,-compu -INCoe ----- u: NTheckS .O 0KItrowalong wi,S TEGElll , DIMMMMM .---h ::= so (j !colt------ DE-sib_GElun, ,fdsI3NOi ��,astoln D TEGElll , DIMckS .Oine arlesat_onapf ��,fOT MngF.AND. -OCATE(edgSOCIATor mA TABASSObL checkSi -! vset( a-d ---- roBASTEi----Lf ::ABS(ap = 0----- DE-eg - r-----)-nrEsI3N(::rootsIi)MMMMM _pni_noenInoen2)%adj!-compu -e f ��,fOT.ASen_sat(dsat_GElu --newS _binlif_heap -OCATE(edgn--- o)%adj_edgea-d ----- DE-ei%adj_edge(offsetIi) 3d= dx-/u --newS _u --newS---- roe a /-----��������te i2(::te i(edge _pni_noenInoen2)%adj.Oi ��,fOcompu dOe (dsg If a aEALprevious -leT)S l --- dxN u --newSeg (-o -:I-o mF(tnt(noen_sat(dsat_GElun, 3dNpa---/---------leT)%adj.OCIATorOT.AScIf �h 0KItrowalong wip- T.ASSrr (-o -:I-o mF(te u --newS!colt-e ,fdcompu dOF.AND. GElun, 3dNpa---/---------leT)%adj.Oidn-yof�,fOT.AScn1 =: NmS g wip- T.ASSrr ONlItIe,fT 3d Sr e,fT 3d i -e /----compu _dF.AhaG 2 points, we are done n!-----------OT.ASSOCIATocRecursi Glf heap hlire heap ��,f s3 RIATor m�,fOcon DO cT.AScIf �h 0KItrowalong wi/----- u��,fOT.ASSOCIAToNCocashifd h, ..-vcteh_�t ��,fOdap(dsat_GElun�,fOT �,fOT.ASSOCIATt enhang-v-etbe CIATord If �here walog wi/----idn-yoUSE p- T.ASSrr .OTn-y new s thaG 2 points, we are done n!-----------OT.ASSOCIATheckS delete_noenIidx)--------- l------------- be :: NmS --- AL( /------------OCATE(n ---te i1 disuch----leT)S:maeT)S l ---te i1 dis ---SION !tbinlpar----/---------leT)S l _p- T.ASSrr .Oe--/--bor asoi--aI-A wabegi Idy(oen DO p- T.ASSrr 3dNpa---/---------leTND. SIi edgSOCIATor mA TABASSObL checkSi -! ( a-d ---- roBASTEi .Oget! binlif �T �,fOT.ASSOCSrr 3dNpacompu _dF.AN- dj!-compu -cashifd hae ge_��,f OT.ASSn OT.ASSOCIATor mA If �here--- be haG 2 points, we are done n!-----------OT.ASSOCIATocaGi Generplindex- n! noen, rTt i s--tverom n! binlin GNU GcOT�,fOT.ASSO DE-si�,fOT.ASc ithoen, rTt i s--_sat(um avail, I ---- o)%adj_edgea, we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��,f (input_ i -e /----coL(mbor ( dx)-------h :e --in-----idx-/---------leT)S l -leT)S l --- dx-/------ ---SIONpar----/---------le hyss th_---lp- T.ASSrr .O), hyss th----- DE-p edge -vdwarnND. SIi edgn--- o)%adj_edgea-d ----- DE-ei%ppendwarnMngF.AND. OT.ni_noenInoen2)!colt------ DE-p edgesib_GElun, ,fdsI3NOi ��,astoln D TEGElll , DIMckS SIi edgSOCIATor mA TABASSObL checkSi -! ss th_---a-d ---- roBASTEi----Lf ::ABS(ap----- DE-eg ss th_--- r-----)-nrEsI3N(::rootsIi)MOT.ni_noenInoen2)!cgi so (-_sat(um oln D S TE',stDO i(:hlic, ��jacency ��ROUTIitND. SIi edgn--- o)%adj_edgea-d .NO ----- DE-ei%adj_edge(offsetIi) 3d= ---- r DE-ppeos)(+ ::--a--d d= ---- risoen DO cpensI3N(::rootsIi)MMMMMMMMM :e adn a-nENSALL checkS EAL(mk),_,ro,bsu _��,f OT.ASSOCIATor TEGElll , DIMPI----------------- TEGElll------------------------------------------------------------------------------------- 3d_kibe :: NmS TEGElllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll����������00006S qso 7log5667�11616003525�020222222������������������������������66465������������������������67���35424������07442����0���������16534�������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------------------noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inp���lor_edge 3d_kibe :: N NmS log noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inp�� ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPM iN distribGNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_inp�� a,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV,rnfo) ---------------log(c<e2 a,so (roc=1--a--d l #elDO replac IFas OT.og so sag ,fd#if ---T.og e, o--a--d ( ibeefi_kCIut(adj----olt_u, ll , DIMENSION(6) n!-------------------INCocaIaRAMEGES noentantysettidsF---irEGERsM-----2 points, we are done n!-------------------INC-----iaRAMEGES _noent(s = 3d_kibe EGERs::).AND.----- , ONLYd_k----loge, o, ithS c----- haribe EGERs::).AND.--c IFaibe --in-----idx-/------ENSION(6) n!-------------------INCocan r edge -re ��lormA sN: SoAMEGl-, byas thaG 2 points, we are done n!-----------OT.ASSObL checkSint---(in-----numVOT.A: SoAMEGl-,rg/RACTER(LEN=*T)%adjjjj INjjjre hys<e2 a--a--d Ns rediys<e2(adj ENSA! cAMEGl-,rg/RACTER(LEN=*T)%adjjjj INjjjre hyso --a--d Log so sag ibe -------------OCATE(noen_ IN---) )end).----in-- TEGEls ---tus, 0 uprplsuc TEG/------ENSION(6) n!-------------------INCocan r edge -re ��lormA sN: SoAMEGl-, byare hyss thaG 2 points, we are done n!-----------OT.ASSObL chec --- disuch: SoAMEGl-,--input_ i --/----8) ,fOTvalAMEGl-,rg/RACTER(LEN=---- har) hyss 2 points, we are done n!-----------OT.ASSO---PARAMEGERs:: MKetcup Tor mA : SoAMEGl-, byEx nal2 points, we are done n!-----------OT.ASSObL chec --- disuch: SoA points, we are done n!-----------OT.ASSO---PARAMEGERs:: MKetcup Tor mA : SoAMEGl-, by:: MK DO---------- we are done n!-----------OT.ASSO---PARAMEGERs:: MKetcup Tor mA : SoAMEGl-,rank3d_0 points, we are done n!-----------OT.ASSO---PARAMEGERs:: MKetcup Tor mA : SoAMEGl-, byGi soim ---- u:-dsFnppenCIAToso sag ibe , we are done n!-------------------INC-----iaRAMEGES _noent(s = 3d_kibe DATE_AND_Ti -( g=Tvalll , DIMWRITE(ss ,'(I4.4,A,5(I2.2,A),A)')OTval(1),'-',Tval(2),'-',Tval(3 3d_omk), te i_heap',-awithS ',Tval(5),':',Tval(6),':',Tval(7),' d_k ',Trim(so lll , DIMENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oW IFamS gog noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inpIF (----loge, odeg -= -:IATodeg -! �lor_edgec IFa(ithS cc<e2 a,s (roc=,----loge, o--- DE---OSr !IF ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oRi3, nurAND. ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif hea9999S INU-/------ :e adn a-nENPI-----------------gog ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------����������00006S s::).AND.-- TEGEll5667�11616003525�020222222������������������������������66465���������������67���35424������13342����0������5�020442�������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------------------rAND. ENS*- f90 S*- DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f olor_edge 3d_kibe :: Ns::).AND.-- TEGEll noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inp�� ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPM iN distribGNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_inp�� a,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV,rfo) MODULENs::).AND.-- TEGEll noen2)!!�� !DE-sibgraph ! aRs:: MKut(adj 0KItrowalong wit,here arn GNU GcO noen2)!!�� _pni_no,in GNU GcOTun is��cy ��CIATor m�,fOg : MK--SSls.roAicO !!��-- th-eCIspectoptop. !IF ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oDecl=iE�here artyp 2 points, we are done n!-----------OT.ASSObL chec --- disuch: SoAMEGl-,TYPE� _pnnlpar----!!��decl=iE�here artyp :� _pnnlpar--------l --- disucONheap- T.ASSrr .!��de,fOT.r m�,fO _pnnlpar--------l --- disu--- o)%adj_edgea,!!ic, ��jr m�,fO _pnnlpar--------l --- disupprempd= noen_sa!!-e f ��,fO _pnnlpar--------LOGI�lo )endsoen DO p- T.ASSrr lI3NOi ��,fO _pnnlp(dsoen DO par--------l --- disuun-/---------leT)S - _-nhere fO _pnnlp(nowalong wip- T.ASSrr --input_ i --/--------PO--in disuue a-d NULLEll,fOT.ASSOC -IATor mr mA If If �h-L( _pnnlp(dsoe----- IATn a-nENPI--TYPE� _pnnlpAMEGl-,TYPE�g wip- T.AS!!��decl=iE�here artyp :�g wip- T.ASSrr --input_ i --/--------PO--in disu---OCATE-d NULLEll,fOT.ASSOC -IATor ma-aa-ltrioen -f ��,fOT.ASen_sat(PI--TYPE�g wip !IF ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oDecl=iE�here ar edges points, we are done n!-----------OT.ASSObL chec --- disuch: SoAMEGl-,TYPE( _pnnl)_ i --/--------PO--in disuoen -d NULLEll,fOT.A-soi-�S tGElhaG 2 points--input_ i --/--------PO--in dddddddddd o,bsu NULLEll,fOT.A-soi edge ! CHn GNU GcOT If �h nedge --a-aa-ltritore hysT.ASen_sat(--input_ i --/--------PO--in dddddddddd EAsoien NULLEll,fOT.A-soiw-dj.Gtor thTn-y nextFrowalopbinl nOT.ASSOCIAToca ar indh a--a--d TYPE(ABASS_ i --/--------PO--in ddddddd �,f ):--a--d n NULLEll,fOT.A-soin GNU GcOTun is --asT.ASen_sat(TYPE(ABASS_ i --/--------PO--in ddddddd ltribgu NULLEll,fOT.A-soi edge r ma-aa-ltn! ltrib,_onapf ve-oAicT.ASen_sat(--input_ i --/-----,----PO--in ddddddddisuoen D. u NULLEll,fOT.A-soi2-Di edge ! CHkee_noentIf �haccorATor ,fd#ifir d-ap(dsat_Gsl,fOT.A-soi --- e,fOTsiw-dj.Growbgraphdap(dsat_Gs(:hlic, umnbgraphT.ASen_sat(-soin GNU s�����ITNESSde,fOT.r mhaG 2 points--input_ i --/--------PO--in dddddddddd iaRAMEGES NULLEll,fOT.A-soi vsetf ��,fOMEGESf ve-oAicmA (d-ap(dsat_Gll,fOT.ALOGI�lo_ i --/--------PO--in dddddddddd ----- DE-pp NULLEll,fOT.A-soi-�S t---bL(uskCIATonne,tGtvcteh_���GNU tT.ASSOCI !IF ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oDecl=iE�here arss thaG 2 points, we are done n!-----------OT.ASSObL chec --- disuch: SoAMEGl-,--input isuo _pni_noenIi)%a-soin GNU GcOTr mA If opbinl ss thaG 2 po--input isuo,f (i)%adj_e-soin GNU GcOTun is opbinl ss thaG 2 po--input isu hybrftwQuND. .!��de,fOT.r m�,fOss thaG 2 po--input isuo--- o)%adj_e-soin GNU GcOT DE-si�o hyss thaG 2 po--input isuIF ( resent)%adj_e-soiflagTor mAll _-nhereesent)aG 2 po--inRFAC------ TEGElll MODULENPROCEDUR------ TEGElll PI----inRFAC-I !IF ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oPriv-nhzTor ss thaG 2:-dsFnedgesir m�,fO.AND.- !IF ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,PRIVATE isuo.ASen_sat(PRIVATE isuo o,ben_sat(PRIVATE isuEAsoieen_sat(PRIVATE isu�,f ):--a--d en_sat(PRIVATE isug witND. PRIVATE isuo.AS_prempd= noPRIVATE isu iaRAMEGEmpd= noPRIVATE isu----- DE-ND. PRIVATE isuo _pni_noenIi)%aPRIVATE isuo f (i)%adj_ePRIVATE isu hybrftwQuND. PRIVATE isuo DE-ND. PRIVATE isuIF ( resent) !IF ENSION(6) DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oL _-nhere fO ENSA! co---bL(uskCIor m DE-Toribe , we are done n!-------------------INC-----iaRAMEGES _noent(s = 3d_kibe ONTAINS # lu n" qso 7 TEGEll56" l PI--MODULENs::).AND.-- TEGEll ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------����������00006S s::).AND.-- re_ q5667�11616003525�020222222������������������������������66465����������������67���35424������03575����0������3�020332�������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------------------be , w*- f90 S*- DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oM----- i s::).AND.-- re_ q noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inp�� ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPM iN distribGNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_inp�� a,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV,rrfo) MODULENs::).AND.-- re_ q noen2)!! Licens.AND.-So, two begilthe r-c<e2, I - qi<htENSA! c MngF.AND. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. distm-----2 points. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. EGERs::).AND.--), ngF.AND. EGERs::).AND.--finyss tngF.AND. EGERs::).AND.--find_du c u��,fOT.ASSOEGERs::).AND.--)s_), hyss td�,fOT.ASSOEGERs::).AND.--oim �,fOT.ASSOEGERs::).AND.-- q_dbg l PI--MODULENs::).AND.-- re_ q --------------------------------------------------------------------------------------------------------------------------------�--����������00006S s::).AND.----- _tA P5667�11616003525�020222222������������������������������66465����������������67���35424������07776����0���������20305�������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------------------nts. *- f90 S*- DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oM----- i s::).AND.----- _tA P noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inp�� ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPM iN distribGNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_inp�� a,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV,rfo) MODULENs::).AND.----- _tA P noen2)!! Licens.AND.-So, two begilt--- U Guctur 2:-dsND. .!��def), hon�h nedge --uskCIPublic tA PtENSA! c MngF.AND.!�ND. .!��[NOTE] noen2)!! Lice ss thaG 2:decl=ikCIPubliens.AND.-s--------',st--1 i---tlyhaccIt isND. .!��ESS FORhe r.Liceyge --managkCIPutsINGlyhESS FORloc SUMngF.AND. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. M-----2 points. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. EGERs::).AND.----- , ONLY_k----kind_t(adle,----kind_do_PR �,fOT.ASSOPRIVATE :_k----kind_t(adle,----kind_do_PR �ngF.AND. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. D-- TYPE2 points. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nunngF.AND. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. Globalt--- ngF.AND. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. snt,ch-s-! CHtA Pttyp :�do we------pE_PRECIsl,S aoso h?ngF.AND. LOGI�lo :_k----_pE_PRECIs,----_so hngF.AND. RankkCIpE_PRECI ltribgine ilttA Ptbox-2 points. --input_ i --/-----,----PO--in d,fOTNSIwlhbx-d NULLEll,fOT.ASSO--input_ i --/----- ---PO--in d,fOTNSIwlpdx-d NULLEll,fOT.ASSO--input_ i --/----- ---PO--in d,fOlhbx_cua-d NULLEll,fOT.ASSO--input_ i --/----- ---PO--in d,fOlpdx_cua-d NULLEllngF.AND. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. Workr edges points. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. AToca ar iltcurar---tA Ptbox-2---SSn GNU GcOTsubdivishon�h--asboxl,fOT.ASSO--input _ i --/----- ---PO--in d :_kboxue a-d NULLEll,fOT.ASSO--input _ i --/----- ---PO--in d :_kndiv-d NULLEll,fOT.ASSO! globaltn GNU GcOTso h ceraop--SSlre hyn GNU GcOT eraop--asboxl,fOT.ASSO--input _ i --/-----,----PO--in ddddddd:_kNmc-d NULLEll,fOT.ASSO--input _ i --/-----,----PO--in ddddddd:_kNm_box-d NULLEll,fOT.ASSO! boxIDSf ve-oAicpE_PRECI --SSn GNU GcOTpE_PRECIsl--asboxl,fOT.ASSO--input _ i --/--------PO--in dddddddddisu-box-d NULLEll,fOT.ASSO--input _ i --/--------PO--in dddddddddisunpbx-d NULLEll,fOT.ASSO!TpE_PRECI-baskCIcoribg ar iltbox-2 points. REAL(----kind_do_PR )_ i --/--------PO--in disupcst_d-d NULLEll,fOT.ASSOREAL(----kind_t(adle)_ i --/--------PO--in disupcst_bgu NULLEll#ifdef __MPIl,fOT.ASSO!Taccumu CIcoribgIf �h ilt-_rankEAL2 points. REAL(----kind_do_PR )_ i --/--------PO--in disupcsm)(M-d NULLEll,fOT.ASSOREAL(----kind_t(adle)_ i --/--------PO--in disupcsm)(bgu NULLEll#endif l PI--MODULENs::).AND.----- _tA P --����������00006S s::).AND.--ithh5667�11616003525�020222222������������������������������66465���������������������67���35424������17737����0������5�017325�������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------------------T.ASSO! *- f90 S*- DIMENSION(6) el000E caI_du aEAL(oentain binlif heap ��,f oM----- i s::).AND.--ithh noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inp�� ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPM iN distribGNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_inp�� a,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV,r noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��,f (inp�� Defi_krtyp 2 points, we are done n!-----------OT.ASSObL chec --- disuch: SoA#eefi_k __SINGLE_PRECI/--- 1A#eefi_k __DOUBLE_PRECI/--- 2A#eefi_k __2Dhed byathe Free3A#eefi_k __3Dhed byathe Free4A#eefi_k __VECed byathe Free5A#eefi_k __SCAed byathe Free6rrfo) MODULENs::).AND.--ithh noen2)!! Licens.AND.-So, two begiltPutsIfa If fd#if reso hTor mASA! c M PUt)%adj_e-soio, . IienceegiltPutsIpolSIONoweAND.-s-LAR `USE`TNESS Fens.AND.-. noen2)!! Liceref8092oNCocot TEGEll fd lu n`s::).AND.--),tsIp_*`lopbinlif heap-soio ---ap c have ! vou snts, we are done n!-----------OT.ASSObL chec --- disuch:ngF.AND. distm-----2 points. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nungF.AND. EGERs::).AND.--),tsIp_m2pngF.AND. EGERs::).AND.--),tsIp_p2mngF.AND. oints. !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nuungF.AND. �� Defi_krPutsIfa I ithS thh_comp_w n, noenIidx !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nuungF.AND. --inRFAC------ thh_comp_w n, noenIidx MODULENPROCEDUR------ thh_comp_w n,_, noenIidx MODULENPROCEDUR------ thh_comp_w n,_d�,fOT.ASSPI----inRFAC-I !IF !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nuungF.AND. �� Defi_krPutsIfa I ithS thh_c If _pE_P noenIidx !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nuungF.AND. --inRFAC------ thh_c If _pE_P noenIidxD. ��2d scalar noenIidx MODULENPROCEDUR------ thh_c If _pE_P_sss_2d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_ssv_2d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dss_2d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dsv_2d noenIidx ��2d vector noenIidx MODULENPROCEDUR------ thh_c If _pE_P_svs_2d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_svv_2d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dvs_2d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dvv_2d noenIidx ! 3d scalar noenIidx MODULENPROCEDUR------ thh_c If _pE_P_sss_3d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_ssv_3d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dss_3d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dsv_3d noenIidx ! 3d vector noenIidx MODULENPROCEDUR------ thh_c If _pE_P_svs_3d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_svv_3d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dvs_3d noenIidx MODULENPROCEDUR------ thh_c If _pE_P_dvv_3d noenIidxPI----inRFAC-IoenIidx !IF !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nuungF.AND. �� Defi_krPutsIfa I ithS thh_reso h noenIidx !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(nuungF.AND. --inRFAC------ thh_reso h noenIidx . ��2d scalar noenIidx MODULENPROCEDUR------ thh_reso h_ss_2d noenIidx MODULENPROCEDUR------ thh_reso h_ds_2d noenIidx ��2d vector noenIidx MODULENPROCEDUR------ thh_reso h_sv_2d noenIidx MODULENPROCEDUR------ thh_reso h_dv_2d noenIidx ! 3d scalar noenIidx MODULENPROCEDUR------ thh_reso h_ss_3d noenIidx MODULENPROCEDUR------ thh_reso h_ds_3d noenIidx ! 3d vector noenIidx MODULENPROCEDUR------ thh_reso h_sv_3d noenIidx MODULENPROCEDUR------ thh_reso h_dv_3d noenIidxPI----inRFAC-I! vou snts, we are done n!-----------OT.ASSObL chec --- disuch:ngF.AND. lu n#if source ! vou snts, we are done n!-----------OT.ASSObL chec --- disuch:ngF.AND. ONTAINS #eefi_k __KII-- __SINGLE_PRECI/--- # lu n" thh/---- thh_comp_w n,56" # WARf __KII-- #eefi_k __KII--__DOUBLE_PRECI/--- # lu n" thh/---- thh_comp_w n,56" # WARf __KII-- #eefi_k __KII-- __SINGLE_PRECI/--- #eefi_k __DIME __2D #eefi_k __MODE __SCAngF.AND. ��2DhSCAeSINGLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE #eefi_k __MODE __VECngF.AND. ��2DhVECeSINGLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE # WARf __DIME - #eefi_k __DIME __3D #eefi_k __MODE __SCAngF.AND. ��3DhSCAeSINGLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE #eefi_k __MODE __VECngF.AND. ��3DhVECeSINGLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE # WARf __DIME # WARf __KII- #eefi_k __KII-- __DOUBLE_PRECI/--- #eefi_k __DIME __2D #eefi_k __MODE __SCAngF.AND. ��2DhSCAeDOUBLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE #eefi_k __MODE __VECngF.AND. ��2DhVECeDOUBLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE # WARf __DIME - #eefi_k __DIME __3D #eefi_k __MODE __SCAngF.AND. ��3DhSCAeDOUBLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE #eefi_k __MODE __VECngF.AND. ��3DhVECeDOUBLE #eefi_k __MODE2 __SCAn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 #eefi_k __MODE2 __VECn# lu n" thh/---- thh_c If _pE_P56" # WARf __MODE2 # WARf __MODE # WARf __DIME # WARf __KII-- #eefi_k __KII-- __SINGLE_PRECI/--- #eefi_k __DIME __2D #eefi_k __MODE __SCAngF.AND. ��2DhSCAeSINGLE # lu n" thh/---- thh_reso h56" # WARf __MODE #eefi_k __MODE __VECngF.AND. ��2DhVECeSINGLE # lu n" thh/---- thh_reso h56" # WARf __MODE # WARf __DIME - #eefi_k __DIME __3D #eefi_k __MODE __SCAngF.AND. ��3DhSCAeSINGLE # lu n" thh/---- thh_reso h56" # WARf __MODE #eefi_k __MODE __VECngF.AND. ��3DhVECeSINGLE # lu n" thh/---- thh_reso h56" # WARf __MODE # WARf __DIME # WARf __KII- #eefi_k __KII-- __DOUBLE_PRECI/--- #eefi_k __DIME __2D #eefi_k __MODE __SCAngF.AND. ��2DhSCAeDOUBLE # lu n" thh/---- thh_reso h56" # WARf __MODE #eefi_k __MODE __VECngF.AND. ��2DhVECeDOUBLE # lu n" thh/---- thh_reso h56" # WARf __MODE # WARf __DIME - #eefi_k __DIME __3D #eefi_k __MODE __SCAngF.AND. ��3DhSCAeDOUBLE # lu n" thh/---- thh_reso h56" # WARf __MODE #eefi_k __MODE __VECngF.AND. ��3DhVECeDOUBLE # lu n" thh/---- thh_reso h56" # WARf __MODE # WARf __DIME # WARf __KII-- l PI--MODULENs::).AND.--ithh ---------------------------------����������00006S PutsIpolSIe/-----------------------------------------------------------------------���0755�������67���35424������00000����0������3�016271� 5-------------------------------------------------------------------------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------------------����������00006S PutsIpolSIe/s::)),tsIp_p2m5667�11616003525�020222222������������������������������6��������������67���35424�����147047����0������3�021410�������������������������������������������������������������� !-------------------------------------------------------------------------S ! Sub,t�tinea : 3d_find_duplicatesS !----------------------------------------------------------------------------------------------------------------------------------------------------.AND. � we are done n!-----------OT.ASSObL chec --- disuch:--if E�KIt iiiiilor_edge 3d_kibe :: s::)),tsIp_p2m points, we are done n!-----------OT.ASSObL chec --- disuch: Sif E�KIt i ! it rrorrsthe terms ofathe GNU Lessrr Generpl Public License S ! aN published byathe Free Software Forroate G, either S ! verse G 3 ofathe License, ors(at your opte G) any lateraS ! verse G.S n!S n! PPM iN distributed in the hope that it will beouseful,S n! but WITHOUT ANY WARRANTY; witht�t evena�he implied warranty ofS n! MERCHANTABILITY orsFITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Generpl Public License for more details.S naS ! vou should have r n! PPM iN distribGNU Generpl Public LicenseS ! and the GNU Lessrr Generpl Public License along with PPM. If not,S n! see <http://www.gnu.org/licenses/>.S n!S n! Parpllel PartichysMesh Library (PPM)S n! ETH ZurichS ! CH-8092 Zurich, SwitzerlandS !-------------------------------------------------------------------------SS#if E�KIt i==iE�sINGLE_PRECISIONS SUBROUTINE 3d_find_duplicates_s(adaha,lda,Ndaha,nident,ident,info) #elif E�KIt i==iE�DOUBLE_PRECISION00Eoc SUBROUTINE 3d_find_:,:),oates_inp�� a,lda,Ndaha,nident,ident,info) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV! #if __DIME == __2D #if __MODE == __SCAn# f __KII--== __SINGLE_PRECI/--- fo) ------------2m_ss_2d(topoid,so hTd,xp,Np,up,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#elif __KII--== __DOUBLE_PRECI/--- fo) ------------2m_ds_2d(topoid,so hTd,xp,Np,up,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#endif #elif __MODE == __VECn# f __KII--== __SINGLE_PRECI/--- fo) ------------2m_sv_2d(topoid,so hTd,xp,Np,up,lda,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#elif __KII--== __DOUBLE_PRECI/--- fo) ------------2m_dv_2d(topoid,so hTd,xp,Np,up,lda,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#endif #endif #elif __DIME == __3D #if __MODE == __SCAn# f __KII--== __SINGLE_PRECI/--- fo) ------------2m_ss_3d(topoid,so hTd,xp,Np,up,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#elif __KII--== __DOUBLE_PRECI/--- fo) ------------2m_ds_3d(topoid,so hTd,xp,Np,up,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#endif #elif __MODE == __VECn# f __KII--== __SINGLE_PRECI/--- fo) ------------2m_sv_3d(topoid,so hTd,xp,Np,up,lda,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#elif __KII--== __DOUBLE_PRECI/--- fo) ------------2m_dv_3d(topoid,so hTd,xp,Np,up,lda,kernel,omk), te i_heap',-awghoribize,field_up,roc=,-2m_bcARfll#endif #endif #endif p',-aw!! Licens ENSA! co riaph PPpE_PRECI AToso htPutsIpolSIONo. noen2)!! L noen2)!! LCurar--ly 2tPutsIpolSIONowscheso -LAR supp���IT: noen2)!! noen2)!! L* s::)pE_a-- thh_kernel_bsp2 noen2)!! L* s::)pE_a-- thh_kernel_mp4 noen2)!! noen2)!! L[ensNING] p',-aw!! LicensENSA! coassum �h nedg`field_up`tribalreadymAll _-nedMngF.AND.!�ND. .!��[TIP] noen2)!! Licerors(ano nekCIAToper! Cm---`ghori_get`nd f8092s<e2(adjtcensENSA! c noen2)!! Lasd#if rNSA! co raopitself---`ghori_put`n fd#if field aft a--a--d PutsIpolSIOadjIf �hpE_PRECIsl fd#if field.nfo) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV! fo) . --CLUDESnfo) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV! fo) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV! fo) . M-----2 points, we are done n!-------------------INC-----iaRAMEGES _noent(s = 3d_! fo) EGERs::).AND.--esent)%adj_eEGERs::).AND.--All _)%adj_eEGERs::).AND.-- ----t)%adj_eEGERs::).AND.-- --op)%adj_eEGERs::).AND.----- ngF.ANDEGERs::).AND.----- -ithh noen2)EGERs::).AND.----- -so h noenIiEGERs::).AND.--oypeARf noenIiEGERs::).AND.--c IFaibe EGERs::).AND.--map)%adj_eEGERs::).AND.--check_ihaG 2 po--in-----idx-/n# f __KII--== __SINGLE_PRECI/--- fo) --input_ PaAMEin disuMK =k----kind_t(adlel#elif __KII--== __DOUBLE_PRECI/--- fo) --input_ PaAMEin disuMK =k----kind_do_PR �#endif p',-a, we are done n!-----------OT.ASSObL chec --- disuch: So! fo) !yas thaG 2 point, we are done n!-----------OT.ASSObL chec --- disuch: So! #if __MODE == __SCAnfo) REAL(MK) _ i --/------ IN- isu-p--a--d pE_PRECI w n,jIf �hwha,n fd tsIpolSIe #if __DIME == __2D fo) REAL(MK) _ i --/-----,-,-) ) _ PO--in ddddddisufield_up #elif __DIME == __3D fo) REAL(MK) _ i --/-----,-,-,-) ) _ PO--in ddddddisufield_up #endif p',-aw!! Lfield on fdwha,n fd tsIpolSIe #elif __MODE == __VECnfo) --input in- isulda p',-aw!! LleadOadjdihaGshere fO-p--a--d REAL(MK) _ i --/-----,-) IN- isu-p--a--d pE_PRECI w n,jIf �hwha,n fd tsIpolSIe #if __DIME == __2D fo) REAL(MK) _ i --/-----,-,-,-) ) _ PO--in ddddddisufield_up #elif __DIME == __3D fo) REAL(MK) _ i --/-----,-,-,-,-) _ PO--in ddddddisufield_up #endif p',-aw!! Lfield on fdwha,n fd tsIpolSIe #endif p',-awREAL(MK)_ i --/-----,-) IN- disuxp--a--d pE_PRECI pos hon�nfo) --input _ i --/----- - IN- disughoribize noen2)!! Licei vset(width).r m�,fOshori lay a--a--d --input INjjjre hyNp--a--d n GNU GcOTpE_PRECIs--a--d --input INjjjre hyso hTd--a--d Pdir m�,fO.o ht(he r)--a--d --input INjjjre hytopoid--a--d topology PdaG ifiert(he r n GNU Oad).r m�argieen_sat(--input INjjjre hykernel noen2)!! LChoicT.r m�,fOkernel(uskCIATonnmpuFamS w n,5en_sat(--input ---) )end).----in-- TEGEls ---tus, 0 uprplsuc TEG/#if __MODE == __SCAnfo) --input_ i --/----- - PO--in , OPT---lo )en-2m_bcARf #elif __MODE == __VECnfo) --input_ i --/-----,-- PO--in , OPT---lo )en-2m_bcARf #endif p',-a, BURPOSryio, d hon�huskCIor mtcensPutsIpolSIONowrNSA! c,mS y maynd p',-a, diffear---thaIf notbURPOSryio, d hon�hoienPublic topology. p',-a, ice sst_Gs(Publiens edge at ibe_onapof: p',-a, p',-a, - s::)pE_a--bcARf_symmetry p',-a, - s::)pE_a--bcARf_aG isymmetry p',-a, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,yare hyss thaG 2 point, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a --input_ i --/-----,-- --PO--in disui----t d NULLEll,fOT.A--input_ i --/-----,-- --PO--in disun--- d NULLEll,fOT.A--input_ i --/------ PO--in disuiue a1 d NULLEll,fOT.A--input_ i --/------ PO--in disuiue a2 d NULLEll,fOT.AREAL(mk)_ i --/------ PO--in disumin_phybgu NULLEll,fOT.AREAL(mk)_ i --/------ PO--in disumax_phybgu NULLEll,fOT.AREAL(mk)_ i --/----s::)dih) isupxi,dxl,fOT.AREAL(mk) isupxx,dxy,dxz,dxxi,dxyi,dxzil,fOT.AREAL(mk)_ i --/----s::)dih) isulen_phybl,fOT.AREAL(mk) isux1,x2,x3nfo) --input isukernel_supp���l,fOT.A--input_ i --/----s::)dih+2) isuldu,ldll,fOT.A--input_ i --/----s::)dih) isuNcnfo) --input isui,j,k,l,ii,jj,kk,iidec,mapoypenfo) --input isuxlo,xhi,ylo,yhi,zlo,zhinfo) --input isujjdec,nb- ,npE_P,ipE_P noenIi--input isukkdec,ip1,nue a1nfo) --input isuip2,ip3,ifa Info) --input isui ,iIf �,ito,ip,dih,iopP,i lnfo) --input isumax_pE_Pn GNU ,id �,nue a2,id �ll,fOT.A--input_ i --/----s::)dih) d:_kNmnfo) --input isun -l,fOT.A--input_ i --/----6) :_kbcARf noenIi--input isuiq noenIiLOGI�lo isuiutsInal_w n,,lok----------liasebl,fOT.AREAL(mk)_ i --/-----,---------PO--in disumin_ gu NULLEll,fOT.AREAL(mk)_ i --/-----,---------PO--in disumax_ gu NULLEll,fOT.AREAL(mk) isumyepbl,fOT.AREAL(mk) isutim1s, tim1el,fOT.AREAL(mk) isuxp1,xp2,xp3l,fOT.AREAL(mk) isuwx1,wx2,wx3l,fOT.AREAL(mk)_ i --/----s::)dih) isux0l,fOT.AREAL(mk) isux01,x02,x03nfo) --input isuldnnfo) CHARACin (len=256) isumsribe TYPE(s::)t_equi-so h---PO--in dddddddddisup-so hgu NULLEll,fOT.ATYPE(s::)t_topo- --PO--in dddddddddisutopo d NULLEll l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y I, hyss--------, we are done n!-----------OT.ASSObL chec --- disuch: So! l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y icensens hack! Somehow----(adjtro_PR BROUTIo, U GuctE-siopbinlif hea! s::).AND.----- _ithhO.AND.- !IF, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a ---- thh_kernel vset= (/1,2,2,4/llngF.AND�loL ----t('s::)),tsIp_p2m',t0,roc=llngF.ANDdih =k----dihngF.ANDiutsInal_w n, =k.FALSE. l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Checks e thaG 2 point, we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANDIF -s::)debug .GT. 0) THE- fo) ND�loL check fo) NDIF -roc= .NE. 0) GOTO 9999 fo) ENDIF fo) topo d s::)topo(topoid)%ip- T.AS! we are done n!-----------OT.ASSObL chec --- disuch: So fo) . Getm�,fO.o hiinfo) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numVo fo) p-so hgu topo%so h(.o hii)p- T.AS! we are done n!-----------OT.ASSObL chec --- disuch: So fo) . Getmi----t)%adj_e !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV,r noen2)i----t d s-so h%i----t)l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y AssignhaG .r m�,fOhe GNUr edges/scalar noenI, we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANDNm(1:dih) = s-so h%Nm(1:dih) gF.ANDbcARf(1:(2*dih)) = topo%bcARf(1:(2*dih)) gF.ANDn - = topo%n g wip- T.AS! we are done n!-----------OT.ASSObL chec --- disuch: So! gF.AND,y I m�,frors(anothTor ,fddo,�do nearlyanothTorp- T.AS! we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANDIF(Np.EQ.0) GOTO 9998r noen2)! we are done n!-----------OT.ASSOCIATheckS EAL(mk),_edge_��e_��! gF.AND,y All _O.omore ! CHpE_PRECI ltrib gF.AND,y ice awesome s::)All _ ! an(re)All _-nem�,fm, so we-do,tGtekCIan ), ngF.AND,y aofinyss twrNSA! c.nfo) !!! ThiN ,t�tineacan beoused to fates_dheckS IF��lor_edge(numV�! gF.ANDiopPAND= s::)pE_a--IF ( rf ngF.ANDldu(1) = Np--a--d �loL s::)All _(iue a1,ldu,iopP,ioc=ll) NDIF -roc= .NE. 0) THE- fo) NDroc= = s::)esent_f-- l fo) ND�loL s::)esent(s::)ese)All _,'s::)),tsIp_p2m_3d'------mk), te i_heap',-awwwwwwwwww'pE_PRECI ltri 1 ILIST1',__LINE__,ioc=ll) ND GOTO 9999 fo) ENDIF fo) �loL s::)All _(iue a2,ldu,iopP,ioc=ll) NDIF -roc= .NE. 0) THE- fo) Nroc= = s::)esent_f-- l fo) N�loL s::)esent(s::)ese)All _,'s::)),tsIp_p2m_3d'------mk), te i_heap',-awwwwwwwwww'pE_PRECI ltri 2 ILIST2',__LINE__,ioc=ll) ND GOTO 9999 fo) ENDIF gF.ANDiopPAND= s::)pE_a--IF ( rf ngF.ANDldu(1) = n -l,fOT.A�loL s::)All _(st re_roc=,ldu,iopP,ioc=ll) NDIF -roc= .NE. 0) THE- fo) NDroc= = s::)esent_f-- l fo) ND�loL s::)esent(s::)ese)All _,'s::)),tsIp_p2m_3d'------mk), te i_heap',-awwwwwwwwww 'st re_roc=mAll _-nhere:t-_rPR m',__LINE__,ioc=ll) ND GOTO 9999 fo) ENDIF l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y ION00spacTorp- T.A, we are done n!-----------OT.ASSObL chec --- disuch: So! #if __KII--== __SINGLE_PRECI/--- fo) min_phybgu topo%sin_phyb-l,fOT.max_phybgu topo%sax_phybsl#elif __KII--== __DOUBLE_PRECI/--- fo) min_phybgu topo%sin_phybdl,fOT.max_phybgu topo%sax_phybdl#endif l DO i = 1,dihngF.ANDNDN_(i) =DNm(i) - 1ngF.ANDNDlen_phyb(i) =.max_phyb(i) - sin_phyb(i)ngF.ANDNDdx(i) =Dlen_phyb(i)/REAL(N_(i),MK) fo) ENDDO l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y I, hysszamS pE_PRECI ltri noenI, we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANDnue a1 =D0l,fOT.Ast re_roc=m=D0ll DO ipE_P=1,NpngF.AND. nue a1 =Dnue a1 + 1ngF.ANDNDiue a1(nue a1) =.ipE_P noenIiENDDO #if __KII--== __SINGLE_PRECI/--- fo) myepb = s::)myepbs fo) min_ gu topo%sin_ -l,fOT.max_ gu topo%sax_ -l#elif __KII--== __DOUBLE_PRECI/--- fo) myepb = s::)myepbd fo) min_ gu topo%sin_ dl,fOT.max_ gu topo%sax_ dl#endif l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Loop ovRRANTY; domwo be(sincee#if firri domwo bee --mori likely p',-a,y ---bL(empty, we-look backwardsl fdreducee#if n GNU GcOTuR maG 2Dro p',-a,y nue a2Lasdfari ILITossiPR ) noenI, we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANDDO idom = topo%n g wi,1,-1ngF.ANDNDid �l = topo%i g wi(id �)ngF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDND,y Loop ovRRANTY;remwo Tor pE_PRECIs--a--d ND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDNDnue a2L=D0l,fOT.ANDnt you=D0l,fOT.ANDDO i=1,nue a1nfo) ANDNDit you=Diue a1(illngF.AND. ND, we are done n!-----------OT.ASSObL chec --- disu!ngF.AND. ND,y I m�,f pE_PRECI ensPusi n#if curar--- domwo ,oassign itngF.AND. ND, we are done n!-----------OT.ASSObL chec --- disu!ngF.AND. NDIF(----dih.EQ.3) THE- fo) NDD. ND, we are done n!-----------OT.ASSObL chec --- d! fo) NDD. ND,m�,f pE_PRECI ensPun#if closurT.r m�,fO domwo fo) NDD. ND, we are done n!-----------OT.ASSObL chec --- d! fo) NDD. NDIF( ( xp(1,ipE_P).GE.sin_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).GE.sin_ (2,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(3,ipE_P).GE.sin_ (3,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(1,ipE_P).LE.sax_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).LE.sax_ (2,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(3,ipE_P).LE.sax_ (3,id �l) ) ) THE- heap',-awwwwwwwwwIF( (xp(1,ipE_P).LT.sax_ (1,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(2,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.mk), te i_heap',-awwwwwwwwww (xp(2,ipE_P).LT.sax_ (2,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(4,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(4).NE. s::)pE_a--bcARf_periodic)).AND.mk), te i_heap',-awwwwwwwwww (xp(3,ipE_P).LT.sax_ (3,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(6,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(6).NE. s::)pE_a--bcARf_periodic)) ) THE- heap',-awwwwwwwww NDnt you=Dnt you+ 1ngF.ANDNDDDDDDDDDDDDDst re_roc=(id �)u=Dnt yongF.ANDNDDDDDDDDDDELSE heap',-awwwwwwwww NDnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDDDDENDIF fo) DDDDDDDDELSE heap',-awwwwwwwwwnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDPI---F fo) DDDDDELSEIF -s::)dih.EQ.2) THE- heap',-awwwwwwIF( ( xp(1,ipE_P).GE.sin_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).GE.sin_ (2,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(1,ipE_P).LE.sax_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).LE.sax_ (2,id �l) ) ) THE- heap',-awwwwwwwwwIF( (xp(1,ipE_P).LT.sax_ (1,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(2,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.mk), te i_heap',-awwwwwwwwww (xp(2,ipE_P).LT.sax_ (2,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(4,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(4).NE. s::)pE_a--bcARf_periodic))) THE- heap',-awwwwwwwww NDnt you=Dnt you+ 1ngF.ANDNDDDDDDDDDDDDDst re_roc=(id �)u=Dnt yongF.ANDNDDDDDDDDDDELSE heap',-awwwwwwwww NDnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDDDDENDIF fo) DDDDDDDDELSE heap',-awwwwww NDnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDPI---F fo) DDDDDEI---F fo) DDEI--DO fo) DD, we are done n!-----------OT.ASSObL chec --- disuch:ngF.AND. ,y C---- FORloribg(well, only if nue a2 changkCI-:decreaskC)ngF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:ngF.ANDNDIF -nue a2.NE.nue a1) THE- fo) NDD. nue a1 =Dnue a2 fo) NDD. DO i=1,nue a1nfo) ANDND Diue a1(ilu=Diue a2(i)ngF.ANDND IiENDDO ANDND IiENDIF gF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDND,y Exit if FORlori ensempty gF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDNDIF -nue a1.EQ.0) EXIT DDEI--DO l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Checks nedgwd inld ailtt,f pE_PRECI2 point, we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANIF -nue a2.GT.0) THE- fo) NDroc= = s::)esent_f-- l fo) ND�loL s::)esent(s::)ese)pE_P_unass,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwwwwww'MAJORNPROBLEM',__LINE__,ioc=ll) ND GOTO 9999 fo) ENDIF gF.ANmax_pE_Pn GNU u=D0l,fOT.DO idom=1,topo%n g wip- T.ASwwIF(st re_roc=(id �).GE.sax_pE_Pn GNU ) THE- fo) NDD. max_pE_Pn GNU u=Dst re_roc=(id �) fo) DDEI---F fo) EI--DO fo) iopPAND= s::)pE_a--IF ( rf ngF.ANldu(1) = topo%n g wip- T.Aldu(2) =.max_pE_Pn GNU gF.AN�loL s::)All _(g wi- ,ldu,iopP,ioc=ll) NIF(ioc=.NE.0) THE- fo) NDroc= = s::)esent_f-- l fo) ND�loL s::)esent(s::)ese)All _,'s::)),tsIp_p2m_3d'------mk), te i_heap',-awwwwwwwwww '-_rPR msPuniutsInalmAll _-nher',__LINE__,ioc=ll) ND GOTO 9999 fo) END IF gF.ANg wi- =0 l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y I, hysszamS pE_PRECI ltri noenI, we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANnue a1 =D0l,fOT.DO ipE_P=1,NpngF.AND. nue a1 =Dnue a1 + 1ngF.ANDNDiue a1(nue a1) =.ipE_P noenIENDDO l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Loop ovRRANTY; domwo be(sincee#if firri domwo bee --mori likely p',-a,y ---bL(empty, we-look backwardsl fdreducee#if n GNU GcOTuR maG 2Dro p',-a,y nue a2Lasdfari ILITossiPR ) noenI, we are done n!-----------OT.ASSObL chec --- disuch: So! ,fOT.DO idom = topo%n g wi,1,-1ngF.ANDNDid �l = topo%i g wi(id �)ngF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDND,y loop ovRRANTY;remwo Tor pE_PRECIs--a--d ND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDNDnue a2L=D0l,fOT.ANDnt you=D0ll,fOT.ANDDO i=1,nue a1nfo) ANDNDit you=Diue a1(illfo) ANDND, we are done n!-----------OT.ASSObL chec --- disu!ngF.AND. ND,y I m�,f pE_PRECI ensPusi n#if curar--- domwo ,oassign itngF.AND. ND, we are done n!-----------OT.ASSObL chec --- disu!ngF.AND. NDIF(----dih.EQ.3) THE- ffffffffffffffIF( ( xp(1,ipE_P).GE.sin_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).GE.sin_ (2,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(3,ipE_P).GE.sin_ (3,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(1,ipE_P).LE.sax_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).LE.sax_ (2,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(3,ipE_P).LE.sax_ (3,id �l) ) ) THE- heap',-awwwwwwwwwIF( (xp(1,ipE_P).LT.sax_ (1,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(2,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.mk), te i_heap',-awwwwwwwwww (xp(2,ipE_P).LT.sax_ (2,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(4,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(4).NE. s::)pE_a--bcARf_periodic)).AND.mk), te i_heap',-awwwwwwwwww (xp(3,ipE_P).LT.sax_ (3,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(6,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(6).NE. s::)pE_a--bcARf_periodic)) ) THE- heap',-awwwwwwwww NDnt you=Dnt you+ 1ngF.ANDNDDDDDDDDDDDDDg wi- (id �,npE_P) =.ipE_P noenIiNDDDDDDDDDDELSE heap',-awwwwwwwww NDnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDDDDENDIF fo) DDDDDDDDELSE heap',-awwwwww NDnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDPI---F fo) DDDDDELSEIF -s::)dih.EQ.2) THE- heap',-awwwwwwIF( ( xp(1,ipE_P).GE.sin_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).GE.sin_ (2,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(1,ipE_P).LE.sax_ (1,id �l) .AND.-mk), te i_heap',-awwwwwwwwwxp(2,ipE_P).LE.sax_ (2,id �l) ) ) THE- heap',-awwwwwwwwwIF( (xp(1,ipE_P).LT.sax_ (1,id �) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(2,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.mk), te i_heap',-awwwwwwwwww (xp(2,ipE_P).LT.sax_ (2,id �l) .OR.--mk), te i_heap',-awwwwwwwwww (topo% -_bc(4,id �l).EQ.1 .AND.- --mk), te i_heap',-awwwwwwwwww bcARf(4).NE. s::)pE_a--bcARf_periodic))) THE- heap',-awwwwwwwww NDnt you=Dnt you+ 1ngF.ANDNDDDDDDDDDDDDDg wi- (id �,npE_P) =.ipE_P noenIiNDDDDDDDDDDELSE heap',-awwwwwwwww NDnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDDDDENDIF fo) DDDDDDDDELSE heap',-awwwwww NDnue a2 =Dnue a2 + 1ngF.ANDNDDDDDDDDDDiue a2(nue a2) =.ipE_P noenIiNDDDDDDDPI---F fo) DDDDDEI---F fo) DDEI--DO fo) DD, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDND,y C---- FORloribg(well, only if nue a2 changkCI-:decreaskC)ngF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDNDIF -nue a2.NE.nue a1) THE- fo) NDD. nue a1 =Dnue a2 fo) NDD. DO i=1,nue a1nfo) ANDND Diue a1(ilu=Diue a2(i)ngF.ANDND IiENDDO ANDND IiENDIF gF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDND,y Exit if FORlori ensempty gF.ANDND, we are done n!-----------OT.ASSObL chec --- disuch:!ngF.ANDNDIF -nue a1.EQ.0) EXIT DDEI--DO l , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Checks nedgwd inld ailtt,f pE_PRECI2 point, we are done n!-----------OT.ASSObL chec --- disuch: So! gF.ANIF -nue a2.GT.0) THE- fo) NDroc= = s::)esent_f-- l fo) ND�loL s::)esent(s::)ese)pE_P_unass,'s::)),tsIp_p2m_3d'---mk), te i_heap',-awwwwwwwwww'MAJORNPROBLEM',__LINE__,ioc=ll) ND GOTO 9999 fo) ENDIF gF.AN, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y All _-nem--SS-liasmS w n, if wd nekCIAhem. gF.AN, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-amax_pE_Pn GNU u=D0l,fOT.DO idom = 1,topo%n g wip- T.ASwwIF(st re_roc=(id �).GE.sax_pE_Pn GNU ) THE- fo) NDD. max_pE_Pn GNU u=Dst re_roc=(id �) fo) DDEI---F fo) EI--DO 9998 ONTINUE #if __DIME == __3D fo) , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y So�3Dh-h:ngF.AN, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y loop ovRRA -l,fOT.An--- d s-so h%nnodI2 l,fOT.ADO i gu 1,topo%n g wip- T.ASwwi g = topo%i g wi(i )ll,fOT.ANDDO k=1-ghoribize(3),n--- (3,i g)+ghoribize(3) heap',-awwwDO j=1-ghoribize(2),n--- (2,i g)+ghoribize(2) heap',-awwwwwwDO i=1-ghoribize(1),n--- (1,i g)+ghoribize(1) #if __MODE == __VECnfo) p',-awwwwwwDO ldn=1,ldanfo) p',-awwwwwwwwwfield_up(ldn,i,j,k,i )u=D0.0_mknfo) p',-awwwwwwEI--DO #el----------awwwwwwwwwfield_up(i,j,k,i )u=D0.0_mkn#endif p',-aw-awwwwwwEI--DO -aw-awwwwwwEI--DO -aw-awwwEI--DO -aw-awEI--DO #elif __DIME == __2D fo) , we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y So�2Dh-h:ngF.AN, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y loop ovRRA -l,fOT.An--- d s-so h%nnodI2 wwwwwwDO i gu 1,topo%n g wip- T.ASwwi g = topo%i g wi(i )ll,fOT.ANDDO j=1-ghoribize(2),n--- (2,i g)+ghoribize(2) heap',-awwwDO i=1-ghoribize(1),n--- (1,i g)+ghoribize(1) #if __MODE == __VECnfo) p',-awwwDO ldn=1,ldanfo) p',-awwwwwwfield_up(ldn,i,j,i )u=D0.0_mknfo) p',-awwwEI--DO #el----------awwwwwwfield_up(i,j,i )u=D0.0_mkn#endif p',-aw-awwwEI--DO -aw-awwwEI--DO -aw-awEI--DO #endif p',-awIF(np.EQ.0) GOTO 9997 -aw-awSELECTD�lSE(kernelllngF.AND�lSE(s::)pE_a-- thh_kernel_mp4) #if __MODE == __SCAngF.AND. .AND�loL s2:)),tsIp_mp4(topoid,xp,up,field_up,ghoribize,dx,ioc=ll#elif __MODE == __VECnfo) . .AND�loL s2:)),tsIp_mp4(topoid,xp,up,field_up,lda,ghoribize,dx,ioc=ll#endif p',-aw�lSE(s::)pE_a-- thh_kernel_bsp2) #if __MODE == __SCAngF.AND. .AND�loL s2:)),tsIp_bsp2(topoid,xp,up,field_up,ghoribize,dx,ioc=ll#elif __MODE == __VECnfo) . .AND�loL s2:)),tsIp_bsp2(topoid,xp,up,field_up,lda,ghoribize,dx,ioc=ll#endif p',-a�lSE DEFAULT fo) NDroc= = s::)esent_esent)%adj_eND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'-----mk), te i_heap',-awwwwwwwwww'icens cheso enscurar--ly not availhaG . UsI ithS thh_reso h ! CHohe kernel .',omk), te i_heap',-awwwwwwwwww__LINE__,ioc=ll) NEI--SELECTDDDDDDDDD!Okernel(oypennnnn9997 ONTINUE DDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Now mapm�,fOshorinsPunorARRANo getIo, U wir---sst_Gs(atf notbUrARRAtp://www,y -TY; domwo b. gF.AN, we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a�loL s::)map_field_ghori_put(topoid,so hTd,ghoribize,ioc=ll) NIF -roc= .NE. 0) GOTO 9999 /#if __MODE == __SCAnfo) �loL s::)map_field_push(topoid,so hTd,field_up,roc=ll#elif __MODE == __VECnfo) �loL s::)map_field_push(topoid,so hTd,field_up,lda,ioc=ll#endif p',-aIF -roc= .NE. 0) GOTO 9999 /fo) �loL s::)map_field_send(ioc=ll) NIF -roc= .NE. 0) GOTO 9999 /#if __MODE == __SCAnfo) �loL s::)map_field_pop(topoid,so hTd,field_up,ghoribize,ioc=ll#elif __MODE == __VECnfo) �loL s::)map_field_pop(topoid,so hTd,field_up,lda,ghoribize,ioc=ll#endif p',-aIF -roc= .NE. 0) GOTO 9999 /fo) IF -PRES -2m_bcARfl) THE- #if __DIME == __2D #if __MODE == __SCAnDDDDDDDDDO idom = 1,topo%n g wip- T.ASww NDrd �l = topo%i g wi(id �)ngF.ANDNDo) IF -topo% -_bc(1,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = 1 ffffffffffffffuxhi = 1 + ghoribize(1) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(1)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u+-mk), te i_heap',-awwwwwwwwww field_up(xlo-i+1,j,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u--mk), te i_heap',-awwwwwwwwww field_up(xlo-i+1,j,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(2,id �l).EQ.1) THE- ffffffffffffffuxlo = n--- (1,id �l) - ghoribize(1) ffffffffffffffuylo = 1 ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(2)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u+-mk), te i_heap',-awwwwwwwwww w wwfield_up(2*xhi-i,j,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u--mk), te i_heap' p',-awwwwwwwwww wwfield_up(2*xhi-i,j,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(3,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = 1 ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = 1 + ghoribize(2) ffffffffffffffuSELECTD�lSE(-2m_bcARf(3)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u+-mk), te i_heap',-awwwwwwwwww w wwfield_up(i,ylo-j+1,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u--mk), te i_heap' p',-awwwwwwwwww wwfield_up(i,ylo-j+1,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(4,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = n--- (2,id �l) - ghoribize(2) ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(4)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u+-mk), te i_heap',-awwwwwwwwww w wwfield_up(i,2*yhi-j,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwwwDO i=xlo,xhinfo) p',-awwwwwwwwww wwfield_up(i,j,id �)u=Dfield_up(i,j,id �)u--mk), te i_heap' p',-awwwwwwwwww wwfield_up(i,2*yhi-j,id �)nfo) p',-awwwwwwwwwwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDEI--DO #elif __MODE == __VECnfo) . .DO idom = 1,topo%n g wip- T.ASww NDrd �l = topo%i g wi(id �)ngF.ANDNDo) IF -topo% -_bc(1,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffu fuylo = 1 ffffffffffffffu fuxhi = 1 + ghoribize(1) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(1,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,xlo-i+1,j,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,xlo-i+1,j,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(2,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = n--- (1,id �l) - ghoribize(1) ffffffffffffffu fuylo = 1 ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(2,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,2*xhi-i,j,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,2*xhi-i,j,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(3,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffu fuylo = 1 ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = 1 + ghoribize(2) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(3,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,i,ylo-j+1,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,i,ylo-j+1,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(4,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffu fuylo = n--- (2,id �l) - ghoribize(2) ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(4,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,i,2*yhi-j,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu ND NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(l,i,j,id �)u=Dfield_up(l,i,j,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,i,2*yhi-j,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDEI--DO #endif #elif __DIME == __3D #if __MODE == __SCAnfo) DDDDO idom = 1,topo%n g wip- T.ASww NDrd �l = topo%i g wi(id �)ngF.ANDNDo) IF -topo% -_bc(1,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = 1 ffffffffffffffuzlo = 1 ffffffffffffffuxhi = 1 + ghoribize(1) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuzhi = n--- (3,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(1)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(xlo-i+1,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(xlo-i+1,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(2,id �l).EQ.1) THE- ffffffffffffffuxlo = n--- (1,id �l) - ghoribize(1) ffffffffffffffuylo = 1 ffffffffffffffuzlo = 1 ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuzhi = n--- (3,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(2)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwww ww wwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(2*xhi-i,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(2*xhi-i,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(3,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = 1 ffffffffffffffuzlo = 1 ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = 1 + ghoribize(2) ffffffffffffffuzhi = n--- (3,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(3)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(i,ylo-j+1,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(i,ylo-j+1,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(4,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = n--- (2,id �l) - ghoribize(2) ffffffffffffffuzlo = 1 ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuzhi = n--- (3,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(4)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(i,2*yhi-j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(i,2*yhi-j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(5,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = 1 ffffffffffffffuzlo = 1 ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuzhi = 1 + ghoribize(3) ffffffffffffffuSELECTD�lSE(-2m_bcARf(5)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w wwwwwfield_up(i,j,zlo-k+1,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwwwwwwwwwfield_up(i,j,zlo-k+1,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(6,id �l).EQ.1) THE- ffffffffffffffuxlo = 1 ffffffffffffffuylo = 1 ffffffffffffffuzlo = n--- (3,id �l) - ghoribize(3) ffffffffffffffuxhi = n--- (1,id �l) ffffffffffffffuyhi = n--- (2,id �l) ffffffffffffffuzhi = n--- (3,id �l) ffffffffffffffuSELECTD�lSE(-2m_bcARf(6)) ffffffffffffffu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w wwwwwfield_up(i,j,2*zhi-k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(i,j,k,id �)u=Dfield_up(i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwwwwwwwwwfield_up(i,j,2*zhi-k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwwwEI--SELECT -awwwwwwwwwwEI--IF fo) DDDEI--DO #elif __MODE == __VECnfo) . .DO idom = 1,topo%n g wip- T.ASww NDrd �l = topo%i g wi(id �)ngF.ANDNDo) IF -topo% -_bc(1,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffffffylo = 1 ffffffffffffffu fuzlo = 1 ffffffffffffffu fuxhi = 1 + ghoribize(1) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuzhi = n--- (3,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(1,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,xlo-i+1,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww ww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,xlo-i+1,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww wwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(2,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = n--- (1,id �l) - ghoribize(1) ffffffffffffffu fuylo = 1 ffffffffffffffu fuzlo = 1 ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuzhi = n--- (3,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(2,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',-awwwwwwwwwwwwwwwwfield_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,2*xhi-i,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww ww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,2*xhi-i,j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww wwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(3,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffu fuylo = 1 ffffffffffffffu fuzlo = 1 ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = 1 + ghoribize(2) ffffffffffffffu fuzhi = n--- (3,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(3,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,i,ylo-j+1,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww ww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,i,ylo-j+1,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww wwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(4,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffu fuylo = n--- (2,id �l) - ghoribize(2) ffffffffffffffu fuzlo = 1 ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuzhi = n--- (3,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(4,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u+-mk), te i_heap',-awwwwwwwwww w ww wwfield_up(l,i,2*yhi-j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww ww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,i,2*yhi-j,k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww wEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(5,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffu fuylo = 1 ffffffffffffffu fuzlo = 1 ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuzhi = 1 + ghoribize(3) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(5,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u+-mk), te i_heap',-awwwwww--------------field_up(l,i,j,zlo-k+1,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww ww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwww ww wwfield_up(l,i,j,zlo-k+1,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww wwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDDDDIF -topo% -_bc(6,id �l).EQ.1) THE- ffffffffffffffuDO l=1,ldanfo) p',-awwwwwwwxlo = 1 ffffffffffffffu fuylo = 1 ffffffffffffffu fuzlo = n--- (3,id �l) - ghoribize(3) ffffffffffffffu fuxhi = n--- (1,id �l) ffffffffffffffu fuyhi = n--- (2,id �l) ffffffffffffffu fuzhi = n--- (3,id �l) ffffffffffffffu fuSELECTD�lSE(-2m_bcARf(6,l)) ffffffffffffffu fu�lSE(s::)pE_a--bcARf_symmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u+-mk), te i_heap',-awwwwww--------------field_up(l,i,j,2*zhi-k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww ww�lSE(s::)pE_a--bcARf_aG isymmetry) ffffffffffffffu NDDO k= zlo,zhinfo) fffffffffffu NDDO j=ylo,yhinfo) p',-awwwwwwwwww wwDO i=xlo,xhinfo) p',------------------field_up(l,i,j,k,id �)u=Dfield_up(l,i,j,k,id �)u--mk), te i_heap' p',-awwwwwwwwfield_up(l,i,j,2*zhi-k,id �)nfo) p',-awwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwww wwEI--DO -aw-awwwwwwwwwwwwwEI--DO -aw-awwwwwwwwww wwEI--SELECT -awwwwwwwwww wwEI--DO -aw-awwwwwwwEI--IF fo) DDDEI--DO #endif #endif fffffEI--IF fffffIF(np.EQ.0) GOTO 9999 fo) ! we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,yDeAll _-nherGcOT-TY;arrays.... fo) ! we are done n!-----------OT.ASSObL chec --- disuch: So! p',-aiopPA= s::)pE_a--deAll _ p',-aldu(1) = 0l,fOT.�loL s::)All _(iue a1,ldu,iopP,ioc=ll) NIF (ioc=.NE.0) THE- fo) NDroc= = s::)esent_esent)%adj_eND�loL s::)esent(s::)ese)deAll _,omk), te i_heap',-awwww's::)),tsIp_p2m'--mk), te i_heap',-awwww'sbsPuniue a1 deAll _-nher',__LINE__,ioc=ll) ND GOTO 9999 fo) END IF ,fOT.�loL s::)All _(iue a2,ldu,iopP,ioc=ll) NIF (ioc=.NE.0) THE- fo) NDroc= = s::)esent_esent)%adj_eND�loL s::)esent(s::)ese)deAll _,omk), te i_heap',-awwww's::)),tsIp_p2m'---mk), te i_heap',-awwww'sbsPuniue a2 deAll _-nher',__LINE__,ioc=ll) ND GOTO 9999 fo) END IF ,fOT.�loL s::)All _(st re_roc=,ldu,iopP,ioc=ll) NIF (ioc=.NE.0) THE- fo) NDroc= = s::)esent_esent)%adj_eND�loL s::)esent(s::)ese)deAll _,omk), te i_heap',-awwww's::)),tsIp_p2m'---mk), te i_heap',-awwww'sbsPuniue a2 deAll _-nher',__LINE__,ioc=ll) ND GOTO 9999 fo) END IF ,fOT.�loL s::)All _(g wi- ,ldu,iopP,ioc=ll) NIF (ioc=.NE.0) THE- fo) NDroc= = s::)esent_esent)%adj_eND�loL s::)esent(s::)ese)deAll _,omk), te i_heap',-awwww's::)),tsIp_p2m'---mk), te i_heap',-awwww'sbsPuniue a2 deAll _-nher',__LINE__,ioc=ll) ND GOTO 9999 fo) END IF fo) ! we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Return fo) ! we are done n!-----------OT.ASSObL chec --- disuch: So! p9999 ONTINUE DDDDDD�loL -top('s::)),tsIp_p2m'-t0,ioc=ll) NDRETUR- fo) ONTAINS fo) SUBROUTINE checkl) ND IF (.NOT. s::)i, hysszad) THE- ffffffffffffroc= = s::)esent_esent)%adj_eND_eND�loL s::)esent(s::)ese)s::)noi, ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwww'Pleask cailts::)i, firri!',__LINE__,ioc=ll) ND ND GOTO 8888l) ND ENDIF fo) DDIF (Np .GT. 0) THE- fo) ND DDIF (SIZE(xp,2) .LT. Np) THE- ffffffffffffroc= = s::)esent_esent)%adj_eND_eND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwwwwww 'not enough pE_PRECI2Io, tainedsPunxp',__LINE__,ioc=ll) ND ND GOTO 8888l) ND D ENDIF fo) DD DDIF (SIZE(xp,1) .LT.dim) THE- ffffffffffffroc= = s::)esent_esent)%adj_eND_eND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwwwwww 'leadTor dimensherGcOTxpsPusufficiaG ',__LINE__,ioc=ll) ND ND GOTO 8888l) ND D ENDIF fo) DDENDIF fo) DDIF (Np .LE. 0) THE- fo) ND DDIF (Np .LT. 0) THE- fo) ND DDfroc= = s::)esent_esent)%adj_eND_eND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwwwwww 'pE_PRECI2Imust-bL(specified',__LINE__,ioc=ll) ND ND GOTO 8888l) ND D END-IF fo) DDDDDGOTO 8888l) ND END IF fo) DDIF ((kernel.LT.1).OR.(kernel.GT.4)) THE- fo) ND DDroc= = s::)esent_esent)%adj_eND_eN�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwwwwww 'wroor kernel(ARfi, her',__LINE__,ioc=ll) ND DDDGOTO 8888l) ND END IF fo) DDkernel_supporPA= s::) thh_kernelbize(kernell*2 fo) DDIF(.NOT.((kernel_supporP.EQ.2).OR.(kernel_supporP.EQ.4)-mk), te i_heap',-awwwww.OR.(kernel_supporP.EQ.6))) THE- fo) ND DDroc= = s::)esent_esent)%adj_eND_eN�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwwwwww 'wroor kernel(supporP',__LINE__,ioc=ll) ND DDDGOTO 8888l) ND END IF fo) DD�loL s::)check_topoid(topoid,lok,ioc=ll) ND IF (.NOT.lok) THE- fo) ND DDroc= = s::)esent_esent)%adj_eND_eN�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwww'topo_id ensPuvyssd!',__LINE__,ioc=ll) ND ND GOTO 8888l) ND ENDIF fo) DD�loL s::)check_so hTd(topoid,so hTd,lok,ioc=ll) ND IF (.NOT.lok) THE- fo) ND DDroc= = s::)esent_esent)%adj_eND_eN�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_p2m'---mk), te i_heap',-awwwwwww'so h_id ensPuvyssd!',__LINE__,ioc=ll) ND ND GOTO 8888l) ND ENDIF f8888 ONTINUE DDDDDDEI--SUBROUTINE checkl #if __DIME == __2D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDDEI--SUBROUTINE -2m_ss_2d #elif __KII--== __DOUBLE_PRECISION DDDDDEI--SUBROUTINE -2m_ds_2d #endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDDEI--SUBROUTINE -2m_sv_2d #elif __KII--== __DOUBLE_PRECISION DDDDDEI--SUBROUTINE -2m_dv_2d #endif #endif #elif __DIME == __3D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDDEI--SUBROUTINE -2m_ss_3d #elif __KII--== __DOUBLE_PRECISION DDDDDEI--SUBROUTINE -2m_ds_3d #endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDDEI--SUBROUTINE -2m_sv_3d #elif __KII--== __DOUBLE_PRECISION DDDDDEI--SUBROUTINE -2m_dv_3d #endif #endif #endif �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libs::-1.2.1/src/),tsIpolate/s2:)),tsIp_bsp2.f������������������������������������������������������0000644�0001752�0001753�00000072535�11616003523�021461� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD!DDDDDSubroutineDDD:i_heap',-awwwwwww s2:)),tsIp_bsp2 DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD!DC---r n (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), DDDDDD!DDDDDDDDDDDDDDDDDDDDCe,tsI ! CHFluid Dynamics (DTUll) ND!l) ND!l) ND! icensfilo enst youcOT-TY;Parallel(PE_PRECI Mo h Library (PPM).l) ND!l) ND! PPM ensfred inftware: you can redistributo etm--S/ CHmodifyl) ND! etmunARRANTY;tsImsucOT-TY;GNU LessRRAGeneral P g c License DDDDDD!Danst g whed b-- FORFred Snftware Foun---her, eihe DDDDDD!DversherG3ucOT-TY;License, CH(at your op-her)m--y late DDDDDD!Dversher.l) ND!l) ND! PPM ensdistributodsPun-TY;hopes nedgetmwill-bL(useful,l) ND! but WITHOUT ANY WARRANTY;mwithout eveun-TY;implied warrantyAtp://wwwD! MERCHANTABILITY CHFITNESS FOR A PARTICULAR PURPOSE. Sees ne://wwwD! GNU General P g c License f CHmore details.l) ND!l) ND! You should have received a c----cOT-TY;GNU General P g c License DDDDDD!DandT-TY;GNU LessRRAGeneral P g c License aloor with PPM. If not,l) ND! sees<http://www.gnu.org/licenses/>.l) ND!l) ND! Parallel(PE_PRECI Mo h Library (PPM)l) ND! ETH Zurich DDDDDD!DCH-8092 Zurich, Switzerland DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So #if __DIME == __2D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_ss_2d(topoid,xp,up,field_up,ghoribize,dx,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_ds_2d(topoid,xp,up,field_up,ghoribize,dx,ioc=ll#endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_sv_2d(topoid,xp,up,field_up,lda,ghoribize,dx,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_dv_2d(topoid,xp,up,field_up,lda,ghoribize,dx,ioc=ll#endif #endif #elif __DIME == __3D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_ss_3d(topoid,xp,up,field_up,ghoribize,dx,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_ds_3d(topoid,xp,up,field_up,ghoribize,dx,ioc=ll#endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_sv_3d(topoid,xp,up,field_up,lda,ghoribize,dx,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE -2m_),tsIp_bsp2_dv_3d(topoid,xp,up,field_up,lda,ghoribize,dx,ioc=ll#endif #endif #endif DDDDD!!!(PE_PRECI to so h ),tsIpolatherGfollowTor -TY;2ndTUrARRAB-splineD cheso. DDDDD!!! DDDDD!!!(TTY;i,tsIpolatherG cheso ensonly;implehaG ed f CH3D spaces. To DDDDD!!!(increask perf Cmancen-TY;inner loops ovRRA-TY;numbRRAtp prope_PRes to DDDDD!!!(bY;i,tsIpolated are unrolled f CH2,3,4DandT5-vectors. DDDDD!!! DDDDD!!! [NOTE] DDDDD!!!(TTensroutineDonly;perf CmsT-TY;actual i,tsIpolather. It should not be DDDDD!!!(cailed direc-ly b-- FORusRRAbut insteadT-TY;`s::)),tsIp_m2p` DDDDD!!!(routineDshould bL(used with -TY;kernel(Ae thaG set to DDDDD!!!(`s::)pE_a-- thh_kernel_bsp2`.nnnnDDDDD-USE s::)module_esent)%adj_eUSE s::)module_All _ p',-aeUSE s::)module_ -tE_P p',-aeUSE s::)module_ -top p',-aeUSE s::)module_--- p',-aeUSE s::)module_--- - thh p',-aeUSE s::)module_--- -so h p',-aeUSE s::)module_oypedef p',-aeUSE s::)module_write p',-aeUSE s::)module_mapnnnDDDDD-IMPLICIT NONEn#if __KII--== __SINGLE_PRECISION DDDDD-INTEGER, PARAMETER :: MK = s::)kind_sTorlel#elif __KII--== __DOUBLE_PRECISION DDDDD-INTEGER, PARAMETER :: MK = s::)kind_do gel#endif p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S!l) ND! Ae thaG s p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S!l) NDINTEGER ,DINTENT(IN ) :: topoid p',-aw!!!(topology;idaG ifieRAtp tE_get #if __MODE == __SCAnfo) REAL(MK) ,DDIMENSION(:) ,DINTENT(IN) :: up p',-aw!!!(pE_PRECI we nnsfrom which to i,tsIpolate #if __DIME == __2D fo) REAL(MK) ,DDIMENSION(:,:,: ) , POINTER :: field_up #elif __DIME == __3D fo) REAL(MK) ,DDIMENSION(:,:,:,: ) , POINTER :: field_up #endif p',-aw!!!(fieldDonto which to i,tsIpolate #elif __MODE == __VECnfo) INTEGER ,DINTENT(IN) :: ldanfo) !!!(leadTor dimensherGcOTup p',-awREAL(MK) ,DDIMENSION(:,:) ,DINTENT(IN) :: up p',-aw!!!(pE_PRECI we nnsfrom which to i,tsIpolate #if __DIME == __2D fo) REAL(MK) ,DDIMENSION(:,:,:,: ) , POINTER :: field_up #elif __DIME == __3D fo) REAL(MK) ,DDIMENSION(:,:,:,:,:) , POINTER :: field_up #endif p',-aw!!!(fieldDonto which to i,tsIpolate #endif p',-awREAL(MK),DDIMENSION(:,:) ,DINTENT(IN ) :: xp p',-aw!!!(pE_PRECI pos hersnfo) INTEGER ,DDIMENSION(: ) ,DINTENT(IN ) :: ghoribize p',-aw!!!(TTY;bize (width)-cOT-TY;ghori layer p',-awREAL(mk),DDIMENSION(s::)dim) ,DINTENT(IN ) :: dx p',-aw!!!(so h spacTorl) NDINTEGER ,DINTENT( OUT) :: ioc= p',-aw!!!(Returns -tEtus, 0 uperG uccess p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S!l) ND! Locai varia ges p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S!l) NDINTEGER, DDIMENSION(:,:) , POINTER :: i-tE_P => NULL()l) NDINTEGER, DDIMENSION(:,:) , POINTER :: n--- => NULL()l) NDINTEGER, DDIMENSION(:) ,DPOINTER :: iue a1 => NULL()l) NDINTEGER, DDIMENSION(:) ,DPOINTER :: iue a2 => NULL()l) NDREAL(mk),DDIMENSION(:) ,DPOINTER :: min_phys => NULL()l) NDREAL(mk),DDIMENSION(:) ,DPOINTER :: max_phys => NULL()l) NDREAL(mk),DDIMENSION(s::)dim) :: dxil) NDREAL(mk) :: dxx,dxy,dxz,dxxi,dxyi,dxzil) NDREAL(mk),DDIMENSION(s::)dim) :: len_physl) NDREAL(mk) :: x1,x2,x3nfo) INTEGER :: kernel_supporPl) NDINTEGER, DDIMENSION(s::)dim+2) :: ldu,ldll) NDINTEGER, DDIMENSION(s::)dim) :: Ncnfo) INTEGER :: i,j,k,l,ii,jj,kk,iidec,mapoypenfo) INTEGER :: xlo,xhi,ylo,yhi,zlo,zhinfo) INTEGER :: jjdec,nb- ,npE_P,iparPl) NDINTEGER :: kkdec,ip1,nue a1nfo) INTEGER :: ip2,ip3,ifacenfo) INTEGER :: i ,ifrom,ito,ip,iopP,i gnfo) INTEGER :: max_parPnumbRR,id �,nue a2,id �ll) NDINTEGER, DIMENSION(s::)dim) :: Nmnfo) INTEGER :: n sl) NDINTEGER, DIMENSION(6) :: bcARfnfo) INTEGER :: iqnfo) LOGICAL :: i,tsInal_we nn,lok DDDDDD!Daliasesl) NDREAL(mk),DDIMENSION(:,:),) NDPOINTER :: min_ => NULL()l) NDREAL(mk),DDIMENSION(:,:),) NDPOINTER :: max_ => NULL()l) NDREAL(mk) :: myepsl) NDREAL(mk) :: tim1s, tim1el) NDREAL(mk) :: xp1,xp2,xp3l) NDREAL(mk) :: wx1,wx2,wx3l) NDREAL(mk),DDIMENSION(s::)dim) :: x0l) NDREAL(mk) :: x01,x02,x03l) NDCHARACTER(len=256) :: msrl) NDTYPE(s::)t_topo) , POINTER :: topo => NULL()l) ND! we are done n!-----------OT.ASSObL chec --- disuch: S!l) ND! Varia ges f CHunrolled vershers p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S!l) NDREAL(mk) :: x10,x11,x12,x13,x20,x21,x22,x23,x30,x31,x32,x33l) NDREAL(mk) :: a10,a11,a12,a13,a20,a21,a22,a23,a30,a31,a32,a33nfo) INTEGER :: ip10,ip11,ip12,ip13,ip20,ip21,ip22,ip23,ip30,ip31,ip32,ip33nfo) INTEGER :: ldnl) NDREAL(mk) :: a10a20a30l) NDREAL(mk) :: a10a20a31l) NDREAL(mk) :: a10a20a32l) NDREAL(mk) :: a10a20a33l) NDREAL(mk) :: a10a21a30l) NDREAL(mk) :: a10a21a31l) NDREAL(mk) :: a10a21a32l) NDREAL(mk) :: a10a21a33l) NDREAL(mk) :: a10a22a30l) NDREAL(mk) :: a10a22a31l) NDREAL(mk) :: a10a22a32l) NDREAL(mk) :: a10a22a33l) NDREAL(mk) :: a10a23a30l) NDREAL(mk) :: a10a23a31l) NDREAL(mk) :: a10a23a32l) NDREAL(mk) :: a10a23a33l) NDREAL(mk) :: a11a20a30l) NDREAL(mk) :: a11a20a31l) NDREAL(mk) :: a11a20a32l) NDREAL(mk) :: a11a20a33l) NDREAL(mk) :: a11a21a30l) NDREAL(mk) :: a11a21a31l) NDREAL(mk) :: a11a21a32l) NDREAL(mk) :: a11a21a33l) NDREAL(mk) :: a11a22a30l) NDREAL(mk) :: a11a22a31l) NDREAL(mk) :: a11a22a32l) NDREAL(mk) :: a11a22a33l) NDREAL(mk) :: a11a23a30l) NDREAL(mk) :: a11a23a31l) NDREAL(mk) :: a11a23a32l) NDREAL(mk) :: a11a23a33l) NDREAL(mk) :: a12a20a30l) NDREAL(mk) :: a12a20a31l) NDREAL(mk) :: a12a20a32l) NDREAL(mk) :: a12a20a33l) NDREAL(mk) :: a12a21a30l) NDREAL(mk) :: a12a21a31l) NDREAL(mk) :: a12a21a32l) NDREAL(mk) :: a12a21a33l) NDREAL(mk) :: a12a22a30l) NDREAL(mk) :: a12a22a31l) NDREAL(mk) :: a12a22a32l) NDREAL(mk) :: a12a22a33l) NDREAL(mk) :: a12a23a30l) NDREAL(mk) :: a12a23a31l) NDREAL(mk) :: a12a23a32l) NDREAL(mk) :: a12a23a33l) NDREAL(mk) :: a13a20a30l) NDREAL(mk) :: a13a20a31l) NDREAL(mk) :: a13a20a32l) NDREAL(mk) :: a13a20a33l) NDREAL(mk) :: a13a21a30l) NDREAL(mk) :: a13a21a31l) NDREAL(mk) :: a13a21a32l) NDREAL(mk) :: a13a21a33l) NDREAL(mk) :: a13a22a30l) NDREAL(mk) :: a13a22a31l) NDREAL(mk) :: a13a22a32l) NDREAL(mk) :: a13a22a33l) NDREAL(mk) :: a13a23a30l) NDREAL(mk) :: a13a23a31l) NDREAL(mk) :: a13a23a32l) NDREAL(mk) :: a13a23a33ll) N! we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y I, hyssse DDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So! l) NDCloL -tarP('-2m_),tsIp_bsp2'-t0,ioc=lll) NDtopo => s::)topo(topoid)%tll) N! we are done n!-----------OT.ASSObL chec --- disuch: So! p',-a,y Mo h spacTorl) N! we are done n!-----------OT.ASSObL chec --- disuch: So! #if __KII--== __SINGLE_PRECISION DDDDDmin_phys => topo%min_physs p',-amax_phys => topo%max_physsl#elif __KII--== __DOUBLE_PRECISION DDDDDmin_phys => topo%min_physd p',-amax_phys => topo%max_physd #endif n#if __KII--== __SINGLE_PRECISION DDDDD-myeps = s::)myepss p',-awmin_ => topo%min_ sl) NDmax_ => topo%max_ sl#elif __KII--== __DOUBLE_PRECISION DDDDD-myeps = s::)myepsd p',-awmin_ => topo%min_ dl) NDmax_ => topo%max_ d #endif nl) NDdxxi = 1.0_mk/dx(1) ffffffdxyi = 1.0_mk/dx(2) ffffffIF(s::)dim.EQ.3) dxzi = 1.0_mk/dx(3) nl) ND N! we are done n!-----------OT.ASSObL chec --- disuch:!l) ND N! AB-splineD2 (Witch hat)l) ND N! we are done n!-----------OT.ASSObL chec --- disuch:!l#if __DIME == __3D fo) wwDO i = 1,topo%n g wipl#if __MODE == __VECn fo) wwD N! we are done n!-----------OT.ASSObL chec --- d! fo) wwD N! Unrolled vershers f CH3-vectors fo) wwD N! we are done n!-----------OT.ASSObL chec --- d! fo) wwD NIF (lda .EQ. 3) THE- ffffffffffffffi g = topo%i g wi(i )nfo) p',-awwwDO ip = 1,st re_roc=(i )nnfo) p',-awwwfffiqwfff= g wi- (i ,ip)nnfo) p',-awwwfffx01f= (xp(1,iq)-min_ (1,i g))*dxxinfo) p',-awwwfffx02f= (xp(2,iq)-min_ (2,i g))*dxyinfo) p',-awwwfffx03f= (xp(3,iq)-min_ (3,i g))*dxzinnfo) p',-awwwfffip10f= INT(x01)u+-1 ffffffffffffffu fip20f= INT(x02)u+-1 ffffffffffffffu fip30f= INT(x03)u+-1 nfo) p',-awwwfffip11f= ip10f+-1 ffffffffffffffu fip21f= ip20f+-1 ffffffffffffffu fip31f= ip30u+-1 nfo) p',-awwwfffxp1f= x01-REAL(ip10-1,mk)nfo) p',-awwwfffxp2f= x02-REAL(ip20-1,mk)nfo) p',-awwwfffxp3f= x03-REAL(ip30-1,mk)nnfo) p',-awwwfffx10f= xp1nfo) p',-awwwfffx11f= x10f- 1.0_mknnfo) p',-awwwfffx20f= xp2nfo) p',-awwwfffx21f= x20f- 1.0_mknnfo) p',-awwwfffx30f= xp3nfo) p',-awwwfffx31f= x30f- 1.0_mknnfo) p',-awwwfffa10f= 1.0_mkf- x10nfo) p',-awwwfffa20f= 1.0_mkf- x20nfo) p',-awwwfffa30f= 1.0_mkf- x30lnfo) p',-awwwfffa11f= 1.0_mkf+fx11nfo) p',-awwwfffa21f= 1.0_mkf+fx21nfo) p',-awwwfffa31f= 1.0_mkf+fx31lnnfo) p',-awwwfffa10a20a30f= a10*a20*a30l) NDp',-awwwfffa10a20a31f= a10*a20*a31nfo) p',-awwwfffa10a21a30f= a10*a21*a30l) NDp',-awwwfffa10a21a31f= a10*a21*a31nfo) p',-awwwfffa11a20a30f= a11*a20*a30l) NDp',-awwwfffa11a20a31f= a11*a20*a31nfo) p',-awwwfffa11a21a30f= a11*a21*a30l) NDp',-awwwfffa11a21a31f= a11*a21*a31nl#ifdef __NOMICROINSTRUCTIONSl) NDp',-awwwfffield_up(1,ip10,ip20,ip30,i )=field_up(1,ip10,ip20,ip30,i )+&l) NDp',-awwwffffff&a10a20a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip20,ip30,i )=field_up(2,ip10,ip20,ip30,i )+&l) NDp',-awwwffffff&a10a20a30*up(2,iq)l) NDp',-awwwfffield_up(3,ip10,ip20,ip30,i )=field_up(3,ip10,ip20,ip30,i )+&l) NDp',-awwwffffff&a10a20a30*up(3,iq)l) NDp',-awwwfffield_up(1,ip11,ip20,ip30,i )=field_up(1,ip11,ip20,ip30,i )+&l) NDp',-awwwffffff&a11a20a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip20,ip30,i )=field_up(2,ip11,ip20,ip30,i )+&l) NDp',-awwwffffff&a11a20a30*up(2,iq)l) NDp',-awwwfffield_up(3,ip11,ip20,ip30,i )=field_up(3,ip11,ip20,ip30,i )+&l) NDp',-awwwffffff&a11a20a30*up(3,iq)l) NDp',-awwwfffield_up(1,ip10,ip21,ip30,i )=field_up(1,ip10,ip21,ip30,i )+&l) NDp',-awwwffffff&a10a21a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip21,ip30,i )=field_up(2,ip10,ip21,ip30,i )+&l) NDp',-awwwffffff&a10a21a30*up(2,iq)l) NDp',-awwwfffield_up(3,ip10,ip21,ip30,i )=field_up(3,ip10,ip21,ip30,i )+&l) NDp',-awwwffffff&a10a21a30*up(3,iq)l) NDp',-awwwfffield_up(1,ip11,ip21,ip30,i )=field_up(1,ip11,ip21,ip30,i )+&l) NDp',-awwwffffff&a11a21a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip21,ip30,i )=field_up(2,ip11,ip21,ip30,i )+&l) NDp',-awwwffffff&a11a21a30*up(2,iq)l) NDp',-awwwfffield_up(3,ip11,ip21,ip30,i )=field_up(3,ip11,ip21,ip30,i )+&l) NDp',-awwwffffff&a11a21a30*up(3,iq)l) NDp',-awwwfffield_up(1,ip10,ip20,ip31,i )=field_up(1,ip10,ip20,ip31,i )+&l) NDp',-awwwffffff&a10a20a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip20,ip31,i )=field_up(2,ip10,ip20,ip31,i )+&l) NDp',-awwwffffff&a10a20a31*up(2,iq)l) NDp',-awwwfffield_up(3,ip10,ip20,ip31,i )=field_up(3,ip10,ip20,ip31,i )+&l) NDp',-awwwffffff&a10a20a31*up(3,iq)l) NDp',-awwwfffield_up(1,ip11,ip20,ip31,i )=field_up(1,ip11,ip20,ip31,i )+&l) NDp',-awwwffffff&a11a20a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip20,ip31,i )=field_up(2,ip11,ip20,ip31,i )+&l) NDp',-awwwffffff&a11a20a31*up(2,iq)l) NDp',-awwwfffield_up(3,ip11,ip20,ip31,i )=field_up(3,ip11,ip20,ip31,i )+&l) NDp',-awwwffffff&a11a20a31*up(3,iq)l) NDp',-awwwfffield_up(1,ip10,ip21,ip31,i )=field_up(1,ip10,ip21,ip31,i )+&l) NDp',-awwwffffff&a10a21a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip21,ip31,i )=field_up(2,ip10,ip21,ip31,i )+&l) NDp',-awwwffffff&a10a21a31*up(2,iq)l) NDp',-awwwfffield_up(3,ip10,ip21,ip31,i )=field_up(3,ip10,ip21,ip31,i )+&l) NDp',-awwwffffff&a10a21a31*up(3,iq)l) NDp',-awwwfffield_up(1,ip11,ip21,ip31,i )=field_up(1,ip11,ip21,ip31,i )+&l) NDp',-awwwffffff&a11a21a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip21,ip31,i )=field_up(2,ip11,ip21,ip31,i )+&l) NDp',-awwwffffff&a11a21a31*up(2,iq)l) NDp',-awwwfffield_up(3,ip11,ip21,ip31,i )=field_up(3,ip11,ip21,ip31,i )+&l) NDp',-awwwffffff&a11a21a31*up(3,iq)l#else DDDDDDp',-awwwfffield_up(1:3,ip10,ip20,ip30,i )=field_up(1:3,ip10,ip20,ip30,i )+&l) NDp',-awwwffffff&a10a20a30*up(1:3,iq)l) NDp',-awwwfffield_up(1:3,ip11,ip20,ip30,i )=field_up(1:3,ip11,ip20,ip30,i )+&l) NDp',-awwwffffff&a11a20a30*up(1:3,iq)l) NDp',-awwwfffield_up(1:3,ip10,ip21,ip30,i )=field_up(1:3,ip10,ip21,ip30,i )+&l) NDp',-awwwffffff&a10a21a30*up(1:3,iq)l) NDp',-awwwfffield_up(1:3,ip11,ip21,ip30,i )=field_up(1:3,ip11,ip21,ip30,i )+&l) NDp',-awwwffffff&a11a21a30*up(1:3,iq)l) NDp',-awwwfffield_up(1:3,ip10,ip20,ip31,i )=field_up(1:3,ip10,ip20,ip31,i )+&l) NDp',-awwwffffff&a10a20a31*up(1:3,iq)l) NDp',-awwwfffield_up(1:3,ip11,ip20,ip31,i )=field_up(1:3,ip11,ip20,ip31,i )+&l) NDp',-awwwffffff&a11a20a31*up(1:3,iq)l) NDp',-awwwfffield_up(1:3,ip10,ip21,ip31,i )=field_up(1:3,ip10,ip21,ip31,i )+&l) NDp',-awwwffffff&a10a21a31*up(1:3,iq)l) NDp',-awwwfffield_up(1:3,ip11,ip21,ip31,i )=field_up(1:3,ip11,ip21,ip31,i )+&l) NDp',-awwwffffff&a11a21a31*up(1:3,iq)l#endif p',-awwwwwwwwwEI--DO -aw-awwwwwwwww! we are done n!-----------OT.ASSObL chec --- d! fo) wwD N N! Unrolled vershers f CH2-vectors fo) wwD Nwww! we are done n!-----------OT.ASSObL chec --- d! fo) wwD NELSEIF (lda .EQ. 2) THE- ffffffffffffffi g = topo%i g wi(i )nfo) p',-awwwDO ip = 1,st re_roc=(i )nnfo) p',-awwwfffiqwfff= g wi- (i ,ip)nnfo) p',-awwwfffx01f= (xp(1,iq)-min_ (1,i g))*dxxinfo) p',-awwwfffx02f= (xp(2,iq)-min_ (2,i g))*dxyinfo) p',-awwwfffx03f= (xp(3,iq)-min_ (3,i g))*dxzinnfo) p',-awwwfffip10f= INT(x01)u+-1 ffffffffffffffu fip20f= INT(x02)u+-1 ffffffffffffffu fip30f= INT(x03)u+-1 nfo) p',-awwwfffip11f= ip10f+-1 ffffffffffffffu fip21f= ip20f+-1 ffffffffffffffu fip31f= ip30u+-1 nfo) p',-awwwfffxp1f= x01-REAL(ip10-1,mk)nfo) p',-awwwfffxp2f= x02-REAL(ip20-1,mk)nfo) p',-awwwfffxp3f= x03-REAL(ip30-1,mk)nnfo) p',-awwwfffx10f= xp1nfo) p',-awwwfffx11f= x10f- 1.0_mknnfo) p',-awwwfffx20f= xp2nfo) p',-awwwfffx21f= x20f- 1.0_mknnfo) p',-awwwfffx30f= xp3nfo) p',-awwwfffx31f= x30f- 1.0_mknnfo) p',-awwwfffa10f= 1.0_mkf- x10nfo) p',-awwwfffa20f= 1.0_mkf- x20nfo) p',-awwwfffa30f= 1.0_mkf- x30lnfo) p',-awwwfffa11f= 1.0_mkf+fx11nfo) p',-awwwfffa21f= 1.0_mkf+fx21nfo) p',-awwwfffa31f= 1.0_mkf+fx31lnfo) p',-awwwfffa10a20a30f= a10*a20*a30l) NDp',-awwwfffa10a20a31f= a10*a20*a31nfo) p',-awwwfffa10a21a30f= a10*a21*a30l) NDp',-awwwfffa10a21a31f= a10*a21*a31nfo) p',-awwwfffa11a20a30f= a11*a20*a30l) NDp',-awwwfffa11a20a31f= a11*a20*a31nfo) p',-awwwfffa11a21a30f= a11*a21*a30l) NDp',-awwwfffa11a21a31f= a11*a21*a31nl#ifdef __NOMICROINSTRUCTIONSl) NDp',-awwwfffield_up(1,ip10,ip20,ip30,i )=field_up(1,ip10,ip20,ip30,i )+&l) NDp',-awwwffffff&a10a20a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip20,ip30,i )=field_up(2,ip10,ip20,ip30,i )+&l) NDp',-awwwffffff&a10a20a30*up(2,iq)l) NDp',-awwwfffield_up(1,ip11,ip20,ip30,i )=field_up(1,ip11,ip20,ip30,i )+&l) NDp',-awwwffffff&a11a20a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip20,ip30,i )=field_up(2,ip11,ip20,ip30,i )+&l) NDp',-awwwffffff&a11a20a30*up(2,iq)l) NDp',-awwwfffield_up(1,ip10,ip21,ip30,i )=field_up(1,ip10,ip21,ip30,i )+&l) NDp',-awwwffffff&a10a21a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip21,ip30,i )=field_up(2,ip10,ip21,ip30,i )+&l) NDp',-awwwffffff&a10a21a30*up(2,iq)l) NDp',-awwwfffield_up(1,ip11,ip21,ip30,i )=field_up(1,ip11,ip21,ip30,i )+&l) NDp',-awwwffffff&a11a21a30*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip21,ip30,i )=field_up(2,ip11,ip21,ip30,i )+&l) NDp',-awwwffffff&a11a21a30*up(2,iq)l) NDp',-awwwfffield_up(1,ip10,ip20,ip31,i )=field_up(1,ip10,ip20,ip31,i )+&l) NDp',-awwwffffff&a10a20a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip20,ip31,i )=field_up(2,ip10,ip20,ip31,i )+&l) NDp',-awwwffffff&a10a20a31*up(2,iq)l) NDp',-awwwfffield_up(1,ip11,ip20,ip31,i )=field_up(1,ip11,ip20,ip31,i )+&l) NDp',-awwwffffff&a11a20a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip20,ip31,i )=field_up(2,ip11,ip20,ip31,i )+&l) NDp',-awwwffffff&a11a20a31*up(2,iq)l) NDp',-awwwfffield_up(1,ip10,ip21,ip31,i )=field_up(1,ip10,ip21,ip31,i )+&l) NDp',-awwwffffff&a10a21a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip10,ip21,ip31,i )=field_up(2,ip10,ip21,ip31,i )+&l) NDp',-awwwffffff&a10a21a31*up(2,iq)l) NDp',-awwwfffield_up(1,ip11,ip21,ip31,i )=field_up(1,ip11,ip21,ip31,i )+&l) NDp',-awwwffffff&a11a21a31*up(1,iq)l) NDp',-awwwfffield_up(2,ip11,ip21,ip31,i )=field_up(2,ip11,ip21,ip31,i )+&l) NDp',-awwwffffff&a11a21a31*up(2,iq)l#else DDDDDDp',-awwwfffield_up(1:2,ip10,ip20,ip30,i )=field_up(1:2,ip10,ip20,ip30,i )+&l) NDp',-awwwffffff&a10a20a30*up(1:2,iq)l) NDp',-awwwfffield_up(1:2,ip11,ip20,ip30,i )=field_up(1:2,ip11,ip20,ip30,i )+&l) NDp',-awwwffffff&a11a20a30*up(1:2,iq)l) NDp',-awwwfffield_up(1:2,ip10,ip21,ip30,i )=field_up(1:2,ip10,ip21,ip30,i )+&l) NDp',-awwwffffff&a10a21a30*up(1:2,iq)l) NDp',-awwwfffield_up(1:2,ip11,ip21,ip30,i )=field_up(1:2,ip11,ip21,ip30,i )+&l) NDp',-awwwffffff&a11a21a30*up(1:2,iq)l) NDp',-awwwfffield_up(1:2,ip10,ip20,ip31,i )=field_up(1:2,ip10,ip20,ip31,i )+&l) NDp',-awwwffffff&a10a20a31*up(1:2,iq)l) NDp',-awwwfffield_up(1:2,ip11,ip20,ip31,i )=field_up(1:2,ip11,ip20,ip31,i )+&l) NDp',-awwwffffff&a11a20a31*up(1:2,iq)l) NDp',-awwwfffield_up(1:2,ip10,ip21,ip31,i )=field_up(1:2,ip10,ip21,ip31,i )+&l) NDp',-awwwffffff&a10a21a31*up(1:2,iq)l) NDp',-awwwfffield_up(1:2,ip11,ip21,ip31,i )=field_up(1:2,ip11,ip21,ip31,i )+&l) NDp',-awwwffffff&a11a21a31*up(1:2,iq)l#endif p',-awwwwwwwwwEI-DO -aw-awwwwwwwww! we are done n!-----------OT.ASSObL chec --- d! fo) wwD N N! Unrolled vershers f CH1-vectors fo) wwD Nwww! we are done n!-----------OT.ASSObL chec --- d! fo) wwD NELSEIF (lda .EQ. 1) THE- ffffffffffffffi g = topo%i g wi(i )nfo) p',-awwwDO ip = 1,st re_roc=(i )nnfo) p',-awwwfffiqwfff= g wi- (i ,ip)nnfo) p',-awwwfffx01f= (xp(1,iq)-min_ (1,i g))*dxxinfo) p',-awwwfffx02f= (xp(2,iq)-min_ (2,i g))*dxyinfo) p',-awwwfffx03f= (xp(3,iq)-min_ (3,i g))*dxzinnfo) p',-awwwfffip10f= INT(x01)u+-1 ffffffffffffffu fip20f= INT(x02)u+-1 ffffffffffffffu fip30f= INT(x03)u+-1 nfo) p',-awwwfffip11f= ip10f+-1 ffffffffffffffu fip21f= ip20f+-1 ffffffffffffffu fip31f= ip30u+-1 nfo) p',-awwwfffxp1f= x01-REAL(ip10-1,mk)nfo) p',-awwwfffxp2f= x02-REAL(ip20-1,mk)nfo) p',-awwwfffxp3f= x03-REAL(ip30-1,mk)nnfo) p',-awwwfffx10f= xp1nfo) p',-awwwfffx11f= x10f- 1.0_mknnfo) p',-awwwfffx20f= xp2nfo) p',-awwwfffx21f= x20f- 1.0_mknnfo) p',-awwwfffx30f= xp3nfo) p',-awwwfffx31f= x30f- 1.0_mknnfo) p',-awwwfffa10f= 1.0_mkf- x10nfo) p',-awwwfffa20f= 1.0_mkf- x20nfo) p',-awwwfffa30f= 1.0_mkf- x30lnfo) p',-awwwfffa11f= 1.0_mkf+fx11nfo) p',-awwwfffa21f= 1.0_mkf+fx21nfo) p',-awwwfffa31f= 1.0_mkf+fx31lnfo) p',-awwwfffa10a20a30f= a10*a20*a30l) NDp',-awwwfffa10a20a31f= a10*a20*a31nfo) p',-awwwfffa10a21a30f= a10*a21*a30l) NDp',-awwwfffa10a21a31f= a10*a21*a31nfo) p',-awwwfffa11a20a30f= a11*a20*a30l) NDp',-awwwfffa11a20a31f= a11*a20*a31nfo) p',-awwwfffa11a21a30f= a11*a21*a30l) NDp',-awwwfffa11a21a31f= a11*a21*a31nlNDp',-awwwffffield_up(1,ip10,ip20,ip30,i )=field_up(1,ip10,ip20,ip30,i )+&l) N i_heap',-awwwwwwwwa10a20a30*up(1,iq)l) NDp',-awwfield_up(1,ip11,ip20,ip30,i )=field_up(1,ip11,ip20,ip30,i )+&l) N i_heap',-awwwwwwwwa11a20a30*up(1,iq)l) NDp',-awwfield_up(1,ip10,ip21,ip30,i )=field_up(1,ip10,ip21,ip30,i )+&l) N i_heap',-awwwwwwwwa10a21a30*up(1,iq)l) NDp',-awwfield_up(1,ip11,ip21,ip30,i )=field_up(1,ip11,ip21,ip30,i )+&l) N i_heap',-awwwwwwwwa11a21a30*up(1,iq)l) NDp',-awwfield_up(1,ip10,ip20,ip31,i )=field_up(1,ip10,ip20,ip31,i )+&l) N i_heap',-awwwwwwwwa10a20a31*up(1,iq)l) NDp',-awwfield_up(1,ip11,ip20,ip31,i )=field_up(1,ip11,ip20,ip31,i )+&l) N i_heap',-awwwwwwwwa11a20a31*up(1,iq)l) NDp',-awwfield_up(1,ip10,ip21,ip31,i )=field_up(1,ip10,ip21,ip31,i )+&l) N i_heap',-awwwwwwwwa10a21a31*up(1,iq)l) NDp',-awwfield_up(1,ip11,ip21,ip31,i )=field_up(1,ip11,ip21,ip31,i )+&l) N i_heap',-awwwwwwwwa11a21a31*up(1,iq)l p',-awwwwwwwwwEI-DO -aw-awwwwwwwww! we are done n!-----------OT.ASSObL chec --- d! fo) wwD N N! All ohe lda are NOT UNROLLED. VectorizatherGwill-bL(ovRRAlda! fo) wwD N N! we are done n!-----------OT.ASSObL chec --- d! fo) wwD NELSE ffffffffffffffi g = topo%i g wi(i )nfo) p',-awwwDO ip = 1,st re_roc=(i )nnfo) p',-awwwfffiqwfff= g wi- (i ,ip)nnfo) p',-awwwfffx01f= (xp(1,iq)-min_ (1,i g))*dxxinfo) p',-awwwfffx02f= (xp(2,iq)-min_ (2,i g))*dxyinfo) p',-awwwfffx03f= (xp(3,iq)-min_ (3,i g))*dxzinnfo) p',-awwwfffip10f= INT(x01)u+-1 ffffffffffffffu fip20f= INT(x02)u+-1 ffffffffffffffu fip30f= INT(x03)u+-1 nfo) p',-awwwfffip11f= ip10f+-1 ffffffffffffffu fip21f= ip20f+-1 ffffffffffffffu fip31f= ip30u+-1 nfo) p',-awwwfffxp1f= x01-REAL(ip10-1,mk)nfo) p',-awwwfffxp2f= x02-REAL(ip20-1,mk)nfo) p',-awwwfffxp3f= x03-REAL(ip30-1,mk)nnfo) p',-awwwfffx10f= xp1nfo) p',-awwwfffx11f= x10f- 1.0_mknnfo) p',-awwwfffx20f= xp2nfo) p',-awwwfffx21f= x20f- 1.0_mknnfo) p',-awwwfffx30f= xp3nfo) p',-awwwfffx31f= x30f- 1.0_mknnfo) p',-awwwfffa10f= 1.0_mkf- x10nfo) p',-awwwfffa20f= 1.0_mkf- x20nfo) p',-awwwfffa30f= 1.0_mkf- x30lnfo) p',-awwwfffa11f= 1.0_mkf+fx11nfo) p',-awwwfffa21f= 1.0_mkf+fx21nfo) p',-awwwfffa31f= 1.0_mkf+fx31lnfo) p',-awwwfffa10a20a30f= a10*a20*a30l) NDp',-awwwfffa10a20a31f= a10*a20*a31nfo) p',-awwwfffa10a21a30f= a10*a21*a30l) NDp',-awwwfffa10a21a31f= a10*a21*a31nfo) p',-awwwfffa11a20a30f= a11*a20*a30l) NDp',-awwwfffa11a20a31f= a11*a20*a31nfo) p',-awwwfffa11a21a30f= a11*a21*a30l) NDp',-awwwfffa11a21a31f= a11*a21*a31n) NDp',-awwwfffDO ldn=1,ldann) NDp',-field_up(ldn,ip10,ip20,ip30,i )=field_up(ldn,ip10,ip20,ip30,i )+&l) N i_heap',-awwwwwa10a20a30*up(ldn,iq)l) NDp',-field_up(ldn,ip11,ip20,ip30,i )=field_up(ldn,ip11,ip20,ip30,i )+&l) N i_heap',-awwwwwa11a20a30*up(ldn,iq)l) NDp',-field_up(ldn,ip10,ip21,ip30,i )=field_up(ldn,ip10,ip21,ip30,i )+&l) N i_heap',-awwwwwa10a21a30*up(ldn,iq)l) NDp',-field_up(ldn,ip11,ip21,ip30,i )=field_up(ldn,ip11,ip21,ip30,i )+&l) N i_heap',-awwwwwa11a21a30*up(ldn,iq)l) NDp',-field_up(ldn,ip10,ip20,ip31,i )=field_up(ldn,ip10,ip20,ip31,i )+&l) N i_heap',-awwwwwa10a20a31*up(ldn,iq)l) NDp',-field_up(ldn,ip11,ip20,ip31,i )=field_up(ldn,ip11,ip20,ip31,i )+&l) N i_heap',-awwwwwa11a20a31*up(ldn,iq)l) NDp',-field_up(ldn,ip10,ip21,ip31,i )=field_up(ldn,ip10,ip21,ip31,i )+&l) N i_heap',-awwwwwa10a21a31*up(ldn,iq)l) NDp',-field_up(ldn,ip11,ip21,ip31,i )=field_up(ldn,ip11,ip21,ip31,i )+&l) N i_heap',-awwwwwa11a21a31*up(ldn,iq)l) NDp',--------EI-DO----! ldanfo) --------EI-DO--------! iqnfo) -----EI-NIF --------! unrolled lda casesl#elif __MODE == __SCAnfo) i g = topo%i g wi(i )nfo) p',-aDO ip = 1,st re_roc=(i )nnfo) p',-awwwiqwfff= g wi- (i ,ip)nnfo) p',-awwwx01f= (xp(1,iq)-min_ (1,i g))*dxxinfo) p',-awwwx02f= (xp(2,iq)-min_ (2,i g))*dxyinfo) p',-awwwx03f= (xp(3,iq)-min_ (3,i g))*dxzinnfo) p',-awwwip10f= INT(x01)u+-1 ffffffffffffffip20f= INT(x02)u+-1 ffffffffffffffip30f= INT(x03)u+-1 nfo) p',-awwwip11f= ip10f+-1 ffffffffffffffip21f= ip20f+-1 ffffffffffffffip31f= ip30u+-1 nfo) p',-awwwxp1f= x01-REAL(ip10-1,mk)nfo) p',-awwwxp2f= x02-REAL(ip20-1,mk)nfo) p',-awwwxp3f= x03-REAL(ip30-1,mk)nnfo) p',-awwwx10f= xp1nfo) p',-awwwx11f= x10f- 1.0_mknnfo) p',-awwwx20f= xp2nfo) p',-awwwx21f= x20f- 1.0_mknnfo) p',-awwwx30f= xp3nfo) p',-awwwx31f= x30f- 1.0_mknnfo) p',-awwwa10f= 1.0_mkf- x10nfo) p',-awwwa20f= 1.0_mkf- x20nfo) p',-awwwa30f= 1.0_mkf- x30lnfo) p',-awwwa11f= 1.0_mkf+fx11nfo) p',-awwwa21f= 1.0_mkf+fx21nfo) p',-awwwa31f= 1.0_mkf+fx31lnfo) p',-awwwa10a20a30f= a10*a20*a30l) NDp',-awwwa10a20a31f= a10*a20*a31nfo) p',-awwwa10a21a30f= a10*a21*a30l) NDp',-awwwa10a21a31f= a10*a21*a31nfo) p',-awwwa11a20a30f= a11*a20*a30l) NDp',-awwwa11a20a31f= a11*a20*a31nfo) p',-awwwa11a21a30f= a11*a21*a30l) NDp',-awwwa11a21a31f= a11*a21*a31nll) NDp',-awwwfield_up(ip10,ip20,ip30,i )=field_up(ip10,ip20,ip30,i )+&l) N i_heap',-awwwwwwwwwa10a20a30*up(iq)l) NDp',-----field_up(ip11,ip20,ip30,i )=field_up(ip11,ip20,ip30,i )+&l) N i_heap',-awwwwwwwwwa11a20a30*up(iq)l) NDp',-----field_up(ip10,ip21,ip30,i )=field_up(ip10,ip21,ip30,i )+&l) N i_heap',-awwwwwwwwwa10a21a30*up(iq)l) NDp',-----field_up(ip11,ip21,ip30,i )=field_up(ip11,ip21,ip30,i )+&l) N i_heap',-awwwwwwwwwa11a21a30*up(iq)l) NDp',-----field_up(ip10,ip20,ip31,i )=field_up(ip10,ip20,ip31,i )+&l) N i_heap',-awwwwwwwwwa10a20a31*up(iq)l) NDp',-----field_up(ip11,ip20,ip31,i )=field_up(ip11,ip20,ip31,i )+&l) N i_heap',-awwwwwwwwwa11a20a31*up(iq)l) NDp',-----field_up(ip10,ip21,ip31,i )=field_up(ip10,ip21,ip31,i )+&l) N i_heap',-awwwwwwwwwa10a21a31*up(iq)l) NDp',-----field_up(ip11,ip21,ip31,i )=field_up(ip11,ip21,ip31,i )+&l) N i_heap',-awwwwwwwwwa11a21a31*up(iq)l) NDp',--EI-DO--------! iqn#endif p',-awwwEI--DOp',-awwwwwwwww! loop(ovRRAs sl#elif __DIME == __2D fo) DDroc= = s::)esent_esent)%adj_eND�loL s::)esent(s::)ese)Ae thaG ,'s2m_),tsIp_bsp2'- N l) N i_heap','CurraG ly bsp2 ensnot availa ge. Usk p::) thh_reso h f CHohe kernelb.'- &l) N i_heap',-aw__LINE__,ioc=ll#endif p',-awCloL -top('-2m_),tsIp_bsp2'-t0,ioc=llp',-awRETURN #if __DIME == __2D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_ss_2dl#elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_ds_2d #endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_sv_2d #elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_dv_2d #endif #endif #elif __DIME == __3D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_ss_3d #elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_ds_3d #endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_sv_3d #elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE -2m_),tsIp_bsp2_dv_3d #endif #endif #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������libs::-1.2.1/src/),tsIpolate/s::)),tsIp_m2p.f�������������������������������������������������������0000644�0001752�0001753�00000074505�11616003523�021406� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������wwwwww! we are done n!-----------OT.ASSObL chec --- dddddddddd wwwwww! SubroutineDDD:i_heap',-awwwwwww s::)),tsIp_m2p wwwwww! we are done n!-----------OT.ASSObL chec --- dddddddddd wwwwww! C---r n (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), DDDDDD!DDDDDDDDDDDDDDDDDDDDCe,tsI ! CHFluid Dynamics (DTUll) ND!l) ND!l) ND! icensfilo enst youcOT-TY;Parallel(PE_PRECI Mo h Library (PPM).l) ND!l) ND! PPM ensfred inftware: you can redistributo etm--S/ CHmodifyl) ND! etmunARRANTY;tsImsucOT-TY;GNU LessRRAGeneral P g c License DDDDDD!Danst g whed b-- FORFred Snftware Foun---her, eihe DDDDDD!DversherG3ucOT-TY;License, CH(at your op-her)m--y late DDDDDD!Dversher.l) ND!l) ND! PPM ensdistributodsPun-TY;hopes nedgetmwill-bL(useful,l) ND! but WITHOUT ANY WARRANTY;mwithout eveun-TY;implied warrantyAtp://wwwD! MERCHANTABILITY CHFITNESS FOR A PARTICULAR PURPOSE. Sees ne://wwwD! GNU General P g c License f CHmore details.l) ND!l) ND! You should have received a c----cOT-TY;GNU General P g c License DDDDDD!DandT-TY;GNU LessRRAGeneral P g c License aloor with PPM. If not,l) ND! sees<http://www.gnu.org/licenses/>.l) ND!l) ND! Parallel(PE_PRECI Mo h Library (PPM)l) ND! ETH Zurich DDDDDD!DCH-8092 Zurich, Switzerland DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So #if __DIME == __2D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE m2p_ss_2d(topoid,so hid,xp,Np,up,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE m2p_ds_2d(topoid,so hid,xp,Np,up,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE m2p_sv_2d(topoid,so hid,xp,Np,up,lda,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE m2p_dv_2d(topoid,so hid,xp,Np,up,lda,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#endif #endif #elif __DIME == __3D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE m2p_ss_3d(topoid,so hid,xp,Np,up,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE m2p_ds_3d(topoid,so hid,xp,Np,up,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-SUBROUTINE m2p_sv_3d(topoid,so hid,xp,Np,up,lda,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#elif __KII--== __DOUBLE_PRECISION DDDDD-SUBROUTINE m2p_dv_3d(topoid,so hid,xp,Np,up,lda,kernel- &l) N i_heap',-awghoribize,field_up,ioc=ll#endif #endif #endif DDDDDD!!!(TTenssubroutineDcarrRes out so h to(pE_PRECI i,tsIpolather. DDDDDD!!!( DDDDDD!!!(CurraG ly 2;i,tsIpolatherG chesos are supporPed: DDDDDD!!! DDDDDD!!!(* s::)pE_a-- thh_kernel_bsp2 DDDDDD!!!(* s::)pE_a-- thh_kernel_mp4 DDDDDD!!! DDDDDD!!!([WARNING] DDDDDD!!!(TTensroutineDassusos nedg`up` ensalready All _ated. DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! INCLUDES DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Modules p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDUSE s::)module_esent)%adj_eUSE s::)module_All _ p',-aeUSE s::)module_ -tE_P p',-aeUSE s::)module_ -top p',-aeUSE s::)module_--- p',-aeUSE s::)module_--- - thh p',-aeUSE s::)module_--- -so h p',-aeUSE s::)module_oypedef p',-aeUSE s::)module_write p',-aeUSE s::)module_check_id p',-awIMPLICIT NONEnn#if __KII--== __SINGLE_PRECISION DDDDD-INTEGER, PARAMETER :: MK = s::)kind_sTorlel#elif __KII--== __DOUBLE_PRECISION DDDDD-INTEGER, PARAMETER :: MK = s::)kind_do gel#endif p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Ae thaG s p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S- #if __MODE == __SCAnfo) REAL(MK) ,DDIMENSION(:) ,DPOINTER :: up p',-aw!!!(pE_PRECI we nnsonto which to i,tsIpolate #if __DIME == __2D fo) REAL(MK) ,DDIMENSION(:,:,: ) , POINTER :: field_up #elif __DIME == __3D fo) REAL(MK) ,DDIMENSION(:,:,:,: ) , POINTER :: field_up #endif p',-aw!!!(fieldDfrom which to i,tsIpolate #elif __MODE == __VECnfo) INTEGER ,DINTENT(IN ) :: ldanfo) !!!(leadTor dimensherGcOTup p',-awREAL(MK) ,DDIMENSION(:,:) ,DPOINTER :: up p',-aw!!!(pE_PRECI we nnsonto which to i,tsIpolate #if __DIME == __2D fo) REAL(MK) ,DDIMENSION(:,:,:,: ) , POINTER :: field_up #elif __DIME == __3D fo) REAL(MK) ,DDIMENSION(:,:,:,:,:) , POINTER :: field_up #endif p',-aw!!!(fieldDfrom which to i,tsIpolate #endif p',-awREAL(MK),DDIMENSION(:,:) ,DINTENT(IN ) :: xp p',-aw!!!(pE_PRECI pos hersnfo) INTEGER ,DDIMENSION(: ) ,DINTENT(IN ) :: ghoribize p',-aw!!!(ghori bize p',-awINTEGER ,DINTENT(IN ) :: Np p',-aw!!!(numbRRGcOTpE_PRECIs.l) NDINTEGER ,DINTENT(IN ) :: topoid p',-aw!!!(topology;idaG ifieRAtp tE_get ) NDINTEGER ,DINTENT(IN ) :: so hid p',-aw!!!(id-cOT-TY;so h (user) ) NDINTEGER ,DINTENT(IN ) :: kernel DDDDDD!!!(Choice-cOT-TY;kernel(used to computo -TY;we nn. + DDDDDD!!!(One-cO: DDDDDD!!! DDDDDD!!!(* s::)pE_a-- thh_kernel_bsp2 DDDDDD!!!(* s::)pE_a-- thh_kernel_mp4 DDDDDDINTEGER ,DINTENT( OUT) :: ioc= p',-aw!!!(Returns 0 uperG uccess p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Locai varia ges p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S- DDDDDDINTEGER, DDIMENSION(:,:) , POINTER :: i-tE_P => NULL()l) NDINTEGER, DDIMENSION(:) ,DPOINTER :: iue a1 => NULL()l) NDINTEGER, DDIMENSION(:) ,DPOINTER :: iue a2 => NULL()l) NDREAL(mk),DDIMENSION(:) ,DPOINTER :: min_phys => NULL()l) NDREAL(mk),DDIMENSION(:) ,DPOINTER :: max_phys => NULL()l) NDREAL(MK),DDDIMENSION(s::)dim) :: dxi,dx p',-awREAL(MK),DDDIMENSION(s::)dim) :: len_physl) NDREAL(MK) :: x1,x2,x3,epsilon DDDDDDINTEGER :: kernel_supporPl) NDINTEGER, DDIMENSION(s::)dim+2) :: ldu,ldll) NDINTEGER, DDIMENSION(s::)dim) :: Ncnfo) INTEGER :: i,j,k,ii,jj,kk,iidec,mapoypenfo) INTEGER :: jjdec,nb- ,npE_P,iparPl) NDINTEGER :: kkdec,ip1,nbpt_z,nue a1nfo) INTEGER :: ip2,ip3,nbpt_x,nbpt_y,ifacenfo) INTEGER :: i ,ifrom,ito,ip,dim,iopP,i gnfo) INTEGER :: max_parPnumbRR,id �,nue a2,id �ll) NDINTEGER, DIMENSION(s::)dim) :: Nmnfo) INTEGER :: n sl) NDINTEGER, DIMENSION(6) :: bcARfnfo) INTEGER :: iqnfo) LOGICAL :: i,tsInal_we nn,lok DDDDDD!Daliasesl) NDREAL(mk),DDIMENSION(:,:),) NDPOINTER :: min_ => NULL()l) NDREAL(mk),DDIMENSION(:,:),) NDPOINTER :: max_ => NULL()l) NDREAL(mk) :: myepsl) NDREAL(mk) :: tim1s, tim1el) NDTYPE(s::)t_equi-so h), POINTER :: p-so h => NULL()l) NDTYPE(s::)t_topo) , POINTER :: topo => NULL()l DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! I, hyssze p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDCloL -tarP('-::)),tsIp_m2p'-t0,ioc=lll) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Some compilers have pro gems i, hysszTor cerstaG s nedgare declared p',-aw!sPun-TY;modulen-TYrefore we dogetmTYre:l) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDp::) thh_kernelbszef= (/1,2,2,4/lll) NDdim = s::)diml) NDi,tsInal_we nn = .FALSE.ll) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Check ae thaG s p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S- p',-awIF (s::)debug .GT. 0) THE- ffffffffCloL check ffffffffIF (roc= .NE. 0) GOTO 9999 ffffffENDIF p',-awIF(Np.EQ.0) GOTO 9999 p',-awtopo => s::)topo(topoid)%tll) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! GetT-TY;so hl) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDp-so h => topo%mo h(so hid)l) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! GetTi-tE_P p',-ae! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDi-tE_P => s-so h%i-tE_P l) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! AssignhaG -cOT-TY;useful arrays/scaiarl) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDNm(1:dim) = s-so h%Nmnfo) bcARf(1:(2*dim)) = topo%bcARf(1:(2*dim))nfo) n s = topo%n g wipl) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! All _ate;somory f CHpE_PRECI g wis DDDDDD! TTY;awesome s::)All _mwill-(re)All _ateT-TYm, so we doG -need an i, DDDDDD! CHa finysszesroutine. DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDiopP = s::)pE_a--All __f DDDDDDldu(1) = Np p',-awIF(n s.NE.1) �loL s::)All _(iue a1,ldu,iopP,ioc=llp',-awIF (roc=.NE.0) THE- ffffffffDroc= = s::)esent_fatal ffffffffD�loL s::)esent(s::)ese)All _,'-::)),tsIp_m2p_3d'- N &l) N i_heap',-awwwwwwwwwwwww'pE_PRECI g wi 1 ILIST1',__LINE__,ioc=llwwwwwwwwwGOTO 9999 ffffffENDwIF p',-awIF(n s.NE.1) �loL s::)All _(iue a2,ldu,iopP,ioc=llp',-awIF (roc=.NE.0) THE- ffffffffDroc= = s::)esent_fatal ffffffffD�loL s::)esent(s::)ese)All _,'-::)),tsIp_m2p_3d'- N &l) N i_heap',-awwwwwwwwwwwww'pE_PRECI g wi 2 ILIST2',__LINE__,ioc=llwwwwwwwwwGOTO 9999 ffffffENDwIF DDDDDDiopP = s::)pE_a--All __f DDDDDDldu(1) = n sl) NDIF(n s.NE.1) �loL s::)All _(st re_roc=,ldu,iopP,ioc=llp',-awIF (roc=.NE.0) THE- ffffffffDroc= = s::)esent_fatal ffffffffD�loL s::)esent(s::)ese)All _,'-::)),tsIp_m2p_3d'- N &l) N i_heap',-awwwwwwwwwwwww'st re_roc= All _atherG: pro gem',__LINE__,ioc=llwwwwwwwwwGOTO 9999 ffffffENDwIF DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Mo h spacTorl) Nw! we are done n!-----------OT.ASSObL chec --- disuch: S- #if __KII--== __SINGLE_PRECISION DDDDD-min_phys => topo%min_physs p',-aamax_phys => topo%max_physsl#elif __KII--== __DOUBLE_PRECISION DDDDDDmin_phys => topo%min_physd p',-aamax_phys => topo%max_physd #endif np',-aaDO i = 1,diml) NDDDDN_(i) =DNm(i) --1 ffffffffflen_phys(i) =amax_phys(i) --min_phys(i) fffffffffdx(i) =Dlen_phys(i)/REAL(N_(i),MK) ffffffENDwDO -aw-awdxi = 1.0_mk/dx DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! I, hysszeT-TY;pE_PRECI g wi p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: S- p',-awIF(n s.NE.1) THE- ffffffffDnue a1 =D0l) NDp',st re_roc= =D0l) NDp',DO ipE_P=1,Np p',-awfffffDnue a1 =Dnue a1 +-1 ffffffffffffiue a1(nue a1)f= ipE_P p',-aefffENDwDO -aw-awENDwIF #if __KII--== __SINGLE_PRECISION DDDDD-myeps = s::)myepss p',-awmin_ => topo%min_ sl) NDmax_ => topo%max_ sl#elif __KII--== __DOUBLE_PRECISION DDDDD-myeps = s::)myepsd p',-awmin_ => topo%min_ dl) NDmax_ => topo%max_ d #endif nDDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Loop(ovRRA-TY; domains (sinceT-TY;firwi domains are mori likelyl) ND! to be empty, we look backwards to reduceT-TY;numbRRGcOTegemaG sDrol) ND! nue a2Dansfari anstossi ge)l) ND! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDIF(n s.NE.1) THE- ffffffffDDO idom = topo%n g wi,1,-1 ffffffffffffid �l = topo%i g wi(id �)l) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---! Loop(ovRRA-TY;remainTor pE_PRECIsl) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---nue a2D=D0l) NDp',---nt you=D0l) NDp',---DO i=1,nue a1nfo) fffffffffit you=Diue a1(i)nnfo) p',-awwwf! we are done n!-----------OT.ASSObL chec --- dnfo) p',-awwwf! If -TY;pE_PRECI isDrosideT-TY;curraG ; domain,Dassign itnfo) p',-awwwf! we are done n!-----------OT.ASSObL chec --- dnfo) p',-awwwfIF(s::)dim.EQ.3) THE- ffffffffffffffwwwf! we are done n!-----------OT.ASSObL chec --- ffffffffffffffwwwf! TTY;pE_PRECI isDroT-TY;closure-cOT-TY; domain ffffffffffffffwwwf! we are done n!-----------OT.ASSObL chec --- ffffffffffffffwwwfIF( ( xp(1,ipE_P).GE.min_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).GE.min_ (2,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(3,ipE_P).GE.min_ (3,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(1,ipE_P).LE.max_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).LE.max_ (2,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(3,ipE_P).LE.max_ (3,id �l) ) ) THE- ffffffffffffffwwwf wfIF( (xp(1,ipE_P).LT.max_ (1,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(2,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.&l) N i_heap',-awwwwwwwwwwwwwwww(xp(2,ipE_P).LT.max_ (2,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(4,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(4).NE. s::)pE_a--bcARf_periodic)).AND.&l) N i_heap',-awwwwwwwwwwwwwwww(xp(3,ipE_P).LT.max_ (3,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(6,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(6).NE. s::)pE_a--bcARf_periodic)) ) THE- ffffffffffffffwwwf wf --nt you=Dnt you+-1 ffffffffffffffu ffffffffst re_roc=(id �)u=Dnt yo ffffffffffffffu fffffELSE ffffffffffffffwwwf wf --nue a2 =-nue a2 +-1 ffffffffffffffu ffffffffiue a2(nue a2)f= ipE_P p',-aeffffffffu fffffENDIF fffffffffffu fffffELSE ffffffffffffffwwwf wfnue a2 =-nue a2 +-1 ffffffffffffffu fffffiue a2(nue a2)f= ipE_P p',-aeffffffffu ffENDwIF p',-awffu fffffELSEIF (s::)dim.EQ.2) THE- ffffffffffffffffffIF( ( xp(1,ipE_P).GE.min_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).GE.min_ (2,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(1,ipE_P).LE.max_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).LE.max_ (2,id �l) ) ) THE- heap',-awwwwwwwwwwwwwIF( (xp(1,ipE_P).LT.max_ (1,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(2,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.&l) N i_heap',-awwwwwwwwwwwwwwww(xp(2,ipE_P).LT.max_ (2,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(4,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(4).NE. s::)pE_a--bcARf_periodic))) THE- ffffffffffffffwwwf wf --nt you=Dnt you+-1 ffffffffffffffu ffffffffst re_roc=(id �)u=Dnt yo ffffffffffffffu fffffELSE ffffffffffffffwwwf wf --nue a2 =-nue a2 +-1 ffffffffffffffu ffffffffiue a2(nue a2)f= ipE_P p',-aeffffffffu fffffENDwIF p',-awffu ffffffffELSE ffffffffffffffwwwf wfnue a2 =-nue a2 +-1 ffffffffffffffu fffffiue a2(nue a2)f= ipE_P p',-aeffffffffu ffENDwIF p',-awffu fffffENDwIF p',-awffu ffEI--DOp! end loop(ovRRAremainTor pE_PsDroTiue a1nfo) ffffff! we are done n!-----------OT.ASSObL chec --- disul) NDp',---! C---T-TY;g wis (well, only if-nue a2 changed - decreased)l) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---IF (nue a2.NE.nue a1)fTHE- heap',-awwwwwwwnue a1 =-nue a2 heap',-awwwwwwwDO i=1,nue a1nfo) fffffffff Diue a1(i)u=Diue a2(i) fffffffffffu ffEI--DO p',-awffu ffEI-IF DDDDDDffffff! we are done n!-----------OT.ASSObL chec --- disul) NDp',---! Exit if--TY;g wi isDemptyl) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---IF (nue a1.EQ.0) EXIT p',-aefffENDwDOp! end loop(ovRRA sl) ND---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',! Check nedgwd inld All -TY;pE_PRECIsl) ND---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',IF (nue a2.GT.0) THE- ffffffffD fDroc= = s::)esent_fatal ffffffffD fD�loL s::)esent(s::)ese)pE_P_unass,'-::)),tsIp_m2p'- &l) N i_heap',-awwwwwwwwwwwwww'MAJOR PROBLEM',__LINE__,ioc=llwwwwwwwww wwGOTO 9999 ffffff ffENDwIF DDDDDD---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',! WnedsT-TY;saximum(numbRRGcOTpE_PRECIs pRRA domain fffffffff! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',max_parPnumbRR =D0l) NDp',DO idom=1,topo%n g wipwwwwwwwww wwIF(st re_roc=(id �).GE.max_parPnumbRR)fTHE- heap',-awwwwwwwmax_parPnumbRR =Dst re_roc=(id �) p',-awffu ffEI--IF p',-awffuEI--DO p',-awffuiopP = s::)pE_a--All __f DDDDDD DDldu(1) = topo%n g wipwwwwwwwwwldu(2) =amax_parPnumbRR DDDDDD---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',! All _ate;pE_PRECI g wi p',-aw---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',�loL s::)All _(g wi- ,ldu,iopP,ioc=llp',-aw wwIF(roc=.NE.0) THE- ffffffffD fDroc= = s::)esent_fatal ffffffffD fD�loL s::)esent(s::)ese)All _,'-::)),tsIp_m2p_3d'- N &l) N i_heap',-awwwwwwwwwwwwwww'pro gemDroTi,tsInal All _ather',__LINE__,ioc=llwwwwwwwww wwGOTO 9999 ffffff ffENDwIF DDDDDD---g wi- =D0l) NDp',! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',! I, hysszeT-TY;pE_PRECI g wi p',-awp',! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',nue a1 =D0l) NDp',DO ipE_P=1,Np p',-awfffffDnue a1 =Dnue a1 +-1 ffffffffffffiue a1(nue a1)f= ipE_P p',-aefffENDDO l) NDp',! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',! Loop(ovRRA-TY; domains (sinceT-TY;firwi domains are mori likelyl) ND ND! to be empty, we look backwards to reduceT-TY;numbRRGcOTegemaG sDrol) ND ND! nue a2Dansfari anstossi ge)l) NDp',! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',DO idom = topo%n g wi,1,-1 ffffffffffffid �l = topo%i g wi(id �)l) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---! loop(ovRRA-TY;remainTor pE_PRECIsl) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---nue a2D=D0l) NDp',---nt you=D0l) NDp',---DO i=1,nue a1nfo) fffffffffit you=Diue a1(i)nfo) fffffffff! we are done n!-----------OT.ASSObL chec --- dnfo) p',-awwwf! If -TY;pE_PRECI isDrosideT-TY;curraG ; domain,Dassign itnfo) p',-awwwf! we are done n!-----------OT.ASSObL chec --- dnfo) p',-awwwfIF(s::)dim.EQ.3) THE- ffffffffffffffffffIF( ( xp(1,ipE_P).GE.min_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).GE.min_ (2,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(3,ipE_P).GE.min_ (3,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(1,ipE_P).LE.max_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).LE.max_ (2,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(3,ipE_P).LE.max_ (3,id �l) ) ) THE- fffffffffffffffffffffIF( (xp(1,ipE_P).LT.max_ (1,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(2,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.&l) N i_heap',-awwwwwwwwwwwwwwww(xp(2,ipE_P).LT.max_ (2,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(4,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(4).NE. s::)pE_a--bcARf_periodic)).AND.&l) N i_heap',-awwwwwwwwwwwwwwww(xp(3,ipE_P).LT.max_ (3,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(6,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(6).NE. s::)pE_a--bcARf_periodic)) ) THE- ffffffffffffffwwwf wf --nt you=Dnt you+-1 ffffffffffffffu ffffffffg wi- (id �,npE_P)f= ipE_P p',-aeffffffffu fffffELSE ffffffffffffffwwwf wf --nue a2 =-nue a2 +-1 ffffffffffffffu ffffffffiue a2(nue a2)f= ipE_P p',-aeffffffffu fffffENDIF fffffffffffu fffffELSE ffffffffffffffwwwf wfnue a2 =-nue a2 +-1 ffffffffffffffu fffffiue a2(nue a2)f= ipE_P p',-aeffffff fffffENDwIF p',-awffu fffffELSEIF (s::)dim.EQ.2) THE- ffffffffffffffffffIF( ( xp(1,ipE_P).GE.min_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).GE.min_ (2,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(1,ipE_P).LE.max_ (1,id �l) .AND. &l) N i_heap',-awwwwwwwwwwwwwxp(2,ipE_P).LE.max_ (2,id �l) ) ) THE- heap',-awwwwwwwwwwwwwIF( (xp(1,ipE_P).LT.max_ (1,id �) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(2,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(2).NE. s::)pE_a--bcARf_periodic)).AND.&l) N i_heap',-awwwwwwwwwwwwwwww(xp(2,ipE_P).LT.max_ (2,id �l) .OR.N &l) N i_heap',-awwwwwwwwwwwwwwwww(topo% s_bc(4,id �l).EQ.1 .AND. N &l) N i_heap',-awwwwwwwwwwwwwwwwwbcARf(4).NE. s::)pE_a--bcARf_periodic))) THE- eap',-awwwwwwwwwwwwwwwwwnt you=Dnt you+-1 ffffffffffffffu ffffffffg wi- (id �,npE_P)f= ipE_P p',-aeffffffffu fffffELSE ffffffffffffffwwwf wf --nue a2 =-nue a2 +-1 ffffffffffffffu ffffffffiue a2(nue a2)f= ipE_P p',-aeffffffffu fffffENDwIF p',-awffu ffffffffELSE ffffffffffffffwwwf wfnue a2 =-nue a2 +-1 ffffffffffffffu fffffiue a2(nue a2)f= ipE_P p',-aeffffffffu ffENDwIF p',-awffu fffffENDwIF p',-awffu ffEI--DOp! end loop(ovRRA sl) ND--- ff! we are done n!-----------OT.ASSObL chec --- disul) NDp',---! C---T-TY;g wis (well, only if-nue a2 changed - decreased)l) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---IF (nue a2.NE.nue a1)fTHE- heap',-awwwwwwwnue a1 =-nue a2 heap',-awwwwwwwDO i=1,nue a1nfo) fffffffff Diue a1(i)u=Diue a2(i) fffffffffffu ffEI--DO p',-awffu ffEI- IF DDDDDDffffff! we are done n!-----------OT.ASSObL chec --- disul) NDp',---! Exit if--TY;g wi isDemptyl) NDp',---! we are done n!-----------OT.ASSObL chec --- disul) NDp',---IF (nue a1.EQ.0) EXIT p',-aefffENDwDO l) NDp',! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',! Check nedgwd inld All -TY;pE_PRECIsl) ND---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',IF (nue a2.GT.0) THE- ffffffffD fDroc= = s::)esent_fatal ffffffffD fD�loL s::)esent(s::)ese)pE_P_unass,'-::)),tsIp_m2p_3d'- &l) N i_heap',-awwwwwwwwwwwwww'MAJOR PROBLEM',__LINE__,ioc=llwwwwwwwww wwGOTO 9999 ffffff ffENDIF DDDDDD---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',! All _ate;andTalias -TY;we nn if-wd need -TYm. DDDDDD---! we are done n!-----------OT.ASSObL chec --- disuisul) NDp',max_parPnumbRR =D0l) NDp',DO idom = 1,topo%n g wipwwwwwwwww wwIF(st re_roc=(id �).GE.max_parPnumbRR)fTHE- heap',-awwwwwwwmax_parPnumbRR =Dst re_roc=(id �) p',-awffu ffEI--IF p',-awffuEI--DO p',-awELSE,! nowT-TY;caseGcOTonY; domainTonT-Tenstrocessnt)%adj_eNDwmax_parPnumbRR =Dnp p',-awfffiopP = s::)pE_a--All __f DDDDDD DDldu(1) = 1nfo) fff�loL s::)All _(st re_roc=,ldu,iopP,ioc=llp',-aw wwIF(roc=.NE.0) THE- ffffffffD fD�loL s::)esent(s::)ese)All _,'-::)),tsIp_m2p_3d'- N &l) N i_heap',-awwwwwwwwwwwwwww'pro gemDroTi,tsInal All _ather',__LINE__,ioc=llwwwwwwwww wwGOTO 9999 ffffff ffENDwIF ffffff ffst re_roc=(1) =amax_parPnumbRR DDDDDD DDldu(1) = 1nfo) fffldu(2) =amax_parPnumbRR fo) fff�loL s::)All _(g wi- ,ldu,iopP,ioc=llp',-aw wwIF(roc=.NE.0) THE- ffffffffD fD�loL s::)esent(s::)ese)All _,'-::)),tsIp_m2p_3d'- N &l) N i_heap',-awwwwwwwwwwwwwww'pro gemDroTi,tsInal All _ather',__LINE__,ioc=llwwwwwwwww wwGOTO 9999 ffffff ffENDwIF ffffff ffDO i=1,max_parPnumbRR fo) fff ffg wi- (1,i)u=Di p',-awffuEI--DO p',-awEI- IF p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! BeginnTor cOT-TY;computather p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! PE_PRECI quantity reset #if __MODE == __SCAnfo) DO ip=1,np p',-awfffup(ip)u=D0.0_mkn-awffuEI--DO #elif __MODE == __VECnfo) IF(lda.EQ.3) THE- fffffffffDO ip=1,np p',-awffffffup(1,ip)u=D0.0_mkn-awffuffffffup(2,ip)u=D0.0_mkn-awffuffffffup(3,ip)u=D0.0_mkn-awffufffEI--DO p',-awELSEIF(lda.EQ.5) THE- fffffffffDO ip=1,np p',-awffffffup(1,ip)u=D0.0_mkn-awffuffffffup(2,ip)u=D0.0_mkn-awffuffffffup(3,ip)u=D0.0_mkn-awffuffffffup(4,ip)u=D0.0_mkn-awffuffffffup(5,ip)u=D0.0_mkn-awffufffEI--DO p',-awELSE p',-awfffupu=D0.0_mkn-awffuEI--IF #endif p',-awSELECTD�lSE(kernel)nnfo) �lSE(s::)pE_a-- thh_kernel_mp4) #if __MODE == __SCAnfo) D�loL m2p_),tsIp_mp4(topoid,so hid,field_up,xp,up,dx,ghoribize,ioc=ll#elif __MODE == __VECnfo) D�loL m2p_),tsIp_mp4(topoid,so hid,field_up,lda,xp,up,dx,ghoribize,ioc=ll#endif p',-awClSE(s::)pE_a-- thh_kernel_bsp2) #if __MODE == __SCAnfo) D�loL m2p_),tsIp_bsp2(topoid,so hid,field_up,xp,up,dx,ghoribize,ioc=ll#elif __MODE == __VECnfo) D�loL m2p_),tsIp_bsp2(topoid,so hid,field_up,lda,xp,up,dx,ghoribize,ioc=ll#endif p',-awClSE DEFAULT p',-aefffroc= = s::)esent_esent)%adj_eNDD�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- N &l) N i'Only Mp4;andTBSp2 are avail. Usk p::) thh_reso h f CHohe kernelb.'- &l) N i_heap',-awwwwwwwwwww__LINE__,ioc=llwwwwwwEI--SELECTD!;kernel(oypen p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! DoG -deAll _ateTif some-Teor waG ;wrong,DasT-TY;arraysamaysnot eveunbe DDDDDD!DDassociated p',-aw! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDIF (roc=.NE.0) GOTO 9999 ffffff! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! DeAll _atherGcOT-TY;arrays.... ffffff! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDDiopP = s::)pE_a--deAll _ DDDDDDldu(1) = 0 p',-awCloL s::)All _(iue a1,ldu,iopP,ioc=llp',-awIF (roc=.NE.0) THE- ffffffffDroc= = s::)esent_esent)%adj_eNDD�loL s::)esent(s::)ese)deAll _- &l) N i_heap',-awwwww's::)),tsIp_m2p'- &l) N i_heap',-awwwww'sbDroTiue a1-deAll _ather',__LINE__,ioc=llwwwwwwwwwGOTO 9999 ffffffENDwIF p',-aw�loL s::)All _(iue a2,ldu,iopP,ioc=llp',-awIF (roc=.NE.0) THE- ffffffffDroc= = s::)esent_esent)%adj_eNDD�loL s::)esent(s::)ese)deAll _- &l) N i_heap',-awwwww's::)),tsIp_m2p'- &l) N i_heap',-awwwww'sbDroTiue a2-deAll _ather',__LINE__,ioc=llwwwwwwwwwGOTO 9999 ffffffENDwIF p',-aw�loL s::)All _(st re_roc=,ldu,iopP,ioc=llp',-awIF (roc=.NE.0) THE- ffffffffDroc= = s::)esent_esent)%adj_eNDD�loL s::)esent(s::)ese)deAll _- &l) N i_heap',-awwwww's::)),tsIp_m2p'- &l) N i_heap',-awwwww'sbDroTiue a2-deAll _ather',__LINE__,ioc=llwwwwwwwwwGOTO 9999 ffffffENDwIF p',-aw�loL s::)All _(g wi- ,ldu,iopP,ioc=llp',-awIF (roc=.NE.0) THE- ffffffffDroc= = s::)esent_esent)%adj_eNDD�loL s::)esent(s::)ese)deAll _- &l) N i_heap',-awwwww's::)),tsIp_m2p'- &l) N i_heap',-awwwww'sbDroTiue a2-deAll _ather',__LINE__,ioc=llwwwwwwwwwGOTO 9999 ffffffENDwIF ffffff! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! Return ffffff! we are done n!-----------OT.ASSObL chec --- disuch: So 9999DD�ONTINUE p',-aw�loL -top('-::)),tsIp_m2p'-t0,ioc=llp',-awRETURN p',-aw�ONTAINS DDDDDDSUBROUTINE check ffffffffIF (.NOT. s::)), hysszed) THE- ffffffffD fDroc= = s::)esent_esent)%adj_eNDDNDD�loL s::)esent(s::)ese)s::)no), ,'-::)),tsIp_m2p'- &l) N i_heap',-awwwww'Please cAll s::)), ;firwi!',__LINE__,ioc=llwwwwwwwww wwGOTO 8888lwwwwwwwwENDIF ffffffffIF (Np .GT. 0) THE- fffffffffffIF (SIZE(xp,2) .LT. Np) THE- ffffffffD fDroc= = s::)esent_esent)%adj_eNDDNDD�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- &l) N i_heap',-awwwwwwwwwww'not enoughTpE_PRECIs coG ainodsPunxp',__LINE__,ioc=llwwwwwwwww wwGOTO 8888lwwwwwwwwwwwENDIF fffffffffffIF (SIZE(xp,1) .LT.dim) THE- ffffffffD fDroc= = s::)esent_esent)%adj_eNDDNDD�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- &l) N i_heap',-awwwwwwwwwww'leadTor dimensherGcOTxpDrosufficiaG ',__LINE__,ioc=llwwwwwwwww wwGOTO 8888lwwwwwwwwwwwENDIF ffffffffENDIF ffffffffIF (Np .LE. 0) THE- fffffffffffIF (Np .LT. 0) THE- fffffffffffDroc= = s::)esent_esent)%adj_eNDDNDD�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- &l) N i_heap',-awwwwwwwwwww'pE_PRECIs must be specified',__LINE__,ioc=llwwwwwwwww wwGOTO 8888lwwwwwwwwwwwENDwIF p',-awffu fGOTO 8888lwwwwwwwwEND IF ffffffffIF ((kernel.LT.1).OR.(kernel.GT.4)) THE- eap',-awwwwroc= = s::)esent_esent)%adj_eNDDND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- &l) N i_heap',-awwwwwwwwwww'wrong;kernel(def), her',__LINE__,ioc=llwwwwwwwww wGOTO 8888lwwwwwwwwEND IF ffffffffkernel_supporP = s::) thh_kernelbsze(kernel)*2 ffffffffIF(.NOT.((kernel_supporP.EQ.2).OR.(kernel_supporP.EQ.4) &l) N i_heap',-awwwww.OR.(kernel_supporP.EQ.6))) THE- eap',-awwwwroc= = s::)esent_esent)%adj_eNDDND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- &l) N i_heap',-awwwwwwwwwww'wrong;kernel(supporP',__LINE__,ioc=llwwwwwwwww wGOTO 8888lwwwwwwwwEND IF ffffffff�loL s::)check_topoid(topoid,lok,ioc=llwwwwwwwwIF (.NOT.lok) THE- eap',-awwwwroc= = s::)esent_esent)%adj_eNDDND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- &l) N i_heap',-awwwwwww'topo_id isDrovyssd!',__LINE__,ioc=llwwwwwwwww wGOTO 8888lwwwwwwwwENDIF ffffffff�loL s::)check_so hid(topoid,so hid,lok,ioc=llwwwwwwwwIF (.NOT.lok) THE- eap',-awwwwroc= = s::)esent_esent)%adj_eNDDND�loL s::)esent(s::)ese)Ae thaG ,'s::)),tsIp_m2p'- &l) N i_heap',-awwwwwww'so h_id isDrovyssd!',__LINE__,ioc=llwwwwwwwww wGOTO 8888lwwwwwwwwENDIF f8888 DD�ONTINUE p',-awEI--SUBROUTINE check #if __DIME == __2D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE m2p_ss_2d #elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE m2p_ds_2d #endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE m2p_sv_2d #elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE m2p_dv_2d #endif #endif #elif __DIME == __3D #if __MODE == __SCAn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE m2p_ss_3d #elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE m2p_ds_3d #endif #elif __MODE == __VECn#if __KII--== __SINGLE_PRECISION DDDDD-EI--SUBROUTINE m2p_sv_3d #elif __KII--== __DOUBLE_PRECISION DDDDD-EI--SUBROUTINE m2p_dv_3d #endif #endif #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libs::-1.2.1/src/),tsIpolate/test/������������������������������������������������������������������0000755�0001752�0001753�00000000000�11616003523�017250� 5����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libs::-1.2.1/src/),tsIpolate/test/s::)test)),tsIp_m2p.f���������������������������������������������0000644�0001752�0001753�00000021024�11616003523�023410� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������DDDDD-! we are done n!-----------OT.ASSObL chec --- dddddddddd wwwwww! Test Case DD:i_heap',-awwwwwww s::)test)),tsIp_m2p ffffff! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! C---r n (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), DDDDDD!DDDDDDDDDDDDDDDDDDDDCe,tsI ! CHFluid Dynamics (DTUll) ND!l) ND!l) ND! icensfilo enst youcOT-TY;Parallel(PE_PRECI Mo h Library (PPM).l) ND!l) ND! PPM ensfred inftware: you can redistributo etm--S/ CHmodifyl) ND! etmunARRANTY;tsImsucOT-TY;GNU LessRRAGeneral P g c License DDDDDD!Danst g whed b-- FORFred Snftware Foun---her, eihe DDDDDD!DversherG3ucOT-TY;License, CH(at your op-her)m--y late DDDDDD!Dversher.l) ND!l) ND! PPM ensdistributodsPun-TY;hopes nedgetmwill-bL(useful,l) ND! but WITHOUT ANY WARRANTY;mwithout eveun-TY;implied warrantyAtp://wwwD! MERCHANTABILITY CHFITNESS FOR A PARTICULAR PURPOSE. Sees ne://wwwD! GNU General P g c License f CHmore details.l) ND!l) ND! You should have received a c----cOT-TY;GNU General P g c License DDDDDD!DandT-TY;GNU LessRRAGeneral P g c License aloor with PPM. If not,l) ND! sees<http://www.gnu.org/licenses/>.l) ND!l) ND! Parallel(PE_PRECI Mo h Library (PPM)l) ND! ETH Zurich DDDDDD! CH-8092 Zurich, Switzerland DDDDDD! we are done n!-----------OT.ASSObL chec --- disuch: So program s::)test)),tsIp_m2p DDDDusk p::)module_core DDDDusk p::)module_oypedef p',-usk p::)module_mktopo DDDDusk p::)module_oopo_get ) usk p::)module_),tsIp_m2p ffffusk p::)module_),tsIp_p2m ffffusk p::)module_),it ) usk p::)module_finyssze p',-usk p::)module_map ffffUSE s::)module_--- - thh p',-USE s::)module_--- -so h p',-implicetmnonenn#include "../../s::)def),e.h"n#ifdef __MPIlp',-awINCLUDEw'spif.h' #endif nDDDD),tsger, pE_a-ete :: debug = 0 p',-),tsger, pE_a-ete :: MK = s::)kind_do gel real(mk),pE_a-ete :: pi = 3.1415926535897931_mkn-awf),tsger :: ndim,nspecn-awf),tsger :: decompn-awf),tsger :: assign-awf),tsger :: tolexp p',-real(MK) :: toln-awf),tsger :: ioc= p',-),tsger :: topoid,so hid p',-),tsger, pE_a-ete :: ngrid = 2383 p',-),tsger, pE_a-ete :: npgrid = 3029 p',-real(MK),dimensher(:,:),poi,tsI :: xp,wp p',-real(MK),dimensher(: ),poi,tsI :: min_phys,max_phys,len_phys,h,p_h p',-),tsger, dimensher(: ),poi,tsI :: ghoribize p',-),tsger :: i,j,ai,aj,p_i p',-),tsger, dimensher(6) :: bcARfnfo) real(MK),dimensher(: ),poi,tsI :: cowipwwww),tsger, dimensher(:,:),poi,tsI :: i-tE_P,n--- p',-),tsger, dimensher(: ),poi,tsI :: nm p',-real(MK),dimensher(:,:),poi,tsI :: mrosub,maxsub p',-),tsger, dimensher(: ),poi,tsI :: sub2trocn-awf),tsger :: np,mpn-awf),tsger, pE_a-ete :: kernel(= s::)pE_a-- thh_kernel_mp4 DDDDreal(MK),dimensher(:,:,:,: ), poi,tsI :: field_wpD! 2d field_up(ldn,i,j,i )l) !real(MK),dimensher(:,:,:,:,:),)poi,tsI :: field_upD! 3d field_up(ldn,i,j,k,i )l) real(MK),dimensher(: ),poi,tsI :: field_xl real(mk),dimensher(2) :: xl oype(s::)t_topo),)poi,tsI :: topo DDDDreal(MK) :: maxm3n-awf),tsger, pE_a-ete :: nmom = 10 p',-),tsger, dimensher(2,nmom) :: alphal) real(MK),dimensher(nmom) :: f)momaG s, s-sohaG s p',-real(MK),dimensher(2) :: sigma,mul) ! --- disuch: So DDDD! setup p',-! --- disuch: So DDDDtol = 10.0_mk**-6 !100000.0_mk*epsilon(1.0_mk) DDDDtolexpu=Dint(log10(tol))nfo) ndim = 2 ffffnspec = 1nfo) --- ((alpha(ai,aj),)ai=1,2),)aj=1,nmom) /0,0, 1,0, 0,1, 2,0, 0,2- &l) i_heap',-awwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww1,1, 3,0, 0,3, 2,1, 1,2/ nDDDDAll _ate(len_phys(ndim),min_phys(ndim),max_phys(ndim),ghoribize(ndim),&l) i_heap',-nm(ndim),h(ndim),p_h(ndim),field_x(ndim),-tEt=ioc=lll) doge=1,ndiml) NDDDmin_phys(i)u=D0.0_mkn-awffuffmax_phys(i) = 10.0_mkn-awffuffghoribize(i) = 2 fffffffflen_phys(i) =amax_phys(i) --min_phys(i) ffffenddo DDDDbcARf(1:6)(= s::)pE_a--bcARf_periodicll) nullify(xp)l) nullify(wp)ln#ifdef __MPIlp',-cAll MPI_I, (ioc=ll#endif lp',-cAll s::)), (ndim,MK,tolexp,0,debug,ioc=,99lll) ! --- disuch: So DDDD! creatY;pE_PRECIsl) ! --- disuch: So DDDDnp =Dnpgrid**2 ffffmpu=D0 nDDDDAll _ate(xp(ndim,np),wp(nspec,np),-tEt=ioc=llDDDDxpu=D0.0_mkn-awfwpu=D0.0_mkn nDDDDAll _ate(nm(ndim),-tEt=ioc=llDDDDdoge=1,ndiml) NDDDnm(i) =angrid ffffenddo lDDDDdoge=1,ndiml) NDDDp_h(i) =a(max_phys(i) --min_phys(i)) /-real(npgrid,mk) DDDDenddo lDDDDdogj=1,npgrid ffffDDDDdoge=1,npgrid ffffDDDDNDDDp_i = i + (j-1)*npgrid ffffDDDDNDDDxp(1,p_i) =areal(i-1,mk)*p_h(1) ffffDDDDNDDDxp(2,p_i) =areal(j-1,mk)*p_h(2) ffffDDDDenddo DDDDenddo lDDDD! --- disuch: So DDDD! make(topologylDDDD! --- disuch: So DDDDdecomp = s::)pE_a--decomp_user)def),ed ffffassig = s::)pE_a--Assign_user)def),ed DDDDtopoid = 0 p',-so hid = -1 nDDDDAll _ate(mrosub(ndim,1),maxsub(ndim,1),sub2troc(1),cowi(1),-tEt=ioc=lll) cowi(1) = 1.0_mkll) doge=1,ndiml) NDDDmin (i,1)=min_phys(i) ffffffffmaxsub(i,1)=max_phys(i) DDDDenddo lDDDDsub2troc(1)u=D0 nDDDDcAll s::)mktopo(topoid,so hid,xp,np,decomp,Assig,min_phys,max_phys,bcARf- &l) i_heap',-awwwwwghoribize,cowi,i-tE_P,n--- ,nm,ioc=,user)min =mrosub, &l) i_heap',-awwwwwuser)maxsub=maxsub,user)n s=1,user)sub2troc=sub2troc) nDDDDAll _ate(field_wp(nspec,(1-ghoribize(1)):(n--- (1,1)+ghoribize(1)),',-awwwww&l) i_heap',(1-ghoribize(2)):(n--- (2,1)+ghoribize(2)),1),-tEt=ioc=lD! 2dlDDDD!All _ate(field_wp(nspec,n--- (1,1),n--- (2,1),n--- (3,1),1),-tEt=ioc=lD! 3d DDDDfield_wpD=D0.0_mkn ) doge=1,ndiml) NDDDh(i) =a(max_phys(i) --min_phys(i)) /-real(n--- (i,1)-1,mk) ffffenddo DDDD! --- disuch: So DDDD! setup-so h --- p',-! --- disuch: So l) doge=1,ndiml) NDDDmu(i)u=D0.0_mk !(max_phys(i) --min_phys(i))/2.0_mkn-awfenddo DDDDsigma = 2.5_mkn ) dogj=1,n--- (2,1) ffffDDDDdoge=1,n--- (1,1) ffffDDDDNDDDfield_x(1) =amin_phys(1) + h(1)*real(i-1,mk) ffffDDDDNDDDfield_x(2) =amin_phys(2) + h(2)*real(j-1,mk) ffffDDDDNDDDfield_wp(1,i,j,1)u=D0.0001_mk/(2.0_mk*pi*sigma(1)*sigma(2))*&l) i_heap',-awwwwwwwexp(-0.5_mk*(((field_x(1)-mu(1))**2/sigma(1)**2)+ &l) i_heap',-awwwwwwwwwwwwwwwwwwww((field_x(2)-mu(2))**2/sigma(2)**2))) ffffDDDDenddo DDDDenddo lDDDDprint *, 'f), whed ), hysszather' lDDDcAll s::)map_field_ghori_get(topoid,so hid,ghoribize,ioc=llDDDcAll s::)map_field_push(topoid,so hid,field_wp,1,ioc=llDDDcAll s::)map_field_send(ioc=llDDDcAll s::)map_field_pop(topoid,so hid,field_wp,1,ghoribize,ioc=lllDDDD! --- disuch: So DDDD! m --> p p',-! --- disuch: So DDDDcAll s::)),tsIp_m2p(topoid,so hid,xp,np,wp,1,kernel,ghoribize,field_wp,ioc=lllDDDD! --- disuch: So DDDD! test m --> p p',-! --- disuch: So DDDDf)momaG su=D0.0_mkn-awfp)momaG su=D0.0_mkn-awfdogp_i = 1,np p',-awffx = xp(:,p_i) p',-awffif (xp(1,p_i).ge.len_phys(1)) x(1) = xp(1,p_i) - len_phys(1) p',-awffif (xp(2,p_i).ge.len_phys(2)) x(2) = xp(2,p_i) - len_phys(2) ffffDDDDdogaj = 2,nmom ffffDDDDNDDDp_momaG s(aj) =Dp_momaG s(aj) + &l) i_heap',-awwwwwwwwwwwwp_h(1)*p_h(2)*wp(1,p_i)*x(1)**alpha(1,aj)* &l) i_heap',-awwwwwwwwwwwwx(2)**alpha(2,aj) ffffDDDDenddo DDDDNDDDp_momaG s(1) =Dp_momaG s(1) + wp(1,p_i)*p_h(1)*p_h(2)n-awfenddo DDDDdogj=1,n--- (2,1)-1 ffffffffdoge=1,n--- (1,1)-1nfo) ffffffffffield_x(1) =amin_phys(1) + h(1)*real(i-1,mk) ffffDDDDNDDD DDfield_x(2) =amin_phys(2) + h(2)*real(j-1,mk) ffffDDDDNDDD ffx = field_xl if (field_x(1).ge.len_phys(1)) x(1) = field_x(1) - len_phys(1) p',-awff if (field_x(2).ge.len_phys(2)) x(2) = field_x(2) - len_phys(2) ffffDDDDfffffffdogaj = 2,nmom ffffDDDDNDDDNDDD DDf_momaG s(aj) =Df_momaG s(aj) + &l) i_heap',-awwwwwwwwwwwwh(1)*h(2)*field_wp(1,i,j,1)*x(1)**alpha(1,aj)* &l) i_heap',-awwwwwwwwwwwwx(2)**alpha(2,aj) ffffDDDDDDDDenddo DDDDNDDDD DDf_momaG s(1) =Df_momaG s(1) + field_wp(1,i,j,1)*h(1)*h(2) ffffDDDDenddo DDDDenddo lDDDDdogaj = 1,6 p',-awffif (abs(p_momaG s(aj) -Df_momaG s(aj)) .GT. tol)T-TYn ffffffffffffprint *, 'failed at momaG : ',)aj ffffffffffffprint *, 'pE_PRECI momaG s: ',s-sohaG s p',-ffffffffprint *, 'field momaG s: ', DDf_momaG s p',-ffffffff-top 'ERROR: m2p ),tsIpolather: momaG ssnot conserved.' ffffDDDDendif p',-enddo llDDDD! --- disuch: So DDDD! teardown... ffff! --- disuch: So DDDDprint *, 'ECIanTor up' 8000 coG inue nDDDDcAll s::)finyssze(ioc=lln#ifdef __MPIlp',-cAll MPI_Finyssze(ioc=ll#endif p',- DDDDdeAll _ate(xp,wp,field_wp,min_phys,max_phys,ghoribize,nm) lDDDDprint *, 'done.' end program s::)test)),tsIp_m2p ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libs::-1.2.1/src/),tsIpolate/test/s::)module_),tsIp_p2m.fun�����������������������������������������0000644�0001752�0001753�00000033273�11616003523�024272� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test)suitk p::)module_),tsIp_p2m ln#ifdef __MPIlp',-INCLUDEw"spif.h" #endif nDDDD),tsger, pE_a-ete :: debug = 0 p',-),tsger, pE_a-ete :: mk = kind(1.0d0) !kind(1.0e0)n#ifdef __MPIlp',-),tsger, pE_a-ete :: comm = spi_comm_worldl#endif p',-),tsger :: ndim p',-),tsger :: nspecn-awf),tsger :: rankn-awf),tsger :: ntrocn-awf),tsger :: decompn-awf),tsger :: assign-awf),tsger :: tolexp p',-real(mk) :: toln-awf),tsger :: ioc= p',-),tsger :: topoid,so hid p',-real(mk),dimensher(:,:),poi,tsI :: xp => NULL() p',-real(mk),dimensher(:,:),poi,tsI :: wp => NULL() p',-real(mk),dimensher(: ),poi,tsI :: min_phys => NULL() p',-real(mk),dimensher(: ),poi,tsI :: max_phys => NULL() p',-real(mk),dimensher(: ),poi,tsI :: h => NULL() p',-),tsger, dimensher(: ),poi,tsI :: ghoribize => NULL() p',-),tsger :: i,j,k,p_i,ai,aj,it,i p',-),tsger, dimensher(: ),poi,tsI :: bcARf => NULL() p',-real(mk),dimensher(: ),poi,tsI :: cowi => NULL() p',-),tsger, dimensher(:,:),poi,tsI :: i-tE_P => NULL() p',-),tsger, dimensher(:,:),poi,tsI :: n--- => NULL() p',-),tsger, dimensher(: ),poi,tsI :: nm => NULL() p',-),tsger :: np,mpn-awf),tsger :: kernel p',-real(mk),dimensher(:,:,:,: ), poi,tsI :: field_wp2 => NULL()! field_wp(ldn,i,j,i )l) real(mk),dimensher(:,:,:,:,:),)poi,tsI :: field_wp3 => NULL()! field_wp(ldn,i,j,k,i )l) real(mk),dimensher(: ),poi,tsI :: field_x => NULL() p',-real(mk) :: maxm3n-awf),tsger :: seedbize p',-),tsger, Ddimensher(:),All _atabCI :: seed ffff! --- TTY;foll wTor variabCIs are needed f CHtestTor -TY;somaG s p',-),tsger, pE_a-ete :: nmom2 = 10 p',-),tsger, pE_a-ete :: nmom3 = 19 p',-),tsger, dimensher(2,nmom2) :: alpha2 p',-),tsger, dimensher(3,nmom3) :: alpha3l) real(mk),dimensher(nmom2) :: f)momaG s2, f)mom_global2, s-sohaG s2l) real(mk),dimensher(nmom3) :: f)momaG s3, f)mom_global3, s-sohaG s3 lDDDDd-- ((alpha2(ai,aj),)ai=1,2),)aj=1,nmom2) /0,0, 1,0, 0,1, 2,0, 0,2- &l) i_heap',-awwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww1,1, 3,0, 0,3, 2,1, 1,2/ DDDDd-- ((alpha3(ai,aj),)ai=1,3),)aj=1,nmom3) /0,0,0- &l) i_heap',-awwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww1,0,0, 0,1,0, 0,0,1, &l) i_heap',-awwwwwwwwwwww2,0,0, 0,2,0, 0,0,2,w1,1,0, 0,1,1, 1,0,1, &l) i3,0,0, 0,3,0, 0,0,3, 0,1,2, 0,2,1, 1,2,0, 1,0,2, 2,1,0, 2,0,1/ ! we are done n!------ ), Htestsuit we are done n!------ disuch: So DDDD),it ) usk p::)module_--- ) tol = 100.0_mk*epsilon(1.0_mk) DDDD tolexpu=Dint(log10(epsilon(1.0_mk)))nnfo) p'All _ate(mro_phys(3),max_phys(3),ghoribize(3),&l) ) i_heap',-nm(3),h(3),field_x(3),-tEt=ioc=llln#ifdef __MPIlp',-aw,-cAll spi_comm_rank(comm,rank,ioc=llwwwwwwwwcAll spi_comm_bize(comm,ntroc,ioc=ll#else DDDDDD ntroc = 1nfo) ffrank = 0 #endif nDDDDend ),it ! we are done n!-----------OT.ASSObL chec --- disuch: Soh: So ! we are done n!----- finysszeHtestsuit we are done n!------ disuch: DDDDfinyssze ffffffffdeAll _ate(mro_phys,max_phys,ghoribize,nm) lDDDDend finyssze ! we are done n!-----------OT.ASSObL chec --- disuch: Soh: So ! we are done n!---------- test setup-hec --- disuch: Soh: So DDDDsetup p',----- DDDDDD nullify(xp)l) DD nullify(wp)l) DD nullify(field_wp2)l) DD nullify(field_wp3)l) DD nullify(cowi)nnfo) p'np =D400*ntrocn-awfffffmpu=D0 p',----- DDDDDD cAll random_seed(bize=seedbize)nfo) p'All _ate(seed(beedbize)) ffffDDDDdoge=1,seedbize p',---------seed(i)=10+i*i*(rank+1) ffffDDDDenddo DDDDDD cAll random_seed(put=seed) lDDDDend setup ! we are done n!-----------OT.ASSObL chec --- disuch: Soh: So p',----- ! we are done n!------- test teardown-hec --- disuch: Soh: So DDDDteardown p',----- DDDDDD usk p::)module_finyssze DDDDDD cAll s::)finyssze(ioc=llp',----- DDDDDD deAll _ate(xp,wp,-tEt=ioc=llDDDDDD deAll _ate(field_wp2,field_wp3,-tEt=ioc=llDDDDDD deAll _ate(seed) DDDDDD deAll _ate(cowi)nDDDDDD deAll _ate(bcARf) lDDDDend h: Soh: SvE_ate(seed) DDDDDD deAll _ate(cowi)nDDDDDD deAll--- donep2mf),t_2dp',----- ! we are done SSObL chec --- ! we are done DDDh(i) =--- ! we are done disuch: So--- ! we are done St)),tsIp_m2p--- ! we are done oypedef p',-usk--- ! we are done oy,0, 1,0,2, 2,1,0, 2,0,1/ !opo_get ) u--- ! we are done ap------ tes usk p::)modul---- tes maG s p',-),tsger, heap',-awwwwwp(ldn,nDDDh(i) =--- ),tsger, dimensher(:,:), ),poi,tsI :: n!--:,:,:),)poi,tsI--- ),tsger : com n!-----------etup p',-! ------e disuch: So lDDDDDD deAll(2*ffffmoi,tsI--- ffmax_ph2*ffffm(i) = 10.0_mkn-awffl) spacul---- tesr(: ),poi,tsI :: sub2trocn-awf),tsger s(i)) /-real(n--- (iiiiim),ghoribize(ndim),&l) i_heiiiimp',-nm(ndim),him),&l) i_heiiii),field_x(ndim),-tEt=ioc=seedbize)nfo) ----- test teardow_a--bcARf_mkriodicll) nullify(xp)l)fo) ----- tesoc=,99lll) ! --- disuch: So DDDD! creatY;pE_PR test teall _atew'pro e are done disuch: So DDDDnp p ),tsIpolather: momaG pi-1,mk)*p_h(1) ffff p ),tsIpolather: momaG al(j-1,mk)*p_h(2) ffffDDDDcubo_phys(i)) /DDDD! --- disuch: So DDDDffffffffare done ! --- disuchiiiim So DDDDdeco usk p::)modu*2 ffffmpu=D0 nDDDDAll _ s(i)) /-real(n--- (iiiiispec,np)16 DD nullify(w,aj) ffffDD test teardowml) NDDDmin (i,1)=min_phys(i) ffffffffmaxsub(i,1)=max_ teson(1.0_mk) DDDD tttttttphys(ioc(1)u=D0 nDDDDpo(topo --- disuch: St teardowSt)),tsIi_heapwwwwDDDmin (i,1)po(tAll s::)mktodn,nDDDhlon(1.0_mk) DDDD ttttttt: n!--,i ge)l) .0_mk))) usk p::)modudule_finy=mrosub, &l) i_heap'dn,nDDDh(user)maxsub=maxsub,on(1.0_mk) DDDD troc=sub2troc) nDDdn,nDDDh(2e(field_wp(nspeci ge)l) ilon(1.0_mk) DDDD -ghoribize(1)):(All _ s(i)) /-real(n--- (iiiiid_wp(nspec,n--- (1,1),n--- (2,1),n--- (3,1),1),-tEt=ioc=lD! 3d fy(w,aj) ffffDD test teardowmap- disnmom2)wDDDmin =min_pibize(1)pos)%adjsfffDD test teardowmap- dis'f), rdoch: So Dpibize( ge=1,trengthsfffDD test teardowmap- dis(topo :: npibize( geeeeeee=1,nndfffDD test teardowmap- dis'op rdoch: So Dp npibize( =1,trengthsfffDD test teardowmap- dis'op =min! --- : npibize( g1)pos)%adjsfffDD tesy(xp)mp-- dn,i,e(ndim),&l) i_heDD! --fffffup(2,ip)u=D0.p ),tsIpolather: momaG eeee=1pAll smup(2,ip)u=D0.p ),tsIpolather: momaG eeeew(npgrid,mk)him),&l) i_heiiiild_pop(topoid,so p'd,field_wp,1,ghoribize,ioc=lllDDDD! --- di&l) i_heiiiiaj=1,nmom3) dule_finysDDDD! m -->ip)u=D0.p ),tsIpolather: momaG eeee=1 donepAll smup(2,ip)u=D0.p ),tsIpolather: momaG eeeeer(2,nmom2e(ndim),&l) i_heiiiipr(2,nmom2e(ndim),&l) i_heiiiis(i) we n!-----------OT.Aiwwwwww--------OTwp,-tEt=iociiiis(iDDendoc=sub2troc) , **alpha(! fie(field_wp(nsp,-tEt=iociiiiiiiis(i)Dendoc=sub2troc,(1-ghori1(! fie(field_wp(nj-1,mk) ffffDDDDND dule_f) + wp(1,p_i)*p_h(1)*p_h(2)n-awfenddo DDDDdogj=1,n--- dule_f) ffffffffdoge=1,n--- (1,1)-1nfo) ffffffffffield_x(1iiiiis(iDDDenddl(mk)ffffffffield_x(1iiiii dr(2,nmom2(2).ge.len_phys(22)) x(2dule_finy=1 * &ffffffffield_x(1iiiii aj=1,nmom3dule_f) + s(aj) +2DDDNDDDdule_f) ffs(aj) +2D&l) i_heap',-awwwwwwwwwwwwwwwwwwwwh(1)*h(2)*wwwwwwwwwwwwh(1)*h(2)*wwwwwwwwh(1)*h(2)*wwwwwwnnfo) p'All _ate(mrrrrr i_heap ioop(ov(er(2,nmom2) :: alpha2 l(mk),rdowmeapdif ,! --SUMi&l) i_heiiiiaj=1,nmom3) (3),f(3),-tEt=ioc=llln#if dr(2,: alpha2ge.len_phys(2oc=ll#elif __MMMMMMMs(iDDDenddl(mk)ffffffffield_x(1ipr(2,nmom2(2).ge.kn-awfp)ms(aj) +2DDDNDDDwffif (xps(aj) +2D&l) i_heap',-awwwwwwwwwwwwh(1)*h(2)*DDDDDDenddo DDDDNDDDDDDDDDDDatailt_equal_havein(dr(2,: alpha2(2).,pr(2,nmom2(2).riod) --- D DDf_molen_phys(2)) x-f (xp(2,p_i).gld_wp(1,i,j,1)*h( --- disuf (abs(p_momaG s(ajpos:g wi- test m --> --- disuf (abs(p_mDDDDenddo lDDDDdogaj = 1 --- disuf (abs(p_mDffprint *, 'failed at momaG : --- disuf (abs(p_momaG s(aj) -Df_momaG s(aj)) .G --- disufffffffprint p''pE_PRECI momaG s: ',s-sohaG s p',-fffff --- =ll#elif __MMMMMMMwwwwww -DDDDDDen7,10 --- D DDf_molen_phys(2)) x-f (xp(2,p_i).gld_wp(1dn,i,j,1)*h( --- disudn,i,e(nf_molen_phys(2)) x-f (xp(2,p_i).glf --- =ll#el! --- =llwwwwwh(1)*h(2)*w(npgrid,mk)dim),&l) i_he,aj) ff! -f (abs(p_mMaximum 3rrint *, difference---h^3iledn,i,/h**3 --- disucield_ws,ioc=llwwwwwwwwcAll spi_comm_bize(comm,ntroc,ioc=ll#else DDDDDD ntroc = 1nfo) ffate(bcARf) lDDDDend h: Soh: SvE_ate(seed) DDDDDD deAll _ate(cowi)nDDDDDD deAll--- donep2mf),t_3dp',----- ! we are done SSObL chec --- ! we are done DDDh(i) =--- ! we are done disuch: So--- ! we are done St)),tsIp_m2p--- ! we are done oypedef p',-usk--- ! we are done oy,0, 1,0,2, 2,1,0, 2,0,1/ !opo_get ) u--- ! we are done ap------ tes usk p::)modul---- tes maG s p',-),tsger,3heap',-awwwwwp(ldn,nDDDh(i) =--- ),tsger, dimensher(:,:), ),poi,tsI :: n!--:,:,:),)poi,tsI--- ),tsger : com n!--------------------etup p'3 --- e disuch: So lDDDDDD deAll(2*ffffmoi,tsI--- ffmax_ph2*ffffm(i) = 10.0_mkn-awffl) spacul---- tesr(: ),poi,tsI :: sub2trocn-awf),tsger s(i)) /-real(n--- (iiiiim),ghoribize(ndim),&l) i_heiiiimp',-nm(ndim),him),&l) i_heiiii),field_x(ndim),-tEt=ioc=seedbize)nfo) ----- test teardow_a--bcARf_mkriodicll) nullify(xp)l)fo) ----- tesoc=,99lll) ! --- disuch: So DDDD! creatY;pE_PR test teall _atew'pro e are done disuch: So DDDDnp p ),tsIpolather: momaG pi-1,mk)*p_h(1) ffff p ),tsIpolather: mger sl(j-1,mk)*p_h(2) ffffDDDDcubo_phys(i)) /DDDD! --- disuch: So DDDDffffffffare done ! --- disuchiiiim So DDDDdeco usk p::)modu*2 ffffmpu=D0 nDDDDAll _ s(i)) /-real(n--- (iiiiispec,np)16 DD nullify(w,aj) ffffDD test teardowml) NDDDmin (i,1)=min_phys(i) ffffffffmaxsub(i,1)=max_ teson(1.0_mk) DDDD tttttttphys(ioc(1)u=D0 nDDDDpo(topo --- disuch: St teardowSt)),tsIi_heapwwwwDDDmin (i,1)po(tAll s::)mktodn,nDDDhlon(1.0_mk) DDDD ttttttt: n!--,i ge)l) .0_mk) --- d) usk p::)modudule_fin3=mrosub, &l) i_heap'dn,nDDDh(user)maxsub=maxsub,on(1.0_mk) DDDD troc=sub2troc) nDDdn,nDDDh(2e(field_wp(nspec,on(1.0_mk) DDDD troc=sub2troc3 nDDdn,nDDDh(3e(field_wp(n3peci ge)l) ilon(1.0_mk) DDDD :(n--- (2,1)+ghoribiz s(i)) /-real(n--- (iiiiid_wp(nspec,n--- (1,1),n--- (2,1),n--- (3,1),1),-tEt=ioc=lD! 3d fy(w,aj) ffffDD test teardowmap- disnmom2)wDDDmin =min_pibize(1)pos)%adjsfffDD test teardowmap- dis'f), rdoch: So Dpibize( ge=1,trengthsfffDD test teardowmap- dis(topo :: npibize( geeeeeee=1,nndfffDD test teardowmap- dis'op rdoch: So Dp npibize( =1,trengthsfffDD test teardowmap- dis'op =min! --- : npibize( g1)pos)%adjsfffDD tesy(xp)mp-- dn,i,e(ndim),&l) i_heDD! --fffffup(2,ip)u=D0.p ),tsIpolather: momaG eeee=1pAll smup(2,ip)u=D0.p ),tsIpolather: momaG eeeew(npgrid,mk)him),&l) i_heiiiild_pop(topoid,so p'd,field_wp,1,ghoribize,ioc=lllDDDD! --- di&l) i_heiiiiaj=1,nmom3) dule_fin3sDDDD! m -->ip)u=D0.p ),tsIpolather: momaG eeee=1 donepAll smup(2,ip)u=D0.p ),tsIpolather: momaG eeeeer(2,nmom,e(ndim),&l) i_heeeeepr(2,nmom,e(ndim),&l) i_heeeees(i) we n!-----------OT.Aiwwwwww--------OTwp,-tEt=iociiiis(ikDendoc=sub2troc3 , **alph3(! fie(field_wp(n3p,-tEt=iociiiiiiiis(iDDendoc=sub2troc) , **alpha(! fie(field_wp(nsp,-tEt=iociiiiiiiieeees(i)Dendoc=sub2troc,(1-ghori1(! fie(field_wp(nj-1,mk) ffffDDDDND eeeeeule_f) + wp(1,p_i)*p_h(1)*p_h(2)n-awfenddo DDDDdogj=1,n--- eeeeeule_f) ffffffffdoge=1,n--- (1,1)-1nfo) ffffffffffield_x(1iiiiieeeeeule_f) 3fffffffdoge=13n--- (3,1)-1nfk) ffffffffffield_x(1iiiiieeees(iDDDenddl(mk3ffffffffield_x(1iiiiieeeeeeeeer(2,nmom,(2).ge.len_phys(32)) x(2) dule_fin3=1 NULL()! fie* &ffffffffield_x(1iiiii & m3dule_f) + s(aj) +3DDDNDDD&ffffffffield_x(1iiiii & m3dule_f) 2 s(aj) +3D2DNDDD&ffffffffield_x(1iiiii & m3dule_f) 3 s(aj) +3D3l) i_heap',-awwwwwwwwwwwwwwwwwwwwwwwwh(1)*h(2)*wwwwwwwwwwwwwwwwh(1)*h(2)*wwwwwwwwwwwwh(1)*h(2)*wwwwwwwwh(1)*h(2)*wwwwwwnnfo) p'All _ate(mrrrrr i_heap ioop(ov(er(2,nmom3,nsher(nmom2) l(mk3,rdowmeapdif ,! --SUMi&l) i_heiiiiaj=1,nmom3) (3),f(3),-tEt=ioc=llln#if dr(2,: alpha3ge.len_phys(3oc=ll#elif __MMMMMMMs(iDDDenddl(mk3ffffffffield_x(1ipr(2,nmom,(2).ge.kn-awfp)ms(aj) +3DDDNDDD&ffffffffield_x(1iaj=1,nmom3) wffif (xps(aj) +3D2DNDDD&ffffffffield_x(1iaj=1,nmom3) wff3f (xps(aj) +3D3l) i_heap',-awwwwwwwwwwwwh(1)*h(2)*DDDDDDendd10ffffffffield_x(1iatailt_equal_havein(dr(2,: alpha3(2).,pr(2,nmom3(2).riod) --- D DDf_molen_phys(2)) x-f (xp(2,p_i).gld_wp(1,i,j,1)*h( --- disuf (abs(p_momaG s(ajpos:g wi- test m --> --- disuf (abs(p_mDDDDenddo lDDDDdogaj = 1 --- disuf (abs(p_mDffprint *, 'failed at momaG : --- disuf (abs(p_momaG s(aj) -Df_momaG s(aj)) .G --- disufffffffprint p''pE_PRECI momaG s: ',s-sohaG s p',-fffff --- =ll#elif __MMMMMMMwwwwww -DDDDDDen7,10 --- D DDf_molen_phys(2)) x-f (xp(2,p_i).gld_wp(1dn,i,j,1)*h( --- disudn,i,e(nf_molen_phys(2)) x-f (xp(2,p_i).glf --- =ll#el! --- =llwwwwwh(1)*h(2)*w(npgrid,mk)dim),&l) i_he,aj) ff! -f (abs(p_mMaximum 3rrint *, difference---h^3iledn,i,/h**3 --- disucield_ws,ioc=llwwwwwwwwcAll spi_comm_bize(comm,ntroc,ioc=ll#else DDDDDD ntroc = 1nfo) ff ield_ws,������eAll _ate(xp,wp,field_wp,min_phys,max_phys,ghoribize,nm) lDDDDprint *, 'done.' end program s::)test)),tsIp_m2p �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libs::-1.2.1/src/),17040late/test/s::)test3e_),tsIp_p2m.fun�����������������������������������������0000644�0001752�0001753�00000033273�11616003523�024272� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa --- ���������������������������������������������������������������������������������������������������������DDDDD-! we are done n!--- p',-usk--.ASSObL chec --- dddddddddd wwwwww! Test Case DD:i_heap',-awwwwwww s::)test)),tsIp_m2p ffffff! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! C---r n (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), DDDDDD!DDDDDDDDDDDDDDDDDDDDCe,tsI ! CHFluid Dynamics (DTUll) ND!l) ND!l) ND! icensfilo enst youcOT-TY;Parallel(PE_PRECI Mo h Library (PPM).l) ND!l) ND! PPM ensfred inftware: you can redistributo etm--S/ CHmodifyl) ND! etmunARRANTY;tsImsucOT-TY;GNU LessRRAGeneral P g c License DDDDDD!Danst g whed b-- FORFred Snftware Foun---her, eihe DDDDDD!DversherG3ucOT-TY;License, CH(at your op-her)m--y late DDDDDD!Dversher.l) ND!l) ND! PPM ensdistributodsPun-TY;hopes nedgetmwill-bL(useful,l) ND! but WITHOUT ANY WARRANTY;mwithout eveun-TY;implied warrantyAtp://wwwD! MERCHANTABILITY CHFITNESS FOR A PARTICULAR PURPOSE. Sees ne://wwwD! GNU General P g c License f CHmore details.l) ND!l) ND! You should have received a c----cOT-TY;GNU General P g c License DDDDDD!DandT-TY;GNU LessRRAGeneral P g c License aloor with PPM. If not,l) ND! sees<http://www.gnu.org/licenses/>.l) ND!l) ND! Parallel(PE_PRECI Mo h Library (PPM)l) ND! ETH Zurich DDDDDD! CH-8092 Zurich, Switze�����l) -----------OT.ASSObL chec --- disuch: So program s::)test)),tsIp_m2p DDDDusk p::)module_core DDDDusk p::)module_oypedef p',-usk p::)module_mktopo DDDDusk p::)module_oopo_get ) usk p::)module_),tsI) u usk p::)module_finyssze p',-usk p::)module_map ffffUSE s::)module_--- - thh p',-USE s::)module_--- -so h p',-implicetmnonenn#include "../../s::)def),e.h"n#ifdef __MPIlp',-awINCLUDEw'spif.h' #endif nDDte :: MK = s::)kind_do gel real(mk),pE_a-ete :: pi = 3.1415926535897931_mkn-awf),tsger :: ndim,nspecn-awf),tsger :: decompn-awf),tsger :: assign-awf),tsge :: tolexp p',-real(mk) ::-),tsger, pE_a-ete :: ngrid = 2383 p',-),tsger, pE_a-ete :: npgrireal(MK),dimensher(:,:),poi,tsI :: xp,wp p',-real(MK),dimensher(: ),poi,tsI :: min_phys,max_pNULL() p'eal(MK),dimensher(:,:),pimensher(: ),poi,tsI :: ghoribize p',-),tsger :: i,j,ai,aj,p_i p',-),tsger, dimensher(6) :: bcARfnfo) real(MK),dimensher(: ),poi,tsI :: cowipwwww),tsger, dimensher(:,:),poi,tsI :: i-tE_P,n--- p',-),tsger, dimensher(: ),poi,tsI :: nm p',-real(MK),dimensher(:,:),poi,tsI :: mrosub,maxsub p',-),tsger, dimensher(: ),poi,tsI :: sub2trocn-awf),tsger :: np,mpn-awf),tsger, pE_a-ete :: kernel(= s::)pE_a-- thh_kernel_mp4 DDDDreal(MK),dimensher(:,:,:,: ), poi,tsI :: field_wpD! 2d field_up(ldn,i,j,i )l) !real(MK),dimensher(:,:up(ldn,i,j,k,i )l) real(MK),dimensher(: ),poi,tsI :: field_xl real(mk),dimensher(2) :: xl oype(s::)t_topo),)poi,tsI :: topo DDDDreal(MK) :: maxm3n-awf),tsger, pE_a-ete :: nmom = 1 real(MK),dimensher(nmom) :: f)momaG s, s-sohaG s p',-real(MK :: sigma,mul) ! --- disuch: ch: So DDDD),it ) ,muletup p',-! --- disuch: So DDDDtol = 10.0_mk**-6 !100000.0_mk*epsilon(1.0_mk) DDDDtolexpu=Dint(log10(tol))nfo) ndim = 2 ffffnspec = 1nfo) --- ((alpha(ai,aj),)ai=1,2),)aj=1,nmom) /0,0, 0,2- &l) i_heap',-awwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww1,1, 3,0, 0,3, 2,1, 1ll _ate(len_phys(ndim),min_phys(ndim),max_phys(ndim),ghoribize(ndim),&l) i_heap',-nm(ndim),hndim),p_h(ndim),field_x(ndim),-tEt=_mkn-awffuffmax_phys(i) = 10.0_mkn-awffl) spacul-! --- = 2 fffffffflen_phys(i) =amax_phys(i) --min_phys(i) ffffenddo DDDDbcARf(1:6)(= s::)pE_a--bcARf_periodicll) nullify(xp)l) nullify(wp)ln#ifdef __MPIlp',-cAll MPI_I, (ioc=ll#endif lp',-cAll s::)), 40disuch:p,0,debug,ioc=,99lll) ! --- disuch: So DDDD! creatY;pE_PR! p'All _ate(seed(bee(/17,42/ ) ,mult teall _atew'pro e are dondisuch: So DDDDnp DDNDDDxp(1,p_i) =areal(i-1,mk)*p_h(1) ffffDDDDNDDDxp(2,p_i) =areal(j-1,mk)*p_h(2) ffffDDDDenddo DDDDenddo lDDDD! -- disuch: So DDDD! make(topologylDDDD! --- disuch: So DDDDdecomp = s::)pE_a--decomp_user)def),ed ffffassig = s::)pE_a--Assign_user)def),ed DDDDtopoid = 0 p',-so hid = -1 nDDDDAll _ate(mrosub(ndim,1),maxsub(ndim,1),sub2troc(1),cowi(1),-tEt=ioc=lll) cowi(1) = 1.0_mkll) d=Dnpgrid**2 ffffmpu=D0 nDDDDAll _ate(xp(ndim,np),wp(nspec,np)32Et=ioc=lll) cooge=1,ndiml) NDDDmin (i,1)=min_phys(i) ffffffffmaxsub(i,1)=max_phys(i) DDDDenddo lDDDDsub2troc(1)u=D0 nDDDDcAll s::)mktopo(topoid,so hid,xp,np,decomp,Assig,min_phys,max_phys,bcARf- &l) i_heap',-awwwwwghoribize,cowi,i-tE_P,n--- ,nm,ioc=,user)min =mrosub, &l) i_heap',-awwwwwuser)maxsub=maxsub,user)n s=1,user)sub2troc=sub2troc) nDDDDAll _ate(field_wp(nspec,(1-ghoribize(1)):(n--- (1,1)+ghoribize(1)),',-awwwww&l) i_heap',(1-ghoribize(2)):(n--- (2,1)+ghoribizdlDDDD!All _ate(field_wp(nspec,n--- (1,1),n--- (2,1),n--- (3,1),1),-tEt=ioc=lD! 3d DDDDf! 3d :),)IFYNDDDmD! 3d :)check_sst)),tsINDDDmin DDDm .0_mk) -f (abs(p ) -f (abs(p&l) i_heap',-awwwwwwwwwwwwwwwst teardowmap- disnmom2)wDDDmin =min_pibize(1)pos)%adjsfffDDt teardowmap- dis'f), rdoch: So Dpibize( ge=1,trengthsfffDDt teardowmap- dis(topo :: npibize( geeeeeee=1,nndfffDDt teardowmap- dis'op rdoch: So Dp npibize( =1,trengthsfffDDt teardowmap- dis'op =min! --- : npibize( g1)pos)%adjsfffDDD DD8888l.NE. 0j,1)*h(1)*h(2)f (abs(p&lFDDDendtozdlDnmom2)),sppingfffffpringotozDDDD! 3d DD#elif _y(xp)mp--m,1),sui,e(ndim),&l) DD! --fffffup(2,ip)up ),tsIpolather: momaG pipAll smup(2,ip)up ),tsIpolather: momaG w(npgrid,mk)him),&l) i_held_pop(topoid,so p'd,field_wp,1,ghoribize,ioc=lllDDDD! --- disuch: So DDDD! m -->ip)up ),tsIpolather: momaG pi donepAll smup(2,ip)up ),tsIpolather: momaG xp,np,wp,1,kernel,ghorih(2)fp,np,wp,1,kernel,ghorih(2)s(iDDendoc=sub2troc) , **alpha(1e(field_wp(nsp,-tEt=iociiiis(i)Dendoc=sub2troc,(1-ghori1(1e(field_wp(nj-1,mk) ffffDDDDND eule_f) + wp(1,p_i)*p_h(1)*p_h(2)n-awfenddo DDDDdogj=1,n--- eule_f) ffffffffdoge=1,n--- (1,1)-1nfo) ffffffffffield_x(1is(iDDDenddl(mkffffffffield_x(1i if (field_x(2).ge.len_phys(2)) x(21,aj)* &l) i_heap'wwwwwwwwwwwwwwwwww1,1, 3,0, 0,3, 2,1dule_f) + s(aj) +DDDNDDDdule_f) ffs(aj) +D&l) i_heap',-awwwwwwwwwwwwwwwwh(1)*h(2)*wwwwwwwwh(1)*hwwwwwwwwh(1)*hs(iDDDenddl(mkffffffffieldys(1) p',-awffifkn-awfp)ms(aj) +DDDNDDDwffif (xps(aj) +j) + &l) i_heap',-awwwwwwwwwwDDDDDDenddo DDDDNDDDDDDDD DDf_molen_phys(2)) x-f (xp(2,p_i).gld_wp(1,i,j,1)*h(heap',-awwwwwwwwf (abs(p_momaG s(ajpos:g wi- test m -->heap',-awwwwwwwwf (abs(p_mDDDDenddo lDDDDdogaj = 1,6 p',-awffiwwwwf (abs(p_mDffprint *, 'failed at momaG : ',)aj fffffwwwwf (abs(p_momaG s(aj) -Df_momaG s(aj)) .GT. tol)T-TYnnnnnfffffffprint p''pE_PRECI momaG s: ',s-sohaG s p',-fffffwwh(1)*h(2)*www#elif __MMM',-awwwwwwwwwwDDDDDDen7d10ffffffffield_D DDf_molen_phys(2)) x-f (xp(2,p_i).gld_wp(1dn,i,j,1)*h(T. tol)T-TYnnnnndn,i,e(nf_molen_phys(2)) x-f (xp(2,p_i).glfwwh(1)*h(2)*www#elif __MMM',-awwmomaG w(npgrid,mk)ernel,ghori**2/sigma(1)**2)+ &lMaximum 3rrint *, difference---h^3iledn,i,/h**3 -ioc=llDDDcAll s::)map_field_send(ioc=llDDDcAll s::)map s: ', DDf_momaG s p',-ffffffff-top 'ERROR: m2p ),tsIpolather: momaG ssnot conserved.' ffffDDDDendif p',-enddo llDDDD! --- disuch: So DDDD! teardown... ffff! --- disuch: So DDDDprin =arealTor up' 8000 coG inue nDDDDcAll s::)finyssze(ioc=lln#ifdef __MPIlp',-cAll MPI_Finyssze(ioc=ll#endif p',- DD p',������������������������incaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa����������������������������������M1,mC Graaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa�����������libs::-1.2.1/src/),00504late/test/s::)t0707e_),tsIp_p2m.fun�����������������������������������������0000644�0001752�0001753�00000033273�11616003523�024272� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaTESTINC=-Ip',-us-usfinyssze-Lp',-us-us��� -l��� sources=$(wild���� *.f) 024tsIs=$(patawwwt %.f,%,$(sources ) new : servem,io ffff: $(024tsIs) $(024tsIs)f: $(sources reld tea$@.f $(CPP x-P $@.f >tea$@.f $(FC) $(OPTS)tea$@.f $(TESTINC) $(LDFLAGS) $(LIBS) -o $@ reld tea$@.f ./$@ servem: reld tea* reld t$(024tsIs) ������������������������incaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa�����������������������������m2p p',- DDbsp2�������������������������������������������������������������������libs::-1.2.1/src/)111212late/test/s::)t1443e_),tsIp_p2m.fun�����������������������������������������0000644�0001752�0001753�00000033273�11616003523�024272� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������inccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccaG ���������������������������������������������������������������������������������������Subrouf p����������DDDDD-! we arem2p p',- DDbsp2 aG ����������������������������������������������������������������������������������� s::)test)),tsIp_m2p ffffff! we are done n!-----------OT.ASSObL chec --- disuch: So DDDDDD! C---r n (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), DDDDDD!DDDDDDDDDDDDDDDDDDDDCe,tsI ! CHFluid Dynamics (DTUll) ND!l) ND!l) ND! icensfilo enst youcOT-TY;Parallel(PE_PRECI Mo h Library (PPM).l) ND!l) ND! PPM ensfred inftware: you can redistributo etm--S/ CHmodifyl) ND! etmunARRANTY;tsImsucOT-TY;GNU LessRRAGeneral P g c License DDDDDD!Danst g whed b-- FORFred Snftware Foun---her, eihe DDDDDD!DversherG3ucOT-TY;License, CH(at your op-her)m--y late DDDDDD!Dversher.l) ND!l) ND! PPM ensdistributodsPun-TY;hopes nedgetmwill-bL(useful,l) ND! but WITHOUT ANY WARRANTY;mwithout eveun-TY;implied warrantyAtp://wwwD! MERCHANTABILITY CHFITNESS FOR A PARTICULAR PURPOSE. Sees ne://wwwD! GNU General P g c License f CHmore details.l) ND!l) ND! You should have received a c----cOT-TY;GNU General P g c License DDDDDD!DandT-TY;GNU LessRRAGeneral P g c License aloor with PPM. If not,l) ND! sees<http://www.gnu.org/licenses/>.l) ND!l) ND! Parallel(PE_PRECI Mo h Library (PPM)l) ND! ETH Zurich DDDDDD DDD) __DIME == __2D DDD) __MODE == __SCA DDD) __KIND == __SINGLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_ss_2dll s::)map_field_pushuphoriuphdxoid,so hid,field_#elif __KIND == __DOUBLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_ds_2dll s::)map_field_pushuphoriuphdxoid,so hid,field_#eDprin#elif __MODE == __VEC DDD) __KIND == __SINGLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_sv_2dll s::)map_field_pushuphldahoriuphdxoid,so hid,field_#elif __KIND == __DOUBLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_dv_2dll s::)map_field_pushuphldahoriuphdxoid,so hid,field_#eDprin#eDprin#elif __DIME == __3D DDD) __MODE == __SCA DDD) __KIND == __SINGLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_ss_3dll s::)map_field_pushuphoriuphdxoid,so hid,field_#elif __KIND == __DOUBLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_ds_3dll s::)map_field_pushuphoriuphdxoid,so hid,field_#eDprin#elif __MODE == __VEC DDD) __KIND == __SINGLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_sv_3dll s::)map_field_pushuphldahoriuphdxoid,so hid,field_#elif __KIND == __DOUBLE_PRECISION/>.l) SUBRlatINEem2p p',- DDbsp2_dv_3dll s::)map_field_pushuphldahoriuphdxoid,so hid,field_#eDprin#eDprin#eww#elif __!!!c Licetoll MPI_I,'pE_PRECI momam3n-awf),ts CHm2e forI MoB-sD! p��scheme.lif __!!!lif __!!!cmaxmpE_PRECI momamscheme, eionly ND!e *, 2Dnse f3D spacus. Tolif __!!!c���re����per mance-l) n) loopeiov Mo h Lw'pro E. SprrG3MPIesetolif __!!!cbxmpE_PRECI mAR P://unrn-a 2,3,4nse f5-vectors.lif __!!! lif __!!! [NOTE]lif __!!!cma eirouf p��only per mso h Lactu NDpE_PRECI momaeivtNESS FORohaGbelif __!!!c fff diRTItly uto etmhoriher)minstea f CHm`p(topoid,so hi`lif __!!!crouf p��ESS FORe, CHd have CHmr(: ),24tu *, setetollif __!!!c`i,tsI :: sub2trocn-awfbsp2`.co uUp f::)module_)error uUp f::)module_)Tor u uUp f::)module_)awwwt MP uUp f::)module_)awwwtop uUp f::)module_)DDDh(i) =--Up f::)module_)DDDhsub2t(i) =--Up f::)module_)DDDhsap_f(i) =--Up f::)module_)SSObL chec --Up f::)module_)wr���eec --IMPLICIT NONE DDD) __KIND == __SINGLE_PRECISION/>.l) INTEGER,) AMETERawINCLUDEw'spif.h's),tle_#elif __KIND == __DOUBLE_PRECISION/>.l) INTEGER,) AMETERawINCLUDEw'spif.h' #endifc=ll#elif __M�����������������������������������������������������������������������������������A4tu *, slif __M���������������������������������������������������������������������������������INTEGER ,�INTENT(IN )) lif __M�!!c)*p_h(1) id*, id_p E. S024tsI�������INTEGER ,�INTENT(IN )) __!!!c�dE. Sees ap_f(DDD) __MODE == __SCA __REALoi,ts, DIMENSION(:) ,�POINTER --- dis!!!cl MPI_I,'we)teseiontolwhgnuetolpE_PRECI mA DDD) __DIME == __2D __REALoi,ts, DIMENSION(: :: n )),�POINTER d_pushupn#elif __DIME == __3D __REALoi,ts, DIMENSION(: :::: np),�POINTER d_pushupn#ell#elif __M�!: fieldll)omlwhgnuetolpE_PRECI mA Delif __MODE == __VEC ������INTEGER ,�INTENT(IN )) ldalif __M�!: lea ),tsxm3n-awf)E. S --- disREALoi,ts, DIMENSION(: ) ,�POINTER --- dis!!!cl MPI_I,'we)teseiontolwhgnuetolpE_PRECI mA DDD) __DIME == __2D __REALoi,ts, DIMENSION(: :::: np),�POINTER d_pushupn#elif __DIME == __3D __REALoi,ts, DIMENSION(: :::: ) ,�POINTER d_pushupn#ell#elif __M�!: fieldll)omlwhgnuetolpE_PRECI mA Dell#elif __MREALoi,t, DIMENSION(: ) ,�INTENT(IN )) x--- dis!!!cl MPI_I,'pos)%adjsfffDD tINTEGER , DIMENSION(: )) ,�INTENT(IN )) p',-real(MK),dis!!!cp',-r eal(MK),disINTEGER ,�INTENT( lat) is!!!cReturns 0 -mamsuccuss lif __M�����������������������������������������������������������������������������������Lo ffsger lif __M���������������������������������������������������������������������������������INTEGER, DIMENSION(: ) ,�POINTER I :: bcARf :,:,:),)poi,tsI--INTEGER, DIMENSION(:) ,�POINTER I ::----1f :,:,:),)poi,tsI--INTEGER, DIMENSION(:) ,�POINTER I ::----2f :,:,:),)poi,tsI--REALor(3, DIMENSION(:) ,�POINTER I :tsI :: xp => NULL() p',--REALor(3, DIMENSION(:) ,�POINTER I :twp => NULL() p',-real(_MREALoi,t, DIMENSION(k p::ime( geeeeeee = 3xihdxreal(_MREALoi,t, DIMENSION(k p::ime( geeeeeee = n_phys(1 __REALoi,tsssssssssssssssssssssssssssssss x1,x2,x3,ch: So ������INTEGER sssssss ocn-awfsupporti,tsI--INTEGER, DIMENSION(k p::im+ heap',-aww lduhldli,tsI--INTEGER, DIMENSION(k p::immensher(: ),poNc ������INTEGER sssssss eld_wpDeldd_wwpDedec,mapSSOb ������INTEGER sssssss jjdec,nb)aww,nl MP,iparti,tsI--INTEGER sssssss okdec,ip1,nbpt_z,n----1 ������INTEGER sssssss enysDp3,nbpt_x,nbpt_y,ifacul---- tINTEGER sssssss eaww,il)om,itosDp,iop),tsgell---- tINTEGER sssssss twp =artw'pro ,idom,n----2,idomli,tsI--INTEGER, DIMENSION(k p::immensher(: )),poNml---- tINTEGER sssssss -awwwi,tsI--INTEGER, DIMENSION(6tssssssssssssssssss,poi,tsI :: g tINTEGER sssssss eq :: g tLOGICAL sssssss efffffff_we)tese,lok���������ali���s) p',--REALor(3, DIMENSION(:real((((((POINTER I :tsI wwwww=> NULL() p',--REALor(3, DIMENSION(:real((((((POINTER I :twp wwwww=> NULL() p',--REALor(3 sssssss mych:) p',--REALor(3 sssssss tim1s, tim1e) p',--REALor(3 sssssss xp1,xnysxp3) p',--REALor(3 sssssss wx1,wx2,wx3) p',--REALor(3, DIMENSION(k p::immensher(: ) x0 :: g tINTEGER sssssss ld ������TYPEdn,i,j,equisap_f),�POINTER ) ww=> NULL() p',--TYPEdn,i,j,DDDmDp',--,�POINTER ) DDDmww=> NULL() p',--������������������������������������������������������������������������������������Ver unrn-a FORFre lif __M��������������������������������������������������������������������������� DDD) __DIME == __2D __REALor(3 x10,x11,x20,x21 __REALor(3 a10,a11,a20,a21 ������INTEGER en10,en11,en20,en21 __REALor(3 a10a20 __REALor(3 a10a21 __REALor(3 a11a20 __REALor(3 a11a21 #elif __DIME == __3D __REALor(3 x10,x11,x1ysx13,x20,x21,x2ysx23,x30,x31,x32,x33) p',--REALor(3 a10,a11,a1ysa13,a20,a21,a2ysa23,a30,a31,a32,a33) p',--INTEGER en10,en11,en1ysDp13,en20,en21,en2ysDp23,en30,en31,en3ysDp33) p',--REALor(3 a10a20a30) p',--REALor(3 a10a20a31 __REALor(3 a10a20a32 __REALor(3 a10a20a33) p',--REALor(3 a10a21a30) p',--REALor(3 a10a21a31 __REALor(3 a10a21a32 __REALor(3 a10a21a33) p',--REALor(3 a10a22a30) p',--REALor(3 a10a22a31 __REALor(3 a10a22a32 __REALor(3 a10a22a33) p',--REALor(3 a10a23a30) p',--REALor(3 a10a23a31 __REALor(3 a10a23a32 __REALor(3 a10a23a33) p',--REALor(3 a11a20a30) p',--REALor(3 a11a20a31 __REALor(3 a11a20a32 __REALor(3 a11a20a33) p',--REALor(3 a11a21a30) p',--REALor(3 a11a21a31 __REALor(3 a11a21a32 __REALor(3 a11a21a33) p',--REALor(3 a11a22a30) p',--REALor(3 a11a22a31 __REALor(3 a11a22a32 __REALor(3 a11a22a33) p',--REALor(3 a11a23a30) p',--REALor(3 a11a23a31 __REALor(3 a11a23a32 __REALor(3 a11a23a33) p',--REALor(3 a12a20a30) p',--REALor(3 a12a20a31 __REALor(3 a12a20a32 __REALor(3 a12a20a33) p',--REALor(3 a12a21a30) p',--REALor(3 a12a21a31 __REALor(3 a12a21a32 __REALor(3 a12a21a33) p',--REALor(3 a12a22a30) p',--REALor(3 a12a22a31 __REALor(3 a12a22a32 __REALor(3 a12a22a33) p',--REALor(3 a12a23a30) p',--REALor(3 a12a23a31 __REALor(3 a12a23a32 __REALor(3 a12a23a33) p',--REALor(3 a13a20a30) p',--REALor(3 a13a20a31 __REALor(3 a13a20a32 __REALor(3 a13a20a33) p',--REALor(3 a13a21a30) p',--REALor(3 a13a21a31 __REALor(3 a13a21a32 __REALor(3 a13a21a33) p',--REALor(3 a13a22a30) p',--REALor(3 a13a22a31 __REALor(3 a13a22a32 __REALor(3 a13a22a33) p',--REALor(3 a13a23a30) p',--REALor(3 a13a23a31 __REALor(3 a13a23a32 __REALor(3 a13a23a33)DDDprin ) p',--������������������������������������������������������������������������������������I',-awwwwe) p',--���������������������������������������������������������������������������������:)cheawwwt MP('m2p p',- DDbsp2',t0 DDDD! m -->ipDDDmww=>ck_sst))ll s::))%ti,tsI-- ww=>l s:% ( ! m -->ip: bcARfw=> %: bcAR DDD) __KIND == __SINGLE_PRECISION/>.l) tsI :: xp =>l s:% sI :: x lif __Mtwp => NULL(l s:% wp => Ns_#elif __KIND == __DOUBLE_PRECISION/>.l) tsI :: xp =>l s:% sI :: xdlif __Mtwp => NULL(l s:% wp => Ndn#eDprin#DD) __KIND == __SINGLE_PRECISION/>.l) tych:UDEw'sptych:s/>.l) tsI wwwww=>l s:% sI awwwi,tsI--twp wwwww=>l s:% wp awwwi#elif __KIND == __DOUBLE_PRECISION/>.l) tych:UDEw'sptych:d/>.l) tsI wwwww=>l s:% sI awwdi,tsI--twp wwwww=>l s:% wp awwdDDDDprin =are 3ximk)him),&/dx m -->ip)u=DOAiwwwwww1p % n!---#DD) __DIME == __2D __ p',--�������������������������������������������������������������������� __ p',--� ---- 2Dn��� __ p',--�������������������������������������������������������������������� #DD) __MODE == __SCA __ -->ip: nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMMDOAipwww1pstorktopfo(D! 2d fie __ -->ip:q->ip= ----_b2troaww,ip! m -->ip)u=D0....x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDNDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! m -->ip)u=D0....en10wp(INT(x0 + x(21m -->ip)u=D0....en20wp(INT(x0 2 x(21mm -->ip)u=D0....en11--- n10w(21m -->ip)u=D0....en21--- n20x(21mm -->ip)u=D0....xp1---x0 + -REALo n10) ffffffffffield_x(1xp2---x0 2 -REALo n20) fffffffffffield_x(1x10wp(xp1ffffffffield_x(1x11---x10w-d = 0 p',-so fffield_x(1x20wp(xp)ffffffffield_x(1x21---x20w-d = 0 p',-so fffield_x(1a10wp( = 0 pw-dx10ffffffffield_x(1a20wp( = 0 pw-dx20',-so fffield_x(1a11wp( = 0 pw+1x11ffffffffield_x(1a21wp( = 0 pw+1x21mm -->ip)u=D0....a10a20e(nf10*a20 __)u=D0....a10a21e(nf10*a21mm -->ip)u=D0....a11a20e(nf11*a20 __)u=D0....a11a21e(nf11*a21mm -->ip)u=D0....up(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a10a20*poi,tsI :en10,en20,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a10a21*poi,tsI :en10,en21,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a11a20*poi,tsI :en11,en20,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a11a21*poi,tsI :en11,en21,e! 2d fie __ --END DOA-� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain Delif __MODE == __VEC �������������������������������������������������������������������������������� __ p',--� -Unrn-a FORFre 1-vectors �������������������������������������������������������������������������������� __ p',--IF(lda.EQ.+ wTHENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->ip ip:q->ip= ----_b2troaww,ip! m -->ip)u=D0.... ..x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! m -->ip)u=D0.... ..en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffield_x(1 (1xp2---x0 2 -REALo n20) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mm -->ip)u=D0.... ..a10a20e(nf10*a20 __)u=D0.... ..a10a21e(nf10*a21mm -->ip)u=D0.... ..a11a20e(nf11*a20 __)u=D0.... ..a11a21e(nf11*a21mm -->ip)u=D0.... ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20*poi,tsI :1,en10,en20,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21*poi,tsI :1,en10,en21,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20*poi,tsI :1,en11,en20,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21*poi,tsI :1,en11,en21,e! 2d fie __ -- --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ -- --����������������������������������������������������������������� fie __ -- --� -Unrn-a FORFre 2-vectors ������������ --����������������������������������������������������������������� fie __ --ELSEIF(lda.EQ.2 wTHENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->ip ip:q->ip= ----_b2troaww,ip! m -->ip)u=D0.... ..x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! m -->ip)u=D0.... ..en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffield_x(1 (1xp2---x0 2 -REALo n20) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mm -->ip)u=D0.... ..a10a20e(nf10*a20 __)u=D0.... ..a10a21e(nf10*a21mm -->ip)u=D0.... ..a11a20e(nf11*a20 __)u=D0.... ..a11a21e(nf11*a21mm -->ip)u=D0.... ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20*poi,tsI :1,en10,en20,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21*poi,tsI :1,en10,en21,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20*poi,tsI :1,en11,en20,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21*poi,tsI :1,en11,en21,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20*poi,tsI :2,en10,en20,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21*poi,tsI :2,en10,en21,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20*poi,tsI :2,en11,en20,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21*poi,tsI :2,en11,en21,e! 2d fie __ -- --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ -- --����������������������������������������������������������������� fie __ -- --� -Unrn-a FORFre 3-vectors ������������ --����������������������������������������������������������������� fie __ --ELSEIF(lda.EQ.3 wTHENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->ip ip:q->ip= ----_b2troaww,ip! m -->ip)u=D0.... ..x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! m -->ip)u=D0.... ..en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffield_x(1 (1xp2---x0 2 -REALo n20) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mm -->ip)u=D0.... ..a10a20e(nf10*a20 __)u=D0.... ..a10a21e(nf10*a21mm -->ip)u=D0.... ..a11a20e(nf11*a20 __)u=D0.... ..a11a21e(nf11*a21mm -->ip)u=D0.... ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20*poi,tsI :1,en10,en20,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21*poi,tsI :1,en10,en21,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20*poi,tsI :1,en11,en20,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21*poi,tsI :1,en11,en21,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20*poi,tsI :2,en10,en20,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21*poi,tsI :2,en10,en21,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20*poi,tsI :2,en11,en20,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21*poi,tsI :2,en11,en21,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20*poi,tsI :3,en10,en20,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21*poi,tsI :3,en10,en21,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20*poi,tsI :3,en11,en20,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21*poi,tsI :3,en11,en21,e! 2d fie __ -- --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ -- --����������������������������������������������������������������� fie __ -- --� -All oRRANTlda P://ohaGunrn-a .cma eiicensvectorizeiov Molda! fie __ -- --����������������������������������������������������������������� fie __ --ELSEm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->ip ip:q->ip= ----_b2troaww,ip! m -->ip)u=D0.... ..x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! m -->ip)u=D0.... ..en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffield_x(1 (1xp2---x0 2 -REALo n20) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mm -->ip)u=D0.... ..a10a20e(nf10*a20 __)u=D0.... ..a10a21e(nf10*a21mm -->ip)u=D0.... ..a11a20e(nf11*a20 __)u=D0.... ..a11a21e(nf11*a21m __)u=D0.... ..DOAldn=1,ldalif __MMMMMMMMMMMMMMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a20*poi,tsI :: fien10,en20,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a21*poi,tsI :: fien10,en21,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a20*poi,tsI :: fien11,en20,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a21*poi,tsI :: fien11,en21,e! 2d fie __ -- -- --END DOA--� ld ������ -- -- --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ --END IFn#eDprin#elif __DIME == __3D fie __ --�������������������������������������������������������������������� __ p',--� ---- 3Dn��� __ p',--�������������������������������������������������������������������� #DD) __MODE == __SCA __ -->ip: nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMMDOAipwww1pstorktopfo(D! 2d fie __ -->ip:q->ip= ----_b2troaww,ip! fie __ -->ipx0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDNDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDNDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u=D0....en10wp(INT(x0 + x(21m -->ip)u=D0....en20wp(INT(x0 2 x(21m -->ip)u=D0....en30wp(INT(x0 3 x(21mm -->ip)u=D0....en11--- n10w(21m -->ip)u=D0....en21--- n20x(21m -->ip)u=D0....en31--- n30x(21mm -->ip)u=D0....xp1---x0 + -REALo n10) ffffffffffield_x(1xp2---x0 2 -REALo n20) ffffffffffield_x(1xp3---x0 3 -REALo n30) fffffffffffield_x(1x10wp(xp1ffffffffield_x(1x11---x10w-d = 0 p',-so fffield_x(1x20wp(xp)ffffffffield_x(1x21---x20w-d = 0 p',-so fffield_x(1x30wp(xp3,-so fffield_x(1x31---x30w-d = 0 p',-so fffield_x(1a10wp( = 0 pw-dx10ffffffffield_x(1a20wp( = 0 pw-dx20'fffffffield_x(1a30wp( = 0 pw-dx30',-so fffield_x(1a11wp( = 0 pw+1x11ffffffffield_x(1a21wp( = 0 pw+1x21mfffffffield_x(1a31wp( = 0 pw+1x31mm -->ip)u=D0....a10a20a30wp(f10*a20*a30) p',--)u=D0....a10a20a31wp(f10*a20*a31mm -->ip)u=D0....a10a21a30wp(f10*a21*a30) p',--)u=D0....a10a21a31wp(f10*a21*a31mm -->ip)u=D0....a11a20a30wp(f11*a20*a30) p',--)u=D0....a11a20a31wp(f11*a20*a31mm -->ip)u=D0....a11a21a30wp(f11*a21*a30) p',--)u=D0....a11a21a31wp(f11*a21*a31mm -->ip)u=D0....up(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a10a20a30*poi,tsI :en10,en20,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a10a20a31*poi,tsI :en10,en20,en31,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a10a21a30*poi,tsI :en10,en21,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a10a21a31*poi,tsI :en10,en21,en31,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a11a20a30*poi,tsI :en11,en20,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a11a20a31*poi,tsI :en11,en20,en31,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a11a21a30*poi,tsI :en11,en21,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2) wwwwwwwwwww1,1, 3,0, 0a11a21a31*poi,tsI :en11,en21,en31,e! 2d w1,1, 3,0, 0END DOA-� iq Delif __MODE == __VEC �������������������������������������������������������������������������������� __ p',--� -Unrn-a FORFre 1-vectors �������������������������������������������������������������������������������� __ p',--IF(lda.EQ.+ wTHENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->ip ip:q->ip= ----_b2troaww,ip! fie __ -->ip ipx0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u=D0.... ..en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21m -->ip)u=D0.... ..en30wp(INT(x0 3 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21m -->ip)u=D0.... ..en31--- n30x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffield_x(1 (1xp2---x0 2 -REALo n20) ffffffffffield_x(1 (1xp3---x0 3 -REALo n30) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1x30wp(xp3,-so fffield_x(1 (1x31---x30w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20'fffffffield_x(1 (1a30wp( = 0 pw-dx30',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mfffffffield_x(1 (1a31wp( = 0 pw+1x31mm -->ip)u=D0.... ..a10a20a30wp(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31mm -->ip)u=D0.... ..a10a21a30wp(f10*a21*a30) p',--)u=D0.... ..a10a21a31wp(f10*a21*a31mm -->ip)u=D0.... ..a11a20a30wp(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31mm -->ip)u=D0.... ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31mm -->ip)u=D0.... ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :1,en10,en20,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :1,en10,en20,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :1,en10,en21,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :1,en10,en21,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :1,en11,en20,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :1,en11,en20,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :1,en11,en21,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :1,en11,en21,en31,e! 2d w1,1, 3,0, 0 --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ -- --����������������������������������������������������������������� fie __ -- --� -Unrn-a FORFre 2-vectors ������������ --����������������������������������������������������������������� fie __ --ELSEIF(lda.EQ.2 wTHENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->ip ip:q->ip= ----_b2troaww,ip! fie __ -->ip ipx0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u=D0.... ..en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21m -->ip)u=D0.... ..en30wp(INT(x0 3 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21m -->ip)u=D0.... ..en31--- n30x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffield.... ..xp2---x0 2 -REALo n20) ffffffffffield_x(1 (1xp3---x0 3 -REALo n30) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1x30wp(xp3,-so fffield_x(1 (1x31---x30w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20'fffffffield_x(1 (1a30wp( = 0 pw-dx30',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mfffffffield_x(1 (1a31wp( = 0 pw+1x31mm -->ip)u=D0.... ..a10a20a30wp(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31mm -->ip)u=D0.... ..a10a21a30wp(f10*a21*a30) p',--)u=D0.... ..a10a21a31wp(f10*a21*a31mm -->ip)u=D0.... ..a11a20a30wp(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31mm -->ip)u=D0.... ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31mm -->ip)u=D0.... ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :1,en10,en20,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :1,en10,en20,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :1,en10,en21,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :1,en10,en21,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :1,en11,en20,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :1,en11,en20,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :1,en11,en21,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :1,en11,en21,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :2,en10,en20,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :2,en10,en20,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :2,en10,en21,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :2,en10,en21,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :2,en11,en20,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :2,en11,en20,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :2,en11,en21,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :2,en11,en21,en31,e! 2d w1,1, 3,0, 0 --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ -- --����������������������������������������������������������������� fie __ -- --� -Unrn-a FORFre 3-vectors ������������ --����������������������������������������������������������������� fie __ --ELSEIF(lda.EQ.3 wTHENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->i....eq->ip= ----_b2troaww,ip! fie __ -->ip ipx0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u=D0.... ..en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21m -->ip)u=D0.... ..en30wp(INT(x0 3 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21m -->ip)u=D0.... ..en31--- n30x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffield.... ..xp2---x0 2 -REALo n20) ffffffffffield.... ..xp3---x0 3 -REALo n30) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1x30wp(xp3,-so fffield_x(1 (1x31---x30w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20'fffffffield_x(1 (1a30wp( = 0 pw-dx30',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mfffffffield_x(1 (1a31wp( = 0 pw+1x31mm -->ip)u=D0.... ..a10a20a30wp(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31mm -->ip)u=D0.... ..a10a21a30wp(f10*a21*a30) p',--)u=D0.... ..a10a21a31wp(f10*a21*a31mm -->ip)u=D0.... ..a11a20a30wp(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31mm -->ip)u=D0.... ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31mm -->ip)u=D0.... ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :1,en10,en20,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :1,en10,en20,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :1,en10,en21,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :1,en10,en21,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :1,en11,en20,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :1,en11,en20,en31,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :1,en11,en21,en30,e! 2d fie __ -->ip ipup(awiq)e(nup(awiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :1,en11,en21,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :2,en10,en20,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :2,en10,en20,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :2,en10,en21,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :2,en10,en21,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :2,en11,en20,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :2,en11,en20,en31,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :2,en11,en21,en30,e! 2d fie __ -->ip ipup(2wiq)e(nup(2wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :2,en11,en21,en31,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :3,en10,en20,en30,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :3,en10,en20,en31,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :3,en10,en21,en30,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :3,en10,en21,en31,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :3,en11,en20,en30,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :3,en11,en20,en31,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :3,en11,en21,en30,e! 2d fie __ -->ip ipup(3wiq)e(nup(3wiq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :3,en11,en21,en31,e! 2d w1,1, 3,0, 0 --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ -- --����������������������������������������������������������������� fie __ -- --� -All oRRANTlda P://ohaGunrn-a .cma eiicensvectorizeiov Molda! fie __ -- --����������������������������������������������������������������� fie __ --ELSEm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->i....eq->ip= ----_b2troaww,ip! fie __ -->ip ipx0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u= -->i....en10wp(INT(x0 + x(21m -->ip)u=D0.... ..en20wp(INT(x0 2 x(21m -->ip)u=D0.... ..en30wp(INT(x0 3 x(21mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21m -->ip)u=D0.... ..en31--- n30x(21mm -->ip)u=D0.... ..xp1---x0 + -REALo n10) ffffffffffu=D0.... ..xp2---x0 2 -REALo n20) ffffffffffield.... ..xp3---x0 3 -REALo n30) fffffffffffield_x(1 (1x10wp(xp1ffffffffield_x(1 (1x11---x10w-d = 0 p',-so fffield_x(1 (1x20wp(xp)ffffffffield_x(1 (1x21---x20w-d = 0 p',-so fffield_x(1 (1x30wp(xp3,-so fffield_x(1 (1x31---x30w-d = 0 p',-so fffield_x(1 (1a10wp( = 0 pw-dx10ffffffffield_x(1 (1a20wp( = 0 pw-dx20'fffffffield_x(1 (1a30wp( = 0 pw-dx30',-so fffield_x(1 (1a11wp( = 0 pw+1x11ffffffffield_x(1 (1a21wp( = 0 pw+1x21mfffffffield_x(1 (1a31wp( = 0 pw+1x31mm -->ip)u=D0.... ..a10a20a30wp(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31mm -->ip)u=D0.... ..a10a21a30wp(f10*a21*a30) p',--)u=D0.... ..a10a21a31wp(f10*a21*a31mm -->ip)u=D0.... ..a11a20a30wp(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31mm -->ip)u=D0.... ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31mm -->ip)u=D0.... ipDOAldn=1,ldalif __MMMMMMMMMMMMMMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a20a30*poi,tsI :: fien10,en20,en30,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a20a31*poi,tsI :: fien10,en20,en31,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a21a30*poi,tsI :: fien10,en21,en30,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a21a31*poi,tsI :: fien10,en21,en31,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a20a30*poi,tsI :: fien11,en20,en30,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a20a31*poi,tsI :: fien11,en20,en31,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a21a30*poi,tsI :: fien11,en21,en30,e! 2d fie __ -->ip ipMMMI :: fieq)e(nup(: fieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a21a31*poi,tsI :: fien11,en21,en31,e! 2d w1,1, 3,0, 0 -- --END DOA--� ld ������ -- -- --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain fie __ --END IF-� ldaGunrn-an#eDprin#ell#elif __MMMMEND DOA� e! 2n ) p',--:)cheawwwtop('m2p p',- DDbsp2',t0 DDDD! p',--RETURN� DDD) __DIME == __2D #DD) __MODE == __SCA #DD) __KIND == __SINGLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_ss_2di#elif __KIND == __DOUBLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_ds_2di#eDprin#elif __MODE == __VEC #DD) __KIND == __SINGLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_sv_2di#elif __KIND == __DOUBLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_dv_2di#eDprin#eDprin#elif __DIME == __3D #DD) __MODE == __SCA #DD) __KIND == __SINGLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_ss_3di#elif __KIND == __DOUBLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_ds_3di#eDprin#elif __MODE == __VEC #DD) __KIND == __SINGLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_sv_3di#elif __KIND == __DOUBLE_PRECISION/>.l) END SUBROUTINE m2p p',- DDbsp2_dv_3di#eDprin#eDprin#eDprin��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/p',- Dolate/m2p p',- DDmp4.f�������������������������������������������������������0000644�0001752�0001753�00000300147�11616003523�021304� 0����������������������������������������������������������������������������������������������������u bcA �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������>.l) ���������������������������������������������������������������������������������������Subroutine���:ww1,1, 3,0, 0 0 0m2p p',- DDmp4 >.l) �����������������������������������������������������������������������������������Copyr)tes (c) 2010wCSE Lab (ETH Zuricf),�MOSAIC Group (ETH Zuricf),�����������������������������Ce',- Fluid Dynamics (DTU() p',--�) p',--�) p',--�cma eifile e!ol MP ofvershParallelhParPI_I, M wLibrary (PPM).) p',--�) p',--�cPPM e!ofree software: you can redistribute et and/ mopriy) p',--�ciaGund- ersh,- ms ofvershGNU Less- General P----cwLicense����������a!ol-----hed byvershFree Software Foundation, eiRRANT��������� FORFre 3 ofvershLicense, (at your option) any lateNT��������� FORFre.) p',--�) p',--�cPPM e!odistributedD!Dvershhopsh,hat iaGicensbe useful,) p',--�cbut WITHOUT ANY WARRANTY;Gicthout eveDvershimpliedDwarranty of) p',--�cMERCHANTABILITY FITNESS FOR A PARTICULAR PURPOSE. Sesh,he) p',--�hGNU General P----cwLicense�f more details.) p',--�) p',--�cYou should have receivedDa copy ofvershGNU General P----cwLicense���������anysershGNU Less- General P----cwLicense�alongGicthcPPM. If/oha,) p',--�csesh<http://www.gnu.org/licenses/>.) p',--�) p',--�cParallelhParPI_I, M wLibrary (PPM)) p',--�cETH Zuricf���������CH-8092 Zuricf, Sictzerlany >.l) ��������������������������������������������������������������������������� DDD) __DIME == __2D #DD) __MODE == __SCA #DD) __KIND == __SINGLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_ss_2dll s::), ,poi,tsI ,xp,I ,dx,ghostsize DDDD! #elif __KIND == __DOUBLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_ds_2dll s::), ,poi,tsI ,xp,I ,dx,ghostsize DDDD! #eDprin#elif __MODE == __VEC #DD) __KIND == __SINGLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_sv_2dll s::), ,poi,tsI ,lda,xp,I ,dx,ghostsize DDDD! #elif __KIND == __DOUBLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_dv_2dll s::), ,poi,tsI ,lda,xp,I ,dx,ghostsize DDDD! #eDprin#eDprin#elif __DIME == __3D #DD) __MODE == __SCA #DD) __KIND == __SINGLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_ss_3dll s::), ,poi,tsI ,xp,I ,dx,ghostsize DDDD! #elif __KIND == __DOUBLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_ds_3dll s::), ,poi,tsI ,xp,I ,dx,ghostsize DDDD! #eDprin#elif __MODE == __VEC #DD) __KIND == __SINGLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_sv_3dll s::), ,poi,tsI ,lda,xp,I ,dx,ghostsize DDDD! #elif __KIND == __DOUBLE_PRECISION/>.l) SUBROUTINE m2p p',- DDmp4_dv_3dll s::), ,poi,tsI ,lda,xp,I ,dx,ghostsize DDDD! #eDprin#eDprin#eDprin.l) �!! M wtool MPI_I, p',- DolatFre llowingGershMP4 scheme.n.l) �!!n.l) �!! Th, p',- DolatFre scheme e!oonlyhimplementedD 2D�anys3D spaces. Ton.l) �!! increase�per mancevershinn Moloopsiov Moershnumb MoofvpropsMPIeswton.l) �!! b, p',- DolatedDare unrn-a D 2,3,4�anys5-vectors.n.l) �!! n.l) �!! [NOTE]n.l) �!! The!oroutine�onlyhper msoershactual p',- DolatFre. It should ohaGben.l) �!! ca-a Ddirectlyhbyvershus- but insteaysersh`w'spp',- DDm2p`n.l) �!! routine�should be usedGicthcershkernelhargum*, setwtoon.l) �!! `w'spl Mam_ msh_kernelDmp4`.n ) p',--USE w'sptodule_error) p',--USE w'sptodule_a-aoc) p',--USE w'sptodule_swwwt MP) p',--USE w'sptodule_swwwtop) p',--USE w'sptodule_data) p',--USE w'sptodule_data_ msh) p',--USE w'sptodule_data_ ) p',--USE w'sptodule_typedef) p',--USE w'sptodule_write�������IMPLICIT NONE DDD) __KIND == __SINGLE_PRECISION/>.l) INTEGER, PARAMETER MK DEw'spkind_single #elif __KIND == __DOUBLE_PRECISION/>.l) INTEGER, PARAMETER MK DEw'spkind_do---en#ell#elif __M�����������������������������������������������������������������������������������Argum*, slif __M���������������������������������������������������������������������������������INTEGER ,�INTENT(IN 3 l s::)lif __M�!! l s:logyhid*, ipoiMoofvt Mget�������INTEGER ,�INTENT(IN 3 lif __M�!! id ofversh w(us- ) #DD) __MODE == __SCA __REALoMK) ,�DIMENSION(:) ,�POINTER uplif __M�!! l MPI_I, we)tes!oontoowhicfwtoop',- Dolate DDD) __DIME == __2D __REALoMK) ,�DIMENSION(:,:,: 3 ,�POINTER poi,tsI n#elif __DIME == __3D fie REALoMK) ,�DIMENSION(:,:,:,: 3 ,�POINTER poi,tsI n#ell#elif __M�!! poi,tofromowhicfwtoop',- Dolate Delif __MODE == __VEC ������INTEGER ,�INTENT(IN 3 ldalif __M�!! leayingGdim*,RFre ofvuplif __MREALoMK) ,�DIMENSION(:,:) ,�POINTER uplif __M�!! l MPI_I, we)tes!oontoowhicfwtoop',- Dolate DDD) __DIME == __2D __REALoMK) ,�DIMENSION(:,:,:,: 3 ,�POINTER poi,tsI n#elif __DIME == __3D fie REALoMK) ,�DIMENSION(:,:,:,:,:) ,�POINTER poi,tsI n#ell#elif __M�!! poi,tofromowhicfwtoop',- Dolate Dell#elif __MREALoMK),�DIMENSION(:,:) ,�INTENT(IN 3 xplif __M�!! l MPI_I, positFres ������INTEGER ,�DIMENSION(: 3 ,�INTENT(IN 3 ghostsizelif __M�!! ghost sizelif __MINTEGER ,�INTENT( OUT3 DDDDlif __M�!! Returns 0 upre successlif __M���������������������������������������������������������������������������������! Loca- varia--eslif __M���������������������������������������������������������������������������������INTEGER, �DIMENSION(:,:) ,�POINTER Dwt MP => NULL()�������INTEGER, �DIMENSION(:) ,�POINTER D----1 => NULL()�������INTEGER, �DIMENSION(:) ,�POINTER D----2 => NULL()�������REALomk),�DIMENSION(:) ,�POINTER sI phys => NULL()�������REALomk),�DIMENSION(:) ,�POINTER ax phys => NULL()�������REALoMK),��DIMENSION(w'spdim) dxi,dx�������REALoMK),��DIMENSION(w'spdim) leI phys fie REALoMK) x1,x2,x3,epsilon ������INTEGER kernelDsupport�������INTEGER, �DIMENSION(w'spdim+2) ldu,ldl�������INTEGER, �DIMENSION(w'spdim) Nc ������INTEGER i,j,k,ii,jj,kk,iidec,maptype ������INTEGER jjdec,nb_sww,nl MP,ipart�������INTEGER kkdec,ip1,nbpt_z,n----1 ������INTEGER ip2,en3,nbpt_x,nbpt_y,iface ������INTEGER iaww,ifrom,ito,en,iopt(! fil ������INTEGER ax partnumb M,idom,n----2,idoml�������INTEGER, DIMENSION(w'spdim) Nm ������INTEGER nswww�������INTEGER, DIMENSION(6) bcdef) p',--INTEGER iq) p',--LOGICAL i',- nal_we)tes!,lok���������aliases�������REALomk),�DIMENSION(:,:),������POINTER sI sww => NULL()�������REALomk),�DIMENSION(:,:),������POINTER ax sww => NULL()�������REALomk) myeps�������REALomk) tim1s, tim1e�������REALomk) xp1,xp2,xp3,-so ffREALomk) wx1,wx2,wx3) p',--INTEGER ld ������REALomk),�DIMENSION(w'spdim) x0) p',--TYPE(w'spt_equi_ ),�POINTER => NULL()�������TYPE(w'spt_l s:) ,�POINTER l s: => NULL()�������������������������������������������������������������������������������������������Varia--esD unrn-a FORFreslif __M���������������������������������������������������������������������������� DDD) __DIME == __2D -so ffREALomk) a10a20 -so ffREALomk) a10a21 -so ffREALomk) a11a20 -so ffREALomk) a11a21n#elif __DIME == __3D fie REALomk) x10,x11,x12,x13,x20,x21,x22,x23,x30,x31,x32,x33,-so ffREALomk) a10,a11,a12,a13,a20,a21,a22,a23,a30,a31,a32,a33) p',--INTEGER ip10,en11,en12,en13,en20,en21,en22,en23,en30,en31,ep32,en33,-so ffREALomk) a10a20a30,-so ffREALomk) a10a20a31 -so ffREALomk) a10a20a32 -so ffREALomk) a10a20a33,-so ffREALomk) a10a21a30,-so ffREALomk) a10a21a31 -so ffREALomk) a10a21a32 -so ffREALomk) a10a21a33,-so ffREALomk) a10a22a30,-so ffREALomk) a10a22a31 -so ffREALomk) a10a22a32 -so ffREALomk) a10a22a33,-so ffREALomk) a10a23a30,-so ffREALomk) a10a23a31 -so ffREALomk) a10a23a32 -so ffREALomk) a10a23a33,-so ffREALomk) a11a20a30,-so ffREALomk) a11a20a31 -so ffREALomk) a11a20a32 -so ffREALomk) a11a20a33,-so ffREALomk) a11a21a30,-so ffREALomk) a11a21a31 -so ffREALomk) a11a21a32 -so ffREALomk) a11a21a33,-so ffREALomk) a11a22a30,-so ffREALomk) a11a22a31 -so ffREALomk) a11a22a32 -so ffREALomk) a11a22a33,-so ffREALomk) a11a23a30,-so ffREALomk) a11a23a31 -so ffREALomk) a11a23a32 -so ffREALomk) a11a23a33,-so ffREALomk) a12a20a30,-so ffREALomk) a12a20a31 -so ffREALomk) a12a20a32 -so ffREALomk) a12a20a33,-so ffREALomk) a12a21a30,-so ffREALomk) a12a21a31 -so ffREALomk) a12a21a32 -so ffREALomk) a12a21a33,-so ffREALomk) a12a22a30,-so ffREALomk) a12a22a31 -so ffREALomk) a12a22a32 -so ffREALomk) a12a22a33,-so ffREALomk) a12a23a30,-so ffREALomk) a12a23a31 -so ffREALomk) a12a23a32 -so ffREALomk) a12a23a33,-so ffREALomk) a13a20a30,-so ffREALomk) a13a20a31 -so ffREALomk) a13a20a32 -so ffREALomk) a13a20a33,-so ffREALomk) a13a21a30,-so ffREALomk) a13a21a31 -so ffREALomk) a13a21a32 -so ffREALomk) a13a21a33,-so ffREALomk) a13a22a30,-so ffREALomk) a13a22a31 -so ffREALomk) a13a22a32 -so ffREALomk) a13a22a33,-so ffREALomk) a13a23a30,-so ffREALomk) a13a23a31 -so ffREALomk) a13a23a32 -so ffREALomk) a13a23a33,Dell#el�������������������������������������������������������������������������������������������Initializelif __M���������������������������������������������������������������������������������:)cheawwwtart('m2p p',- DDmp4',t0 DDDD! �������l s: => w'spt s:ll s::))%t������� => % ( ! �������Dwt MP => %Dwt MP DDD) __KIND == __SINGLE_PRECISION/>.l) sI phys => % sI physslif __M ax phys => % ax physs #elif __KIND == __DOUBLE_PRECISION/>.l) sI phys => % sI physdlif __M ax phys => % ax physdi#eDprin#DD) __KIND == __SINGLE_PRECISION/>.l) yeps DEw'sp yepss/>.l) sI sww => % sI swww������� ax sww => % ax swww�#elif __KIND == __DOUBLE_PRECISION/>.l) yeps DEw'sp yepsd/>.l) sI sww => % sI swwd������� ax sww => % ax swwdi#eDprin �������dxiwp( = 0 p/dx fie __���loopiov Moswww������� MMDOAisww = 1, %n-------n#DD)__DIME == __2D -so ffif __M�������������������������������������������������������������������� -so ffif __M� ---- 2Dn��� __ p',--�������������������������������������������������������������������� #DD)__MODE == __SCA __ -->ip: nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMMDOAipwww1pstorktopfo(D! 2d fie __ -->ip:q->ip= ----_b2troaww,ip! fie __ -->ipx0 + wp((kn-awiq)- sI phys + *3xinj-1,mk) ffffDDDDNDx0 2 wp((kn-2wiq)- sI phys 2))*3xin2! m -->ip)u=D0....ip1---INT(x0 + +2-Dwt MPi1(! fil)m -->ip)u=D0....ip2wp(INT(x0 2 +2-Dwt MPi2(! fil)mm -->ip)u=D0....xp1---x0 + -AINT(x0 + m -->ip)u=D0....xp2---x0 2 -AINT(x0 2 mm -->ip)u=D0....DOAjj----1,)ffffffffield_x(1 (1x2---ABS(xp2--fREALojj ffd w1,1, 3,0, 0 -- --IF(x2.LT. = 0 p wTHENm -->ip)u=D0..........wx2--- = 0 pw-dx2**2*(2.50 p-1.50 p*x2! ,mk) ffffDDDDND NDELSEm -->ip)u=D0..........wx2---2= 0 pw+1(-4= 0 pw+1) wwwwwwwwwww1,1, 3,0, 0 0 (2.50 pw-d0.50 pw*dx2)*x2)*x2 ,mk) ffffDDDDND NDEND IFn ,mk) ffffDDDDND NDDOAiiD ND=w-d ,)ffffffffield_x(1 (1 (1x1---ABS(xp1--fREALoii ffd w1,1, 3,0, 0 -- -- --IF(x1.LT. = 0MK) THENm -->ip)u=D0.............wx1---( = 0 pw-dx1**2*(2.50 pw-d) wwwwwwwwwww1,1, 3,0, 0 0 0 -( =50 p*xj-1,mk) ffffDDDDND ND NDELSEm -->ip)u=D0.............wx1---(2= 0 pw+1(-4= 0 pw+1) wwwwwwwwwww1,1, 3,0, 0 0 (2.50 pw-d0.50 p*xj-*xj-*xj1,mk) ffffDDDDND ND NDEND IFn,mk) ffffDDDDND ND NDup(iq)e(nup(iq)e(2wx1*wx2*poi,tsI :ei+ip1,jj+ip2,e! 2d w1,1, 3,0, 0 -- --END DO w1,1, 3,0, 0 --END DO w1,1, 3,0, 0END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain Delif __MODE == __VEC �������������cma eiicensonlyhvectorizeiov Molda __ -->ip: nwww %--------OT! 2d __ -->ipDOAipwww1pstorktopfo(D! 2d fie __ -->ip:q->ip= ----_b2troaww,ip! fie __ -->ipx0 + wp((kn-awiq)- sI phys + *3xinj-1,mk) ffffDDDDNDx0 2 wp((kn-2wiq)- sI phys 2))*3xin2! m -->ip)u=D0....ip1---INT(x0 + +2-Dwt MPi1(! fil)m -->ip)u=D0....ip2wp(INT(x0 2 +2-Dwt MPi2(! fil)mm -->ip)u=D0....xp1---x0 + -AINT(x0 + m -->ip)u=D0....xp2---x0 2 -AINT(x0 2 mm -->ip)u=D0....DOAjj----1,)ffffffffield_x(1 (1x2---ABS(xp2--fREALojj ffd w1,1, 3,0, 0 -- --IF(x2.LT. = 0 p wTHENm -->ip)u=D0..........wx2--- = 0 pw-dx2**2*(2.50 p-1.50 p*x2! ,mk) ffffDDDDND NDELSEm -->ip)u=D0..........wx2---2= 0 pw+1(-4= 0 pw+1) wwwwwwwwwww1,1, 3,0, 0 0 (2.50 pw-d0.50 pw*dx2)*x2)*x2 ,mk) ffffDDDDND NDEND IFn ,mk) ffffDDDDND NDDOAiiD ND=w-d ,)ffffffffield_x(1 (1 (1x1---ABS(xp1--fREALoii ffd fffffffield_x(1 (1 (1IF(x1.LT. = 0MK) THENm -->ip)u=D0.............wx1---( = 0 pw-dx1**2*(2.50 pw-d) wwwwwwwwwww1,1, 3,0, 0 0 0 -( =50 p*xj-1,mk) ffffDDDDND ND NDELSEm -->ip)u=D0.............wx1---(2= 0 pw+1(-4= 0 pw+1) wwwwwwwwwww1,1, 3,0, 0 0 (2.50 pw-d0.50 p*xj-*xj-*xj1,mk) ffffDDDDND ND NDEND IFn,mk) ffffDDDDND ND NDDOAldn=1,ldalif __MMMMMMMMMMMMMMMM MMI :: fieq)e(nup(: fieq)e(2wx1*wx2* w wwwwwwwwwww1,1, 3,0, 0 0 poi,tsI :: fiei+ip1,jj+ip2,e! 2d w1,1, 3,0, 0 -- -- --END DO w1,1, 3,0, 0 -- --END DO w1,1, 3,0, 0 --END DO w1,1, 3,0, 0END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain DeDprin#elif __DIME == __3D fie __ --�������������������������������������������������������������������� __ p',--� ---- 3Dn��� __ p',--�������������������������������������������������������������������� #DD) __MODE == __SCA __ -->ip: nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMMDOAipwww1pstorktopfo(D! 2d fie __ -->ip:q->ip= ----_b2troaww,ip! fie __ -->ipx0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDNDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDNDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u=D0....en10wp(INT(x0 + m -->ip)u=D0....ip20wp(INT(x0 2 m -->ip)u=D0....ip30wp(INT(x0 3 mm -->ip)u=D0....en11--- n10w(21m -->ip)u=D0....en21--- n20x(21m -->ip)u=D0....en31--- n30x(21mm -->ip)u=D0....en12--- n11w(21m -->ip)u=D0....en22--- n21w(21m -->ip)u=D0....en32--- n31x(21mm -->ip)u=D0....en13--- n11w(2)ffffffffield_x(1en23--- n21w(2)ffffffffield_x(1en33--- n31x(22mm -->ip)u=D0....xp1---x0 + -REALo n10 ffffffffffield_x(1xp2---x0 2 -REALo n20 ffffffffffield_x(1xp3---x0 3 -REALo n30 fffffffffffield_x(1x10wp(xp1x(21= 0 p'fffffffield_x(1x11---x10w-d = 0 p'fffffffield_x(1x12---x10w-d2= 0 p'fffffffield_x(1x13---x10w-d3= 0 p',-so fffield_x(1x20wp(xp)x(21= 0 p'fffffffield_x(1x21---x20w-d = 0 p'fffffffield_x(1x22---x20w-d2= 0 p'fffffffield_x(1x23---x20w-d3= 0 p',-so fffield_x(1x30wp(xp3x(21= 0 p'fffffffield_x(1x31---x30w-d = 0 p'fffffffield_x(1x32---x30w-d2= 0 p'fffffffield_x(1x33---x30w-d3= 0 p',-so fffield_x(1a10wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1a10a20a30wp(f10*a20*a30) p',--)u=D0....a10a20a31wp(f10*a20*a31m p',--)u=D0....a10a20a32wp(f10*a20*a32,-so fffield_x(1a10a20a33wp(f10*a20*a33,-so fffield_x(1a10a21a30wp(f10*a21*a30) p',--)u=D0....a10a21a31wp(f10*a21*a31m p',--)u=D0....a10a21a32wp(f10*a21*a32,-so fffield_x(1a10a21a33wp(f10*a21*a33,-so fffield_x(1a10a22a30wp(f10*a22*a30) p',--)u=D0....a10a22a31wp(f10*a22*a31m p',--)u=D0....a10a22a32wp(f10*a22*a32,-so fffield_x(1a10a22a33wp(f10*a22*a33,-so fffield_x(1a10a23a30wp(f10*a23*a30) p',--)u=D0....a10a23a31wp(f10*a23*a31m p',--)u=D0....a10a23a32wp(f10*a23*a32,-so fffield_x(1a10a23a33wp(f10*a23*a33,-so fffield_x(1a11a20a30wp(f11*a20*a30) p',--)u=D0....a11a20a31wp(f11*a20*a31m p',--)u=D0....a11a20a32wp(f11*a20*a32,-so fffield_x(1a11a20a33wp(f11*a20*a33,-so fffield_x(1a11a21a30wp(f11*a21*a30) p',--)u=D0....a11a21a31wp(f11*a21*a31m p',--)u=D0....a11a21a32wp(f11*a21*a32,-so fffield_x(1a11a21a33wp(f11*a21*a33,-so fffield_x(1a11a22a30wp(f11*a22*a30) p',--)u=D0....a11a22a31wp(f11*a22*a31m p',--)u=D0....a11a22a32wp(f11*a22*a32,-so fffield_x(1a11a22a33wp(f11*a22*a33,-so fffield_x(1a11a23a30wp(f11*a23*a30) p',--)u=D0....a11a23a31wp(f11*a23*a31m p',--)u=D0....a11a23a32wp(f11*a23*a32,-so fffield_x(1a11a23a33wp(f11*a23*a33,-so fffield_x(1a12a20a30wp(f12*a20*a30) p',--)u=D0....a12a20a31wp(f12*a20*a31m p',--)u=D0....a12a20a32wp(f12*a20*a32,-so fffield_x(1a12a20a33wp(f12*a20*a33,-so fffield_x(1a12a21a30wp(f12*a21*a30) p',--)u=D0....a12a21a31wp(f12*a21*a31m p',--)u=D0....a12a21a32wp(f12*a21*a32,-so fffield_x(1a12a21a33wp(f12*a21*a33,-so fffield_x(1a12a22a30wp(f12*a22*a30) p',--)u=D0....a12a22a31wp(f12*a22*a31m p',--)u=D0....a12a22a32wp(f12*a22*a32,-so fffield_x(1a12a22a33wp(f12*a22*a33,-so fffield_x(1a12a23a30wp(f12*a23*a30) p',--)u=D0....a12a23a31wp(f12*a23*a31m p',--)u=D0....a12a23a32wp(f12*a23*a32,-so fffield_x(1a12a23a33wp(f12*a23*a33,-so fffield_x(1a13a20a30wp(f13*a20*a30) p',--)u=D0....a13a20a31wp(f13*a20*a31m p',--)u=D0....a13a20a32wp(f13*a20*a32,-so fffield_x(1a13a20a33wp(f13*a20*a33,-so fffield_x(1a13a21a30wp(f13*a21*a30) p',--)u=D0....a13a21a31wp(f13*a21*a31m p',--)u=D0....a13a21a32wp(f13*a21*a32,-so fffield_x(1a13a21a33wp(f13*a21*a33,-so fffield_x(1a13a22a30wp(f13*a22*a30) p',--)u=D0....a13a22a31wp(f13*a22*a31m p',--)u=D0....a13a22a32wp(f13*a22*a32,-so fffield_x(1a13a22a33wp(f13*a22*a33,-so fffield_x(1a13a23a30wp(f13*a23*a30) p',--)u=D0....a13a23a31wp(f13*a23*a31m p',--)u=D0....a13a23a32wp(f13*a23*a32,-so fffield_x(1a13a23a33wp(f13*a23*a33,,-so fffield_x(1up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a20a30*poi,tsI :en10,en20,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a20a31*poi,tsI :en10,en20,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a20a32*poi,tsI :en10,en20,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a20a33*poi,tsI :en10,en20,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a21a30*poi,tsI :en10,en21,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a21a31*poi,tsI :en10,en21,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a21a32*poi,tsI :en10,en21,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a21a33*poi,tsI :en10,en21,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a22a30*poi,tsI :en10,en22,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a22a31*poi,tsI :en10,en22,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a22a32*poi,tsI :en10,en22,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a22a33*poi,tsI :en10,en22,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a23a30*poi,tsI :en10,en23,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a23a31*poi,tsI :en10,en23,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a23a32*poi,tsI :en10,en23,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a10a23a33*poi,tsI :en10,en23,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a20a30*poi,tsI :en11,en20,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a20a31*poi,tsI :en11,en20,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a20a32*poi,tsI :en11,en20,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a20a33*poi,tsI :en11,en20,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a21a30*poi,tsI :en11,en21,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a21a31*poi,tsI :en11,en21,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a21a32*poi,tsI :en11,en21,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a21a33*poi,tsI :en11,en21,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a22a30*poi,tsI :en11,en22,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a22a31*poi,tsI :en11,en22,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a22a32*poi,tsI :en11,en22,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a22a33*poi,tsI :en11,en22,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a23a30*poi,tsI :en11,en23,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a23a31*poi,tsI :en11,en23,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a23a32*poi,tsI :en11,en23,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a11a23a33*poi,tsI :en11,en23,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a20a30*poi,tsI :en12,en20,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a20a31*poi,tsI :en12,en20,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a20a32*poi,tsI :en12,en20,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a20a33*poi,tsI :en12,en20,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a21a30*poi,tsI :en12,en21,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a21a31*poi,tsI :en12,en21,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a21a32*poi,tsI :en12,en21,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a21a33*poi,tsI :en12,en21,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a22a30*poi,tsI :en12,en22,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a22a31*poi,tsI :en12,en22,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a22a32*poi,tsI :en12,en22,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a22a33*poi,tsI :en12,en22,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a23a30*poi,tsI :en12,en23,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a23a31*poi,tsI :en12,en23,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a23a32*poi,tsI :en12,en23,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a12a23a33*poi,tsI :en12,en23,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a20a30*poi,tsI :en13,en20,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a20a31*poi,tsI :en13,en20,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a20a32*poi,tsI :en13,en20,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a20a33*poi,tsI :en13,en20,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a21a30*poi,tsI :en13,en21,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a21a31*poi,tsI :en13,en21,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a21a32*poi,tsI :en13,en21,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a21a33*poi,tsI :en13,en21,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a22a30*poi,tsI :en13,en22,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a22a31*poi,tsI :en13,en22,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a22a32*poi,tsI :en13,en22,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a22a33*poi,tsI :en13,en22,en33,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a23a30*poi,tsI :en13,en23,en30,e! 2d fie __ -->ipup(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a23a31*poi,tsI :en13,en23,en31,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a23a32*poi,tsI :en13,en23,en32,e! 2d w1,1, 3,0, 0 --up(iq)e(nup(iq)e(2w wwwwwwwwwww1,1, 3,0, 0a13a23a33*poi,tsI :en13,en23,en33,e! 2d w1,1, 3,0, 0END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain Delif __MODE == __VEC �������������������������������������������������������������������������������� ������������� Unrn-a FORFreD 1-vectors �������������������������������������������������������������������������������� ������������IF(lda.EQ.1) THENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->i....eq->ip= ----_b2troaww,ip! fie __ -->i....x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u= -->i....en10wp(INT(x0 + m -->ip)u= -->i....en20wp(INT(x0 2 m -->ip)u=D0.... ..ip30wp(INT(x0 3 mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21m -->ip)u=D0.... ..en31--- n30x(21mm -->ip)u=D0.... ..en12--- n11w(21m -->ip)u=D0.... ..en22--- n21w(21m -->ip)u=D0.... ..en32--- n31x(21mm -->ip)u=D0.... ..en13--- n11w(2)ffffffffield_x(1 (1en23--- n21w(2)ffffffffield_x(1 (1en33--- n31x(22mm -->ip)u=D0.... ..xp1---x0 + -REALo n10 ffffffffffield_x(1 (1xp2---x0 2 -REALo n20 ffffffffffield_x(1 (1xp3---x0 3 -REALo n30 fffffffffffield_x(1 (1x10wp(xp1x(21= 0 p'fffffffield_x(1 (1x11---x10w-d = 0 p'fffffffield_x(1 (1x12---x10w-d2= 0 p'fffffffield_x(1 (1x13---x10w-d3= 0 p',-so fffield_x(1 (1x20wp(xp)x(21= 0 p'fffffffield_x(1 (1x21---x20w-d = 0 p'fffffffield_x(1 (1x22---x20w-d2= 0 p'fffffffield_x(1 (1x23---x20w-d3= 0 p',-so fffield_x(1 (1x30wp(xp3x(21= 0 p'fffffffield_x(1 (1x31---x30w-d = 0 p'fffffffield_x(1 (1x32---x30w-d2= 0 p'fffffffield_x(1 (1x33---x30w-d3= 0 p',-so fffield_x(1 0a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 0a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 0a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 0a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 0a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 0a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 0a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 0a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 0a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 0a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 0a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 0a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1 0a10a20a30 p(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31m p',--)u=D0.... ..a10a20a32wp(f10*a20*a32,-so fffield_x(1 ..a10a20a33wp(f10*a20*a33,-so fffield_x(1 ..a10a21a30wp(f10*a21*a30) p',--)u=D0.... ..a10a21a31wp(f10*a21*a31m p',--)u=D0.... ..a10a21a32wp(f10*a21*a32,-so fffield_x(1 ..a10a21a33wp(f10*a21*a33,-so fffield_x(1 ..a10a22a30wp(f10*a22*a30) p',--)u=D0.... ..a10a22a31wp(f10*a22*a31m p',--)u=D0.... ..a10a22a32wp(f10*a22*a32,-so fffield_x(1 ..a10a22a33wp(f10*a22*a33,-so fffield_x(1 ..a10a23a30wp(f10*a23*a30) p',--)u=D0.... ..a10a23a31wp(f10*a23*a31m p',--)u=D0.... ..a10a23a32wp(f10*a23*a32,-so fffield_x(1 ..a10a23a33wp(f10*a23*a33,-so fffield_x(1 0a11a20a30 p(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31m p',--)u=D0.... ..a11a20a32wp(f11*a20*a32,-so fffield_x(1 ..a11a20a33wp(f11*a20*a33,-so fffield_x(1 ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31m p',--)u=D0.... ..a11a21a32wp(f11*a21*a32,-so fffield_x(1 ..a11a21a33wp(f11*a21*a33,-so fffield_x(1 ..a11a22a30wp(f11*a22*a30) p',--)u=D0.... ..a11a22a31wp(f11*a22*a31m p',--)u=D0.... ..a11a22a32wp(f11*a22*a32,-so fffield_x(1 ..a11a22a33wp(f11*a22*a33,-so fffield_x(1 ..a11a23a30wp(f11*a23*a30) p',--)u=D0.... ..a11a23a31wp(f11*a23*a31m p',--)u=D0.... ..a11a23a32wp(f11*a23*a32,-so fffield_x(1 ..a11a23a33wp(f11*a23*a33,-so fffield_x(1 0a12a20a30 p(f12*a20*a30) p',--)u=D0.... 0a12a20a31wp(f12*a20*a31m p',--)u=D0.... 0a12a20a32wp(f12*a20*a32,-so fffield_x(1 0a12a20a33wp(f12*a20*a33,-so fffield_x(1 0a12a21a30wp(f12*a21*a30) p',--)u=D0.... 0a12a21a31wp(f12*a21*a31m p',--)u=D0.... 0a12a21a32wp(f12*a21*a32,-so fffield_x(1 0a12a21a33wp(f12*a21*a33,-so fffield_x(1 0a12a22a30wp(f12*a22*a30) p',--)u=D0.... 0a12a22a31wp(f12*a22*a31m p',--)u=D0.... 0a12a22a32wp(f12*a22*a32,-so fffield_x(1 0a12a22a33wp(f12*a22*a33,-so fffield_x(1 0a12a23a30wp(f12*a23*a30) p',--)u=D0.... 0a12a23a31wp(f12*a23*a31m p',--)u=D0.... 0a12a23a32wp(f12*a23*a32,-so fffield_x(1 0a12a23a33wp(f12*a23*a33,-so fffield_x(1 0a13a20a30 p(f13*a20*a30) p',--)u=D0.... 0a13a20a31wp(f13*a20*a31m p',--)u=D0.... 0a13a20a32wp(f13*a20*a32,-so fffield_x(1 0a13a20a33wp(f13*a20*a33,-so fffield_x(1 0a13a21a30wp(f13*a21*a30) p',--)u=D0.... 0a13a21a31wp(f13*a21*a31m p',--)u=D0.... 0a13a21a32wp(f13*a21*a32,-so fffield_x(1 0a13a21a33wp(f13*a21*a33,-so fffield_x(1 0a13a22a30wp(f13*a22*a30) p',--)u=D0.... 0a13a22a31wp(f13*a22*a31m p',--)u=D0.... 0a13a22a32wp(f13*a22*a32,-so fffield_x(1 0a13a22a33wp(f13*a22*a33,-so fffield_x(1 0a13a23a30wp(f13*a23*a30) p',--)u=D0.... 0a13a23a31wp(f13*a23*a31m p',--)u=D0.... 0a13a23a32wp(f13*a23*a32,-so fffield_x(1 0a13a23a33wp(f13*a23*a33,,-so fffield_x(1 --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :1,en10,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :1,en10,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a32*poi,tsI :1,en10,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a33*poi,tsI :1,en10,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :1,en10,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :1,en10,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a32*poi,tsI :1,en10,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a33*poi,tsI :1,en10,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a30*poi,tsI :1,en10,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a31*poi,tsI :1,en10,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a32*poi,tsI :1,en10,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a33*poi,tsI :1,en10,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a30*poi,tsI :1,en10,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a31*poi,tsI :1,en10,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a32*poi,tsI :1,en10,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a33*poi,tsI :1,en10,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :1,en11,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :1,en11,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a32*poi,tsI :1,en11,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a33*poi,tsI :1,en11,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :1,en11,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :1,en11,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a32*poi,tsI :1,en11,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a33*poi,tsI :1,en11,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a30*poi,tsI :1,en11,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a31*poi,tsI :1,en11,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a32*poi,tsI :1,en11,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a33*poi,tsI :1,en11,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a30*poi,tsI :1,en11,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a31*poi,tsI :1,en11,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a32*poi,tsI :1,en11,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a33*poi,tsI :1,en11,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a30*poi,tsI :1,en12,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a31*poi,tsI :1,en12,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a32*poi,tsI :1,en12,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a33*poi,tsI :1,en12,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a30*poi,tsI :1,en12,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a31*poi,tsI :1,en12,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a32*poi,tsI :1,en12,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a33*poi,tsI :1,en12,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a30*poi,tsI :1,en12,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a31*poi,tsI :1,en12,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a32*poi,tsI :1,en12,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a33*poi,tsI :1,en12,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a30*poi,tsI :1,en12,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a31*poi,tsI :1,en12,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a32*poi,tsI :1,en12,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a33*poi,tsI :1,en12,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a30*poi,tsI :1,en13,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a31*poi,tsI :1,en13,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a32*poi,tsI :1,en13,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a33*poi,tsI :1,en13,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a30*poi,tsI :1,en13,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a31*poi,tsI :1,en13,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a32*poi,tsI :1,en13,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a33*poi,tsI :1,en13,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a30*poi,tsI :1,en13,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a31*poi,tsI :1,en13,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a32*poi,tsI :1,en13,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a33*poi,tsI :1,en13,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a30*poi,tsI :1,en13,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a31*poi,tsI :1,en13,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a32*poi,tsI :1,en13,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a33*poi,tsI :1,en13,en23,en33,e! 2d w1,1, 3,0, 0 --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain w1,1, 3,0, 0 --����������������������������������������������������������������� w1,1, 3,0, 0 --� Unrn-a FORFreD 2-vectors ������������ --����������������������������������������������������������������� w1,1, 3,0, 0ELSEIF(lda.EQ.2) THENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->i....eq->ip= ----_b2troaww,ip! fie __ -->i....x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u= -->i....en10wp(INT(x0 + m -->ip)u= -->i....en20wp(INT(x0 2 m -->ip)u=D0.... ..ip30wp(INT(x0 3 mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..en21--- n20x(21m -->ip)u=D0.... ..en31--- n30x(21mm -->ip)u=D0.... ..en12--- n11w(21m -->ip)u=D0.... ..en22--- n21w(21m -->ip)u=D0.... ..en32--- n31x(21mm -->ip)u=D0.... ..en13--- n11w(2)ffffffffield_x(1 (1en23--- n21w(2)ffffffffield_x(1 (1en33--- n31x(22mm xp1---x0 + -REALo n10 ffffffffffield_x(1 (1xp2---x0 2 -REALo n20 ffffffffffield_x(1 (1xp3---x0 3 -REALo n30 fffffffffffield_x(1 (1x10wp(xp1x(21= 0 p'fffffffield_x(1 (1x11---x10w-d = 0 p'fffffffield_x(1 (1x12---x10w-d2= 0 p'fffffffield_x(1 (1x13---x10w-d3= 0 p',-so fffield_x(1 (1x20wp(xp)x(21= 0 p'fffffffield_x(1 (1x21---x20w-d = 0 p'fffffffield_x(1 (1x22---x20w-d2= 0 p'fffffffield_x(1 (1x23---x20w-d3= 0 p',-so fffield_x(1 (1x30wp(xp3x(21= 0 p'fffffffield_x(1 (1x31---x30w-d = 0 p'fffffffield_x(1 (1x32---x30w-d2= 0 p'fffffffield_x(1 (1x33---x30w-d3= 0 p',-so fffield_x(1 0a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 0a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 0a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 0a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 0a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 0a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 0a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 0a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 0a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 0a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 0a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 0a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1 0a10a20a30 p(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31m p',--)u=D0.... ..a10a20a32wp(f10*a20*a32,-so fffield_x(1 ..a10a20a33wp(f10*a20*a33,-so fffield_x(1 ..a10a21a30wp(f10*a21*a30) p',--)u=D0.... ..a10a21a31wp(f10*a21*a31m p',--)u=D0.... ..a10a21a32wp(f10*a21*a32,-so fffield_x(1 ..a10a21a33wp(f10*a21*a33,-so fffield_x(1 ..a10a22a30wp(f10*a22*a30) p',--)u=D0.... ..a10a22a31wp(f10*a22*a31m p',--)u=D0.... ..a10a22a32wp(f10*a22*a32,-p',--)u=D0.... ..a10a22a33wp(f10*a22*a33,-so fffield_x(1 ..a10a23a30wp(f10*a23*a30) p',--)u=D0.... ..a10a23a31wp(f10*a23*a31m p',--)u=D0.... ..a10a23a32wp(f10*a23*a32,-so fffield_x(1 ..a10a23a33wp(f10*a23*a33,-so fffield_x(1 0a11a20a30 p(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31m p',--)u=D0.... ..a11a20a32wp(f11*a20*a32,-so fffield_x(1 ..a11a20a33wp(f11*a20*a33,-so fffield_x(1 ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31m p',--)u=D0.... ..a11a21a32wp(f11*a21*a32,-so fffield_x(1 ..a11a21a33wp(f11*a21*a33,-so fffield_x(1 ..a11a22a30wp(f11*a22*a30) p',--)u=D0.... ..a11a22a31wp(f11*a22*a31m p',--)u=D0.... ..a11a22a32wp(f11*a22*a32,-so fffield_x(1 ..a11a22a33wp(f11*a22*a33,-so fffield_x(1 ..a11a23a30wp(f11*a23*a30) p',--)u=D0.... ..a11a23a31wp(f11*a23*a31m p',--)u=D0.... ..a11a23a32wp(f11*a23*a32,-so fffield_x(1 ..a11a23a33wp(f11*a23*a33,-so fffield_x(1 0a12a20a30 p(f12*a20*a30) p',--)u=D0.... 0a12a20a31wp(f12*a20*a31m p',--)u=D0.... 0a12a20a32wp(f12*a20*a32,-so fffield_x(1 0a12a20a33wp(f12*a20*a33,-so fffield_x(1 0a12a21a30wp(f12*a21*a30) p',--)u=D0.... 0a12a21a31wp(f12*a21*a31m p',--)u=D0.... 0a12a21a32wp(f12*a21*a32,-so fffield_x(1 0a12a21a33wp(f12*a21*a33,-so fffield_x(1 0a12a22a30wp(f12*a22*a30) p',--)u=D0.... 0a12a22a31wp(f12*a22*a31m p',--)u=D0.... 0a12a22a32wp(f12*a22*a32,-so fffield_x(1 0a12a22a33wp(f12*a22*a33,-so fffield_x(1 0a12a23a30wp(f12*a23*a30) p',--)u=D0.... 0a12a23a31wp(f12*a23*a31m p',--)u=D0.... 0a12a23a32wp(f12*a23*a32,-so fffield_x(1 0a12a23a33wp(f12*a23*a33,-so fffield_x(1 0a13a20a30 p(f13*a20*a30) po fffield_x(1 0a13a20a31wp(f13*a20*a31m p',--)u=D0.... 0a13a20a32wp(f13*a20*a32,-so fffield_x(1 0a13a20a33wp(f13*a20*a33,-so fffield_x(1 0a13a21a30wp(f13*a21*a30) p',--)u=D0.... 0a13a21a31wp(f13*a21*a31m p',--)u=D0.... 0a13a21a32wp(f13*a21*a32,-so fffield_x(1 0a13a21a33wp(f13*a21*a33,-so fffield_x(1 0a13a22a30wp(f13*a22*a30) p',--)u=D0.... 0a13a22a31wp(f13*a22*a31m p',--)u=D0.... 0a13a22a32wp(f13*a22*a32,-so fffield_x(1 0a13a22a33wp(f13*a22*a33,-so fffield_x(1 0a13a23a30wp(f13*a23*a30) p',--)u=D0.... 0a13a23a31wp(f13*a23*a31m p',--)u=D0.... 0a13a23a32wp(f13*a23*a32,-so fffield_x(1 0a13a23a33wp(f13*a23*a33,,-so fffield_x(1 --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :1,en10,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :1,en10,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a32*poi,tsI :1,en10,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a33*poi,tsI :1,en10,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :1,en10,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :1,en10,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a32*poi,tsI :1,en10,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a33*poi,tsI :1,en10,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a30*poi,tsI :1,en10,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a31*poi,tsI :1,en10,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a32*poi,tsI :1,en10,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a33*poi,tsI :1,en10,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a30*poi,tsI :1,en10,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a31*poi,tsI :1,en10,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a32*poi,tsI :1,en10,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a33*poi,tsI :1,en10,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :1,en11,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :1,en11,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a32*poi,tsI :1,en11,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a33*poi,tsI :1,en11,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :1,en11,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :1,en11,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a32*poi,tsI :1,en11,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a33*poi,tsI :1,en11,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a30*poi,tsI :1,en11,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a31*poi,tsI :1,en11,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a32*poi,tsI :1,en11,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a33*poi,tsI :1,en11,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a30*poi,tsI :1,en11,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a31*poi,tsI :1,en11,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a32*poi,tsI :1,en11,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a33*poi,tsI :1,en11,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a30*poi,tsI :1,en12,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a31*poi,tsI :1,en12,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a32*poi,tsI :1,en12,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a33*poi,tsI :1,en12,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a30*poi,tsI :1,en12,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a31*poi,tsI :1,en12,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a32*poi,tsI :1,en12,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a33*poi,tsI :1,en12,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a30*poi,tsI :1,en12,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a31*poi,tsI :1,en12,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a32*poi,tsI :1,en12,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a33*poi,tsI :1,en12,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a30*poi,tsI :1,en12,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a31*poi,tsI :1,en12,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a32*poi,tsI :1,en12,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a33*poi,tsI :1,en12,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a30*poi,tsI :1,en13,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a31*poi,tsI :1,en13,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a32*poi,tsI :1,en13,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a33*poi,tsI :1,en13,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a30*poi,tsI :1,en13,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a31*poi,tsI :1,en13,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a32*poi,tsI :1,en13,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a33*poi,tsI :1,en13,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a30*poi,tsI :1,en13,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a31*poi,tsI :1,en13,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a32*poi,tsI :1,en13,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a33*poi,tsI :1,en13,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a30*poi,tsI :1,en13,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a31*poi,tsI :1,en13,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a32*poi,tsI :1,en13,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a33*poi,tsI :1,en13,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :2,en10,en20,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :2,en10,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a32*poi,tsI :2,en10,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a33*poi,tsI :2,en10,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :2,en10,en21,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :2,en10,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a32*poi,tsI :2,en10,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a33*poi,tsI :2,en10,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a30*poi,tsI :2,en10,en22,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a31*poi,tsI :2,en10,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a32*poi,tsI :2,en10,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a33*poi,tsI :2,en10,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a30*poi,tsI :2,en10,en23,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a31*poi,tsI :2,en10,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a32*poi,tsI :2,en10,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a33*poi,tsI :2,en10,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :2,en11,en20,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :2,en11,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a32*poi,tsI :2,en11,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a33*poi,tsI :2,en11,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :2,en11,en21,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :2,en11,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a32*poi,tsI :2,en11,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a33*poi,tsI :2,en11,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a30*poi,tsI :2,en11,en22,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a31*poi,tsI :2,en11,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a32*poi,tsI :2,en11,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a33*poi,tsI :2,en11,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a30*poi,tsI :2,en11,en23,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a31*poi,tsI :2,en11,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a32*poi,tsI :2,en11,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a33*poi,tsI :2,en11,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a30*poi,tsI :2,en12,en20,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a31*poi,tsI :2,en12,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a32*poi,tsI :2,en12,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a33*poi,tsI :2,en12,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a30*poi,tsI :2,en12,en21,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a31*poi,tsI :2,en12,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a32*poi,tsI :2,en12,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a33*poi,tsI :2,en12,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a30*poi,tsI :2,en12,en22,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a31*poi,tsI :2,en12,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a32*poi,tsI :2,en12,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a33*poi,tsI :2,en12,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a30*poi,tsI :2,en12,en23,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a31*poi,tsI :2,en12,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a32*poi,tsI :2,en12,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a33*poi,tsI :2,en12,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a30*poi,tsI :2,en13,en20,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a31*poi,tsI :2,en13,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a32*poi,tsI :2,en13,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a33*poi,tsI :2,en13,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a30*poi,tsI :2,en13,en21,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a31*poi,tsI :2,en13,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a32*poi,tsI :2,en13,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a33*poi,tsI :2,en13,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a30*poi,tsI :2,en13,en22,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a31*poi,tsI :2,en13,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a32*poi,tsI :2,en13,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a33*poi,tsI :2,en13,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a30*poi,tsI :2,en13,en23,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a31*poi,tsI :2,en13,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a32*poi,tsI :2,en13,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a33*poi,tsI :2,en13,en23,en33,e! 2d w1,1, 3,0, 0 --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain w1,1, 3,0, 0 --����������������������������������������������������������������� w1,1, 3,0, 0 --� Unrn-a FORFreD 3-vectors ������������ --����������������������������������������������������������������� w1,1, 3,0, 0ELSEIF(lda.EQ.3) THENm -->ip)u=D0....e nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->i....eq->ip= ----_b2troaww,ip! fie __ -->i....x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u= -->i....en10wp(INT(x0 + m -->ip)u= -->i....en20wp(INT(x0 2 m -->ip)u=D0.... ..ip30wp(INT(x0 3 mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..in21--- n20x(21m -->ip)u=D0.... ..en31--- n30x(21mm -->ip)u=D0.... ..en12--- n11w(21m -->ip)u=D0.... ..en22--- n21w(21m -->ip)u=D0.... ..en32--- n31x(21mm -->ip)u=D0.... ..en13--- n11w(2)ffffffffield_x(1 (1en23--- n21w(2)ffffffffield_x(1 (1en33--- n31x(22mm xp1---x0 + -REALo n10 ffffffffffield_x(1 (1xp2---x0 2 -REALo n20 ffffffffffield_x(1 (1xp3---x0 3 -REALo n30 fffffffffffield_x(1 (1x10wp(xp1x(21= 0 p'fffffffield_x(1 (1x11---x10w-d = 0 p'fffffffield_x(1 (1x12---x10w-d2= 0 p'fffffffield_x(1 (1x13---x10w-d3= 0 p',-so fffield_x(1 (1x20wp(xp)x(21= 0 p'fffffffield_x(1 (1x21---x20w-d = 0 p'fffffffield_x(1 (1x22---x20w-d2= 0 p'fffffffield_x(1 (1x23---x20w-d3= 0 p',-so fffield_x(1 (1x30wp(xp3x(21= 0 p'fffffffield_x(1 (1x31---x30w-d = 0 p'fffffffield_x(1 (1x32---x30w-d2= 0 p'fffffffield_x(1 (1x33---x30w-d3= 0 p',-so fffield_x(1 0a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 0a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 0a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 0a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 0a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 0a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 0a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 0a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 0a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 0a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 0a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 0a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1 0a10a20a30 p(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31m p',--)u=D0.... ..a10a20a32wp(f10*a20*a32,-so fffield_x(1 ..a10a20a33wp(f10*a20*a33,-so fffield_x(1 ..a10a21a30wp(f10*a21*a30) p',--)u=D0.... ..a10a21a31wp(f10*a21*a31m p',--)u=D0.... ..a10a21a32wp(f10*a21*a32,-so fffield_x(1 ..a10a21a33wp(f10*a21*a33,-so fffield_x(1 ..a10a22a30wp(f10*a22*a30) p',--)u=D0.... ..a10a22a31wp(f10*a22*a31m p',--)u=D0.... ..a10a22a32wp(f10*a22*a32,-p',--)u=D0.... ..a10a22a33wp(f10*a22*a33,-so fffield_x(1 ..a10a23a30wp(f10*a23*a30) p',--)u=D0.... ..a10a23a31wp(f10*a23*a31m p',--)u=D0.... ..a10a23a32wp(f10*a23*a32,-so fffield_x(1 ..a10a23a33wp(f10*a23*a33,-so fffield_x(1 0a11a20a30 p(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31m p',--)u=D0.... ..a11a20a32wp(f11*a20*a32,-so fffield_x(1 ..a11a20a33wp(f11*a20*a33,-so fffield_x(1 ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31m p',--)u=D0.... ..a11a21a32wp(f11*a21*a32,-so fffield_x(1 ..a11a21a33wp(f11*a21*a33,-so fffield_x(1 ..a11a22a30wp(f11*a22*a30) p',--)u=D0.... ..a11a22a31wp(f11*a22*a31m p',--)u=D0.... ..a11a22a32wp(f11*a22*a32,-so fffield_x(1 ..a11a22a33wp(f11*a22*a33,-so fffield_x(1 ..a11a23a30wp(f11*a23*a30) p',--)u=D0.... ..a11a23a31wp(f11*a23*a31m p',--)u=D0.... ..a11a23a32wp(f11*a23*a32,-so fffield_x(1 ..a11a23a33wp(f11*a23*a33,-so fffield_x(1 0a12a20a30 p(f12*a20*a30) p',--)u=D0.... 0a12a20a31wp(f12*a20*a31m p',--)u=D0.... 0a12a20a32wp(f12*a20*a32,-so fffield_x(1 0a12a20a33wp(f12*a20*a33,-so fffield_x(1 0a12a21a30wp(f12*a21*a30) p',--)u=D0.... 0a12a21a31wp(f12*a21*a31m p',--)u=D0.... 0a12a21a32wp(f12*a21*a32,-so fffield_x(1 0a12a21a33wp(f12*a21*a33,-so fffield_x(1 0a12a22a30wp(f12*a22*a30) p',--)u=D0.... 0a12a22a31wp(f12*a22*a31m p',--)u=D0.... 0a12a22a32wp(f12*a22*a32,-so fffield_x(1 0a12a22a33wp(f12*a22*a33,-so fffield_x(1 0a12a23a30wp(f12*a23*a30) p',--)u=D0.... 0a12a23a31wp(f12*a23*a31m p',--)u=D0.... 0a12a23a32wp(f12*a23*a32,-so fffield_x(1 0a12a23a33wp(f12*a23*a33,-so fffield_x(1 0a13a20a30 p(f13*a20*a30) po fffield_x(1 0a13a20a31wp(f13*a20*a31m p',--)u=D0.... 0a13a20a32wp(f13*a20*a32,-so fffield_x(1 0a13a20a33wp(f13*a20*a33,-so fffield_x(1 0a13a21a30wp(f13*a21*a30) p',--)u=D0.... 0a13a21a31wp(f13*a21*a31m p',--)u=D0.... 0a13a21a32wp(f13*a21*a32,-so fffield_x(1 0a13a21a33wp(f13*a21*a33,-so fffield_x(1 0a13a22a30wp(f13*a22*a30) p',--)u=D0.... 0a13a22a31wp(f13*a22*a31m p',--)u=D0.... 0a13a22a32wp(f13*a22*a32,-so fffield_x(1 0a13a22a33wp(f13*a22*a33,-so fffield_x(1 0a13a23a30wp(f13*a23*a30) p',--)u=D0.... 0a13a23a31wp(f13*a23*a31m p',--)u=D0.... 0a13a23a32wp(f13*a23*a32,-so fffield_x(1 0a13a23a33wp(f13*a23*a33,, w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :1,en10,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :1,en10,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a32*poi,tsI :1,en10,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a33*poi,tsI :1,en10,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :1,en10,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :1,en10,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a32*poi,tsI :1,en10,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a33*poi,tsI :1,en10,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a30*poi,tsI :1,en10,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a31*poi,tsI :1,en10,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a32*poi,tsI :1,en10,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a33*poi,tsI :1,en10,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a30*poi,tsI :1,en10,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a31*poi,tsI :1,en10,en23,en31,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a32*poi,tsI :1,en10,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a33*poi,tsI :1,en10,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :1,en11,en20,en30,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :1,en11,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a32*poi,tsI :1,en11,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a33*poi,tsI :1,en11,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :1,en11,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :1,en11,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a32*poi,tsI :1,en11,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a33*poi,tsI :1,en11,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a30*poi,tsI :1,en11,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a31*poi,tsI :1,en11,en22,en31,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a32*poi,tsI :1,en11,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a33*poi,tsI :1,en11,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a30*poi,tsI :1,en11,en23,en30,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a31*poi,tsI :1,en11,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a32*poi,tsI :1,en11,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a33*poi,tsI :1,en11,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a30*poi,tsI :1,en12,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a31*poi,tsI :1,en12,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a32*poi,tsI :1,en12,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a33*poi,tsI :1,en12,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a30*poi,tsI :1,en12,en21,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a31*poi,tsI :1,en12,en21,en31,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a32*poi,tsI :1,en12,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a33*poi,tsI :1,en12,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a30*poi,tsI :1,en12,en22,en30,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a31*poi,tsI :1,en12,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a32*poi,tsI :1,en12,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a33*poi,tsI :1,en12,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a30*poi,tsI :1,en12,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a31*poi,tsI :1,en12,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a32*poi,tsI :1,en12,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a33*poi,tsI :1,en12,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a30*poi,tsI :1,en13,en20,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a31*poi,tsI :1,en13,en20,en31,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a32*poi,tsI :1,en13,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a33*poi,tsI :1,en13,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a30*poi,tsI :1,en13,en21,en30,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a31*poi,tsI :1,en13,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a32*poi,tsI :1,en13,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a33*poi,tsI :1,en13,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a30*poi,tsI :1,en13,en22,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a31*poi,tsI :1,en13,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a32*poi,tsI :1,en13,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a33*poi,tsI :1,en13,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a30*poi,tsI :1,en13,en23,en30,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a31*poi,tsI :1,en13,en23,en31,e! 2d fie __ -->ip --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a32*poi,tsI :1,en13,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(1ieq)e(nup(1ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a33*poi,tsI :1,en13,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :2,en10,en20,en30,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :2,en10,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a32*poi,tsI :2,en10,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a33*poi,tsI :2,en10,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :2,en10,en21,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :2,en10,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a32*poi,tsI :2,en10,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a33*poi,tsI :2,en10,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a30*poi,tsI :2,en10,en22,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a31*poi,tsI :2,en10,en22,en31,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a32*poi,tsI :2,en10,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a33*poi,tsI :2,en10,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a30*poi,tsI :2,en10,en23,en30,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a31*poi,tsI :2,en10,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a32*poi,tsI :2,en10,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a33*poi,tsI :2,en10,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :2,en11,en20,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :2,en11,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a32*poi,tsI :2,en11,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a33*poi,tsI :2,en11,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :2,en11,en21,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :2,en11,en21,en31,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a32*poi,tsI :2,en11,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a33*poi,tsI :2,en11,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a30*poi,tsI :2,en11,en22,en30,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a31*poi,tsI :2,en11,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a32*poi,tsI :2,en11,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a33*poi,tsI :2,en11,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a30*poi,tsI :2,en11,en23,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a31*poi,tsI :2,en11,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a32*poi,tsI :2,en11,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a33*poi,tsI :2,en11,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a30*poi,tsI :2,en12,en20,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a31*poi,tsI :2,en12,en20,en31,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a32*poi,tsI :2,en12,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a33*poi,tsI :2,en12,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a30*poi,tsI :2,en12,en21,en30,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a31*poi,tsI :2,en12,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a32*poi,tsI :2,en12,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a33*poi,tsI :2,en12,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a30*poi,tsI :2,en12,en22,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a31*poi,tsI :2,en12,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a32*poi,tsI :2,en12,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a33*poi,tsI :2,en12,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a30*poi,tsI :2,en12,en23,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a31*poi,tsI :2,en12,en23,en31,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a32*poi,tsI :2,en12,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a33*poi,tsI :2,en12,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a30*poi,tsI :2,en13,en20,en30,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a31*poi,tsI :2,en13,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a32*poi,tsI :2,en13,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a33*poi,tsI :2,en13,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a30*poi,tsI :2,en13,en21,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a31*poi,tsI :2,en13,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a32*poi,tsI :2,en13,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a33*poi,tsI :2,en13,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a30*poi,tsI :2,en13,en22,en30,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a31*poi,tsI :2,en13,en22,en31,e! 2d fie __ -->ip --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a32*poi,tsI :2,en13,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a33*poi,tsI :2,en13,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a30*poi,tsI :2,en13,en23,en30,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a31*poi,tsI :2,en13,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a32*poi,tsI :2,en13,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(2ieq)e(nup(2ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a33*poi,tsI :2,en13,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a30*poi,tsI :3,en10,en20,en30,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a31*poi,tsI :3,en10,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a32*poi,tsI :3,en10,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a20a33*poi,tsI :3,en10,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a30*poi,tsI :3,en10,en21,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a31*poi,tsI :3,en10,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a32*poi,tsI :3,en10,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a21a33*poi,tsI :3,en10,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a30*poi,tsI :3,en10,en22,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a31*poi,tsI :3,en10,en22,en31,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a32*poi,tsI :3,en10,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a22a33*poi,tsI :3,en10,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a30*poi,tsI :3,en10,en23,en30,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a31*poi,tsI :3,en10,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a32*poi,tsI :3,en10,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a10a23a33*poi,tsI :3,en10,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a30*poi,tsI :3,en11,en20,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a31*poi,tsI :3,en11,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a32*poi,tsI :3,en11,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a20a33*poi,tsI :3,en11,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a30*poi,tsI :3,en11,en21,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a31*poi,tsI :3,en11,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a32*poi,tsI :3,en11,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a21a33*poi,tsI :3,en11,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a30*poi,tsI :3,en11,en22,en30,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a31*poi,tsI :3,en11,en22,en31,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a32*poi,tsI :3,en11,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a22a33*poi,tsI :3,en11,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a30*poi,tsI :3,en11,en23,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a31*poi,tsI :3,en11,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a32*poi,tsI :3,en11,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a11a23a33*poi,tsI :3,en11,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a30*poi,tsI :3,en12,en20,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a31*poi,tsI :3,en12,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a32*poi,tsI :3,en12,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a20a33*poi,tsI :3,en12,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a30*poi,tsI :3,en12,en21,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a31*poi,tsI :3,en12,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a32*poi,tsI :3,en12,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a21a33*poi,tsI :3,en12,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a30*poi,tsI :3,en12,en22,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a31*poi,tsI :3,en12,en22,en31,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a32*poi,tsI :3,en12,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a22a33*poi,tsI :3,en12,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a30*poi,tsI :3,en12,en23,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a31*poi,tsI :3,en12,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a32*poi,tsI :3,en12,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a12a23a33*poi,tsI :3,en12,en23,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a30*poi,tsI :3,en13,en20,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a31*poi,tsI :3,en13,en20,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a32*poi,tsI :3,en13,en20,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a20a33*poi,tsI :3,en13,en20,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a30*poi,tsI :3,en13,en21,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a31*poi,tsI :3,en13,en21,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a32*poi,tsI :3,en13,en21,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a21a33*poi,tsI :3,en13,en21,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a30*poi,tsI :3,en13,en22,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a31*poi,tsI :3,en13,en22,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a32*poi,tsI :3,en13,en22,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a22a33*poi,tsI :3,en13,en22,en33,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a30*poi,tsI :3,en13,en23,en30,e! 2d fie __ -->ip --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a31*poi,tsI :3,en13,en23,en31,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a32*poi,tsI :3,en13,en23,en32,e! 2d w1,1, 3,0, 0 -- --up(3ieq)e(nup(3ieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0a13a23a33*poi,tsI :3,en13,en23,en33,e! 2d w1,1, 3,0, 0 --END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain w1,1, 3,0, 0 --����������������������������������������������������������������� w1,1, 3,0, 0 --� All oersr lda are not unrn-a . This will vectorizeiov Molda! w1,1, 3,0, 0 --����������������������������������������������������������������� w1,1, 3,0, 0ELSE w1,1, 3,0, 0 --e! 2nwww %--------OT! 2d DDDD! teaSXF90 !CDIR NODEPoc=ll#elif __MMMMMMM MMDOAipwww1pstorktopfo(D! 2d fie __ -->i....eq->ip= ----_b2troaww,ip! fie __ -->i....x0 + wp((kn-awiq)- sI awwi1(! fil))*3xinj-1,mk) ffffDDDDND NDx0 2 wp((kn-2wiq)- sI awwi2(! fil))*3xin2! ,mk) ffffDDDDND NDx0 3 wp((kn-3wiq)- sI awwi3(! fil))*3xin3! m -->ip)u= -->i....en10wp(INT(x0 + m -->ip)u= -->i....en20wp(INT(x0 2 m -->ip)u=D0.... ..ip30wp(INT(x0 3 mm -->ip)u=D0.... ..en11--- n10w(21m -->ip)u=D0.... ..in21--- n20x(21m -->ip)u=D0.... ..ip31--- n30x(21mm -->ip)u=D0.... ..en12--- n11w(21m -->ip)u=D0.... ..en22--- n21w(21m -->ip)u=D0.... ..en32--- n31x(21mm -->ip)u=D0.... ..en13--- n11w(2)ffffffffield_x(1 (1en23--- n21w(2)ffffffffield_x(1 (1en33--- n31x(22mm xp1---x0 + -REALo n10 ffffffffffield_x(1 (1xp2---x0 2 -REALo n20 ffffffffffield_x(1 (1xp3---x0 3 -REALo n30 fffffffffffield_x(1 (1x10wp(xp1x(21= 0 p'fffffffield_x(1 (1x11---x10w-d = 0 p'fffffffield_x(1 (1x12---x10w-d2= 0 p'fffffffield_x(1 (1x13---x10w-d3= 0 p',-so fffield_x(1 (1x20wp(xp)x(21= 0 p'fffffffield_x(1 (1x21---x20w-d = 0 p'fffffffield_x(1 (1x22---x20w-d2= 0 p'fffffffield_x(1 (1x23---x20w-d3= 0 p',-so fffield_x(1 (1x30wp(xp3x(21= 0 p'fffffffield_x(1 (1x31---x30w-d = 0 p'fffffffield_x(1 (1x32---x30w-d2= 0 p'fffffffield_x(1 (1x33---x30w-d3= 0 p',-so fffield_x(1 0a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 0a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 0a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 0a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 0a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 0a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 0a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 0a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 0a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 0a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 0a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 0a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1 0a10a20a30 p(f10*a20*a30) p',--)u=D0.... ..a10a20a31wp(f10*a20*a31m p',--)u=D0.... ..a10a20a32wp(f10*a20*a32,-so fffield_x(1 ..a10a20a33wp(f10*a20*a33,-so fffield_x(1 ..a10a21a30wp(f10*a21*a30) po fffield_x(1 ..a10a21a31wp(f10*a21*a31m p',--)u=D0.... ..a10a21a32wp(f10*a21*a32,-so fffield_x(1 ..a10a21a33wp(f10*a21*a33,-so fffield_x(1 ..a10a22a30wp(f10*a22*a30) p',--)u=D0.... ..a10a22a31wp(f10*a22*a31m p',--)u=D0.... ..a10a22a32wp(f10*a22*a32,-p',--)u=D0.... ..a10a22a33wp(f10*a22*a33,-so fffield_x(1 ..a10a23a30wp(f10*a23*a30) p',--)u=D0.... ..a10a23a31wp(f10*a23*a31m p',--)u=D0.... ..a10a23a32wp(f10*a23*a32,-so fffield_x(1 ..a10a23a33wp(f10*a23*a33,-so fffield_x(1 0a11a20a30 p(f11*a20*a30) p',--)u=D0.... ..a11a20a31wp(f11*a20*a31m p',--)u=D0.... ..a11a20a32wp(f11*a20*a32,-so fffield_x(1 ..a11a20a33wp(f11*a20*a33,-so fffield_x(1 ..a11a21a30wp(f11*a21*a30) p',--)u=D0.... ..a11a21a31wp(f11*a21*a31m p',--)u=D0.... ..a11a21a32wp(f11*a21*a32,-so fffield_x(1 ..a11a21a33wp(f11*a21*a33,-so fffield_x(1 ..a11a22a30wp(f11*a22*a30) p',--)u=D0.... ..a11a22a31wp(f11*a22*a31m p',--)u=D0.... ..a11a22a32wp(f11*a22*a32,-so fffield_x(1 ..a11a22a33wp(f11*a22*a33,-so fffield_x(1 ..a11a23a30wp(f11*a23*a30) p',--)u=D0.... ..a11a23a31wp(f11*a23*a31m p',--)u=D0.... ..a11a23a32wp(f11*a23*a32,-so fffield_x(1 ..a11a23a33wp(f11*a23*a33,-so fffield_x(1 0a12a20a30 p(f12*a20*a30) p',--)u=D0.... 0a12a20a31wp(f12*a20*a31m p',--)u=D0.... 0a12a20a32wp(f12*a20*a32,-so fffield_x(1 0a12a20a33wp(f12*a20*a33,-so fffield_x(1 0a12a21a30wp(f12*a21*a30) p',fffield_x(1 0a12a21a31wp(f12*a21*a31m p',--)u=D0.... 0a12a21a32wp(f12*a21*a32,-so fffield_x(1 0a12a21a33wp(f12*a21*a33,-so fffield_x(1 0a12a22a30wp(f12*a22*a30) p',--)u=D0.... 0a12a22a31wp(f12*a22*a31m p',--)u=D0.... 0a12a22a32wp(f12*a22*a32,-so fffield_x(1 0a12a22a33wp(f12*a22*a33,-so fffield_x(1 0a12a23a30wp(f12*a23*a30) p',--)u=D0.... 0a12a23a31wp(f12*a23*a31m p',--)u=D0.... 0a12a23a32wp(f12*a23*a32,-so fffield_x(1 0a12a23a33wp(f12*a23*a33,-so fffield_x(1 0a13a20a30 p(f13*a20*a30) po fffield_x(1 0a13a20a31wp(f13*a20*a31m p',--)u=D0.... 0a13a20a32wp(f13*a20*a32,-so fffield_x(1 0a13a20a33wp(f13*a20*a33,-so fffield_x(1 0a13a21a30wp(f13*a21*a30) p',--)u=D0.... 0a13a21a31wp(f13*a21*a31m p',--)u=D0.... 0a13a21a32wp(f13*a21*a32,-so fffield_x(1 0a13a21a33wp(f13*a21*a33,-so fffield_x(1 0a13a22a30wp(f13*a22*a30) p',--)u=D0.... 0a13a22a31wp(f13*a22*a31m p',--)u=D0.... 0a13a22a32wp(f13*a22*a32,-so fffield_x(1 0a13a22a33wp(f13*a22*a33,-so fffield_x(1 0a13a23a30wp(f13*a23*a30) p',--)u=D0.... 0a13a23a31wp(f13*a23*a31m p',--)u=D0.... 0a13a23a32wp(f13*a23*a32,-so fffield_x(1 0a13a23a33wp(f13*a23*a33,,-so fffield_x(1 0DO ldn=1,lda,-so fffield_x(1 0 --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a20a30*poi,tsI :ldnien10,en20,en30,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a20a31*poi,tsI :ldnien10,en20,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a20a32*poi,tsI :ldnien10,en20,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a20a33*poi,tsI :ldnien10,en20,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a21a30*poi,tsI :ldnien10,en21,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a21a31*poi,tsI :ldnien10,en21,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a21a32*poi,tsI :ldnien10,en21,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a21a33*poi,tsI :ldnien10,en21,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a22a30*poi,tsI :ldnien10,en22,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a22a31*poi,tsI :ldnien10,en22,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a22a32*poi,tsI :ldnien10,en22,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a22a33*poi,tsI :ldnien10,en22,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a23a30*poi,tsI :ldnien10,en23,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a23a31*poi,tsI :ldnien10,en23,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a23a32*poi,tsI :ldnien10,en23,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a10a23a33*poi,tsI :ldnien10,en23,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a20a30*poi,tsI :ldnien11,en20,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a20a31*poi,tsI :ldnien11,en20,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a20a32*poi,tsI :ldnien11,en20,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a20a33*poi,tsI :ldnien11,en20,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a21a30*poi,tsI :ldnien11,en21,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a21a31*poi,tsI :ldnien11,en21,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a21a32*poi,tsI :ldnien11,en21,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a21a33*poi,tsI :ldnien11,en21,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a22a30*poi,tsI :ldnien11,en22,en30,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a22a31*poi,tsI :ldnien11,en22,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a22a32*poi,tsI :ldnien11,en22,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a22a33*poi,tsI :ldnien11,en22,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a23a30*poi,tsI :ldnien11,en23,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a23a31*poi,tsI :ldnien11,en23,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a23a32*poi,tsI :ldnien11,en23,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a11a23a33*poi,tsI :ldnien11,en23,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a20a30*poi,tsI :ldnien12,en20,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a20a31*poi,tsI :ldnien12,en20,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a20a32*poi,tsI :ldnien12,en20,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a20a33*poi,tsI :ldnien12,en20,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a21a30*poi,tsI :ldnien12,en21,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a21a31*poi,tsI :ldnien12,en21,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a21a32*poi,tsI :ldnien12,en21,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a21a33*poi,tsI :ldnien12,en21,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a22a30*poi,tsI :ldnien12,en22,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a22a31*poi,tsI :ldnien12,en22,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a22a32*poi,tsI :ldnien12,en22,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a22a33*poi,tsI :ldnien12,en22,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a23a30*poi,tsI :ldnien12,en23,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a23a31*poi,tsI :ldnien12,en23,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a23a32*poi,tsI :ldnien12,en23,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a12a23a33*poi,tsI :ldnien12,en23,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a20a30*poi,tsI :ldnien13,en20,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a20a31*poi,tsI :ldnien13,en20,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a20a32*poi,tsI :ldnien13,en20,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a20a33*poi,tsI :ldnien13,en20,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a21a30*poi,tsI :ldnien13,en21,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a21a31*poi,tsI :ldnien13,en21,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a21a32*poi,tsI :ldnien13,en21,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a21a33*poi,tsI :ldnien13,en21,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a22a30*poi,tsI :ldnien13,en22,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a22a31*poi,tsI :ldnien13,en22,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a22a32*poi,tsI :ldnien13,en22,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a22a33*poi,tsI :ldnien13,en22,en33,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a23a30*poi,tsI :ldnien13,en23,en30,e! 2d fie __ -->ip -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a23a31*poi,tsI :ldnien13,en23,en31,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a23a32*poi,tsI :ldnien13,en23,en32,e! 2d w1,1, 3,0, 0 -- -- --up(ldnieq)e(nup(ldnieq)e(2) wwwwwwwwwww1,1, 3,0, 0 0 0a13a23a33*poi,tsI :ldnien13,en23,en33,e! 2d w1,1, 3,0, 0 0 0END DOA� lda,-so fffield_x(1END DOA� inysloopiov Mol MPI_I, D!Dvershcurr*, swwdomain w1,1, 3,0, 0END IFA� unrn-a lda casesoc=ll#elc=ll#elif __MMMMEND DOA� e! 2 DDDMMM__DIME ==M__2D DDDMMM__MODE ==M__SCA DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_ss_2dlc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_ds_2dlc=ll#elc=lifM__MODE ==M__VEC DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_sv_2dlc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_dv_2dlc=ll#elc=ll#elc=lifM__DIME ==M__3D DDDMMM__MODE ==M__SCA DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_ss_3dlc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_ds_3dlc=ll#elc=lifM__MODE ==M__VEC DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_sv_3dlc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMEND SUBROUTINE m2p_interp_mp4_dv_3dlc=ll#elc=ll#elc=ll#el�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/interpolate/p2m_interp_mp4.f�������������������������������������������������������0000644�0001752�0001753�00000315562�11616003523�021313� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������__MMMM�������������������������������������������������������������������������� w1,1, !1,1, Subroutine1, :ww1,1, 3,0, 0 0 0p2m_interp_mp4 __MMMM�������������������������������������������������������������������������� w1,1, !1Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), w1,1, !1,1, Center for Fluid Dynamics (DTUd w1,1, ! w1,1, ! w1,1, ! This file e!ol MP ofvershPara-a lhParPI_I, Mesh Library (PPM). w1,1, ! w1,1, ! PPM e!ofree software: you can redistribute et and/or mol#ey w1,1, ! it under ershterms ofvershGNU Lesser Genera- P----c License w1,1, !1a!ol-----h byvershFree Software Foundation, eiersr w1,1, !1v Msion 3 ofvershLicense, or (at your option) any later w1,1, !1v Msion. w1,1, ! w1,1, ! PPM e!odistributedD!Dvershhopshthat it will be useful, w1,1, ! but WITHOUT ANY WARRANTY; without eveDvershimpliedDwarranty of w1,1, ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Seshthe w1,1, ! GNU Genera- P----c License for more details. w1,1, ! w1,1, ! You should have receivedDa copy ofvershGNU Genera- P----c License w1,1, !1anysershGNU Lesser Genera- P----c License along with PPM. If not, w1,1, ! sesh<http://www.gnu.org/licenses/>. w1,1, ! w1,1, ! Para-a lhParPI_I, Mesh Library (PPM) w1,1, ! ETH Zurich w1,1, !1CH-8092 Zurich, Switzerlany __MMMM�������������������������������������������������������������������������� DDDMMM__DIME ==M__2D DDDMMM__MODE ==M__SCA DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_ss_2d( id,xp,up,poi,tsI ,ghostsize,dx,opfo)lc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_ds_2d( id,xp,up,poi,tsI ,ghostsize,dx,opfo)lc=ll#elc=lifM__MODE ==M__VEC DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_sv_2d( id,xp,up,poi,tsI ,lda,ghostsize,dx,opfo)lc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_dv_2d( id,xp,up,poi,tsI ,lda,ghostsize,dx,opfo)lc=ll#elc=ll#elc=lifM__DIME ==M__3D DDDMMM__MODE ==M__SCA DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_ss_3d( id,xp,up,poi,tsI ,ghostsize,dx,opfo)lc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_ds_3d( id,xp,up,poi,tsI ,ghostsize,dx,opfo)lc=ll#elc=lifM__MODE ==M__VEC DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_sv_3d( id,xp,up,poi,tsI ,lda,ghostsize,dx,opfo)lc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMSUBROUTINE p2m_interp_mp4_dv_3d( id,xp,up,poi,tsI ,lda,ghostsize,dx,opfo)lc=ll#elc=ll#elc=ll#el_MMMM�!!hParPI_I, to mesh interpolation following ershM-prime-4 scheme.l_MMMM�!!l_MMMM�!!hTrshinterpolation scheme e!oonlyhimplementedDfor 2D1anys3D spaces. Tol_MMMM�!!hincrease performancevershinn Moloopsiov Moershnumb MoofvpropsrPIes tol_MMMM�!!hbshinterpolatedDare unrn-a for 2,3,41anys5-vectors.l_MMMM�!! l_MMMM�!! [NOTE]l_MMMM�!!hTre!oroutine1onlyhperformsoershactua- interpolation. It should not bel_MMMM�!!hca-a directlyhbyvershuser but insteaysersh`ppm_interp_m2p`l_MMMM�!!hroutine1should be used with ershkern lhargum*, set to l_MMMM�!!h`ppm_l Mam_rmsh_kern l_mp4`. ,,-so ffUSE ppm_molule_error,-so ffUSE ppm_molule_a-aoc,-so ffUSE ppm_molule_substart,-so ffUSE ppm_molule_substop,-so ffUSE ppm_molule_data,-so ffUSE ppm_molule_data_rmsh,-so ffUSE ppm_molule_data_mesh,-so ffUSE ppm_molule_typedef,-so ffUSE ppm_molule_write,-so ffUSE ppm_molule_map ,,-so ffIMPLICIT NONE DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMINTEGER, PARAMETER :: MK = ppm_kind_singlelc=lifM__KIND ==M__DOUBLE_PRECISION __MMMMINTEGER, PARAMETER :: MK = ppm_kind_do---elc=ll#elif __M�������������������������������������������������������������������������! w1,1, ! Argum*, slif __M�������������������������������������������������������������������������! w1,1, INTEGER , INTENT(IN ) :: idlif __M�!!h logyhid*, ipoir (user numb Ming) ofvearget DDDMMM__MODE ==M__SCA if __MREALoMK) , DIMENSION(:) , INTENT(IN) :: uplif __M�!!hl MPI_I, weight!ofrom which to interpolate DDDMMM__DIME ==M__2D if __MREALoMK) , DIMENSION(:,:,: ) , POINTER :: poi,tsI lc=lifM__DIME ==M__3D if __MREALoMK) , DIMENSION(:,:,:,: ) , POINTER :: poi,tsI lc=ll#elif __M�!!hpoi,t1onto which to interpolate D=lifM__MODE ==M__VEC w1,1, INTEGER , INTENT(IN) :: lda,-so ff�!!hleaying dimension ofvuplif __MREALoMK) , DIMENSION(:,:) , INTENT(IN) :: uplif __M�!!hl MPI_I, weight!ofrom which to interpolate DDDMMM__DIME ==M__2D if __MREALoMK) , DIMENSION(:,:,:,: ) , POINTER :: poi,tsI lc=lifM__DIME ==M__3D if __MREALoMK) , DIMENSION(:,:,:,:,:) , POINTER :: poi,tsI lc=ll#elif __M�!!hpoi,t1onto which to interpolate D=ll#elif __MREALoMK), DIMENSION(:,:) , INTENT(IN ) :: xplif __M�!!hl MPI_I, positions w1,1, INTEGER , DIMENSION(: ) , INTENT(IN ) :: ghostsizelif __M�!!hTrshsize (width) ofvershghost layerlif __MREALomk), DIMENSION(ppm_dim) , INTENT(IN ) :: dxlif __M�!!hmesh spacing w1,1, INTEGER , INTENT( OUT) :: opfolif __M�!!hReturns status, 0 upon successlif __M�������������������������������������������������������������������������! w1,1, ! Loca- varia--eslif __M�������������������������������������������������������������������������! w1,1, INTEGER, DIMENSION(:,:) , POINTER :: ostart => NULL() w1,1, INTEGER, DIMENSION(:,:) , POINTER :: ndata => NULL() w1,1, INTEGER, DIMENSION(:) , POINTER :: o----1 => NULL() w1,1, INTEGER, DIMENSION(:) , POINTER :: o----2 => NULL() w1,1, REALomk), DIMENSION(:) , POINTER :: sI phys => NULL() w1,1, REALomk), DIMENSION(:) , POINTER :: ax phys => NULL() w1,1, REALomk), DIMENSION(ppm_dim) :: dxi w1,1, REALomk) :: dxx,dxy,dxz,dxxi,dxyi,dxzi w1,1, REALomk), DIMENSION(ppm_dim) :: leI phys w1,1, REALomk) :: x1,x2,x3 w1,1, INTEGER :: kern l_support,-so ffINTEGER, DIMENSION(ppm_dim+2) :: ldu,ldl,-so ffINTEGER, DIMENSION(ppm_dim) :: Nc w1,1, INTEGER :: i,j,k,l,ii,jj,kk,iidec,maptype w1,1, INTEGER :: xlo,xhi,ylo,yhi,zlo,zhi w1,1, INTEGER :: jjdec,nb_sub,nl MP,ipart,-so ffINTEGER :: kkdec,ip1,n----1 w1,1, INTEGER :: ip2,en3,iface w1,1, INTEGER :: iaww,ifrom,ito,en,iopt(! fil w1,1, INTEGER :: ax partnumb M,idom,n----2,idoml,-so ffINTEGER, DIMENSION(ppm_dim) :: Nm w1,1, INTEGER :: nsubs,-so ffINTEGER, DIMENSION(6) :: bcdef,-so ffINTEGER :: iq,-so ffLOGICAL :: internal_weight!,lok w1,1, ! aliasesow1,1, REALomk), DIMENSION(:,:),w1,1, POINTER :: sI sub => NULL() w1,1, REALomk), DIMENSION(:,:),w1,1, POINTER :: ax sub => NULL() w1,1, REALomk) :: myeps w1,1, REALomk) :: tim1s, tim1e w1,1, REALomk) :: xp1,xp2,xp3 w1,1, REALomk) :: wx1,wx2,wx3 w1,1, REALomk), DIMENSION(ppm_dim) :: x0 w1,1, REALomk) :: x01,x02,x03 w1,1, CHARACTER(leI=256) :: msg w1,1, TYPE(ppm_t_ ) , POINTER :: => NULL() w1,1, �������������������������������������������������������������������������! w1,1, ! Varia--es for unrn-a v Msionslif __M�������������������������������������������������������������������������! w1,1, REALomk) :: x10,x11,x12,x13,x20,x21,x22,x23,x30,x31,x32,x33 w1,1, REALomk) :: a10,a11,a12,a13,a20,a21,a22,a23,a30,a31,a32,a33,-so ffINTEGER :: ip10,en11,en12,en13,en20,en21,en22,en23,en30,en31,en32,ep33,-so ffINTEGER :: ldn w1,1, REALomk) :: a10a20a30 w1,1, REALomk) :: a10a20a31 w1,1, REALomk) :: a10a20a32 w1,1, REALomk) :: a10a20a33 w1,1, REALomk) :: a10a21a30 w1,1, REALomk) :: a10a21a31 w1,1, REALomk) :: a10a21a32 w1,1, REALomk) :: a10a21a33 w1,1, REALomk) :: a10a22a30 w1,1, REALomk) :: a10a22a31 w1,1, REALomk) :: a10a22a32 w1,1, REALomk) :: a10a22a33 w1,1, REALomk) :: a10a23a30 w1,1, REALomk) :: a10a23a31 w1,1, REALomk) :: a10a23a32 w1,1, REALomk) :: a10a23a33 w1,1, REALomk) :: a11a20a30 w1,1, REALomk) :: a11a20a31 w1,1, REALomk) :: a11a20a32 w1,1, REALomk) :: a11a20a33 w1,1, REALomk) :: a11a21a30 w1,1, REALomk) :: a11a21a31 w1,1, REALomk) :: a11a21a32 w1,1, REALomk) :: a11a21a33 w1,1, REALomk) :: a11a22a30 w1,1, REALomk) :: a11a22a31 w1,1, REALomk) :: a11a22a32 w1,1, REALomk) :: a11a22a33 w1,1, REALomk) :: a11a23a30 w1,1, REALomk) :: a11a23a31 w1,1, REALomk) :: a11a23a32 w1,1, REALomk) :: a11a23a33 w1,1, REALomk) :: a12a20a30 w1,1, REALomk) :: a12a20a31 w1,1, REALomk) :: a12a20a32 w1,1, REALomk) :: a12a20a33 w1,1, REALomk) :: a12a21a30 w1,1, REALomk) :: a12a21a31 w1,1, REALomk) :: a12a21a32 w1,1, REALomk) :: a12a21a33 w1,1, REALomk) :: a12a22a30 w1,1, REALomk) :: a12a22a31 w1,1, REALomk) :: a12a22a32 w1,1, REALomk) :: a12a22a33 w1,1, REALomk) :: a12a23a30 w1,1, REALomk) :: a12a23a31 w1,1, REALomk) :: a12a23a32 w1,1, REALomk) :: a12a23a33 w1,1, REALomk) :: a13a20a30 w1,1, REALomk) :: a13a20a31 w1,1, REALomk) :: a13a20a32 w1,1, REALomk) :: a13a20a33 w1,1, REALomk) :: a13a21a30 w1,1, REALomk) :: a13a21a31 w1,1, REALomk) :: a13a21a32 w1,1, REALomk) :: a13a21a33 w1,1, REALomk) :: a13a22a30 w1,1, REALomk) :: a13a22a31 w1,1, REALomk) :: a13a22a32 w1,1, REALomk) :: a13a22a33 w1,1, REALomk) :: a13a23a30 w1,1, REALomk) :: a13a23a31 w1,1, REALomk) :: a13a23a32 w1,1, REALomk) :: a13a23a33 ,,-so f��������������������������������������������������������������������������!l_MMMM�ffInitialise w1,1,��������������������������������������������������������������������������!l w1,1, CALL substart('p2m_interp_mp4',t0,opfo)l w1,1, => ppm_t ( id)%t,,-so f��������������������������������������������������������������������������!l_MMMM�ffMesh spacing w1,1,��������������������������������������������������������������������������!lDDDMMM__KIND ==M__SINGLE_PRECISION __MMM sI phys => % sI physslif __ ax phys => % ax physslc=lifM__KIND ==M__DOUBLE_PRECISION __MMM sI phys => % sI physdlif __ ax phys => % ax physdlc=ll#el DDDMMM__KIND ==M__SINGLE_PRECISION __MMMMmyeps = ppm_myepsslif __M sI sub => % sI subs,-so ff ax sub => % ax subs,c=lifM__KIND ==M__DOUBLE_PRECISION __MMMMmyeps = ppm_myepsdlif __M sI sub => % sI subd,-so ff ax sub => % ax subdlc=ll#el ,-so ffdxxi p( = 0 p/dxnj-1,mk) fdxyi p( = 0 p/dxn2! ,mk) fIF(ppm_dim.EQ.3) dxzi p( = 0 p/dxn3! m DDDM__DIME ==M__3D ,mk) fMMDOAisub = 1, %n-------m DDDM__MODE ==M__VEC ,mk) fMM w1,1,�����������������������������������������������������������������! w1,1, 3,0, 0 -�ffUnrn-a v Msions for 3-vectors ,mk) fMM w1,1,�����������������������������������������������������������������! w1,1, 3,0, IF (lda .EQ. 3) THEN ,mk) fMM w1,1,e! 2nwww %--------OT! 2d ,mk) fMM w1,1,DOAipwww1pstorktopfo(D! 2d ,mk) fMM w1,1, ..eq->ip= ----_b2troaww,ip! fie __ -->i...x01 p((kn-awiq)- sI awwi1(! fil))*3xxi w1,1, __ -->i...x02 p((kn-2wiq)- sI awwi2(! fil))*3xyi w1,1, __ -->i...x03 p((kn-3wiq)- sI awwi3(! fil))*3xzi ,mk) fMM w1,1, ..en10wp(INT(x0j-1,mk) ffffDDDDND Nen20wp(INT(x02! ,mk) ffffDDDDND Nip30wp(INT(x03! m -->ip)u= -->i...en11--- n10w(21m -->ip)u=D0.... .in21--- n20x(21m -->ip)u=D0.... .ip31--- n30x(21mm -->ip)u=D0.... .en12--- n11w(21m -->ip)u=D0.... .en22--- n21w(21m -->ip)u=D0.... .en32--- n31x(21mm -->ip)u=D0.... .en13--- n11w(2)ffffffffield_x(1 (en23--- n21w(2)ffffffffield_x(1 (en33--- n31x(22mm xp1---x01-REALo n10 ffffffffffield_x(1 (xp2---x02-REALo n20 ffffffffffield_x(1 (xp3---x03-REALo n30 fffffffffffield_x(1 (x10wp(xp1x(21= 0 p'fffffffield_x(1 (x11---x10w-d = 0 p'fffffffield_x(1 (x12---x10w-d2= 0 p'fffffffield_x(1 (x13---x10w-d3= 0 p',-so fffield_x(1 (x20wp(xp)x(21= 0 p'fffffffield_x(1 (x21---x20w-d = 0 p'fffffffield_x(1 (x22---x20w-d2= 0 p'fffffffield_x(1 (x23---x20w-d3= 0 p',-so fffield_x(1 (x30wp(xp3x(21= 0 p'fffffffield_x(1 (x31---x30w-d = 0 p'fffffffield_x(1 (x32---x30w-d2= 0 p'fffffffield_x(1 (x33---x30w-d3= 0 p',-so fffield_x(1 a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1 a10a20a30 p(f10*a20*a30) p',--)u=D0.... .a10a20a31wp(f10*a20*a31m p',--)u=D0.... .a10a20a32wp(f10*a20*a32,-so fffield_x(1 .a10a20a33wp(f10*a20*a33,-so fffield_x(1 .a10a21a30wp(f10*a21*a30) po fffield_x(1 .a10a21a31wp(f10*a21*a31m p',--)u=D0.... .a10a21a32wp(f10*a21*a32,-so fffield_x(1 .a10a21a33wp(f10*a21*a33,-so fffield_x(1 .a10a22a30wp(f10*a22*a30) p',--)u=D0.... .a10a22a31wp(f10*a22*a31m p',--)u=D0.... .a10a22a32wp(f10*a22*a32,-p',--)u=D0.... .a10a22a33wp(f10*a22*a33,-so fffield_x(1 .a10a23a30wp(f10*a23*a30) p',--)u=D0.... .a10a23a31wp(f10*a23*a31m p',--)u=D0.... .a10a23a32wp(f10*a23*a32,-so fffield_x(1 .a10a23a33wp(f10*a23*a33,-so fffield_x(1 a11a20a30 p(f11*a20*a30) p',--)u=D0.... .a11a20a31wp(f11*a20*a31m p',--)u=D0.... .a11a20a32wp(f11*a20*a32,-so fffield_x(1 .a11a20a33wp(f11*a20*a33,-so fffield_x(1 .a11a21a30wp(f11*a21*a30) p',--)u=D0.... .a11a21a31wp(f11*a21*a31m p',--)u=D0.... .a11a21a32wp(f11*a21*a32,-so fffield_x(1 .a11a21a33wp(f11*a21*a33,-so fffield_x(1 .a11a22a30wp(f11*a22*a30) p',--)u=D0.... .a11a22a31wp(f11*a22*a31m p',--)u=D0.... .a11a22a32wp(f11*a22*a32,-so fffield_x(1 .a11a22a33wp(f11*a22*a33,-so fffield_x(1 .a11a23a30wp(f11*a23*a30) p',--)u=D0.... .a11a23a31wp(f11*a23*a31m p',--)u=D0.... .a11a23a32wp(f11*a23*a32,-so fffield_x(1 .a11a23a33wp(f11*a23*a33,-so fffield_x(1 a12a20a30 p(f12*a20*a30) p',--)u=D0.... a12a20a31wp(f12*a20*a31m p',--)u=D0.... a12a20a32wp(f12*a20*a32,-so fffield_x(1 a12a20a33wp(f12*a20*a33,-so fffield_x(1 a12a21a30wp(f12*a21*a30) p',fffield_x(1 a12a21a31wp(f12*a21*a31m p',--)u=D0.... a12a21a32wp(f12*a21*a32,-so fffield_x(1 a12a21a33wp(f12*a21*a33,-so fffield_x(1 a12a22a30wp(f12*a22*a30) p',--)u=D0.... a12a22a31wp(f12*a22*a31m p',--)u=D0.... a12a22a32wp(f12*a22*a32,-so fffield_x(1 a12a22a33wp(f12*a22*a33,-so fffield_x(1 a12a23a30wp(f12*a23*a30) p',--)u=D0.... a12a23a31wp(f12*a23*a31m p',--)u=D0.... a12a23a32wp(f12*a23*a32,-so fffield_x(1 a12a23a33wp(f12*a23*a33,-so fffield_x(1 a13a20a30 p(f13*a20*a30) po fffield_x(1 a13a20a31wp(f13*a20*a31m p',--)u=D0.... a13a20a32wp(f13*a20*a32,-so fffield_x(1 a13a20a33wp(f13*a20*a33,-so fffield_x(1 a13a21a30wp(f13*a21*a30) p',--)u=D0.... a13a21a31wp(f13*a21*a31m p',--)u=D0.... a13a21a32wp(f13*a21*a32,-so fffield_x(1 a13a21a33wp(f13*a21*a33,-so fffield_x(1 a13a22a30wp(f13*a22*a30) p',--)u=D0.... a13a22a31wp(f13*a22*a31m p',--)u=D0.... a13a22a32wp(f13*a22*a32,-so fffield_x(1 a13a22a33wp(f13*a22*a33,-so fffield_x(1 a13a23a30wp(f13*a23*a30) p',--)u=D0.... a13a23a31wp(f13*a23*a31m p',--)u=D0.... a13a23a32wp(f13*a23*a32,-so fffield_x(1 a13a23a33wp(f13*a23*a33,,DDDD! teaNOMICROINSTRUCTIONS,-so ffpoi,tsI :1,en10,en20,en30,e! 2d=poi,tsI :1,en10,en20,en30,e! 2d+) &a10a20a30*un-awiq),-so ffpoi,tsI :2,en10,en20,en30,e! 2d=poi,tsI :2,en10,en20,en30,e! 2d+) &a10a20a30*un-2wiq),-so ffpoi,tsI :3,en10,en20,en30,e! 2d=poi,tsI :3,en10,en20,en30,e! 2d+) &a10a20a30*un-3wiq),-so ffpoi,tsI :1,en11,en20,en30,e! 2d=poi,tsI :1,en11,en20,en30,e! 2d+) &a11a20a30*un-awiq),-so ffpoi,tsI :2,en11,en20,en30,e! 2d=poi,tsI :2,en11,en20,en30,e! 2d+) &a11a20a30*un-2wiq),-so ffpoi,tsI :3,en11,en20,en30,e! 2d=poi,tsI :3,en11,en20,en30,e! 2d+) &a11a20a30*un-3wiq),-so ffpoi,tsI :1,en12,en20,en30,e! 2d=poi,tsI :1,en12,en20,en30,e! 2d+) &a12a20a30*un-awiq),-so ffpoi,tsI :2,en12,en20,en30,e! 2d=poi,tsI :2,en12,en20,en30,e! 2d+) &a12a20a30*un-2wiq),-so ffpoi,tsI :3,en12,en20,en30,e! 2d=poi,tsI :3,en12,en20,en30,e! 2d+) &a12a20a30*un-3wiq),-so ffpoi,tsI :1,en13,en20,en30,e! 2d=poi,tsI :1,en13,en20,en30,e! 2d+) &a13a20a30*un-awiq),-so ffpoi,tsI :2,en13,en20,en30,e! 2d=poi,tsI :2,en13,en20,en30,e! 2d+) &a13a20a30*un-2wiq),-so ffpoi,tsI :3,en13,en20,en30,e! 2d=poi,tsI :3,en13,en20,en30,e! 2d+) &a13a20a30*un-3wiq),-so ffpoi,tsI :1,en10,en21,en30,e! 2d=poi,tsI :1,en10,en21,en30,e! 2d+) &a10a21a30*un-awiq),-so ffpoi,tsI :2,en10,en21,en30,e! 2d=poi,tsI :2,en10,en21,en30,e! 2d+) &a10a21a30*un-2wiq),-so ffpoi,tsI :3,en10,en21,en30,e! 2d=poi,tsI :3,en10,en21,en30,e! 2d+) &a10a21a30*un-3wiq),-so ffpoi,tsI :1,en11,en21,en30,e! 2d=poi,tsI :1,en11,en21,en30,e! 2d+) &a11a21a30*un-awiq),-so ffpoi,tsI :2,en11,en21,en30,e! 2d=poi,tsI :2,en11,en21,en30,e! 2d+) &a11a21a30*un-2wiq),-so ffpoi,tsI :3,en11,en21,en30,e! 2d=poi,tsI :3,en11,en21,en30,e! 2d+) &a11a21a30*un-3wiq),-so ffpoi,tsI :1,en12,en21,en30,e! 2d=poi,tsI :1,en12,en21,en30,e! 2d+) &a12a21a30*un-awiq),-so ffpoi,tsI :2,en12,en21,en30,e! 2d=poi,tsI :2,en12,en21,en30,e! 2d+) &a12a21a30*un-2wiq),-so ffpoi,tsI :3,en12,en21,en30,e! 2d=poi,tsI :3,en12,en21,en30,e! 2d+) &a12a21a30*un-3wiq),-so ffpoi,tsI :1,en13,en21,en30,e! 2d=poi,tsI :1,en13,en21,en30,e! 2d+) &a13a21a30*un-awiq),-so ffpoi,tsI :2,en13,en21,en30,e! 2d=poi,tsI :2,en13,en21,en30,e! 2d+) &a13a21a30*un-2wiq),-so ffpoi,tsI :3,en13,en21,en30,e! 2d=poi,tsI :3,en13,en21,en30,e! 2d+) &a13a21a30*un-3wiq),-so ffpoi,tsI :1,en10,en22,en30,e! 2d=poi,tsI :1,en10,en22,en30,e! 2d+) &a10a22a30*un-awiq),-so ffpoi,tsI :2,en10,en22,en30,e! 2d=poi,tsI :2,en10,en22,en30,e! 2d+) &a10a22a30*un-2wiq),-so ffpoi,tsI :3,en10,en22,en30,e! 2d=poi,tsI :3,en10,en22,en30,e! 2d+) &a10a22a30*un-3wiq),-so ffpoi,tsI :1,en11,en22,en30,e! 2d=poi,tsI :1,en11,en22,en30,e! 2d+) &a11a22a30*un-awiq),-so ffpoi,tsI :2,en11,en22,en30,e! 2d=poi,tsI :2,en11,en22,en30,e! 2d+) &a11a22a30*un-2wiq),-so ffpoi,tsI :3,en11,en22,en30,e! 2d=poi,tsI :3,en11,en22,en30,e! 2d+) &a11a22a30*un-3wiq),-so ffpoi,tsI :1,en12,en22,en30,e! 2d=poi,tsI :1,en12,en22,en30,e! 2d+) &a12a22a30*un-awiq),-so ffpoi,tsI :2,en12,en22,en30,e! 2d=poi,tsI :2,en12,en22,en30,e! 2d+) &a12a22a30*un-2wiq),-so ffpoi,tsI :3,en12,en22,en30,e! 2d=poi,tsI :3,en12,en22,en30,e! 2d+) &a12a22a30*un-3wiq),-so ffpoi,tsI :1,en13,en22,en30,e! 2d=poi,tsI :1,en13,en22,en30,e! 2d+) &a13a22a30*un-awiq),-so ffpoi,tsI :2,en13,en22,en30,e! 2d=poi,tsI :2,en13,en22,en30,e! 2d+) &a13a22a30*un-2wiq),-so ffpoi,tsI :3,en13,en22,en30,e! 2d=poi,tsI :3,en13,en22,en30,e! 2d+) &a13a22a30*un-3wiq),-so ffpoi,tsI :1,en10,en23,en30,e! 2d=poi,tsI :1,en10,en23,en30,e! 2d+) &a10a23a30*un-awiq),-so ffpoi,tsI :2,en10,en23,en30,e! 2d=poi,tsI :2,en10,en23,en30,e! 2d+) &a10a23a30*un-2wiq),-so ffpoi,tsI :3,en10,en23,en30,e! 2d=poi,tsI :3,en10,en23,en30,e! 2d+) &a10a23a30*un-3wiq),-so ffpoi,tsI :1,en11,en23,en30,e! 2d=poi,tsI :1,en11,en23,en30,e! 2d+) &a11a23a30*un-awiq),-so ffpoi,tsI :2,en11,en23,en30,e! 2d=poi,tsI :2,en11,en23,en30,e! 2d+) &a11a23a30*un-2wiq),-so ffpoi,tsI :3,en11,en23,en30,e! 2d=poi,tsI :3,en11,en23,en30,e! 2d+) &a11a23a30*un-3wiq),-so ffpoi,tsI :1,en12,en23,en30,e! 2d=poi,tsI :1,en12,en23,en30,e! 2d+) &a12a23a30*un-awiq),-so ffpoi,tsI :2,en12,en23,en30,e! 2d=poi,tsI :2,en12,en23,en30,e! 2d+) &a12a23a30*un-2wiq),-so ffpoi,tsI :3,en12,en23,en30,e! 2d=poi,tsI :3,en12,en23,en30,e! 2d+) &a12a23a30*un-3wiq),-so ffpoi,tsI :1,en13,en23,en30,e! 2d=poi,tsI :1,en13,en23,en30,e! 2d+) &a13a23a30*un-awiq),-so ffpoi,tsI :2,en13,en23,en30,e! 2d=poi,tsI :2,en13,en23,en30,e! 2d+) &a13a23a30*un-2wiq),-so ffpoi,tsI :3,en13,en23,en30,e! 2d=poi,tsI :3,en13,en23,en30,e! 2d+) &a13a23a30*un-3wiq),-so ffpoi,tsI :1,en10,en20,en31,e! 2d=poi,tsI :1,en10,en20,en31,e! 2d+) &a10a20a31*un-awiq),-so ffpoi,tsI :2,en10,en20,en31,e! 2d=poi,tsI :2,en10,en20,en31,e! 2d+) &a10a20a31*un-2wiq),-so ffpoi,tsI :3,en10,en20,en31,e! 2d=poi,tsI :3,en10,en20,en31,e! 2d+) &a10a20a31*un-3wiq),-so ffpoi,tsI :1,en11,en20,en31,e! 2d=poi,tsI :1,en11,en20,en31,e! 2d+) &a11a20a31*un-awiq),-so ffpoi,tsI :2,en11,en20,en31,e! 2d=poi,tsI :2,en11,en20,en31,e! 2d+) &a11a20a31*un-2wiq),-so ffpoi,tsI :3,en11,en20,en31,e! 2d=poi,tsI :3,en11,en20,en31,e! 2d+) &a11a20a31*un-3wiq),-so ffpoi,tsI :1,en12,en20,en31,e! 2d=poi,tsI :1,en12,en20,en31,e! 2d+) &a12a20a31*un-awiq),-so ffpoi,tsI :2,en12,en20,en31,e! 2d=poi,tsI :2,en12,en20,en31,e! 2d+) &a12a20a31*un-2wiq),-so ffpoi,tsI :3,en12,en20,en31,e! 2d=poi,tsI :3,en12,en20,en31,e! 2d+) &a12a20a31*un-3wiq),-so ffpoi,tsI :1,en13,en20,en31,e! 2d=poi,tsI :1,en13,en20,en31,e! 2d+) &a13a20a31*un-awiq),-so ffpoi,tsI :2,en13,en20,en31,e! 2d=poi,tsI :2,en13,en20,en31,e! 2d+) &a13a20a31*un-2wiq),-so ffpoi,tsI :3,en13,en20,en31,e! 2d=poi,tsI :3,en13,en20,en31,e! 2d+) &a13a20a31*un-3wiq),-so ffpoi,tsI :1,en10,en21,en31,e! 2d=poi,tsI :1,en10,en21,en31,e! 2d+) &a10a21a31*un-awiq),-so ffpoi,tsI :2,en10,en21,en31,e! 2d=poi,tsI :2,en10,en21,en31,e! 2d+) &a10a21a31*un-2wiq),-so ffpoi,tsI :3,en10,en21,en31,e! 2d=poi,tsI :3,en10,en21,en31,e! 2d+) &a10a21a31*un-3wiq),-so ffpoi,tsI :1,en11,en21,en31,e! 2d=poi,tsI :1,en11,en21,en31,e! 2d+) &a11a21a31*un-awiq),-so ffpoi,tsI :2,en11,en21,en31,e! 2d=poi,tsI :2,en11,en21,en31,e! 2d+) &a11a21a31*un-2wiq),-so ffpoi,tsI :3,en11,en21,en31,e! 2d=poi,tsI :3,en11,en21,en31,e! 2d+) &a11a21a31*un-3wiq),-so ffpoi,tsI :1,en12,en21,en31,e! 2d=poi,tsI :1,en12,en21,en31,e! 2d+) &a12a21a31*un-awiq),-so ffpoi,tsI :2,en12,en21,en31,e! 2d=poi,tsI :2,en12,en21,en31,e! 2d+) &a12a21a31*un-2wiq),-so ffpoi,tsI :3,en12,en21,en31,e! 2d=poi,tsI :3,en12,en21,en31,e! 2d+) &a12a21a31*un-3wiq),-so ffpoi,tsI :1,en13,en21,en31,e! 2d=poi,tsI :1,en13,en21,en31,e! 2d+) &a13a21a31*un-awiq),-so ffpoi,tsI :2,en13,en21,en31,e! 2d=poi,tsI :2,en13,en21,en31,e! 2d+) &a13a21a31*un-2wiq),-so ffpoi,tsI :3,en13,en21,en31,e! 2d=poi,tsI :3,en13,en21,en31,e! 2d+) &a13a21a31*un-3wiq),-so ffpoi,tsI :1,en10,en22,en31,e! 2d=poi,tsI :1,en10,en22,en31,e! 2d+) &a10a22a31*un-awiq),-so ffpoi,tsI :2,en10,en22,en31,e! 2d=poi,tsI :2,en10,en22,en31,e! 2d+) &a10a22a31*un-2wiq),-so ffpoi,tsI :3,en10,en22,en31,e! 2d=poi,tsI :3,en10,en22,en31,e! 2d+) &a10a22a31*un-3wiq),-so ffpoi,tsI :1,en11,en22,en31,e! 2d=poi,tsI :1,en11,en22,en31,e! 2d+) &a11a22a31*un-awiq),-so ffpoi,tsI :2,en11,en22,en31,e! 2d=poi,tsI :2,en11,en22,en31,e! 2d+) &a11a22a31*un-2wiq),-so ffpoi,tsI :3,en11,en22,en31,e! 2d=poi,tsI :3,en11,en22,en31,e! 2d+) &a11a22a31*un-3wiq),-so ffpoi,tsI :1,en12,en22,en31,e! 2d=poi,tsI :1,en12,en22,en31,e! 2d+) &a12a22a31*un-awiq),-so ffpoi,tsI :2,en12,en22,en31,e! 2d=poi,tsI :2,en12,en22,en31,e! 2d+) &a12a22a31*un-2wiq),-so ffpoi,tsI :3,en12,en22,en31,e! 2d=poi,tsI :3,en12,en22,en31,e! 2d+) &a12a22a31*un-3wiq),-so ffpoi,tsI :1,en13,en22,en31,e! 2d=poi,tsI :1,en13,en22,en31,e! 2d+) &a13a22a31*un-awiq),-so ffpoi,tsI :2,en13,en22,en31,e! 2d=poi,tsI :2,en13,en22,en31,e! 2d+) &a13a22a31*un-2wiq),-so ffpoi,tsI :3,en13,en22,en31,e! 2d=poi,tsI :3,en13,en22,en31,e! 2d+) &a13a22a31*un-3wiq),-so ffpoi,tsI :1,en10,en23,en31,e! 2d=poi,tsI :1,en10,en23,en31,e! 2d+) &a10a23a31*un-awiq),-so ffpoi,tsI :2,en10,en23,en31,e! 2d=poi,tsI :2,en10,en23,en31,e! 2d+) &a10a23a31*un-2wiq),-so ffpoi,tsI :3,en10,en23,en31,e! 2d=poi,tsI :3,en10,en23,en31,e! 2d+) &a10a23a31*un-3wiq),-so ffpoi,tsI :1,en11,en23,en31,e! 2d=poi,tsI :1,en11,en23,en31,e! 2d+) &a11a23a31*un-awiq),-so ffpoi,tsI :2,en11,en23,en31,e! 2d=poi,tsI :2,en11,en23,en31,e! 2d+) &a11a23a31*un-2wiq),-so ffpoi,tsI :3,en11,en23,en31,e! 2d=poi,tsI :3,en11,en23,en31,e! 2d+) &a11a23a31*un-3wiq),-so ffpoi,tsI :1,en12,en23,en31,e! 2d=poi,tsI :1,en12,en23,en31,e! 2d+) &a12a23a31*un-awiq),-so ffpoi,tsI :2,en12,en23,en31,e! 2d=poi,tsI :2,en12,en23,en31,e! 2d+) &a12a23a31*un-2wiq),-so ffpoi,tsI :3,en12,en23,en31,e! 2d=poi,tsI :3,en12,en23,en31,e! 2d+) &a12a23a31*un-3wiq),-so ffpoi,tsI :1,en13,en23,en31,e! 2d=poi,tsI :1,en13,en23,en31,e! 2d+) &a13a23a31*un-awiq),-so ffpoi,tsI :2,en13,en23,en31,e! 2d=poi,tsI :2,en13,en23,en31,e! 2d+) &a13a23a31*un-2wiq),-so ffpoi,tsI :3,en13,en23,en31,e! 2d=poi,tsI :3,en13,en23,en31,e! 2d+) &a13a23a31*un-3wiq),-so ffpoi,tsI :1,en10,en20,en32,e! 2d=poi,tsI :1,en10,en20,en32,e! 2d+) &a10a20a32*un-awiq),-so ffpoi,tsI :2,en10,en20,en32,e! 2d=poi,tsI :2,en10,en20,en32,e! 2d+) &a10a20a32*un-2wiq),-so ffpoi,tsI :3,en10,en20,en32,e! 2d=poi,tsI :3,en10,en20,en32,e! 2d+) &a10a20a32*un-3wiq),-so ffpoi,tsI :1,en11,en20,en32,e! 2d=poi,tsI :1,en11,en20,en32,e! 2d+) &a11a20a32*un-awiq),-so ffpoi,tsI :2,en11,en20,en32,e! 2d=poi,tsI :2,en11,en20,en32,e! 2d+) &a11a20a32*un-2wiq),-so ffpoi,tsI :3,en11,en20,en32,e! 2d=poi,tsI :3,en11,en20,en32,e! 2d+) &a11a20a32*un-3wiq),-so ffpoi,tsI :1,en12,en20,en32,e! 2d=poi,tsI :1,en12,en20,en32,e! 2d+) &a12a20a32*un-awiq),-so ffpoi,tsI :2,en12,en20,en32,e! 2d=poi,tsI :2,en12,en20,en32,e! 2d+) &a12a20a32*un-2wiq),-so ffpoi,tsI :3,en12,en20,en32,e! 2d=poi,tsI :3,en12,en20,en32,e! 2d+) &a12a20a32*un-3wiq),-so ffpoi,tsI :1,en13,en20,en32,e! 2d=poi,tsI :1,en13,en20,en32,e! 2d+) &a13a20a32*un-awiq),-so ffpoi,tsI :2,en13,en20,en32,e! 2d=poi,tsI :2,en13,en20,en32,e! 2d+) &a13a20a32*un-2wiq),-so ffpoi,tsI :3,en13,en20,en32,e! 2d=poi,tsI :3,en13,en20,en32,e! 2d+) &a13a20a32*un-3wiq),-so ffpoi,tsI :1,en10,en21,en32,e! 2d=poi,tsI :1,en10,en21,en32,e! 2d+) &a10a21a32*un-awiq),-so ffpoi,tsI :2,en10,en21,en32,e! 2d=poi,tsI :2,en10,en21,en32,e! 2d+) &a10a21a32*un-2wiq),-so ffpoi,tsI :3,en10,en21,en32,e! 2d=poi,tsI :3,en10,en21,en32,e! 2d+) &a10a21a32*un-3wiq),-so ffpoi,tsI :1,en11,en21,en32,e! 2d=poi,tsI :1,en11,en21,en32,e! 2d+) &a11a21a32*un-awiq),-so ffpoi,tsI :2,en11,en21,en32,e! 2d=poi,tsI :2,en11,en21,en32,e! 2d+) &a11a21a32*un-2wiq),-so ffpoi,tsI :3,en11,en21,en32,e! 2d=poi,tsI :3,en11,en21,en32,e! 2d+) &a11a21a32*un-3wiq),-so ffpoi,tsI :1,en12,en21,en32,e! 2d=poi,tsI :1,en12,en21,en32,e! 2d+) &a12a21a32*un-awiq),-so ffpoi,tsI :2,en12,en21,en32,e! 2d=poi,tsI :2,en12,en21,en32,e! 2d+) &a12a21a32*un-2wiq),-so ffpoi,tsI :3,en12,en21,en32,e! 2d=poi,tsI :3,en12,en21,en32,e! 2d+) &a12a21a32*un-3wiq),-so ffpoi,tsI :1,en13,en21,en32,e! 2d=poi,tsI :1,en13,en21,en32,e! 2d+) &a13a21a32*un-awiq),-so ffpoi,tsI :2,en13,en21,en32,e! 2d=poi,tsI :2,en13,en21,en32,e! 2d+) &a13a21a32*un-2wiq),-so ffpoi,tsI :3,en13,en21,en32,e! 2d=poi,tsI :3,en13,en21,en32,e! 2d+) &a13a21a32*un-3wiq),-so ffpoi,tsI :1,en10,en22,en32,e! 2d=poi,tsI :1,en10,en22,en32,e! 2d+) &a10a22a32*un-awiq),-so ffpoi,tsI :2,en10,en22,en32,e! 2d=poi,tsI :2,en10,en22,en32,e! 2d+) &a10a22a32*un-2wiq),-so ffpoi,tsI :3,en10,en22,en32,e! 2d=poi,tsI :3,en10,en22,en32,e! 2d+) &a10a22a32*un-3wiq),-so ffpoi,tsI :1,en11,en22,en32,e! 2d=poi,tsI :1,en11,en22,en32,e! 2d+) &a11a22a32*un-awiq),-so ffpoi,tsI :2,en11,en22,en32,e! 2d=poi,tsI :2,en11,en22,en32,e! 2d+) &a11a22a32*un-2wiq),-so ffpoi,tsI :3,en11,en22,en32,e! 2d=poi,tsI :3,en11,en22,en32,e! 2d+) &a11a22a32*un-3wiq),-so ffpoi,tsI :1,en12,en22,en32,e! 2d=poi,tsI :1,en12,en22,en32,e! 2d+) &a12a22a32*un-awiq),-so ffpoi,tsI :2,en12,en22,en32,e! 2d=poi,tsI :2,en12,en22,en32,e! 2d+) &a12a22a32*un-2wiq),-so ffpoi,tsI :3,en12,en22,en32,e! 2d=poi,tsI :3,en12,en22,en32,e! 2d+) &a12a22a32*un-3wiq),-so ffpoi,tsI :1,en13,en22,en32,e! 2d=poi,tsI :1,en13,en22,en32,e! 2d+) &a13a22a32*un-awiq),-so ffpoi,tsI :2,en13,en22,en32,e! 2d=poi,tsI :2,en13,en22,en32,e! 2d+) &a13a22a32*un-2wiq),-so ffpoi,tsI :3,en13,en22,en32,e! 2d=poi,tsI :3,en13,en22,en32,e! 2d+) &a13a22a32*un-3wiq),-so ffpoi,tsI :1,en10,en23,en32,e! 2d=poi,tsI :1,en10,en23,en32,e! 2d+) &a10a23a32*un-awiq),-so ffpoi,tsI :2,en10,en23,en32,e! 2d=poi,tsI :2,en10,en23,en32,e! 2d+) &a10a23a32*un-2wiq),-so ffpoi,tsI :3,en10,en23,en32,e! 2d=poi,tsI :3,en10,en23,en32,e! 2d+) &a10a23a32*un-3wiq),-so ffpoi,tsI :1,en11,en23,en32,e! 2d=poi,tsI :1,en11,en23,en32,e! 2d+) &a11a23a32*un-awiq),-so ffpoi,tsI :2,en11,en23,en32,e! 2d=poi,tsI :2,en11,en23,en32,e! 2d+) &a11a23a32*un-2wiq),-so ffpoi,tsI :3,en11,en23,en32,e! 2d=poi,tsI :3,en11,en23,en32,e! 2d+) &a11a23a32*un-3wiq),-so ffpoi,tsI :1,en12,en23,en32,e! 2d=poi,tsI :1,en12,en23,en32,e! 2d+) &a12a23a32*un-awiq),-so ffpoi,tsI :2,en12,en23,en32,e! 2d=poi,tsI :2,en12,en23,en32,e! 2d+) &a12a23a32*un-2wiq),-so ffpoi,tsI :3,en12,en23,en32,e! 2d=poi,tsI :3,en12,en23,en32,e! 2d+) &a12a23a32*un-3wiq),-so ffpoi,tsI :1,en13,en23,en32,e! 2d=poi,tsI :1,en13,en23,en32,e! 2d+) &a13a23a32*un-awiq),-so ffpoi,tsI :2,en13,en23,en32,e! 2d=poi,tsI :2,en13,en23,en32,e! 2d+) &a13a23a32*un-2wiq),-so ffpoi,tsI :3,en13,en23,en32,e! 2d=poi,tsI :3,en13,en23,en32,e! 2d+) &a13a23a32*un-3wiq),-so ffpoi,tsI :1,en10,en20,en33,e! 2d=poi,tsI :1,en10,en20,en33,e! 2d+) &a10a20a33*un-awiq),-so ffpoi,tsI :2,en10,en20,en33,e! 2d=poi,tsI :2,en10,en20,en33,e! 2d+) &a10a20a33*un-2wiq),-so ffpoi,tsI :3,en10,en20,en33,e! 2d=poi,tsI :3,en10,en20,en33,e! 2d+) &a10a20a33*un-3wiq),-so ffpoi,tsI :1,en11,en20,en33,e! 2d=poi,tsI :1,en11,en20,en33,e! 2d+) &a11a20a33*un-awiq),-so ffpoi,tsI :2,en11,en20,en33,e! 2d=poi,tsI :2,en11,en20,en33,e! 2d+) &a11a20a33*un-2wiq),-so ffpoi,tsI :3,en11,en20,en33,e! 2d=poi,tsI :3,en11,en20,en33,e! 2d+) &a11a20a33*un-3wiq),-so ffpoi,tsI :1,en12,en20,en33,e! 2d=poi,tsI :1,en12,en20,en33,e! 2d+) &a12a20a33*un-awiq),-so ffpoi,tsI :2,en12,en20,en33,e! 2d=poi,tsI :2,en12,en20,en33,e! 2d+) &a12a20a33*un-2wiq),-so ffpoi,tsI :3,en12,en20,en33,e! 2d=poi,tsI :3,en12,en20,en33,e! 2d+) &a12a20a33*un-3wiq),-so ffpoi,tsI :1,en13,en20,en33,e! 2d=poi,tsI :1,en13,en20,en33,e! 2d+) &a13a20a33*un-awiq),-so ffpoi,tsI :2,en13,en20,en33,e! 2d=poi,tsI :2,en13,en20,en33,e! 2d+) &a13a20a33*un-2wiq),-so ffpoi,tsI :3,en13,en20,en33,e! 2d=poi,tsI :3,en13,en20,en33,e! 2d+) &a13a20a33*un-3wiq),-so ffpoi,tsI :1,en10,en21,en33,e! 2d=poi,tsI :1,en10,en21,en33,e! 2d+) &a10a21a33*un-awiq),-so ffpoi,tsI :2,en10,en21,en33,e! 2d=poi,tsI :2,en10,en21,en33,e! 2d+) &a10a21a33*un-2wiq),-so ffpoi,tsI :3,en10,en21,en33,e! 2d=poi,tsI :3,en10,en21,en33,e! 2d+) &a10a21a33*un-3wiq),-so ffpoi,tsI :1,en11,en21,en33,e! 2d=poi,tsI :1,en11,en21,en33,e! 2d+) &a11a21a33*un-awiq),-so ffpoi,tsI :2,en11,en21,en33,e! 2d=poi,tsI :2,en11,en21,en33,e! 2d+) &a11a21a33*un-2wiq),-so ffpoi,tsI :3,en11,en21,en33,e! 2d=poi,tsI :3,en11,en21,en33,e! 2d+) &a11a21a33*un-3wiq),-so ffpoi,tsI :1,en12,en21,en33,e! 2d=poi,tsI :1,en12,en21,en33,e! 2d+) &a12a21a33*un-awiq),-so ffpoi,tsI :2,en12,en21,en33,e! 2d=poi,tsI :2,en12,en21,en33,e! 2d+) &a12a21a33*un-2wiq),-so ffpoi,tsI :3,en12,en21,en33,e! 2d=poi,tsI :3,en12,en21,en33,e! 2d+) &a12a21a33*un-3wiq),-so ffpoi,tsI :1,en13,en21,en33,e! 2d=poi,tsI :1,en13,en21,en33,e! 2d+) &a13a21a33*un-awiq),-so ffpoi,tsI :2,en13,en21,en33,e! 2d=poi,tsI :2,en13,en21,en33,e! 2d+) &a13a21a33*un-2wiq),-so ffpoi,tsI :3,en13,en21,en33,e! 2d=poi,tsI :3,en13,en21,en33,e! 2d+) &a13a21a33*un-3wiq),-so ffpoi,tsI :1,en10,en22,en33,e! 2d=poi,tsI :1,en10,en22,en33,e! 2d+) &a10a22a33*un-awiq),-so ffpoi,tsI :2,en10,en22,en33,e! 2d=poi,tsI :2,en10,en22,en33,e! 2d+) &a10a22a33*un-2wiq),-so ffpoi,tsI :3,en10,en22,en33,e! 2d=poi,tsI :3,en10,en22,en33,e! 2d+) &a10a22a33*un-3wiq),-so ffpoi,tsI :1,en11,en22,en33,e! 2d=poi,tsI :1,en11,en22,en33,e! 2d+) &a11a22a33*un-awiq),-so ffpoi,tsI :2,en11,en22,en33,e! 2d=poi,tsI :2,en11,en22,en33,e! 2d+) &a11a22a33*un-2wiq),-so ffpoi,tsI :3,en11,en22,en33,e! 2d=poi,tsI :3,en11,en22,en33,e! 2d+) &a11a22a33*un-3wiq),-so ffpoi,tsI :1,en12,en22,en33,e! 2d=poi,tsI :1,en12,en22,en33,e! 2d+) &a12a22a33*un-awiq),-so ffpoi,tsI :2,en12,en22,en33,e! 2d=poi,tsI :2,en12,en22,en33,e! 2d+) &a12a22a33*un-2wiq),-so ffpoi,tsI :3,en12,en22,en33,e! 2d=poi,tsI :3,en12,en22,en33,e! 2d+) &a12a22a33*un-3wiq),-so ffpoi,tsI :1,en13,en22,en33,e! 2d=poi,tsI :1,en13,en22,en33,e! 2d+) &a13a22a33*un-awiq),-so ffpoi,tsI :2,en13,en22,en33,e! 2d=poi,tsI :2,en13,en22,en33,e! 2d+) &a13a22a33*un-2wiq),-so ffpoi,tsI :3,en13,en22,en33,e! 2d=poi,tsI :3,en13,en22,en33,e! 2d+) &a13a22a33*un-3wiq),-so ffpoi,tsI :1,en10,en23,en33,e! 2d=poi,tsI :1,en10,en23,en33,e! 2d+) &a10a23a33*un-awiq),-so ffpoi,tsI :2,en10,en23,en33,e! 2d=poi,tsI :2,en10,en23,en33,e! 2d+) &a10a23a33*un-2wiq),-so ffpoi,tsI :3,en10,en23,en33,e! 2d=poi,tsI :3,en10,en23,en33,e! 2d+) &a10a23a33*un-3wiq),-so ffpoi,tsI :1,en11,en23,en33,e! 2d=poi,tsI :1,en11,en23,en33,e! 2d+) &a11a23a33*un-awiq),-so ffpoi,tsI :2,en11,en23,en33,e! 2d=poi,tsI :2,en11,en23,en33,e! 2d+) &a11a23a33*un-2wiq),-so ffpoi,tsI :3,en11,en23,en33,e! 2d=poi,tsI :3,en11,en23,en33,e! 2d+) &a11a23a33*un-3wiq),-so ffpoi,tsI :1,en12,en23,en33,e! 2d=poi,tsI :1,en12,en23,en33,e! 2d+) &a12a23a33*un-awiq),-so ffpoi,tsI :2,en12,en23,en33,e! 2d=poi,tsI :2,en12,en23,en33,e! 2d+) &a12a23a33*un-2wiq),-so ffpoi,tsI :3,en12,en23,en33,e! 2d=poi,tsI :3,en12,en23,en33,e! 2d+) &a12a23a33*un-3wiq),-so ffpoi,tsI :1,en13,en23,en33,e! 2d=poi,tsI :1,en13,en23,en33,e! 2d+) &a13a23a33*un-awiq),-so ffpoi,tsI :2,en13,en23,en33,e! 2d=poi,tsI :2,en13,en23,en33,e! 2d+) &a13a23a33*un-2wiq),-so ffpoi,tsI :3,en13,en23,en33,e! 2d=poi,tsI :3,en13,en23,en33,e! 2d+) &a13a23a33*un-3wiq),#else w1,1,fpoi,tsI :1:3,en10,en20,en30,e! 2d=poi,tsI :1:3,en10,en20,en30,e! 2d+) &a10a20a30*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en20,en30,e! 2d=poi,tsI :1:3,en11,en20,en30,e! 2d+) &a11a20a30*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en20,en30,e! 2d=poi,tsI :1:3,en12,en20,en30,e! 2d+) &a12a20a30*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en20,en30,e! 2d=poi,tsI :1:3,en13,en20,en30,e! 2d+) &a13a20a30*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en21,en30,e! 2d=poi,tsI :1:3,en10,en21,en30,e! 2d+) &a10a21a30*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en21,en30,e! 2d=poi,tsI :1:3,en11,en21,en30,e! 2d+) &a11a21a30*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en21,en30,e! 2d=poi,tsI :1:3,en12,en21,en30,e! 2d+) &a12a21a30*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en21,en30,e! 2d=poi,tsI :1:3,en13,en21,en30,e! 2d+) &a13a21a30*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en22,en30,e! 2d=poi,tsI :1:3,en10,en22,en30,e! 2d+) &a10a22a30*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en22,en30,e! 2d=poi,tsI :1:3,en11,en22,en30,e! 2d+) &a11a22a30*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en22,en30,e! 2d=poi,tsI :1:3,en12,en22,en30,e! 2d+) &a12a22a30*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en22,en30,e! 2d=poi,tsI :1:3,en13,en22,en30,e! 2d+) &a13a22a30*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en23,en30,e! 2d=poi,tsI :1:3,en10,en23,en30,e! 2d+) &a10a23a30*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en23,en30,e! 2d=poi,tsI :1:3,en11,en23,en30,e! 2d+) &a11a23a30*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en23,en30,e! 2d=poi,tsI :1:3,en12,en23,en30,e! 2d+) &a12a23a30*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en23,en30,e! 2d=poi,tsI :1:3,en13,en23,en30,e! 2d+) &a13a23a30*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en20,en31,e! 2d=poi,tsI :1:3,en10,en20,en31,e! 2d+) &a10a20a31*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en20,en31,e! 2d=poi,tsI :1:3,en11,en20,en31,e! 2d+) &a11a20a31*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en20,en31,e! 2d=poi,tsI :1:3,en12,en20,en31,e! 2d+) &a12a20a31*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en20,en31,e! 2d=poi,tsI :1:3,en13,en20,en31,e! 2d+) &a13a20a31*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en21,en31,e! 2d=poi,tsI :1:3,en10,en21,en31,e! 2d+) &a10a21a31*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en21,en31,e! 2d=poi,tsI :1:3,en11,en21,en31,e! 2d+) &a11a21a31*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en21,en31,e! 2d=poi,tsI :1:3,en12,en21,en31,e! 2d+) &a12a21a31*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en21,en31,e! 2d=poi,tsI :1:3,en13,en21,en31,e! 2d+) &a13a21a31*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en22,en31,e! 2d=poi,tsI :1:3,en10,en22,en31,e! 2d+) &a10a22a31*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en22,en31,e! 2d=poi,tsI :1:3,en11,en22,en31,e! 2d+) &a11a22a31*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en22,en31,e! 2d=poi,tsI :1:3,en12,en22,en31,e! 2d+) &a12a22a31*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en22,en31,e! 2d=poi,tsI :1:3,en13,en22,en31,e! 2d+) &a13a22a31*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en23,en31,e! 2d=poi,tsI :1:3,en10,en23,en31,e! 2d+) &a10a23a31*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en23,en31,e! 2d=poi,tsI :1:3,en11,en23,en31,e! 2d+) &a11a23a31*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en23,en31,e! 2d=poi,tsI :1:3,en12,en23,en31,e! 2d+) &a12a23a31*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en23,en31,e! 2d=poi,tsI :1:3,en13,en23,en31,e! 2d+) &a13a23a31*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en20,en32,e! 2d=poi,tsI :1:3,en10,en20,en32,e! 2d+) &a10a20a32*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en20,en32,e! 2d=poi,tsI :1:3,en11,en20,en32,e! 2d+) &a11a20a32*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en20,en32,e! 2d=poi,tsI :1:3,en12,en20,en32,e! 2d+) &a12a20a32*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en20,en32,e! 2d=poi,tsI :1:3,en13,en20,en32,e! 2d+) &a13a20a32*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en21,en32,e! 2d=poi,tsI :1:3,en10,en21,en32,e! 2d+) &a10a21a32*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en21,en32,e! 2d=poi,tsI :1:3,en11,en21,en32,e! 2d+) &a11a21a32*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en21,en32,e! 2d=poi,tsI :1:3,en12,en21,en32,e! 2d+) &a12a21a32*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en21,en32,e! 2d=poi,tsI :1:3,en13,en21,en32,e! 2d+) &a13a21a32*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en22,en32,e! 2d=poi,tsI :1:3,en10,en22,en32,e! 2d+) &a10a22a32*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en22,en32,e! 2d=poi,tsI :1:3,en11,en22,en32,e! 2d+) &a11a22a32*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en22,en32,e! 2d=poi,tsI :1:3,en12,en22,en32,e! 2d+) &a12a22a32*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en22,en32,e! 2d=poi,tsI :1:3,en13,en22,en32,e! 2d+) &a13a22a32*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en23,en32,e! 2d=poi,tsI :1:3,en10,en23,en32,e! 2d+) &a10a23a32*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en23,en32,e! 2d=poi,tsI :1:3,en11,en23,en32,e! 2d+) &a11a23a32*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en23,en32,e! 2d=poi,tsI :1:3,en12,en23,en32,e! 2d+) &a12a23a32*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en23,en32,e! 2d=poi,tsI :1:3,en13,en23,en32,e! 2d+) &a13a23a32*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en20,en33,e! 2d=poi,tsI :1:3,en10,en20,en33,e! 2d+) &a10a20a33*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en20,en33,e! 2d=poi,tsI :1:3,en11,en20,en33,e! 2d+) &a11a20a33*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en20,en33,e! 2d=poi,tsI :1:3,en12,en20,en33,e! 2d+) &a12a20a33*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en20,en33,e! 2d=poi,tsI :1:3,en13,en20,en33,e! 2d+) &a13a20a33*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en21,en33,e! 2d=poi,tsI :1:3,en10,en21,en33,e! 2d+) &a10a21a33*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en21,en33,e! 2d=poi,tsI :1:3,en11,en21,en33,e! 2d+) &a11a21a33*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en21,en33,e! 2d=poi,tsI :1:3,en12,en21,en33,e! 2d+) &a12a21a33*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en21,en33,e! 2d=poi,tsI :1:3,en13,en21,en33,e! 2d+) &a13a21a33*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en22,en33,e! 2d=poi,tsI :1:3,en10,en22,en33,e! 2d+) &a10a22a33*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en22,en33,e! 2d=poi,tsI :1:3,en11,en22,en33,e! 2d+) &a11a22a33*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en22,en33,e! 2d=poi,tsI :1:3,en12,en22,en33,e! 2d+) &a12a22a33*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en22,en33,e! 2d=poi,tsI :1:3,en13,en22,en33,e! 2d+) &a13a22a33*un-a:3wiq),-so ffpoi,tsI :1:3,en10,en23,en33,e! 2d=poi,tsI :1:3,en10,en23,en33,e! 2d+) &a10a23a33*un-a:3wiq),-so ffpoi,tsI :1:3,en11,en23,en33,e! 2d=poi,tsI :1:3,en11,en23,en33,e! 2d+) &a11a23a33*un-a:3wiq),-so ffpoi,tsI :1:3,en12,en23,en33,e! 2d=poi,tsI :1:3,en12,en23,en33,e! 2d+) &a12a23a33*un-a:3wiq),-so ffpoi,tsI :1:3,en13,en23,en33,e! 2d=poi,tsI :1:3,en13,en23,en33,e! 2d+) &a13a23a33*un-a:3wiq),lc=ll#el END DOl �����������������������������������������������������������������! w1,1, 3,0, 0 -�ffUnrn-a v Msions for 2-vectors ,mk) fMM w1,1,�����������������������������������������������������������������! w1,1, 3,0, ELSEIF (lda .EQ. 2) THEN ,mk) fMM w1,1,e! 2nwww %--------OT! 2d ,mk) fMM w1,1,DOAipwww1pstorktopfo(D! 2d ,mk) fMM w1,1, ..eq->ip= ----_b2troaww,ip! fie __ -->i...x01 p((kn-awiq)- sI awwi1(! fil))*3xxi w1,1, __ -->i...x02 p((kn-2wiq)- sI awwi2(! fil))*3xyi w1,1, __ -->i...x03 p((kn-3wiq)- sI awwi3(! fil))*3xzi ,mk) fMM w1,1, ..en10wp(INT(x0j-1,mk) ffffDDDDND Nen20wp(INT(x02! ,mk) ffffDDDDND Nip30wp(INT(x03! m -->ip)u= -->i...en11--- n10w(21m -->ip)u=D0.... .in21--- n20x(21m -->ip)u=D0.... .ip31--- n30x(21mm -->ip)u=D0.... .en12--- n11w(21m -->ip)u=D0.... .en22--- n21w(21m -->ip)u=D0.... .en32--- n31x(21mm -->ip)u=D0.... .en13--- n11w(2)ffffffffield_x(1 (en23--- n21w(2)ffffffffield_x(1 (en33--- n31x(22mm xp1---x01-REALo n10 ffffffffffield_x(1 (xp2---x02-REALo n20 ffffffffffield_x(1 (xp3---x03-REALo n30 fffffffffffield_x(1 (x10wp(xp1x(21= 0 p'fffffffield_x(1 (x11---x10w-d = 0 p'fffffffield_x(1 (x12---x10w-d2= 0 p'fffffffield_x(1 (x13---x10w-d3= 0 p',-so fffield_x(1 (x20wp(xp)x(21= 0 p'fffffffield_x(1 (x21---x20w-d = 0 p'fffffffield_x(1 (x22---x20w-d2= 0 p'fffffffield_x(1 (x23---x20w-d3= 0 p',-so fffield_x(1 (x30wp(xp3x(21= 0 p'fffffffield_x(1 (x31---x30w-d = 0 p'fffffffield_x(1 (x32---x30w-d2= 0 p'fffffffield_x(1 (x33---x30w-d3= 0 p',-so fffield_x(1 a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1 a10a20a30 p(f10*a20*a30) p',--)u=D0.... .a10a20a31wp(f10*a20*a31m p',--)u=D0.... .a10a20a32wp(f10*a20*a32,-so fffield_x(1 .a10a20a33wp(f10*a20*a33,-so fffield_x(1 .a10a21a30wp(f10*a21*a30) po fffield_x(1 .a10a21a31wp(f10*a21*a31m p',--)u=D0.... .a10a21a32wp(f10*a21*a32,-so fffield_x(1 .a10a21a33wp(f10*a21*a33,-so fffield_x(1 .a10a22a30wp(f10*a22*a30) p',--)u=D0.... .a10a22a31wp(f10*a22*a31m p',--)u=D0.... .a10a22a32wp(f10*a22*a32,-p',--)u=D0.... .a10a22a33wp(f10*a22*a33,-so fffield_x(1 .a10a23a30wp(f10*a23*a30) p',-ffield_x(1 .a10a23a31wp(f10*a23*a31m p',--)u=D0.... .a10a23a32wp(f10*a23*a32,-so fffield_x(1 .a10a23a33wp(f10*a23*a33,-so fffield_x(1 a11a20a30 p(f11*a20*a30) p',--)u=D0.... .a11a20a31wp(f11*a20*a31m p',--)u=D0.... .a11a20a32wp(f11*a20*a32,-so fffield_x(1 .a11a20a33wp(f11*a20*a33,-so fffield_x(1 .a11a21a30wp(f11*a21*a30) p',--)u=D0.... .a11a21a31wp(f11*a21*a31m p',--)u=D0.... .a11a21a32wp(f11*a21*a32,-so fffield_x(1 .a11a21a33wp(f11*a21*a33,-so fffield_x(1 .a11a22a30wp(f11*a22*a30) p',--)u=D0.... .a11a22a31wp(f11*a22*a31m p',--)u=D0.... .a11a22a32wp(f11*a22*a32,-so fffield_x(1 .a11a22a33wp(f11*a22*a33,-so fffield_x(1 .a11a23a30wp(f11*a23*a30) p',--)u=D0.... .a11a23a31wp(f11*a23*a31m p',--)u=D0.... .a11a23a32wp(f11*a23*a32,-so fffield_x(1 .a11a23a33wp(f11*a23*a33,-so fffield_x(1 a12a20a30 p(f12*a20*a30) p',--)u=D0.... a12a20a31wp(f12*a20*a31m p',--)u=D0.... a12a20a32wp(f12*a20*a32,-so fffield_x(1 a12a20a33wp(f12*a20*a33,-so fffield_x(1 a12a21a30wp(f12*a21*a30) p',fffield_x(1 a12a21a31wp(f12*a21*a31m p',--)u=D0.... a12a21a32wp(f12*a21*a32,-so fffi=D0.... a12a21a33wp(f12*a21*a33,-so fffield_x(1 a12a22a30wp(f12*a22*a30) p',--)u=D0.... a12a22a31wp(f12*a22*a31m p',--)u=D0.... a12a22a32wp(f12*a22*a32,-so fffield_x(1 a12a22a33wp(f12*a22*a33,-so fffield_x(1 a12a23a30wp(f12*a23*a30) p',--)u=D0.... a12a23a31wp(f12*a23*a31m p',--)u=D0.... a12a23a32wp(f12*a23*a32,-so fffield_x(1 a12a23a33wp(f12*a23*a33,-so fffield_x(1 a13a20a30 p(f13*a20*a30) po fffield_x(1 a13a20a31wp(f13*a20*a31m p',--)u=D0.... a13a20a32wp(f13*a20*a32,-so fffield_x(1 a13a20a33wp(f13*a20*a33,-so fffield_x(1 a13a21a30wp(f13*a21*a30) p',--)u=D0.... a13a21a31wp(f13*a21*a31m p',--)u=D0.... a13a21a32wp(f13*a21*a32,-so fffield_x(1 a13a21a33wp(f13*a21*a33,-so fffield_x(1 a13a22a30wp(f13*a22*a30) p',--)u=D0.... a13a22a31wp(f13*a22*a31m p',--)u=D0.... a13a22a32wp(f13*a22*a32,-so fffield_x(1 a13a22a33wp(f13*a22*a33,-so fffield_x(1 a13a23a30wp(f13*a23*a30) p',--)u=D0.... a13a23a31wp(f13*a23*a31m p',--)u=D0.... a13a23a32wp(f13*a23*a32,-so fffield_x(1 a13a23a33wp(f13*a23*a33,,DDDD! teaNOMICROINSTRUCTIONS,-so ffpoi,tsI :1,en10,en20,en30,e! 2d=poi,tsI :1,en10,en20,en30,e! 2d+) &a10a20a30*un-awiq),-so ffpoi,tsI :2,en10,en20,en30,e! 2d=poi,tsI :2,en10,en20,en30,e! 2d+) &a10a20a30*un-2wiq),-so ffpoi,tsI :1,en11,en20,en30,e! 2d=poi,tsI :1,en11,en20,en30,e! 2d+) &a11a20a30*un-awiq),-so ffpoi,tsI :2,en11,en20,en30,e! 2d=poi,tsI :2,en11,en20,en30,e! 2d+) &a11a20a30*un-2wiq),-so ffpoi,tsI :1,en12,en20,en30,e! 2d=poi,tsI :1,en12,en20,en30,e! 2d+) &a12a20a30*un-awiq),-so ffpoi,tsI :2,en12,en20,en30,e! 2d=poi,tsI :2,en12,en20,en30,e! 2d+) &a12a20a30*un-2wiq),-so ffpoi,tsI :1,en13,en20,en30,e! 2d=poi,tsI :1,en13,en20,en30,e! 2d+) &a13a20a30*un-awiq),-so ffpoi,tsI :2,en13,en20,en30,e! 2d=poi,tsI :2,en13,en20,en30,e! 2d+) &a13a20a30*un-2wiq),-so ffpoi,tsI :1,en10,en21,en30,e! 2d=poi,tsI :1,en10,en21,en30,e! 2d+) &a10a21a30*un-awiq),-so ffpoi,tsI :2,en10,en21,en30,e! 2d=poi,tsI :2,en10,en21,en30,e! 2d+) &a10a21a30*un-2wiq),-so ffpoi,tsI :1,en11,en21,en30,e! 2d=poi,tsI :1,en11,en21,en30,e! 2d+) &a11a21a30*un-awiq),-so ffpoi,tsI :2,en11,en21,en30,e! 2d=poi,tsI :2,en11,en21,en30,e! 2d+) &a11a21a30*un-2wiq),-so ffpoi,tsI :1,en12,en21,en30,e! 2d=poi,tsI :1,en12,en21,en30,e! 2d+) &a12a21a30*un-awiq),-so ffpoi,tsI :2,en12,en21,en30,e! 2d=poi,tsI :2,en12,en21,en30,e! 2d+) &a12a21a30*un-2wiq),-so ffpoi,tsI :1,en13,en21,en30,e! 2d=poi,tsI :1,en13,en21,en30,e! 2d+) &a13a21a30*un-awiq),-so ffpoi,tsI :2,en13,en21,en30,e! 2d=poi,tsI :2,en13,en21,en30,e! 2d+) &a13a21a30*un-2wiq),-so ffpoi,tsI :1,en10,en22,en30,e! 2d=poi,tsI :1,en10,en22,en30,e! 2d+) &a10a22a30*un-awiq),-so ffpoi,tsI :2,en10,en22,en30,e! 2d=poi,tsI :2,en10,en22,en30,e! 2d+) &a10a22a30*un-2wiq),-so ffpoi,tsI :1,en11,en22,en30,e! 2d=poi,tsI :1,en11,en22,en30,e! 2d+) &a11a22a30*un-awiq),-so ffpoi,tsI :2,en11,en22,en30,e! 2d=poi,tsI :2,en11,en22,en30,e! 2d+) &a11a22a30*un-2wiq),-so ffpoi,tsI :1,en12,en22,en30,e! 2d=poi,tsI :1,en12,en22,en30,e! 2d+) &a12a22a30*un-awiq),-so ffpoi,tsI :2,en12,en22,en30,e! 2d=poi,tsI :2,en12,en22,en30,e! 2d+) &a12a22a30*un-2wiq),-so ffpoi,tsI :1,en13,en22,en30,e! 2d=poi,tsI :1,en13,en22,en30,e! 2d+) &a13a22a30*un-awiq),-so ffpoi,tsI :2,en13,en22,en30,e! 2d=poi,tsI :2,en13,en22,en30,e! 2d+) &a13a22a30*un-2wiq),-so ffpoi,tsI :1,en10,en23,en30,e! 2d=poi,tsI :1,en10,en23,en30,e! 2d+) &a10a23a30*un-awiq),-so ffpoi,tsI :2,en10,en23,en30,e! 2d=poi,tsI :2,en10,en23,en30,e! 2d+) &a10a23a30*un-2wiq),-so ffpoi,tsI :1,en11,en23,en30,e! 2d=poi,tsI :1,en11,en23,en30,e! 2d+) &a11a23a30*un-awiq),-so ffpoi,tsI :2,en11,en23,en30,e! 2d=poi,tsI :2,en11,en23,en30,e! 2d+) &a11a23a30*un-2wiq),-so ffpoi,tsI :1,en12,en23,en30,e! 2d=poi,tsI :1,en12,en23,en30,e! 2d+) &a12a23a30*un-awiq),-so ffpoi,tsI :2,en12,en23,en30,e! 2d=poi,tsI :2,en12,en23,en30,e! 2d+) &a12a23a30*un-2wiq),-so ffpoi,tsI :1,en13,en23,en30,e! 2d=poi,tsI :1,en13,en23,en30,e! 2d+) &a13a23a30*un-awiq),-so ffpoi,tsI :2,en13,en23,en30,e! 2d=poi,tsI :2,en13,en23,en30,e! 2d+) &a13a23a30*un-2wiq),-so ffpoi,tsI :1,en10,en20,en31,e! 2d=poi,tsI :1,en10,en20,en31,e! 2d+) &a10a20a31*un-awiq),-so ffpoi,tsI :2,en10,en20,en31,e! 2d=poi,tsI :2,en10,en20,en31,e! 2d+) &a10a20a31*un-2wiq),-so ffpoi,tsI :1,en11,en20,en31,e! 2d=poi,tsI :1,en11,en20,en31,e! 2d+) &a11a20a31*un-awiq),-so ffpoi,tsI :2,en11,en20,en31,e! 2d=poi,tsI :2,en11,en20,en31,e! 2d+) &a11a20a31*un-2wiq),-so ffpoi,tsI :1,en12,en20,en31,e! 2d=poi,tsI :1,en12,en20,en31,e! 2d+) &a12a20a31*un-awiq),-so ffpoi,tsI :2,en12,en20,en31,e! 2d=poi,tsI :2,en12,en20,en31,e! 2d+) &a12a20a31*un-2wiq),-so ffpoi,tsI :1,en13,en20,en31,e! 2d=poi,tsI :1,en13,en20,en31,e! 2d+) &a13a20a31*un-awiq),-so ffpoi,tsI :2,en13,en20,en31,e! 2d=poi,tsI :2,en13,en20,en31,e! 2d+) &a13a20a31*un-2wiq),-so ffpoi,tsI :1,en10,en21,en31,e! 2d=poi,tsI :1,en10,en21,en31,e! 2d+) &a10a21a31*un-awiq),-so ffpoi,tsI :2,en10,en21,en31,e! 2d=poi,tsI :2,en10,en21,en31,e! 2d+) &a10a21a31*un-2wiq),-so ffpoi,tsI :1,en11,en21,en31,e! 2d=poi,tsI :1,en11,en21,en31,e! 2d+) &a11a21a31*un-awiq),-so ffpoi,tsI :2,en11,en21,en31,e! 2d=poi,tsI :2,en11,en21,en31,e! 2d+) &a11a21a31*un-2wiq),-so ffpoi,tsI :1,en12,en21,en31,e! 2d=poi,tsI :1,en12,en21,en31,e! 2d+) &a12a21a31*un-awiq),-so ffpoi,tsI :2,en12,en21,en31,e! 2d=poi,tsI :2,en12,en21,en31,e! 2d+) &a12a21a31*un-2wiq),-so ffpoi,tsI :1,en13,en21,en31,e! 2d=poi,tsI :1,en13,en21,en31,e! 2d+) &a13a21a31*un-awiq),-so ffpoi,tsI :2,en13,en21,en31,e! 2d=poi,tsI :2,en13,en21,en31,e! 2d+) &a13a21a31*un-2wiq),-so ffpoi,tsI :1,en10,en22,en31,e! 2d=poi,tsI :1,en10,en22,en31,e! 2d+) &a10a22a31*un-awiq),-so ffpoi,tsI :2,en10,en22,en31,e! 2d=poi,tsI :2,en10,en22,en31,e! 2d+) &a10a22a31*un-2wiq),-so ffpoi,tsI :1,en11,en22,en31,e! 2d=poi,tsI :1,en11,en22,en31,e! 2d+) &a11a22a31*un-awiq),-so ffpoi,tsI :2,en11,en22,en31,e! 2d=poi,tsI :2,en11,en22,en31,e! 2d+) &a11a22a31*un-2wiq),-so ffpoi,tsI :1,en12,en22,en31,e! 2d=poi,tsI :1,en12,en22,en31,e! 2d+) &a12a22a31*un-awiq),-so ffpoi,tsI :2,en12,en22,en31,e! 2d=poi,tsI :2,en12,en22,en31,e! 2d+) &a12a22a31*un-2wiq),-so ffpoi,tsI :1,en13,en22,en31,e! 2d=poi,tsI :1,en13,en22,en31,e! 2d+) &a13a22a31*un-awiq),-so ffpoi,tsI :2,en13,en22,en31,e! 2d=poi,tsI :2,en13,en22,en31,e! 2d+) &a13a22a31*un-2wiq),-so ffpoi,tsI :1,en10,en23,en31,e! 2d=poi,tsI :1,en10,en23,en31,e! 2d+) &a10a23a31*un-awiq),-so ffpoi,tsI :2,en10,en23,en31,e! 2d=poi,tsI :2,en10,en23,en31,e! 2d+) &a10a23a31*un-2wiq),-so ffpoi,tsI :1,en11,en23,en31,e! 2d=poi,tsI :1,en11,en23,en31,e! 2d+) &a11a23a31*un-awiq),-so ffpoi,tsI :2,en11,en23,en31,e! 2d=poi,tsI :2,en11,en23,en31,e! 2d+) &a11a23a31*un-2wiq),-so ffpoi,tsI :1,en12,en23,en31,e! 2d=poi,tsI :1,en12,en23,en31,e! 2d+) &a12a23a31*un-awiq),-so ffpoi,tsI :2,en12,en23,en31,e! 2d=poi,tsI :2,en12,en23,en31,e! 2d+) &a12a23a31*un-2wiq),-so ffpoi,tsI :1,en13,en23,en31,e! 2d=poi,tsI :1,en13,en23,en31,e! 2d+) &a13a23a31*un-awiq),-so ffpoi,tsI :2,en13,en23,en31,e! 2d=poi,tsI :2,en13,en23,en31,e! 2d+) &a13a23a31*un-2wiq),-so ffpoi,tsI :1,en10,en20,en32,e! 2d=poi,tsI :1,en10,en20,en32,e! 2d+) &a10a20a32*un-awiq),-so ffpoi,tsI :2,en10,en20,en32,e! 2d=poi,tsI :2,en10,en20,en32,e! 2d+) &a10a20a32*un-2wiq),-so ffpoi,tsI :1,en11,en20,en32,e! 2d=poi,tsI :1,en11,en20,en32,e! 2d+) &a11a20a32*un-awiq),-so ffpoi,tsI :2,en11,en20,en32,e! 2d=poi,tsI :2,en11,en20,en32,e! 2d+) &a11a20a32*un-2wiq),-so ffpoi,tsI :1,en12,en20,en32,e! 2d=poi,tsI :1,en12,en20,en32,e! 2d+) &a12a20a32*un-awiq),-so ffpoi,tsI :2,en12,en20,en32,e! 2d=poi,tsI :2,en12,en20,en32,e! 2d+) &a12a20a32*un-2wiq),-so ffpoi,tsI :1,en13,en20,en32,e! 2d=poi,tsI :1,en13,en20,en32,e! 2d+) &a13a20a32*un-awiq),-so ffpoi,tsI :2,en13,en20,en32,e! 2d=poi,tsI :2,en13,en20,en32,e! 2d+) &a13a20a32*un-2wiq),-so ffpoi,tsI :1,en10,en21,en32,e! 2d=poi,tsI :1,en10,en21,en32,e! 2d+) &a10a21a32*un-awiq),-so ffpoi,tsI :2,en10,en21,en32,e! 2d=poi,tsI :2,en10,en21,en32,e! 2d+) &a10a21a32*un-2wiq),-so ffpoi,tsI :1,en11,en21,en32,e! 2d=poi,tsI :1,en11,en21,en32,e! 2d+) &a11a21a32*un-awiq),-so ffpoi,tsI :2,en11,en21,en32,e! 2d=poi,tsI :2,en11,en21,en32,e! 2d+) &a11a21a32*un-2wiq),-so ffpoi,tsI :1,en12,en21,en32,e! 2d=poi,tsI :1,en12,en21,en32,e! 2d+) &a12a21a32*un-awiq),-so ffpoi,tsI :2,en12,en21,en32,e! 2d=poi,tsI :2,en12,en21,en32,e! 2d+) &a12a21a32*un-2wiq),-so ffpoi,tsI :1,en13,en21,en32,e! 2d=poi,tsI :1,en13,en21,en32,e! 2d+) &a13a21a32*un-awiq),-so ffpoi,tsI :2,en13,en21,en32,e! 2d=poi,tsI :2,en13,en21,en32,e! 2d+) &a13a21a32*un-2wiq),-so ffpoi,tsI :1,en10,en22,en32,e! 2d=poi,tsI :1,en10,en22,en32,e! 2d+) &a10a22a32*un-awiq),-so ffpoi,tsI :2,en10,en22,en32,e! 2d=poi,tsI :2,en10,en22,en32,e! 2d+) &a10a22a32*un-2wiq),-so ffpoi,tsI :1,en11,en22,en32,e! 2d=poi,tsI :1,en11,en22,en32,e! 2d+) &a11a22a32*un-awiq),-so ffpoi,tsI :2,en11,en22,en32,e! 2d=poi,tsI :2,en11,en22,en32,e! 2d+) &a11a22a32*un-2wiq),-so ffpoi,tsI :1,en12,en22,en32,e! 2d=poi,tsI :1,en12,en22,en32,e! 2d+) &a12a22a32*un-awiq),-so ffpoi,tsI :2,en12,en22,en32,e! 2d=poi,tsI :2,en12,en22,en32,e! 2d+) &a12a22a32*un-2wiq),-so ffpoi,tsI :1,en13,en22,en32,e! 2d=poi,tsI :1,en13,en22,en32,e! 2d+) &a13a22a32*un-awiq),-so ffpoi,tsI :2,en13,en22,en32,e! 2d=poi,tsI :2,en13,en22,en32,e! 2d+) &a13a22a32*un-2wiq),-so ffpoi,tsI :1,en10,en23,en32,e! 2d=poi,tsI :1,en10,en23,en32,e! 2d+) &a10a23a32*un-awiq),-so ffpoi,tsI :2,en10,en23,en32,e! 2d=poi,tsI :2,en10,en23,en32,e! 2d+) &a10a23a32*un-2wiq),-so ffpoi,tsI :1,en11,en23,en32,e! 2d=poi,tsI :1,en11,en23,en32,e! 2d+) &a11a23a32*un-awiq),-so ffpoi,tsI :2,en11,en23,en32,e! 2d=poi,tsI :2,en11,en23,en32,e! 2d+) &a11a23a32*un-2wiq),-so ffpoi,tsI :1,en12,en23,en32,e! 2d=poi,tsI :1,en12,en23,en32,e! 2d+) &a12a23a32*un-awiq),-so ffpoi,tsI :2,en12,en23,en32,e! 2d=poi,tsI :2,en12,en23,en32,e! 2d+) &a12a23a32*un-2wiq),-so ffpoi,tsI :1,en13,en23,en32,e! 2d=poi,tsI :1,en13,en23,en32,e! 2d+) &a13a23a32*un-awiq),-so ffpoi,tsI :2,en13,en23,en32,e! 2d=poi,tsI :2,en13,en23,en32,e! 2d+) &a13a23a32*un-2wiq),-so ffpoi,tsI :1,en10,en20,en33,e! 2d=poi,tsI :1,en10,en20,en33,e! 2d+) &a10a20a33*un-awiq),-so ffpoi,tsI :2,en10,en20,en33,e! 2d=poi,tsI :2,en10,en20,en33,e! 2d+) &a10a20a33*un-2wiq),-so ffpoi,tsI :1,en11,en20,en33,e! 2d=poi,tsI :1,en11,en20,en33,e! 2d+) &a11a20a33*un-awiq),-so ffpoi,tsI :2,en11,en20,en33,e! 2d=poi,tsI :2,en11,en20,en33,e! 2d+) &a11a20a33*un-2wiq),-so ffpoi,tsI :1,en12,en20,en33,e! 2d=poi,tsI :1,en12,en20,en33,e! 2d+) &a12a20a33*un-awiq),-so ffpoi,tsI :2,en12,en20,en33,e! 2d=poi,tsI :2,en12,en20,en33,e! 2d+) &a12a20a33*un-2wiq),-so ffpoi,tsI :1,en13,en20,en33,e! 2d=poi,tsI :1,en13,en20,en33,e! 2d+) &a13a20a33*un-awiq),-so ffpoi,tsI :2,en13,en20,en33,e! 2d=poi,tsI :2,en13,en20,en33,e! 2d+) &a13a20a33*un-2wiq),-so ffpoi,tsI :1,en10,en21,en33,e! 2d=poi,tsI :1,en10,en21,en33,e! 2d+) &a10a21a33*un-awiq),-so ffpoi,tsI :2,en10,en21,en33,e! 2d=poi,tsI :2,en10,en21,en33,e! 2d+) &a10a21a33*un-2wiq),-so ffpoi,tsI :1,en11,en21,en33,e! 2d=poi,tsI :1,en11,en21,en33,e! 2d+) &a11a21a33*un-awiq),-so ffpoi,tsI :2,en11,en21,en33,e! 2d=poi,tsI :2,en11,en21,en33,e! 2d+) &a11a21a33*un-2wiq),-so ffpoi,tsI :1,en12,en21,en33,e! 2d=poi,tsI :1,en12,en21,en33,e! 2d+) &a12a21a33*un-awiq),-so ffpoi,tsI :2,en12,en21,en33,e! 2d=poi,tsI :2,en12,en21,en33,e! 2d+) &a12a21a33*un-2wiq),-so ffpoi,tsI :1,en13,en21,en33,e! 2d=poi,tsI :1,en13,en21,en33,e! 2d+) &a13a21a33*un-awiq),-so ffpoi,tsI :2,en13,en21,en33,e! 2d=poi,tsI :2,en13,en21,en33,e! 2d+) &a13a21a33*un-2wiq),-so ffpoi,tsI :1,en10,en22,en33,e! 2d=poi,tsI :1,en10,en22,en33,e! 2d+) &a10a22a33*un-awiq),-so ffpoi,tsI :2,en10,en22,en33,e! 2d=poi,tsI :2,en10,en22,en33,e! 2d+) &a10a22a33*un-2wiq),-so ffpoi,tsI :1,en11,en22,en33,e! 2d=poi,tsI :1,en11,en22,en33,e! 2d+) &a11a22a33*un-awiq),-so ffpoi,tsI :2,en11,en22,en33,e! 2d=poi,tsI :2,en11,en22,en33,e! 2d+) &a11a22a33*un-2wiq),-so ffpoi,tsI :1,en12,en22,en33,e! 2d=poi,tsI :1,en12,en22,en33,e! 2d+) &a12a22a33*un-awiq),-so ffpoi,tsI :2,en12,en22,en33,e! 2d=poi,tsI :2,en12,en22,en33,e! 2d+) &a12a22a33*un-2wiq),-so ffpoi,tsI :1,en13,en22,en33,e! 2d=poi,tsI :1,en13,en22,en33,e! 2d+) &a13a22a33*un-awiq),-so ffpoi,tsI :2,en13,en22,en33,e! 2d=poi,tsI :2,en13,en22,en33,e! 2d+) &a13a22a33*un-2wiq),-so ffpoi,tsI :1,en10,en23,en33,e! 2d=poi,tsI :1,en10,en23,en33,e! 2d+) &a10a23a33*un-awiq),-so ffpoi,tsI :2,en10,en23,en33,e! 2d=poi,tsI :2,en10,en23,en33,e! 2d+) &a10a23a33*un-2wiq),-so ffpoi,tsI :1,en11,en23,en33,e! 2d=poi,tsI :1,en11,en23,en33,e! 2d+) &a11a23a33*un-awiq),-so ffpoi,tsI :2,en11,en23,en33,e! 2d=poi,tsI :2,en11,en23,en33,e! 2d+) &a11a23a33*un-2wiq),-so ffpoi,tsI :1,en12,en23,en33,e! 2d=poi,tsI :1,en12,en23,en33,e! 2d+) &a12a23a33*un-awiq),-so ffpoi,tsI :2,en12,en23,en33,e! 2d=poi,tsI :2,en12,en23,en33,e! 2d+) &a12a23a33*un-2wiq),-so ffpoi,tsI :1,en13,en23,en33,e! 2d=poi,tsI :1,en13,en23,en33,e! 2d+) &a13a23a33*un-awiq),-so ffpoi,tsI :2,en13,en23,en33,e! 2d=poi,tsI :2,en13,en23,en33,e! 2d+) &a13a23a33*un-2wiq),#else w1,1,fpoi,tsI :1:2,en10,en20,en30,e! 2d=poi,tsI :1:2,en10,en20,en30,e! 2d+) &a10a20a30*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en20,en30,e! 2d=poi,tsI :1:2,en11,en20,en30,e! 2d+) &a11a20a30*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en20,en30,e! 2d=poi,tsI :1:2,en12,en20,en30,e! 2d+) &a12a20a30*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en20,en30,e! 2d=poi,tsI :1:2,en13,en20,en30,e! 2d+) &a13a20a30*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en21,en30,e! 2d=poi,tsI :1:2,en10,en21,en30,e! 2d+) &a10a21a30*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en21,en30,e! 2d=poi,tsI :1:2,en11,en21,en30,e! 2d+) &a11a21a30*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en21,en30,e! 2d=poi,tsI :1:2,en12,en21,en30,e! 2d+) &a12a21a30*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en21,en30,e! 2d=poi,tsI :1:2,en13,en21,en30,e! 2d+) &a13a21a30*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en22,en30,e! 2d=poi,tsI :1:2,en10,en22,en30,e! 2d+) &a10a22a30*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en22,en30,e! 2d=poi,tsI :1:2,en11,en22,en30,e! 2d+) &a11a22a30*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en22,en30,e! 2d=poi,tsI :1:2,en12,en22,en30,e! 2d+) &a12a22a30*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en22,en30,e! 2d=poi,tsI :1:2,en13,en22,en30,e! 2d+) &a13a22a30*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en23,en30,e! 2d=poi,tsI :1:2,en10,en23,en30,e! 2d+) &a10a23a30*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en23,en30,e! 2d=poi,tsI :1:2,en11,en23,en30,e! 2d+) &a11a23a30*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en23,en30,e! 2d=poi,tsI :1:2,en12,en23,en30,e! 2d+) &a12a23a30*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en23,en30,e! 2d=poi,tsI :1:2,en13,en23,en30,e! 2d+) &a13a23a30*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en20,en31,e! 2d=poi,tsI :1:2,en10,en20,en31,e! 2d+) &a10a20a31*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en20,en31,e! 2d=poi,tsI :1:2,en11,en20,en31,e! 2d+) &a11a20a31*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en20,en31,e! 2d=poi,tsI :1:2,en12,en20,en31,e! 2d+) &a12a20a31*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en20,en31,e! 2d=poi,tsI :1:2,en13,en20,en31,e! 2d+) &a13a20a31*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en21,en31,e! 2d=poi,tsI :1:2,en10,en21,en31,e! 2d+) &a10a21a31*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en21,en31,e! 2d=poi,tsI :1:2,en11,en21,en31,e! 2d+) &a11a21a31*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en21,en31,e! 2d=poi,tsI :1:2,en12,en21,en31,e! 2d+) &a12a21a31*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en21,en31,e! 2d=poi,tsI :1:2,en13,en21,en31,e! 2d+) &a13a21a31*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en22,en31,e! 2d=poi,tsI :1:2,en10,en22,en31,e! 2d+) &a10a22a31*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en22,en31,e! 2d=poi,tsI :1:2,en11,en22,en31,e! 2d+) &a11a22a31*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en22,en31,e! 2d=poi,tsI :1:2,en12,en22,en31,e! 2d+) &a12a22a31*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en22,en31,e! 2d=poi,tsI :1:2,en13,en22,en31,e! 2d+) &a13a22a31*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en23,en31,e! 2d=poi,tsI :1:2,en10,en23,en31,e! 2d+) &a10a23a31*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en23,en31,e! 2d=poi,tsI :1:2,en11,en23,en31,e! 2d+) &a11a23a31*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en23,en31,e! 2d=poi,tsI :1:2,en12,en23,en31,e! 2d+) &a12a23a31*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en23,en31,e! 2d=poi,tsI :1:2,en13,en23,en31,e! 2d+) &a13a23a31*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en20,en32,e! 2d=poi,tsI :1:2,en10,en20,en32,e! 2d+) &a10a20a32*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en20,en32,e! 2d=poi,tsI :1:2,en11,en20,en32,e! 2d+) &a11a20a32*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en20,en32,e! 2d=poi,tsI :1:2,en12,en20,en32,e! 2d+) &a12a20a32*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en20,en32,e! 2d=poi,tsI :1:2,en13,en20,en32,e! 2d+) &a13a20a32*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en21,en32,e! 2d=poi,tsI :1:2,en10,en21,en32,e! 2d+) &a10a21a32*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en21,en32,e! 2d=poi,tsI :1:2,en11,en21,en32,e! 2d+) &a11a21a32*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en21,en32,e! 2d=poi,tsI :1:2,en12,en21,en32,e! 2d+) &a12a21a32*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en21,en32,e! 2d=poi,tsI :1:2,en13,en21,en32,e! 2d+) &a13a21a32*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en22,en32,e! 2d=poi,tsI :1:2,en10,en22,en32,e! 2d+) &a10a22a32*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en22,en32,e! 2d=poi,tsI :1:2,en11,en22,en32,e! 2d+) &a11a22a32*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en22,en32,e! 2d=poi,tsI :1:2,en12,en22,en32,e! 2d+) &a12a22a32*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en22,en32,e! 2d=poi,tsI :1:2,en13,en22,en32,e! 2d+) &a13a22a32*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en23,en32,e! 2d=poi,tsI :1:2,en10,en23,en32,e! 2d+) &a10a23a32*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en23,en32,e! 2d=poi,tsI :1:2,en11,en23,en32,e! 2d+) &a11a23a32*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en23,en32,e! 2d=poi,tsI :1:2,en12,en23,en32,e! 2d+) &a12a23a32*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en23,en32,e! 2d=poi,tsI :1:2,en13,en23,en32,e! 2d+) &a13a23a32*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en20,en33,e! 2d=poi,tsI :1:2,en10,en20,en33,e! 2d+) &a10a20a33*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en20,en33,e! 2d=poi,tsI :1:2,en11,en20,en33,e! 2d+) &a11a20a33*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en20,en33,e! 2d=poi,tsI :1:2,en12,en20,en33,e! 2d+) &a12a20a33*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en20,en33,e! 2d=poi,tsI :1:2,en13,en20,en33,e! 2d+) &a13a20a33*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en21,en33,e! 2d=poi,tsI :1:2,en10,en21,en33,e! 2d+) &a10a21a33*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en21,en33,e! 2d=poi,tsI :1:2,en11,en21,en33,e! 2d+) &a11a21a33*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en21,en33,e! 2d=poi,tsI :1:2,en12,en21,en33,e! 2d+) &a12a21a33*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en21,en33,e! 2d=poi,tsI :1:2,en13,en21,en33,e! 2d+) &a13a21a33*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en22,en33,e! 2d=poi,tsI :1:2,en10,en22,en33,e! 2d+) &a10a22a33*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en22,en33,e! 2d=poi,tsI :1:2,en11,en22,en33,e! 2d+) &a11a22a33*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en22,en33,e! 2d=poi,tsI :1:2,en12,en22,en33,e! 2d+) &a12a22a33*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en22,en33,e! 2d=poi,tsI :1:2,en13,en22,en33,e! 2d+) &a13a22a33*un-a:2wiq),-so ffpoi,tsI :1:2,en10,en23,en33,e! 2d=poi,tsI :1:2,en10,en23,en33,e! 2d+) &a10a23a33*un-a:2wiq),-so ffpoi,tsI :1:2,en11,en23,en33,e! 2d=poi,tsI :1:2,en11,en23,en33,e! 2d+) &a11a23a33*un-a:2wiq),-so ffpoi,tsI :1:2,en12,en23,en33,e! 2d=poi,tsI :1:2,en12,en23,en33,e! 2d+) &a12a23a33*un-a:2wiq),-so ffpoi,tsI :1:2,en13,en23,en33,e! 2d=poi,tsI :1:2,en13,en23,en33,e! 2d+) &a13a23a33*un-a:2wiq),lc=ll#el ENDDOl �����������������������������������������������������������������! w1,1, 3,0, 0 -�ffUnrn-a v Msions for 1-vectors ,mk) fMM w1,1,�����������������������������������������������������������������! w1,1, 3,0, ELSEIF (lda .EQ. 1) THEN ,mk) fMM w1,1,e! 2nwww %--------OT! 2d ,mk) fMM w1,1,DOAipwww1pstorktopfo(D! 2d ,mk) fMM w1,1, ..eq->ip= ----_b2troaww,ip! fie __ -->i...x01 p((kn-awiq)- sI awwi1(! fil))*3xxi w1,1, __ -->i...x02 p((kn-2wiq)- sI awwi2(! fil))*3xyi w1,1, __ -->i...x03 p((kn-3wiq)- sI awwi3(! fil))*3xzi ,mk) fMM w1,1, ..en10wp(INT(x0j-1,mk) ffffDDDDND Nen20wp(INT(x02! ,mk) ffffDDDDND Nip30wp(INT(x03! m -->ip)u= -->i...en11--- n10w(21m -->ip)u=D0.... .in21--- n20x(21m -->ip)u=D0.... .ip31--- n30x(21mm -->ip)u=D0.... .en12--- n11w(21m -->ip)u=D0.... .en22--- n21w(21m -->ip)u=D0.... .en32--- n31x(21mm -->ip)u=D0.... .en13--- n11w(2)ffffffffield_x(1 (en23--- n21w(2)ffffffffield_x(1 (en33--- n31x(22mm xp1---x01-REALo n10 ffffffffffield_x(1 (xp2---x02-REALo n20 ffffffffffield_x(1 (xp3---x03-REALo n30 fffffffffffield_x(1 (x10wp(xp1x(21= 0 p'fffffffield_x(1 (x11---x10w-d = 0 p'fffffffield_x(1 (x12---x10w-d2= 0 p'fffffffield_x(1 (x13---x10w-d3= 0 p',-so fffield_x(1 (x20wp(xp)x(21= 0 p'fffffffield_x(1 (x21---x20w-d = 0 p'fffffffield_x(1 (x22---x20w-d2= 0 p'fffffffield_x(1 (x23---x20w-d3= 0 p',-so fffield_x(1 (x30wp(xp3x(21= 0 p'fffffffield_x(1 (x31---x30w-d = 0 p'fffffffield_x(1 (x32---x30w-d2= 0 p'fffffffield_x(1 (x33---x30w-d3= 0 p',-so fffield_x(1 a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',,-so fffield_x(1 a10a20a30 p(f10*a20*a30) p',--)u=D0.... .a10a20a31wp(f10*a20*a31m p',--)u=D0.... .a10a20a32wp(f10*a20*a32,-so fffield_x(1 .a10a20a33wp(f10*a20*a33,-so fffield_x(1 .a10a21a30wp(f10*a21*a30) po fffield_x(1 .a10a21a31wp(f10*a21*a31m p',--)u=D0.... .a10a21a32wp(f10*a21*a32,-so fffield_x(1 .a10a21a33wp(f10*a21*a33,-so fffield_x(1 .a10a22a30wp(f10*a22*a30) p',--)u=D0.... .a10a22a31wp(f10*a22*a31m p',--)u=D0.... .a10a22a32wp(f10*a22*a32,-p',--)u=D0.... .a10a22a33wp(f10*a22*a33,-so fffield_x(1 .a10a23a30wp(f10*a23*a30) p' fffield_x(1 .a10a23a31wp(f10*a23*a31m p',--)u=D0.... .a10a23a32wp(f10*a23*a32,-so fffield_x(1 .a10a23a33wp(f10*a23*a33,-so fffield_x(1 a11a20a30 p(f11*a20*a30) p',--)u=D0.... .a11a20a31wp(f11*a20*a31m p',--)u=D0.... .a11a20a32wp(f11*a20*a32,-so fffield_x(1 .a11a20a33wp(f11*a20*a33,-so fffield_x(1 .a11a21a30wp(f11*a21*a30) p',--)u=D0.... .a11a21a31wp(f11*a21*a31m p',--)u=D0.... .a11a21a32wp(f11*a21*a32,-so fffield_x(1 .a11a21a33wp(f11*a21*a33,-so fffield_x(1 .a11a22a30wp(f11*a22*a30) p',--)u=D0.... .a11a22a31wp(f11*a22*a31m p',--)u=D0.... .a11a22a32wp(f11*a22*a32,-so fffield_x(1 .a11a22a33wp(f11*a22*a33,-so fffield_x(1 .a11a23a30wp(f11*a23*a30) p',--)u=D0.... .a11a23a31wp(f11*a23*a31m p',--)u=D0.... .a11a23a32wp(f11*a23*a32,-so fffield_x(1 .a11a23a33wp(f11*a23*a33,-so fffield_x(1 a12a20a30 p(f12*a20*a30) p',--)u=D0.... a12a20a31wp(f12*a20*a31m p',--)u=D0.... a12a20a32wp(f12*a20*a32,-so fffield_x(1 a12a20a33wp(f12*a20*a33,-so fffield_x(1 a12a21a30wp(f12*a21*a30) p',fffield_x(1 a12a21a31wp(f12*a21*a31m p',--)u=D0.... a12a21a32wp(f12*a21*a32,-so fffi=D0.... a12a21a33wp(f12*a21*a33,-so fffield_x(1 a12a22a30wp(f12*a22*a30) p',--)u=D0.... a12a22a31wp(f12*a22*a31m p',--)u=D0.... a12a22a32wp(f12*a22*a32,-so fffield_x(1 a12a22a33wp(f12*a22*a33,-so fffield_x(1 a12a23a30wp(f12*a23*a30) p',--)u=D0.... a12a23a31wp(f12*a23*a31m p',--)u=D0.... a12a23a32wp(f12*a23*a32,-so fffield_x(1 a12a23a33wp(f12*a23*a33,-so fffield_x(1 a13a20a30 p(f13*a20*a30) po fffield_x(1 a13a20a31wp(f13*a20*a31m p',--)u=D0.... a13a20a32wp(f13*a20*a32,-so fffield_x(1 a13a20a33wp(f13*a20*a33,-so fffield_x(1 a13a21a30wp(f13*a21*a30) p',--)u=D0.... a13a21a31wp(f13*a21*a31m p',--)u=D0.... a13a21a32wp(f13*a21*a32,-so fffield_x(1 a13a21a33wp(f13*a21*a33,-so fffield_x(1 a13a22a30wp(f13*a22*a30) p',--)u=D0.... a13a22a31wp(f13*a22*a31m p',--)u=D0.... a13a22a32wp(f13*a22*a32,-so fffield_x(1 a13a22a33wp(f13*a22*a33,-so fffield_x(1 a13a23a30wp(f13*a23*a30) p',--)u=D0.... a13a23a31wp(f13*a23*a31m p',--)u=D0.... a13a23a32wp(f13*a23*a32,-so fffield_x(1 a13a23a33wp(f13*a23*a33,,fffield_x(1 poi,tsI :1,en10,en20,en30,e! 2d=poi,tsI :1,en10,en20,en30,e! 2d+) &-so fffield_x(1 a10a20a30*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en20,en30,e! 2d=poi,tsI :1,en11,en20,en30,e! 2d+) &-so fffield_x(1 a11a20a30*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en20,en30,e! 2d=poi,tsI :1,en12,en20,en30,e! 2d+) &-so fffield_x(1 a12a20a30*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en20,en30,e! 2d=poi,tsI :1,en13,en20,en30,e! 2d+) &-so fffield_x(1 a13a20a30*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en21,en30,e! 2d=poi,tsI :1,en10,en21,en30,e! 2d+) &-so fffield_x(1 a10a21a30*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en21,en30,e! 2d=poi,tsI :1,en11,en21,en30,e! 2d+) &-so fffield_x(1 a11a21a30*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en21,en30,e! 2d=poi,tsI :1,en12,en21,en30,e! 2d+) &-so fffield_x(1 a12a21a30*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en21,en30,e! 2d=poi,tsI :1,en13,en21,en30,e! 2d+) &-so fffield_x(1 a13a21a30*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en22,en30,e! 2d=poi,tsI :1,en10,en22,en30,e! 2d+) &-so fffield_x(1 a10a22a30*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en22,en30,e! 2d=poi,tsI :1,en11,en22,en30,e! 2d+) &-so fffield_x(1 a11a22a30*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en22,en30,e! 2d=poi,tsI :1,en12,en22,en30,e! 2d+) &-so fffield_x(1 a12a22a30*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en22,en30,e! 2d=poi,tsI :1,en13,en22,en30,e! 2d+) &-so fffield_x(1 a13a22a30*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en23,en30,e! 2d=poi,tsI :1,en10,en23,en30,e! 2d+) &-so fffield_x(1 a10a23a30*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en23,en30,e! 2d=poi,tsI :1,en11,en23,en30,e! 2d+) &-so fffield_x(1 a11a23a30*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en23,en30,e! 2d=poi,tsI :1,en12,en23,en30,e! 2d+) &-so fffield_x(1 a12a23a30*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en23,en30,e! 2d=poi,tsI :1,en13,en23,en30,e! 2d+) &-so fffield_x(1 a13a23a30*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en20,en31,e! 2d=poi,tsI :1,en10,en20,en31,e! 2d+) &-so fffield_x(1 a10a20a31*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en20,en31,e! 2d=poi,tsI :1,en11,en20,en31,e! 2d+) &-so fffield_x(1 a11a20a31*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en20,en31,e! 2d=poi,tsI :1,en12,en20,en31,e! 2d+) &-so fffield_x(1 a12a20a31*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en20,en31,e! 2d=poi,tsI :1,en13,en20,en31,e! 2d+) &-so fffield_x(1 a13a20a31*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en21,en31,e! 2d=poi,tsI :1,en10,en21,en31,e! 2d+) &-so fffield_x(1 a10a21a31*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en21,en31,e! 2d=poi,tsI :1,en11,en21,en31,e! 2d+) &-so fffield_x(1 a11a21a31*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en21,en31,e! 2d=poi,tsI :1,en12,en21,en31,e! 2d+) &-so fffield_x(1 a12a21a31*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en21,en31,e! 2d=poi,tsI :1,en13,en21,en31,e! 2d+) &-so fffield_x(1 a13a21a31*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en22,en31,e! 2d=poi,tsI :1,en10,en22,en31,e! 2d+) &-so fffield_x(1 a10a22a31*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en22,en31,e! 2d=poi,tsI :1,en11,en22,en31,e! 2d+) &-so fffield_x(1 a11a22a31*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en22,en31,e! 2d=poi,tsI :1,en12,en22,en31,e! 2d+) &-so fffield_x(1 a12a22a31*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en22,en31,e! 2d=poi,tsI :1,en13,en22,en31,e! 2d+) &-so fffield_x(1 a13a22a31*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en23,en31,e! 2d=poi,tsI :1,en10,en23,en31,e! 2d+) &-so fffield_x(1 a10a23a31*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en23,en31,e! 2d=poi,tsI :1,en11,en23,en31,e! 2d+) &-so fffield_x(1 a11a23a31*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en23,en31,e! 2d=poi,tsI :1,en12,en23,en31,e! 2d+) &-so fffield_x(1 a12a23a31*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en23,en31,e! 2d=poi,tsI :1,en13,en23,en31,e! 2d+) &-so fffield_x(1 a13a23a31*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en20,en32,e! 2d=poi,tsI :1,en10,en20,en32,e! 2d+) &-so fffield_x(1 a10a20a32*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en20,en32,e! 2d=poi,tsI :1,en11,en20,en32,e! 2d+) &-so fffield_x(1 a11a20a32*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en20,en32,e! 2d=poi,tsI :1,en12,en20,en32,e! 2d+) &-so fffield_x(1 a12a20a32*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en20,en32,e! 2d=poi,tsI :1,en13,en20,en32,e! 2d+) &-so fffield_x(1 a13a20a32*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en21,en32,e! 2d=poi,tsI :1,en10,en21,en32,e! 2d+) &-so fffield_x(1 a10a21a32*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en21,en32,e! 2d=poi,tsI :1,en11,en21,en32,e! 2d+) &-so fffield_x(1 a11a21a32*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en21,en32,e! 2d=poi,tsI :1,en12,en21,en32,e! 2d+) &-so fffield_x(1 a12a21a32*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en21,en32,e! 2d=poi,tsI :1,en13,en21,en32,e! 2d+) &-so fffield_x(1 a13a21a32*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en22,en32,e! 2d=poi,tsI :1,en10,en22,en32,e! 2d+) &-so fffield_x(1 a10a22a32*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en22,en32,e! 2d=poi,tsI :1,en11,en22,en32,e! 2d+) &-so fffield_x(1 a11a22a32*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en22,en32,e! 2d=poi,tsI :1,en12,en22,en32,e! 2d+) &-so fffield_x(1 a12a22a32*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en22,en32,e! 2d=poi,tsI :1,en13,en22,en32,e! 2d+) &-so fffield_x(1 a13a22a32*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en23,en32,e! 2d=poi,tsI :1,en10,en23,en32,e! 2d+) &-so fffield_x(1 a10a23a32*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en23,en32,e! 2d=poi,tsI :1,en11,en23,en32,e! 2d+) &-so fffield_x(1 a11a23a32*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en23,en32,e! 2d=poi,tsI :1,en12,en23,en32,e! 2d+) &-so fffield_x(1 a12a23a32*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en23,en32,e! 2d=poi,tsI :1,en13,en23,en32,e! 2d+) &-so fffield_x(1 a13a23a32*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en20,en33,e! 2d=poi,tsI :1,en10,en20,en33,e! 2d+) &-so fffield_x(1 a10a20a33*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en20,en33,e! 2d=poi,tsI :1,en11,en20,en33,e! 2d+) &-so fffield_x(1 a11a20a33*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en20,en33,e! 2d=poi,tsI :1,en12,en20,en33,e! 2d+) &-so fffield_x(1 a12a20a33*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en20,en33,e! 2d=poi,tsI :1,en13,en20,en33,e! 2d+) &-so fffield_x(1 a13a20a33*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en21,en33,e! 2d=poi,tsI :1,en10,en21,en33,e! 2d+) &-so fffield_x(1 a10a21a33*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en21,en33,e! 2d=poi,tsI :1,en11,en21,en33,e! 2d+) &-so fffield_x(1 a11a21a33*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en21,en33,e! 2d=poi,tsI :1,en12,en21,en33,e! 2d+) &-so fffield_x(1 a12a21a33*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en21,en33,e! 2d=poi,tsI :1,en13,en21,en33,e! 2d+) &-so fffield_x(1 a13a21a33*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en22,en33,e! 2d=poi,tsI :1,en10,en22,en33,e! 2d+) &-so fffield_x(1 a10a22a33*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en22,en33,e! 2d=poi,tsI :1,en11,en22,en33,e! 2d+) &-so fffield_x(1 a11a22a33*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en22,en33,e! 2d=poi,tsI :1,en12,en22,en33,e! 2d+) &-so fffield_x(1 a12a22a33*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en22,en33,e! 2d=poi,tsI :1,en13,en22,en33,e! 2d+) &-so fffield_x(1 a13a22a33*un-awiq),-so ffd_x(1 poi,tsI :1,en10,en23,en33,e! 2d=poi,tsI :1,en10,en23,en33,e! 2d+) &-so fffield_x(1 a10a23a33*un-awiq),-so ffd_x(1 poi,tsI :1,en11,en23,en33,e! 2d=poi,tsI :1,en11,en23,en33,e! 2d+) &-so fffield_x(1 a11a23a33*un-awiq),-so ffd_x(1 poi,tsI :1,en12,en23,en33,e! 2d=poi,tsI :1,en12,en23,en33,e! 2d+) &-so fffield_x(1 a12a23a33*un-awiq),-so ffd_x(1 poi,tsI :1,en13,en23,en33,e! 2d=poi,tsI :1,en13,en23,en33,e! 2d+) &-so fffield_x(1 a13a23a33*un-awiq),,-so ffd_x(1 ENDDOl �����������������������������������������������������������������! w1,1, 3,0, 0 -�ffAll other lda are NOT UNROLLED. Vectorization will be over lda! w1,1, 3,0, 0 -�����������������������������������������������������������������! w1,1, 3,0, ELSE w1,1, 3,0, 0 -e! 2nwww %--------OT! 2d ,mk) fMM w1,1,DOAipwww1pstorktopfo(D! 2d ,mk) fMM w1,1, ..eq->ip= ----_b2troaww,ip! fie __ -->i...x01 p((kn-awiq)- sI awwi1(! fil))*3xxi w1,1, __ -->i...x02 p((kn-2wiq)- sI awwi2(! fil))*3xyi w1,1, __ -->i...x03 p((kn-3wiq)- sI awwi3(! fil))*3xzi ,mk) fMM w1,1, ..en10wp(INT(x0j-1,mk) ffffDDDDND Nen20wp(INT(x02! ,mk) ffffDDDDND Nip30wp(INT(x03! m -->ip)u= -->i...en11--- n10w(21m -->ip)u=D0.... .in21--- n20x(21m -->ip)u=D0.... .ip31--- n30x(21mm -->ip)u=D0.... .en12--- n11w(21m -->ip)u=D0.... .in22--- n21w(21m -->ip)u=D0.... .en32--- n31x(21mm -->ip)u=D0.... .en13--- n11w(2)ffffffffield_x(1 (en23--- n21w(2)ffffffffield_x(1 (en33--- n31x(22mm xp1---x01-REALo n10 ffffffffffield_x(1 (xp2---x02-REALo n20 ffffffffffield_x(1 (xp3---x03-REALo n30 fffffffffffield_x(1 (x10wp(xp1x(21= 0 p'fffffffield_x(1 (x11---x10w-d = 0 p'fffffffield_x(1 (x12---x10w-d2= 0 p'fffffffield_x(1 (x13---x10w-d3= 0 p',-so fffield_x(1 (x20wp(xp)x(21= 0 p'fffffffield_x(1 (x21---x20w-d = 0 p'fffffffield_x(1 (x22---x20w-d2= 0 p'fffffffield_x(1 (x23---x20w-d3= 0 p',-so fffield_x(1 (x30wp(xp3x(21= 0 p'fffffffield_x(1 (x31---x30w-d = 0 p'fffffffield_x(1 (x32---x30w-d2= 0 p'fffffffield_x(1 (x33---x30w-d3= 0 p',-so fffield_x(1 a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(1 a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(1 a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(1 a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(1 a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(1 a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(1 a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(1 a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(1 a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(1 a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(1 a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(1 a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(1 a10a20a30 p(f10*a20*a30) p',--)u=D0.... .a10a20a31wp(f10*a20*a31m p',--)u=D0.... .a10a20a32wp(f10*a20*a32,-so fffield_x(1 .a10a20a33wp(f10*a20*a33,-so fffield_x(1 .a10a21a30wp(f10*a21*a30) po fffield_x(1 .a10a21a31wp(f10*a21*a31m p',--)u=D0.... .a10a21a32wp(f10*a21*a32,-so fffield_x(1 .a10a21a33wp(f10*a21*a33,-so fffield_x(1 .a10a22a30wp(f10*a22*a30) p',--)u=D0.... .a10a22a31wp(f10*a22*a31m p',--)u=D0.... .a10a22a32wp(f10*a22*a32,-p',--)u=D0.... .a10a22a33wp(f10*a22*a33,-so fffield_x(1 .a10a23a30wp(f10*a23*a30) po fffield_x(1 .a10a23a31wp(f10*a23*a31m p',--)u=D0.... .a10a23a32wp(f10*a23*a32,-so fffield_x(1 .a10a23a33wp(f10*a23*a33,-so fffield_x(1 a11a20a30 p(f11*a20*a30) p',--)u=D0.... .a11a20a31wp(f11*a20*a31m p',--)u=D0.... .a11a20a32wp(f11*a20*a32,-so fffield_x(1 .a11a20a33wp(f11*a20*a33,-so fffield_x(1 .a11a21a30wp(f11*a21*a30) p',--)u=D0.... .a11a21a31wp(f11*a21*a31m p',--)u=D0.... .a11a21a32wp(f11*a21*a32,-so fffield_x(1 .a11a21a33wp(f11*a21*a33,-so fffield_x(1 .a11a22a30wp(f11*a22*a30) p',--)u=D0.... .a11a22a31wp(f11*a22*a31m p',--)u=D0.... .a11a22a32wp(f11*a22*a32,-so fffield_x(1 .a11a22a33wp(f11*a22*a33,-so fffield_x(1 .a11a23a30wp(f11*a23*a30) p',--)u=D0.... .a11a23a31wp(f11*a23*a31m p',--)u=D0.... .a11a23a32wp(f11*a23*a32,-so fffield_x(1 .a11a23a33wp(f11*a23*a33,-so fffield_x(1 a12a20a30 p(f12*a20*a30) p',--)u=D0.... a12a20a31wp(f12*a20*a31m p',--)u=D0.... a12a20a32wp(f12*a20*a32,-so fffield_x(1 a12a20a33wp(f12*a20*a33,-so fffield_x(1 a12a21a30wp(f12*a21*a30) p',fffield_x(1 a12a21a31wp(f12*a21*a31m p',--)u=D0.... a12a21a32wp(f12*a21*a32,-so fffi=D0.... a12a21a33wp(f12*a21*a33,-so fffield_x(1 a12a22a30wp(f12*a22*a30) p',--)u=D0.... a12a22a31wp(f12*a22*a31m p',--)u=D0.... a12a22a32wp(f12*a22*a32,-so fffield_x(1 a12a22a33wp(f12*a22*a33,-so fffield_x(1 a12a23a30wp(f12*a23*a30) p',--)u=D0.... a12a23a31wp(f12*a23*a31m p',--)u=D0.... a12a23a32wp(f12*a23*a32,-so fffield_x(1 a12a23a33wp(f12*a23*a33,-so fffield_x(1 a13a20a30 p(f13*a20*a30) po fffield_x(1 a13a20a31wp(f13*a20*a31m p',--)u=D0.... a13a20a32wp(f13*a20*a32,-so fffield_x(1 a13a20a33wp(f13*a20*a33,-so fffield_x(1 a13a21a30wp(f13*a21*a30) p',--)u=D0.... a13a21a31wp(f13*a21*a31m p',--)u=D0.... a13a21a32wp(f13*a21*a32,-so fffield_x(1 a13a21a33wp(f13*a21*a33,-so fffield_x(1 a13a22a30wp(f13*a22*a30) p',--)u=D0.... a13a22a31wp(f13*a22*a31m p',--)u=D0.... a13a22a32wp(f13*a22*a32,-so fffield_x(1 a13a22a33wp(f13*a22*a33,-so fffield_x(1 a13a23a30wp(f13*a23*a30) p',--)u=D0.... a13a23a31wp(f13*a23*a31m p',--)u=D0.... a13a23a32wp(f13*a23*a32,-so fffield_x(1 a13a23a33wp(f13*a23*a33,,fffield_x(1 DO ldn=1,lda,,fffield_poi,tsI :ldn,en10,en20,en30,e! 2d=poi,tsI :ldn,en10,en20,en30,e! 2d+) &-so fffield_xa10a20a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en20,en30,e! 2d=poi,tsI :ldn,en11,en20,en30,e! 2d+) &-so fffield_xa11a20a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en20,en30,e! 2d=poi,tsI :ldn,en12,en20,en30,e! 2d+) &-so fffield_xa12a20a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en20,en30,e! 2d=poi,tsI :ldn,en13,en20,en30,e! 2d+) &-so fffield_xa13a20a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en21,en30,e! 2d=poi,tsI :ldn,en10,en21,en30,e! 2d+) &-so fffield_xa10a21a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en21,en30,e! 2d=poi,tsI :ldn,en11,en21,en30,e! 2d+) &-so fffield_xa11a21a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en21,en30,e! 2d=poi,tsI :ldn,en12,en21,en30,e! 2d+) &-so fffield_xa12a21a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en21,en30,e! 2d=poi,tsI :ldn,en13,en21,en30,e! 2d+) &-so fffield_xa13a21a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en22,en30,e! 2d=poi,tsI :ldn,en10,en22,en30,e! 2d+) &-so fffield_xa10a22a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en22,en30,e! 2d=poi,tsI :ldn,en11,en22,en30,e! 2d+) &-so fffield_xa11a22a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en22,en30,e! 2d=poi,tsI :ldn,en12,en22,en30,e! 2d+) &-so fffield_xa12a22a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en22,en30,e! 2d=poi,tsI :ldn,en13,en22,en30,e! 2d+) &-so fffield_xa13a22a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en23,en30,e! 2d=poi,tsI :ldn,en10,en23,en30,e! 2d+) &-so fffield_xa10a23a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en23,en30,e! 2d=poi,tsI :ldn,en11,en23,en30,e! 2d+) &-so fffield_xa11a23a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en23,en30,e! 2d=poi,tsI :ldn,en12,en23,en30,e! 2d+) &-so fffield_xa12a23a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en23,en30,e! 2d=poi,tsI :ldn,en13,en23,en30,e! 2d+) &-so fffield_xa13a23a30*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en20,en31,e! 2d=poi,tsI :ldn,en10,en20,en31,e! 2d+) &-so fffield_xa10a20a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en20,en31,e! 2d=poi,tsI :ldn,en11,en20,en31,e! 2d+) &-so fffield_xa11a20a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en20,en31,e! 2d=poi,tsI :ldn,en12,en20,en31,e! 2d+) &-so fffield_xa12a20a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en20,en31,e! 2d=poi,tsI :ldn,en13,en20,en31,e! 2d+) &-so fffield_xa13a20a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en21,en31,e! 2d=poi,tsI :ldn,en10,en21,en31,e! 2d+) &-so fffield_xa10a21a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en21,en31,e! 2d=poi,tsI :ldn,en11,en21,en31,e! 2d+) &-so fffield_xa11a21a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en21,en31,e! 2d=poi,tsI :ldn,en12,en21,en31,e! 2d+) &-so fffield_xa12a21a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en21,en31,e! 2d=poi,tsI :ldn,en13,en21,en31,e! 2d+) &-so fffield_xa13a21a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en22,en31,e! 2d=poi,tsI :ldn,en10,en22,en31,e! 2d+) &-so fffield_xa10a22a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en22,en31,e! 2d=poi,tsI :ldn,en11,en22,en31,e! 2d+) &-so fffield_xa11a22a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en22,en31,e! 2d=poi,tsI :ldn,en12,en22,en31,e! 2d+) &-so fffield_xa12a22a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en22,en31,e! 2d=poi,tsI :ldn,en13,en22,en31,e! 2d+) &-so fffield_xa13a22a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en23,en31,e! 2d=poi,tsI :ldn,en10,en23,en31,e! 2d+) &-so fffield_xa10a23a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en23,en31,e! 2d=poi,tsI :ldn,en11,en23,en31,e! 2d+) &-so fffield_xa11a23a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en23,en31,e! 2d=poi,tsI :ldn,en12,en23,en31,e! 2d+) &-so fffield_xa12a23a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en23,en31,e! 2d=poi,tsI :ldn,en13,en23,en31,e! 2d+) &-so fffield_xa13a23a31*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en20,en32,e! 2d=poi,tsI :ldn,en10,en20,en32,e! 2d+) &-so fffield_xa10a20a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en20,en32,e! 2d=poi,tsI :ldn,en11,en20,en32,e! 2d+) &-so fffield_xa11a20a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en20,en32,e! 2d=poi,tsI :ldn,en12,en20,en32,e! 2d+) &-so fffield_xa12a20a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en20,en32,e! 2d=poi,tsI :ldn,en13,en20,en32,e! 2d+) &-so fffield_xa13a20a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en21,en32,e! 2d=poi,tsI :ldn,en10,en21,en32,e! 2d+) &-so fffield_xa10a21a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en21,en32,e! 2d=poi,tsI :ldn,en11,en21,en32,e! 2d+) &-so fffield_xa11a21a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en21,en32,e! 2d=poi,tsI :ldn,en12,en21,en32,e! 2d+) &-so fffield_xa12a21a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en21,en32,e! 2d=poi,tsI :ldn,en13,en21,en32,e! 2d+) &-so fffield_xa13a21a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en22,en32,e! 2d=poi,tsI :ldn,en10,en22,en32,e! 2d+) &-so fffield_xa10a22a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en22,en32,e! 2d=poi,tsI :ldn,en11,en22,en32,e! 2d+) &-so fffield_xa11a22a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en22,en32,e! 2d=poi,tsI :ldn,en12,en22,en32,e! 2d+) &-so fffield_xa12a22a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en22,en32,e! 2d=poi,tsI :ldn,en13,en22,en32,e! 2d+) &-so fffield_xa13a22a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en23,en32,e! 2d=poi,tsI :ldn,en10,en23,en32,e! 2d+) &-so fffield_xa10a23a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en23,en32,e! 2d=poi,tsI :ldn,en11,en23,en32,e! 2d+) &-so fffield_xa11a23a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en23,en32,e! 2d=poi,tsI :ldn,en12,en23,en32,e! 2d+) &-so fffield_xa12a23a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en23,en32,e! 2d=poi,tsI :ldn,en13,en23,en32,e! 2d+) &-so fffield_xa13a23a32*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en20,en33,e! 2d=poi,tsI :ldn,en10,en20,en33,e! 2d+) &-so fffield_xa10a20a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en20,en33,e! 2d=poi,tsI :ldn,en11,en20,en33,e! 2d+) &-so fffield_xa11a20a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en20,en33,e! 2d=poi,tsI :ldn,en12,en20,en33,e! 2d+) &-so fffield_xa12a20a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en20,en33,e! 2d=poi,tsI :ldn,en13,en20,en33,e! 2d+) &-so fffield_xa13a20a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en21,en33,e! 2d=poi,tsI :ldn,en10,en21,en33,e! 2d+) &-so fffield_xa10a21a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en21,en33,e! 2d=poi,tsI :ldn,en11,en21,en33,e! 2d+) &-so fffield_xa11a21a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en21,en33,e! 2d=poi,tsI :ldn,en12,en21,en33,e! 2d+) &-so fffield_xa12a21a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en21,en33,e! 2d=poi,tsI :ldn,en13,en21,en33,e! 2d+) &-so fffield_xa13a21a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en22,en33,e! 2d=poi,tsI :ldn,en10,en22,en33,e! 2d+) &-so fffield_xa10a22a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en22,en33,e! 2d=poi,tsI :ldn,en11,en22,en33,e! 2d+) &-so fffield_xa11a22a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en22,en33,e! 2d=poi,tsI :ldn,en12,en22,en33,e! 2d+) &-so fffield_xa12a22a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en22,en33,e! 2d=poi,tsI :ldn,en13,en22,en33,e! 2d+) &-so fffield_xa13a22a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en10,en23,en33,e! 2d=poi,tsI :ldn,en10,en23,en33,e! 2d+) &-so fffield_xa10a23a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en11,en23,en33,e! 2d=poi,tsI :ldn,en11,en23,en33,e! 2d+) &-so fffield_xa11a23a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en12,en23,en33,e! 2d=poi,tsI :ldn,en12,en23,en33,e! 2d+) &-so fffield_xa12a23a33*un-ldn,eq),-so ffd_poi,tsI :ldn,en13,en23,en33,e! 2d=poi,tsI :ldn,en13,en23,en33,e! 2d+) &-so fffield_xa13a23a33*un-ldn,eq), ENDDO ! lda ENDDO ! iq END IF ! unrn-a lda cases,#elif __MODE == __SCA e! 2nwww %--------OT! 2d ,mk) fMM w1DOAipwww1pstorktopfo(D! 2d ,mk) fMM w1,1,eq->ip= ----_b2troaww,ip! fie __ -->ix01 p((kn-awiq)- sI awwi1(! fil))*3xxi w1,1, __ -->ix02 p((kn-2wiq)- sI awwi2(! fil))*3xyi w1,1, __ -->ix03 p((kn-3wiq)- sI awwi3(! fil))*3xzi ,mk) fMM w1,1,in10wp(INT(x0j-1,mk) ffffDDDDNin20wp(INT(x02! ,mk) ffffDDDDNip30wp(INT(x03! m -->ip)u= -->iin11--- n10w(21m -->ip)u=D0...in21--- n20x(21m -->ip)u=D0...ip31--- n30x(21mm -->ip)u=D0...in12--- n11w(21m -->ip)u=D0...in22--- n21w(21m -->ip)u=D0...in32--- n31x(21mm -->ip)u=D0...in13--- n11w(2)ffffffffield_x(in23--- n21w(2)ffffffffield_x(in33--- n31x(22mm xp1---x01-REALo n10 ffffffffffield_x(xp2---x02-REALo n20 ffffffffffield_x(xp3---x03-REALo n30 fffffffffffield_x(x10wp(xp1x(21= 0 p'fffffffield_x(x11---x10w-d = 0 p'fffffffield_x(x12---x10w-d2= 0 p'fffffffield_x(x13---x10w-d3= 0 p',-so fffield_x(x20wp(xp)x(21= 0 p'fffffffield_x(x21---x20w-d = 0 p'fffffffield_x(x22---x20w-d2= 0 p'fffffffield_x(x23---x20w-d3= 0 p',-so fffield_x(x30wp(xp3x(21= 0 p'fffffffield_x(x31---x30w-d = 0 p'fffffffield_x(x32---x30w-d2= 0 p'fffffffield_x(x33---x30w-d3= 0 p',-so fffield_x(a10 p(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*xj0)*xj0)*xj0,-so fffield_x(a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x20,-so fffield_x(a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x30',-so fffield_x(a11wp( = 0 pw+1(-2.50 p+ =50 p*xjj-*xj1**2,-so fffield_x(a21wp( = 0 pw+1(-2.50 p+ =50 p*x2j-*x21**2,-so fffield_x(a31wp( = 0 pw+1(-2.50 p+ =50 p*x3j-*x31**2,,-so fffield_x(a12wp( = 0 pw+1(-2.50 p-1.50 p*x12)*x12**2,-so fffield_x(a22wp( = 0 pw+1(-2.50 p-1.50 p*x22)*x22**2,-so fffield_x(a32wp( = 0 pw+1(-2.50 p-1.50 p*x32)*x32**2,,-so fffield_x(a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*xj3)*xj3)*xj3,-so fffield_x(a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x23,-so fffield_x(a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33',-so fffield_x(a10a20a30 p(f10*a20*a30) p',--)u=D0...a10a20a31wp(f10*a20*a31m p',--)u=D0...a10a20a32wp(f10*a20*a32,-so fffield_x(a10a20a33wp(f10*a20*a33,-so fffield_x(a10a21a30wp(f10*a21*a30) po fffield_x(a10a21a31wp(f10*a21*a31m p',--)u=D0...a10a21a32wp(f10*a21*a32,-so fffield_x(a10a21a33wp(f10*a21*a33,-so fffield_x(a10a22a30wp(f10*a22*a30) p',--)u=D0...a10a22a31wp(f10*a22*a31m p',--)u=D0...a10a22a32wp(f10*a22*a32,-p',--)u=D0...a10a22a33wp(f10*a22*a33,-so fffield_x(a10a23a30wp(f10*a23*a30) po fffield_x(a10a23a31wp(f10*a23*a31m p',--)u=D0...a10a23a32wp(f10*a23*a32,-so fffield_x(a10a23a33wp(f10*a23*a33,-so fffield_x(a11a20a30 p(f11*a20*a30) p',--)u=D0...a11a20a31wp(f11*a20*a31m p',--)u=D0...a11a20a32wp(f11*a20*a32,-so fffield_x(a11a20a33wp(f11*a20*a33,-so fffield_x(a11a21a30wp(f11*a21*a30) p',--)u=D0...a11a21a31wp(f11*a21*a31m p',--)u=D0...a11a21a32wp(f11*a21*a32,-so fffield_x(a11a21a33wp(f11*a21*a33,-so fffield_x(a11a22a30wp(f11*a22*a30) p',--)u=D0...a11a22a31wp(f11*a22*a31m p',--)u=D0...a11a22a32wp(f11*a22*a32,-so fffield_x(a11a22a33wp(f11*a22*a33,-so fffield_x(a11a23a30wp(f11*a23*a30) p',--)u=D0...a11a23a31wp(f11*a23*a31m p',--)u=D0...a11a23a32wp(f11*a23*a32,-so fffield_x(a11a23a33wp(f11*a23*a33,-so fffield_x(a12a20a30 p(f12*a20*a30) p',--)u=D0...a12a20a31wp(f12*a20*a31m p',--)u=D0...a12a20a32wp(f12*a20*a32,-so fffield_x(a12a20a33wp(f12*a20*a33,-so fffield_x(a12a21a30wp(f12*a21*a30) p',fffield_x(a12a21a31wp(f12*a21*a31m p',--)u=D0...a12a21a32wp(f12*a21*a32,-so fffi=D0...a12a21a33wp(f12*a21*a33,-so fffield_x(a12a22a30wp(f12*a22*a30) p',--)u=D0...a12a22a31wp(f12*a22*a31m p',--)u=D0...a12a22a32wp(f12*a22*a32,-so fffield_x(a12a22a33wp(f12*a22*a33,-so fffield_x(a12a23a30wp(f12*a23*a30) p',--)u=D0...a12a23a31wp(f12*a23*a31m p',--)u=D0...a12a23a32wp(f12*a23*a32,-so fffield_x(a12a23a33wp(f12*a23*a33,-so fffield_x(a13a20a30 p(f13*a20*a30) po fffield_x(a13a20a31wp(f13*a20*a31m p',--)u=D0...a13a20a32wp(f13*a20*a32,-so fffield_x(a13a20a33wp(f13*a20*a33,-so fffield_x(a13a21a30wp(f13*a21*a30) p',--)u=D0...a13a21a31wp(f13*a21*a31m p',--)u=D0...a13a21a32wp(f13*a21*a32,-so fffield_x(a13a21a33wp(f13*a21*a33,-so fffield_x(a13a22a30wp(f13*a22*a30) p',--)u=D0...a13a22a31wp(f13*a22*a31m p',--)u=D0...a13a22a32wp(f13*a22*a32,-so fffield_x(a13a22a33wp(f13*a22*a33,-so fffield_x(a13a23a30wp(f13*a23*a30) p',--)u=D0...a13a23a31wp(f13*a23*a31m p',--)u=D0...a13a23a32wp(f13*a23*a32,-so fffield_x(a13a23a33wp(f13*a23*a33,,fffield_x(1 poi,tsI :en10,en20,en30,e! 2d=poi,tsI :en10,en20,en30,e! 2d+) &-so fffield_x(1 (a10a20a30*un-iq),-so ffd_x(1 poi,tsI :en11,en20,en30,e! 2d=poi,tsI :en11,en20,en30,e! 2d+) &-so fffield_x(1 (a11a20a30*un-iq),-so ffd_x(1 poi,tsI :en12,en20,en30,e! 2d=poi,tsI :en12,en20,en30,e! 2d+) &-so fffield_x(1 (a12a20a30*un-iq),-so ffd_x(1 poi,tsI :en13,en20,en30,e! 2d=poi,tsI :en13,en20,en30,e! 2d+) &-so fffield_x(1 (a13a20a30*un-iq),-so ffd_x(1 poi,tsI :en10,en21,en30,e! 2d=poi,tsI :en10,en21,en30,e! 2d+) &-so fffield_x(1 (a10a21a30*un-iq),-so ffd_x(1 poi,tsI :en11,en21,en30,e! 2d=poi,tsI :en11,en21,en30,e! 2d+) &-so fffield_x(1 (a11a21a30*un-iq),-so ffd_x(1 poi,tsI :en12,en21,en30,e! 2d=poi,tsI :en12,en21,en30,e! 2d+) &-so fffield_x(1 (a12a21a30*un-iq),-so ffd_x(1 poi,tsI :en13,en21,en30,e! 2d=poi,tsI :en13,en21,en30,e! 2d+) &-so fffield_x(1 (a13a21a30*un-iq),-so ffd_x(1 poi,tsI :en10,en22,en30,e! 2d=poi,tsI :en10,en22,en30,e! 2d+) &-so fffield_x(1 (a10a22a30*un-iq),-so ffd_x(1 poi,tsI :en11,en22,en30,e! 2d=poi,tsI :en11,en22,en30,e! 2d+) &-so fffield_x(1 (a11a22a30*un-iq),-so ffd_x(1 poi,tsI :en12,en22,en30,e! 2d=poi,tsI :en12,en22,en30,e! 2d+) &-so fffield_x(1 (a12a22a30*un-iq),-so ffd_x(1 poi,tsI :en13,en22,en30,e! 2d=poi,tsI :en13,en22,en30,e! 2d+) &-so fffield_x(1 (a13a22a30*un-iq),-so ffd_x(1 poi,tsI :en10,en23,en30,e! 2d=poi,tsI :en10,en23,en30,e! 2d+) &-so fffield_x(1 (a10a23a30*un-iq),-so ffd_x(1 poi,tsI :en11,en23,en30,e! 2d=poi,tsI :en11,en23,en30,e! 2d+) &-so fffield_x(1 (a11a23a30*un-iq),-so ffd_x(1 poi,tsI :en12,en23,en30,e! 2d=poi,tsI :en12,en23,en30,e! 2d+) &-so fffield_x(1 (a12a23a30*un-iq),-so ffd_x(1 poi,tsI :en13,en23,en30,e! 2d=poi,tsI :en13,en23,en30,e! 2d+) &-so fffield_x(1 (a13a23a30*un-iq),-so ffd_x(1 poi,tsI :en10,en20,en31,e! 2d=poi,tsI :en10,en20,en31,e! 2d+) &-so fffield_x(1 (a10a20a31*un-iq),-so ffd_x(1 poi,tsI :en11,en20,en31,e! 2d=poi,tsI :en11,en20,en31,e! 2d+) &-so fffield_x(1 (a11a20a31*un-iq),-so ffd_x(1 poi,tsI :en12,en20,en31,e! 2d=poi,tsI :en12,en20,en31,e! 2d+) &-so fffield_x(1 (a12a20a31*un-iq),-so ffd_x(1 poi,tsI :en13,en20,en31,e! 2d=poi,tsI :en13,en20,en31,e! 2d+) &-so fffield_x(1 (a13a20a31*un-iq),-so ffd_x(1 poi,tsI :en10,en21,en31,e! 2d=poi,tsI :en10,en21,en31,e! 2d+) &-so fffield_x(1 (a10a21a31*un-iq),-so ffd_x(1 poi,tsI :en11,en21,en31,e! 2d=poi,tsI :en11,en21,en31,e! 2d+) &-so fffield_x(1 (a11a21a31*un-iq),-so ffd_x(1 poi,tsI :en12,en21,en31,e! 2d=poi,tsI :en12,en21,en31,e! 2d+) &-so fffield_x(1 (a12a21a31*un-iq),-so ffd_x(1 poi,tsI :en13,en21,en31,e! 2d=poi,tsI :en13,en21,en31,e! 2d+) &-so fffield_x(1 (a13a21a31*un-iq),-so ffd_x(1 poi,tsI :en10,en22,en31,e! 2d=poi,tsI :en10,en22,en31,e! 2d+) &-so fffield_x(1 (a10a22a31*un-iq),-so ffd_x(1 poi,tsI :en11,en22,en31,e! 2d=poi,tsI :en11,en22,en31,e! 2d+) &-so fffield_x(1 (a11a22a31*un-iq),-so ffd_x(1 poi,tsI :en12,en22,en31,e! 2d=poi,tsI :en12,en22,en31,e! 2d+) &-so fffield_x(1 (a12a22a31*un-iq),-so ffd_x(1 poi,tsI :en13,en22,en31,e! 2d=poi,tsI :en13,en22,en31,e! 2d+) &-so fffield_x(1 (a13a22a31*un-iq),-so ffd_x(1 poi,tsI :en10,en23,en31,e! 2d=poi,tsI :en10,en23,en31,e! 2d+) &-so fffield_x(1 (a10a23a31*un-iq),-so ffd_x(1 poi,tsI :en11,en23,en31,e! 2d=poi,tsI :en11,en23,en31,e! 2d+) &-so fffield_x(1 (a11a23a31*un-iq),-so ffd_x(1 poi,tsI :en12,en23,en31,e! 2d=poi,tsI :en12,en23,en31,e! 2d+) &-so fffield_x(1 (a12a23a31*un-iq),-so ffd_x(1 poi,tsI :en13,en23,en31,e! 2d=poi,tsI :en13,en23,en31,e! 2d+) &-so fffield_x(1 (a13a23a31*un-iq),-so ffd_x(1 poi,tsI :en10,en20,en32,e! 2d=poi,tsI :en10,en20,en32,e! 2d+) &-so fffield_x(1 (a10a20a32*un-iq),-so ffd_x(1 poi,tsI :en11,en20,en32,e! 2d=poi,tsI :en11,en20,en32,e! 2d+) &-so fffield_x(1 (a11a20a32*un-iq),-so ffd_x(1 poi,tsI :en12,en20,en32,e! 2d=poi,tsI :en12,en20,en32,e! 2d+) &-so fffield_x(1 (a12a20a32*un-iq),-so ffd_x(1 poi,tsI :en13,en20,en32,e! 2d=poi,tsI :en13,en20,en32,e! 2d+) &-so fffield_x(1 (a13a20a32*un-iq),-so ffd_x(1 poi,tsI :en10,en21,en32,e! 2d=poi,tsI :en10,en21,en32,e! 2d+) &-so fffield_x(1 (a10a21a32*un-iq),-so ffd_x(1 poi,tsI :en11,en21,en32,e! 2d=poi,tsI :en11,en21,en32,e! 2d+) &-so fffield_x(1 (a11a21a32*un-iq),-so ffd_x(1 poi,tsI :en12,en21,en32,e! 2d=poi,tsI :en12,en21,en32,e! 2d+) &-so fffield_x(1 (a12a21a32*un-iq),-so ffd_x(1 poi,tsI :en13,en21,en32,e! 2d=poi,tsI :en13,en21,en32,e! 2d+) &-so fffield_x(1 (a13a21a32*un-iq),-so ffd_x(1 poi,tsI :en10,en22,en32,e! 2d=poi,tsI :en10,en22,en32,e! 2d+) &-so fffield_x(1 (a10a22a32*un-iq),-so ffd_x(1 poi,tsI :en11,en22,en32,e! 2d=poi,tsI :en11,en22,en32,e! 2d+) &-so fffield_x(1 (a11a22a32*un-iq),-so ffd_x(1 poi,tsI :en12,en22,en32,e! 2d=poi,tsI :en12,en22,en32,e! 2d+) &-so fffield_x(1 (a12a22a32*un-iq),-so ffd_x(1 poi,tsI :en13,en22,en32,e! 2d=poi,tsI :en13,en22,en32,e! 2d+) &-so fffield_x(1 (a13a22a32*un-iq),-so ffd_x(1 poi,tsI :en10,en23,en32,e! 2d=poi,tsI :en10,en23,en32,e! 2d+) &-so fffield_x(1 (a10a23a32*un-iq),-so ffd_x(1 poi,tsI :en11,en23,en32,e! 2d=poi,tsI :en11,en23,en32,e! 2d+) &-so fffield_x(1 (a11a23a32*un-iq),-so ffd_x(1 poi,tsI :en12,en23,en32,e! 2d=poi,tsI :en12,en23,en32,e! 2d+) &-so fffield_x(1 (a12a23a32*un-iq),-so ffd_x(1 poi,tsI :en13,en23,en32,e! 2d=poi,tsI :en13,en23,en32,e! 2d+) &-so fffield_x(1 (a13a23a32*un-iq),-so ffd_x(1 poi,tsI :en10,en20,en33,e! 2d=poi,tsI :en10,en20,en33,e! 2d+) &-so fffield_x(1 (a10a20a33*un-iq),-so ffd_x(1 poi,tsI :en11,en20,en33,e! 2d=poi,tsI :en11,en20,en33,e! 2d+) &-so fffield_x(1 (a11a20a33*un-iq),-so ffd_x(1 poi,tsI :en12,en20,en33,e! 2d=poi,tsI :en12,en20,en33,e! 2d+) &-so fffield_x(1 (a12a20a33*un-iq),-so ffd_x(1 poi,tsI :en13,en20,en33,e! 2d=poi,tsI :en13,en20,en33,e! 2d+) &-so fffield_x(1 (a13a20a33*un-iq),-so ffd_x(1 poi,tsI :en10,en21,en33,e! 2d=poi,tsI :en10,en21,en33,e! 2d+) &-so fffield_x(1 (a10a21a33*un-iq),-so ffd_x(1 poi,tsI :en11,en21,en33,e! 2d=poi,tsI :en11,en21,en33,e! 2d+) &-so fffield_x(1 (a11a21a33*un-iq),-so ffd_x(1 poi,tsI :en12,en21,en33,e! 2d=poi,tsI :en12,en21,en33,e! 2d+) &-so fffield_x(1 (a12a21a33*un-iq),-so ffd_x(1 poi,tsI :en13,en21,en33,e! 2d=poi,tsI :en13,en21,en33,e! 2d+) &-so fffield_x(1 (a13a21a33*un-iq),-so ffd_x(1 poi,tsI :en10,en22,en33,e! 2d=poi,tsI :en10,en22,en33,e! 2d+) &-so fffield_x(1 (a10a22a33*un-iq),-so ffd_x(1 poi,tsI :en11,en22,en33,e! 2d=poi,tsI :en11,en22,en33,e! 2d+) &-so fffield_x(1 (a11a22a33*un-iq),-so ffd_x(1 poi,tsI :en12,en22,en33,e! 2d=poi,tsI :en12,en22,en33,e! 2d+) &-so fffield_x(1 (a12a22a33*un-iq),-so ffd_x(1 poi,tsI :en13,en22,en33,e! 2d=poi,tsI :en13,en22,en33,e! 2d+) &-so fffield_x(1 (a13a22a33*un-iq),-so ffd_x(1 poi,tsI :en10,en23,en33,e! 2d=poi,tsI :en10,en23,en33,e! 2d+) &-so fffield_x(1 (a10a23a33*un-iq),-so ffd_x(1 poi,tsI :en11,en23,en33,e! 2d=poi,tsI :en11,en23,en33,e! 2d+) &-so fffield_x(1 (a11a23a33*un-iq),-so ffd_x(1 poi,tsI :en12,en23,en33,e! 2d=poi,tsI :en12,en23,en33,e! 2d+) &-so fffield_x(1 (a12a23a33*un-iq),-so ffd_x(1 poi,tsI :en13,en23,en33,e! 2d=poi,tsI :en13,en23,en33,e! 2d+) &-so fffield_x(1 (a13a23a33*un-iq),-so ffd_x(1ENDDO ! iq #endif ffd_x(1END DO ! loop over ! 2s ,#elif __DIME == __2D ffd_x(1DOAi! 2www1p %ns------,-so ffd_x(1DOAipwww1pstorktopfo(D! 2d ,mk) fMM w1,1,es 2nwww %--------OT! 2d ,mk) fMM w1,1,eq->ip= ----_b2troaww,ip! fie __ -->ix01 p((kn-awiq)- sI awwi1(! fil))*3xxi w1,1, __ -->ix02 p((kn-2wiq)- sI awwi2(! fil))*3xyi ,mk) fMM w1,1,ep1---INT(x0j-+1m -->ip)u=D0...in2wp(INT(x02!+1mm -->ip)u=D0...xp1---x01-AINT(x0j-1,mk) ffffDDDDNxp2---x02-AINT(x02! 1,mk) ffffDDDDNDOAjj----1,2mm x2---ABS(xp2-- REALojj ff), IF(x2.LT. = 0 p) THEN wx2wp( = 0 pw- x2**2*(2.50 p-1.50 p*x2-1,mk) ffffDDDDN , ELSE w1,1, 3,0, 0 - wx2wp(2= 0 pw+1(-4= 0 pw+1) &-so fffield_x(1 ((((((((2.50 pw- 0.50 p * x2)*x2)*x21,mk) ffffDDDDN , END IF,,fffield_x(1 DO ii =w-d ,2mm x(x1---ABS(xp1-- REALoii ff), IF(x1.LT. = 0MK) THEN wx1---( = 0 pw- x1**2*(2.50 pw- ) &-so fffield_x(1 (((((((((((1.50 p*x1-1,mk) ffffDDDDN , , ELSE w1,1, 3,0, 0 - wx1---(2= 0 pw+1(-4= 0 pw+1) &-so fffield_x(1 ((((((((((((2.50 pw- 0.50 p*x1-*x1-*x11,mk) ffffDDDDN , , END IF,,#if __MODE == __SCA poi,tsI :ei+ep1,jj+ep2,e! 2d1) &-so fffield_x(1 (((((((= poi,tsI :ei+ep1,jj+ep2,e! 2d1) &-so fffield_x(1 ((((((((((((((((((((((((+ wx1*wx2*un-iq),#else DO ldn=1,lda,(((((((((((((((((((((((poi,tsI :ldn,ei+ep1,jj+ep2,e! 2d1) &-so fffield_x(1 ((((((((((=(poi,tsI :ldn,ei+ep1,jj+ep2,e! 2d1) &-so fffield_x(1 (((((((((((((((((((((((((((+ wx1*wx2*un-ldn,eq),-so ffd_____________ENDDOl#endif ffd_x(1_________END DOl END DOl END DOl END DO ! loop over ! 2s #endif l CALL ! 2s ('p2mtopterp_mp4',t0,epfo),-so ffRETURN,,#if __DIME == __2D #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION END SUBROUTINE p2mtopterp_mp4_ss_2d,#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p2mtopterp_mp4_ds_2d,#endif #elif __MODE == __VEC #if __KIND == __SINGLE_PRECISION END SUBROUTINE p2mtopterp_mp4_sv_2d,#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p2mtopterp_mp4_dv_2d,#endif #endif #elif __DIME == __3D #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION END SUBROUTINE p2mtopterp_mp4_ss_3d,#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p2mtopterp_mp4_ds_3d,#endif #elif __MODE == __VEC #if __KIND == __SINGLE_PRECISION END SUBROUTINE p2mtopterp_mp4_sv_3d,#elif __KIND == __DOUBLE_PRECISION END SUBROUTINE p2mtopterp_mp4_dv_3d,#endif #endif #endif ����������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/opterpolate/ppmtopterp_p2mtrenorm.f������������������������������������������������0000644�0001752�0001753�00000465036�11616003523�022773� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !������������������������������������������������������������������������� ! Subroutine : ffd_x(1_________ppmtopterp_p2mtrenorm !������������������������������������������������������������������������� ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Cepter for Fluid Dynamics (DTU),-so ff!,-so ff!,-so ff! This(pole,es part of the Parallel Particle,Mesh Library (PPM).,-so ff!,-so ff! PPM,es free software: you can red---ribute,et and/or modify,-so ff! et under the terms of the GNU Lesser General P----c License ! as p-----hed by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version.,-so ff!,-so ff! PPM,es d---ributed in the hope that et will be useful,,-so ff! but WITHOUT ANY WARRANTY; without even the implied warranty of,-so ff! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the,-so ff! GNU General P----c License for more details.,-so ff!,-so ff! You should have received a copy of the GNU General P----c License ! and the GNU Lesser General P----c License along with PPM. If not,,-so ff! see <http://www.gnu.org/licenses/>.,-so ff!,-so ff! Parallel Particle,Mesh Library (PPM),-so ff! ETH Zurich ! CH-8092 Zurich, Switzerland !������������������������������������������������������������������������� ,,#if __DIME == __2D #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION SUBROUTINE p2mtrenorm_ss_2d( id,meshid,xp,Np,up,kernel,1) & ghostsize,poi,tsI ,epfo),#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p2mtrenorm_ds_2d( id,meshid,xp,Np,up,kernel,1) & ghostsize,poi,tsI ,epfo),#endif #elif __MODE == __VEC #if __KIND == __SINGLE_PRECISION SUBROUTINE p2mtrenorm_sv_2d( id,meshid,xp,Np,up,lda,kernel,) & ghostsize,poi,tsI ,epfo),#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p2mtrenorm_dv_2d( id,meshid,xp,Np,up,lda,kernel,) & ghostsize,poi,tsI ,epfo),#endif #endif #elif __DIME == __3D #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION SUBROUTINE p2mtrenorm_ss_3d( id,meshid,xp,Np,up,kernel,1) & ghostsize,poi,tsI ,epfo),#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p2mtrenorm_ds_3d( id,meshid,xp,Np,up,kernel,1) & ghostsize,poi,tsI ,epfo),#endif #elif __MODE == __VEC #if __KIND == __SINGLE_PRECISION SUBROUTINE p2mtrenorm_sv_3d( id,meshid,xp,Np,up,lda,kernel,) & ghostsize,poi,tsI ,epfo),#elif __KIND == __DOUBLE_PRECISION SUBROUTINE p2mtrenorm_dv_3d( id,meshid,xp,Np,up,lda,kernel,) & ghostsize,poi,tsI ,epfo),#endif #endif #endif !!! This(routine does particle,to mesh opterpolation. Vector cases for !!! lda < 5 are explicitly unrn-a for the 3D version.fAll 3D !!! versions are explicitly unrn-a over the kernel,1the 2D versions !!! are not. !������������������������������������������������������������������������� ! INCLUDES !������������������������������������������������������������������������� , !������������������������������������������������������������������������� ! Modules, !������������������������������������������������������������������������� USE ppmtmodule_error USE ppmtmodule_alloc USE ppmtmodule_! 2s art USE ppmtmodule_! 2s op USE ppmtmodule_data USE ppmtmodule_data_rmsh USE ppmtmodule_data_mesh USE ppmtmodule_write USE ppmtmodule_map USE ppmtmodule_check_id IMPLICIT NONE w1,1, 3,0, 0 #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = ppmtkind_single,#elif __KIND == __DOUBLE_PRECISION INTEGER, PARAMETER :: MK = ppmtkind_do---el#endif ffd_x!�������������������������������������������������������������������������� ! Argumepts !�������������������������������������������������������������������������� #if __MODE == __SCA REALoMK) , DIMENSION(:), 3,0, 0 , INTENT(IN), 3:: up !!! particle,weights from which,to opterpolate,#if __DIME == __2D REALoMK) , DIMENSION(:,:,: ) , POINTER :: poi,tsI #elif __DIME == __3D REALoMK) , DIMENSION(:,:,:,: ) , POINTER :: poi,tsI #endif ffd_x!!! poi,t onto which,to opterpolate,#elif __MODE == __VEC INTEGER , INTENT(in), 3:: lda,((((((!!! leading d-mepsion of up REALoMK) , DIMENSION(:,:) , INTENT(IN), 3:: up !!! particle,weights from which,to opterpolate,#if __DIME == __2D REALoMK) , DIMENSION(:,:,:,: ) , POINTER :: poi,tsI #elif __DIME == __3D REALoMK) , DIMENSION(:,:,:,:,:) , POINTER :: poi,tsI #endif ffd_x!!! poi,t onto which,to opterpolate,#endif ffd_xREALoMK), DIMENSION(:,:) , INTENT(IN), 3 :: xp !!! particle,positions INTEGER , DIMENSION(: ) , INTENT(IN), 3 :: ghostsize !!! The size (width) of the ghost layer INTEGER , INTENT(IN ) :: Np !!! number of particles INTEGER , INTENT(IN ) :: meshid !!! id of the mesh (user) INTEGER , INTENT(IN ) :: id !!! logy ideptipoir (user numbering) of target INTEGER , INTENT(IN ) :: kernel !!! Choice of the kernel used,to compute,the weights. INTEGER , INTENT( OUT) :: epfo !!! Returns s atus, 0 upon success, !�������������������������������������������������������������������������� ! Local variables, !�������������������������������������������������������������������������- INTEGER, DIMENSION(:,:) , POINTER :: es art => NULL() INTEGER, DIMENSION(:,:) , POINTER :: ndata => NULL() INTEGER, DIMENSION(:) , POINTER :: e----1 => NULL() INTEGER, DIMENSION(:) , POINTER :: e----2 => NULL() REALomk), DIMENSION(:), 3,0, , POINTER :: sI phys => NULL() REALomk), DIMENSION(:), 3,0, , POINTER :: ax phys => NULL() REALoMK), DIMENSION(ppmtd-m), 3,0, 0 3 :: dxi,dx REALoMK), DIMENSION(ppmtd-m), 3,0, 0 3 :: leI phys REALoMK) :: x1,x2,x3,epsilon INTEGER :: kernel_! pport INTEGER, DIMENSION(ppmtd-m+2) :: ldu,ldl INTEGER, DIMENSION(ppmtd-m), 3,0, 0 3 :: Nc INTEGER :: i,j,k,ii,jj,kk,iidec,maptype INTEGER :: jjdec,nb_! 2,npart,ipart INTEGER :: kkdec,ep1,n----1 INTEGER :: ip2,en3,iface INTEGER :: oaww,ifrom,ito,en,d-m,iopt(! fil INTEGER :: ax partnumber,idom,n----2,idoml INTEGER, DIMENSION(ppmtd-m), 3,0, 0 3 :: Nm INTEGER :: n! 2s INTEGER, DIMENSION(6) :: bcdef INTEGER :: oq LOGICAL :: opternal_weights,lok ! aliases, REALomk), DIMENSION(:,:), POINTER :: sI ! 2ww> NULL() REALomk), DIMENSION(:,:), POINTER :: ax ! 2ww> NULL() REALoMK) :: myeps REALoMK) :: tim1s, tim1e REALoMK) :: xp1,xp2,xp3 REALoMK) :: wx1,wx2,wx3 REALoMK), DIMENSION(ppmtd-m), 3,0, 0 3 :: x0) p',--CHARACTER(leI=256) 3 :: msg) p',--TYPE(ppmtt_equi_mesh), POINTER 3 :: p_meshww> NULL() TYPE(ppmtt_ ) , POINTER :: t => NULL() !����������������������������������������������������� ! Renormalization !����������������������������������������������������� #if __DIME == __2D #error two d-mepsional renormalization,es not yet implemepted REALoMK), DIMENSION(:,:,:), POINTER :: poi,tsreno => NULL() #elif __DIME == __3D REALoMK), DIMENSION(:,:,:,:), POINTER :: poi,tsreno => NULL() #endif ffd_x, !������������������������������������������������������������������������� ! Variables for unrn-a versions !������������������������������������������������������������������������� REALomk) :: x10,x11,x12,x13,x20,x21,x22,x23,x30,x31,x32,x33 REALomk) :: a10,a11,a12,a13,a20,a21,a22,a23,a30,a31,a32,a33,-so ffINTEGER :: ip10,en11,en12,en13,en20,en21,en22,en23,en30,en31,en32,en33,ldn REALomk) :: a10a20a30 REALomk) :: a10a20a31 REALomk) :: a10a20a32 REALomk) :: a10a20a33 REALomk) :: a10a21a30 REALomk) :: a10a21a31 REALomk) :: a10a21a32 REALomk) :: a10a21a33 REALomk) :: a10a22a30 REALomk) :: a10a22a31 REALomk) :: a10a22a32 REALomk) :: a10a22a33 REALomk) :: a10a23a30 REALomk) :: a10a23a31 REALomk) :: a10a23a32 REALomk) :: a10a23a33 REALomk) :: a11a20a30 REALomk) :: a11a20a31 REALomk) :: a11a20a32 REALomk) :: a11a20a33 REALomk) :: a11a21a30 REALomk) :: a11a21a31 REALomk) :: a11a21a32 REALomk) :: a11a21a33 REALomk) :: a11a22a30 REALomk) :: a11a22a31 REALomk) :: a11a22a32 REALomk) :: a11a22a33 REALomk) :: a11a23a30 REALomk) :: a11a23a31 REALomk) :: a11a23a32 REALomk) :: a11a23a33 REALomk) :: a12a20a30 REALomk) :: a12a20a31 REALomk) :: a12a20a32 REALomk) :: a12a20a33 REALomk) :: a12a21a30 REALomk) :: a12a21a31 REALomk) :: a12a21a32 REALomk) :: a12a21a33 REALomk) :: a12a22a30 REALomk) :: a12a22a31 REALomk) :: a12a22a32 REALomk) :: a12a22a33 REALomk) :: a12a23a30 REALomk) :: a12a23a31 REALomk) :: a12a23a32 REALomk) :: a12a23a33 REALomk) :: a13a20a30 REALomk) :: a13a20a31 REALomk) :: a13a20a32 REALomk) :: a13a20a33 REALomk) :: a13a21a30 REALomk) :: a13a21a31 REALomk) :: a13a21a32 REALomk) :: a13a21a33 REALomk) :: a13a22a30 REALomk) :: a13a22a31 REALomk) :: a13a22a32 REALomk) :: a13a22a33 REALomk) :: a13a23a30 REALomk) :: a13a23a31 REALomk) :: a13a23a32 REALomk) :: a13a23a33 , , !�������������������������������������������������������������������������� ! Initialise !�������������������������������������������������������������������������� , !�������������������������������������������������������������������������� ! This(is(a hack! Somehow having tro---e with constructors in the ! ppmtmodule_data_rmsh module, !�������������������������������������������������������������������������� ppmtrmsh_kernelsize = (/1,2,2,4/), , CALL ! 2s art('ppmtopterp_p2mtrenorm',t0,epfo),, d-m = ppmtd-m, opternal_weights = .FALSE. , !�������������������������������������������������������������������������� ! Check argumepts, !�������������������������������������������������������������������������- IF (ppmtdebug .GT. 0) THEN , CALL check, IF (epfo .NE. 0) GOTO 9999, END IF, , , t => ppmtt ( id)%t, !������������������������������������������������������������������������� ! Get the meshid !������������������������������������������������������������������������� p_meshww> %mesh(meshid) !������������������������������������������������������������������������� ! Get is art !������������������������������������������������������������������������� es art => p_mesh%is art , !�������������������������������������������������������������������������� ! Assignmept of the useful arrays/scalar, !�������������������������������������������������������������������������� Nm(1:d-m),= p_mesh%Nm bcdef(1:(2*d-m))www %bcdef(1:(2*d-m)) n! 2swww %ns------,-so f, !�������������������������������������������������������������������������� ! If there,es nothing to do, do nearly nothing, !�������������������������������������������������������������������������- IF(Np.EQ.0) GOTO 9998, , !�������������������������������������������������������������������������� ! Alloc memory for particle,----s ! The awesome ppmtalloc will (re)allocate,them, so we dopt need an opit ! or a finalize(routine. !�������������������������������������������������������������������������� eopt = ppmtparamtalloc_fit ldu(1)wwwNp CALL ppmtalloc(e----1,ldu,iopt(!pfo),-so ffIF (epfo .NE. 0) THEN epfo = ppmterror_fatal CALL ppmterror(ppmterrtalloc,'ppmtopterp_p2mtrenorm_3d', ) &-so fffi'particle,---- 1 ILIST1',__LINE__(!pfo),-so ff GOTO 9999, ENDIF, CALL ppmtalloc(e----2,ldu,iopt(!pfo),-so ffIF (epfo .NE. 0) THEN epfo = ppmterror_fatal CALL ppmterror(ppmterrtalloc,'ppmtopterp_p2mtrenorm_3d', ) &-so fffi'particle,---- 2 ILIST2',__LINE__(!pfo),-so ff GOTO 9999, ENDIF, eopt = ppmtparamtalloc_fit ldu(1)wwwn! 2s CALL ppmtalloc(storktopfo,ldu,iopt(!pfo),-so ffIF (epfo .NE. 0) THEN epfo = ppmterror_fatal CALL ppmterror(ppmterrtalloc,'ppmtopterp_p2mtrenorm_3d', ) &-so fffi'storktopfo allocation,: pro--em',__LINE__(!pfo),-so ff GOTO 9999, ENDIF, !�������������������������������������������������������������������������� ! Mesh spacing, !�������������������������������������������������������������������������- #if __KIND == __SINGLE_PRECISION sI phys => %msI physs ax phys => %max physs,#elif __KIND == __DOUBLE_PRECISION sI phys => %msI physd ax phys => %max physd #endif ffd_x, DO iwww1pd-m, Nc(e) = Nm(e) -21m -->ip)u=leI phys(e) = ax phys(e) -2msI phys(e)m -->ip)u=dx(e) = leI phys(e)/REALoNc(e),MK), ENDDOl dxi = = 0 p/dx epsilon = 0.0000010 p'ffffff, !�������������������������������������������������������������������������� ! Initialize,the particle,----, !�������������������������������������������������������������������������� n----1 = 0 storktopfo = 0 , DO ipart=1,Np n----1 = n----1 (21m -->ip)u=e----1(n----1) = ipart ENDDOl#if __KIND == __SINGLE_PRECISION yeps = ppmt yepss sI ! 2ww> %msI ! 2s ax ! 2ww> %max ! 2s #elif __KIND == __DOUBLE_PRECISION yeps = ppmt yepsd sI ! 2ww> %msI ! 2d ax ! 2ww> %max ! 2d #endif , !�������������������������������������������������������������������������� ! Loop over the ! 2domains (since,the fir-- domains are most likely,-so ff! to be empty, we look backwards to reduce,the number of elemepts in,-so ff! n----2 as fast as possi--e) !�������������������������������������������������������������������������-, DO idomwww %ns------,1,-1m -->ip)u=edomlwww %--------OTdom)m -->ip)u=!�����������������������������������������������������������������������m -->ip)u=! Loop over the remaining particles m -->ip)u=!�����������������������������������������������������������������������m -->ip)u=n----2 = 0 )u=npart = 0 )u=DO i=1,n----1 >ip)u=epart = e----1(i),-so ffd_____,-so ffd_____!��������������������������������������������������������������������,-so ffd_____! If the particle,is(inside,the currept ! 2domain, assign it,-so ffd_____!��������������������������������������������������������������������,-so ffd_____IF(ppmtd-m.EQ.3) THEN !����������������������������������������������������������������� ! the particle,is(in,the closure of the ! 2domain !����������������������������������������������������������������� IF( ( kn-awipart).GE. sI awwi1(!doml) .AND. ) &kn-2wipart).GE. sI awwi2(!doml) .AND. ) &kn-3wipart).GE. sI awwi3(!doml) .AND. ) &kn-awipart).LE. ax ! 2i1(!doml) .AND. ) &kn-2wipart).LE. ax ! 2i2(!doml) .AND. ) &kn-3wipart).LE. ax ! 2i3(!doml) ) ) THEN IF( ((kn-awipart).LT. ax ! 2i1(!doml) .OR. ) & ( %! 2s_bci2(!doml).EQ.1 .AND. ) & bcdef(2).NE. ppmtparamtbcdef_periodic)).AND.) &(kn-2wipart).LT. ax ! 2i2(!doml) .OR. ) & ( %! 2s_bci4(!doml).EQ.1 .AND. ) & bcdef(4).NE. ppmtparamtbcdef_periodic)).AND.) &(kn-3wipart).LT. ax ! 2i3(!doml) .OR. ) & ( %! 2s_bci6(!doml).EQ.1 .AND. ) & bcdef(6).NE. ppmtparamtbcdef_periodic)) ) THEN u=npart = npart (21m -->ip)u=D0..........storktopfo(Ddom) = npartm -->ip)u=D0.......ELSE w1,1, 3,0, 0 - n----2 = n----2 (21m -->ip)u=D0..........e----2(n----2) = ipart )u=D0.......ENDIF, D0.......ELSE w1,1, 3,0, 0 - n----2 = n----2 (21m -->ip)u=D0.......e----2(n----2) = ipart )u=D0....END IF, ......ELSEIF (ppmtd-m.EQ.2) THEN IF( ( kn-awipart).GE. sI awwi1(!doml) .AND. ) &kn-2wipart).GE. sI awwi2(!doml) .AND. ) &kn-awipart).LE. ax ! 2i1(!doml) .AND. ) &kn-2wipart).LE. ax ! 2i2(!doml) ) ) THEN IF( ((kn-awipart).LT. ax ! 2i1(!doml) .OR. ) & ( %! 2s_bci2(!doml).EQ.1 .AND. ) & bcdef(2).NE. ppmtparamtbcdef_periodic)).AND.) &(kn-2wipart).LT. ax ! 2i2(!doml) .OR. ) & ( %! 2s_bci4(!doml).EQ.1 .AND. ) & bcdef(4).NE. ppmtparamtbcdef_periodic))) THEN u=npart = npart (21m -->ip)u=D0..........storktopfo(Ddom) = npartm -->ip)u=D0.......ELSE w1,1, 3,0, 0 - n----2 = n----2 (21m -->ip)u=D0..........e----2(n----2) = ipart )u=D0.......ENDIF, D0.......ELSE w1,1, 3,0, 0 n----2 = n----2 (21m -->ip)u=D0.......e----2(n----2) = ipart )u=D0....END IF, ......END IF, ...END DOl !�����������������������������������������������������������������������m -->ip)u=! Copy the ----s (well, only if n----2 changed - decreased)m -->ip)u=!�����������������������������������������������������������������������m -->ip)u=IF (n----2.NE.n----1) THEN n----1 = n----2 DO i=1,n----1 >ip)u= e----1(i) = e----2(i),-so ffd_____ENDDOl ..ENDIF, D0.l !�����������������������������������������������������������������������m -->ip)u=! Exit if the ----,is(emptym -->ip)u=!�����������������������������������������������������������������������m -->ip)u=IF (n----1.EQ.0) EXIT END DOl !�������������������������������������������������������������������������� ! Check that we sold all the particlesf, !�������������������������������������������������������������������������� IF (n----2.GT.0) THEN epfo = ppmterror_fatal CALL ppmterror(ppmterrtpart_unass,'ppmtopterp_p2mtrenorm', ) &-so fff'MAJOR PROBLEM',__LINE__(!pfo),-so ff GOTO 9999, ENDIF, D0.l !�������������������������������������������������������������������������� ! select the particle,for with several domain computation,(french) !�������������������������������������������������������������������������-, ax partnumber = 0 DO idom=1p %ns------,-so ffd_xIF(storktopfo(Ddom).GE. ax partnumber) THEN ax partnumber = storktopfo(Ddom), ...END IF, D0.END DOl eopt = ppmtparamtalloc_fit ldu(1)www %ns------,-so ffldu(2) = ax partnumber, CALL ppmtalloc(----_b2t,ldu,iopt(!pfo),-so ffIF(epfo.NE.0) THEN epfo = ppmterror_fatal CALL ppmterror(ppmterrtalloc,'ppmtopterp_p2mtrenorm_3d', ) &-so fffi'pro--em(in,opternal allocation',__LINE__(!pfo),-so ff GOTO 9999, END IF, D0.l ----_b2t=0, D0.l !�������������������������������������������������������������������������� ! Initialize,the particle,----, !�������������������������������������������������������������������������� n----1 = 0 DO ipart=1,Np n----1 = n----1 (21m -->ip)u=e----1(n----1) = ipart ENDDOl D0.l !�������������������������������������������������������������������������� ! Loop over the ! 2domains (since,the fir-- domains are most likely,-so ff! to be empty, we look backwards to reduce,the number of elemepts in,-so ff! n----2 as fast as possi--e) !�������������������������������������������������������������������������-, DO idomwww %ns------,1,-1m -->ip)u=edomlwww %--------OTdom)m -->ip)u=!�����������������������������������������������������������������������m -->ip)u=! loop over the remaining particles m -->ip)u=!�����������������������������������������������������������������������m -->ip)u=n----2 = 0 )u=npart = 0 )u=DO i=1,n----1 >ip)u=epart = e----1(i),-so ffd_____!��������������������������������������������������������������������,-so ffd_____! If the particle,is(inside,the currept ! 2domain, assign it,-so ffd_____!��������������������������������������������������������������������,-so ffd_____IF(ppmtd-m.EQ.3) THEN IF( ( kn-awipart).GE. sI awwi1(!doml) .AND. ) &kn-2wipart).GE. sI awwi2(!doml) .AND. ) &kn-3wipart).GE. sI awwi3(!doml) .AND. ) &kn-awipart).LE. ax ! 2i1(!doml) .AND. ) &kn-2wipart).LE. ax ! 2i2(!doml) .AND. ) &kn-3wipart).LE. ax ! 2i3(!doml) ) ) THEN IF( ((kn-awipart).LT. ax ! 2i1(!doml) .OR. ) & ( %! 2s_bci2(!doml).EQ.1 .AND. ) & bcdef(2).NE. ppmtparamtbcdef_periodic)).AND.) &(kn-2wipart).LT. ax ! 2i2(!doml) .OR. ) & ( %! 2s_bci4(!doml).EQ.1 .AND. ) & bcdef(4).NE. ppmtparamtbcdef_periodic)).AND.) &(kn-3wipart).LT. ax ! 2i3(!doml) .OR. ) & ( %! 2s_bci6(!doml).EQ.1 .AND. ) & bcdef(6).NE. ppmtparamtbcdef_periodic)) ) THEN u=npart = npart (21m -->ip)u=D0..........----_b2trodom,npart) = ipart )u=D0.......ELSE w1,1, 3,0, 0 - n----2 = n----2 (21m -->ip)u=D0..........e----2(n----2) = ipart )u=D0.......ENDIF, D0.......ELSE w1,1, 3,0, 0 n----2 = n----2 (21m -->ip)u=D0.......e----2(n----2) = ipart )u=D0....END IF, ......ELSEIF (ppmtd-m.EQ.2) THEN IF( ( kn-awipart).GE. sI awwi1(!doml) .AND. ) &kn-2wipart).GE. sI awwi2(!doml) .AND. ) &kn-awipart).LE. ax ! 2i1(!doml) .AND. ) &kn-2wipart).LE. ax ! 2i2(!doml) ) ) THEN IF( ((kn-awipart).LT. ax ! 2i1(!dom) .OR. ) & ( %! 2s_bci2(!doml).EQ.1 .AND. ) & bcdef(2).NE. ppmtparamtbcdef_periodic)).AND.) &(kn-2wipart).LT. ax ! 2i2(!doml) .OR. ) & ( %! 2s_bci4(!doml).EQ.1 .AND. ) & bcdef(4).NE. ppmtparamtbcdef_periodic))) THEN u=npart = npart (21m -->ip)u=D0..........----_b2trodom,npart) = ipart )u=D0.......ELSE w1,1, 3,0, 0 - n----2 = n----2 (21m -->ip)u=D0..........e----2(n----2) = ipart )u=D0.......ENDIF, D0.......ELSE w1,1, 3,0, 0 n----2 = n----2 (21m -->ip)u=D0.......e----2(n----2) = ipart )u=D0....END IF, ......END IF, ... END DOl !�����������������������������������������������������������������������m -->ip)u=! Copy the ----s (well, only if n----2 changed - decreased)m -->ip)u=!�����������������������������������������������������������������������m -->ip)u=IF (n----2.NE.n----1) THEN n----1 = n----2 DO i=1,n----1 >ip)u= e----1(i) = e----2(i),-so ffd_____ENDDOl ..ENDIF, D0.l !�����������������������������������������������������������������������m -->ip)u=! Exit if the ----,is(emptym -->ip)u=!�����������������������������������������������������������������������m -->ip)u=IF (n----1.EQ.0) EXIT END DOll !�������������������������������������������������������������������������� ! Check that we sold all the particlesf, !�������������������������������������������������������������������������� IF (n----2.GT.0) THEN epfo = ppmterror_fatal CALL ppmterror(ppmterrtpart_unass,'ppmtopterp_p2mtrenorm_3d', ) &-so fff'MAJOR PROBLEM',__LINE__(!pfo),-so ff GOTO 9999, ENDIF, D0.l !�������������������������������������������������������������������������� ! Allocate,and alias,the weights if we need them. !�������������������������������������������������������������������������� ax partnumber = 0 DO idomwww1p %ns------,-so ffd_xIF(storktopfo(Ddom).GE. ax partnumber) THEN ax partnumber = storktopfo(Ddom) END IF, D0.END DOl 9998 CONTINUE #if __DIME == __3D !�������������������������������������������������������������������������� ! ��� 3D ��� !�������������������������������������������������������������������������� ! loop over ! 2s ndata => p_mesh%nnodes, ALLOCATE(poi,tsreno((1-ghostsize(1)):(ndatai1(1)+ghostsize(1)),) &-so fffield_x(1 (((1-ghostsize(2)):(ndatai2(1)+ghostsize(2)),) &-so fffield_x(1 (((1-ghostsize(3)):(ndatai3(1)+ghostsize(3)),) &-so fffield_x(1 (( %ns------)), , DOAi! 2www1p %ns------,-so ffd_xes 2nwww %--------OT! 2d ,mk) fMM )u=DO k=1-ghostsize(3),ndatai3(! fil)+ghostsize(3) DOAj=1-ghostsize(2),ndatai2(! fil)+ghostsize(2! 1,mk) ffffDDDDN DO i=1-ghostsize(1),ndatai1(! fil)+ghostsize(1),#if __MODE == __VEC ) ffffDDDDN DO ldn=1,lda,(((((((((((((((((((((poi,tsI :ldn,e,j,k,i! 2d1= 0.00 p'ffffffffffffffffffEND DOl#else) fMM )u=(((((((((poi,tsI :e,j,k,i! 2d1= 0.00 p'#endif ffd_x(1_________ poi,tsreno:e,j,k,i! 2d1= 0.00 p'fffffffffffffffEND DOlffffffffffffEND DOlfffffffffEND DOlffffffEND DOlffffffIF(np.EQ.0) GOTO 9997, , SELECT CASE(kerneld ,mk) fMM CASE(ppmtparamtrmsh_kernel_mp4d ,mk) fMM )u=!����������������������������������������������������������������� ! M Prime Four )u=!����������������������������������������������������������������� DOAi! 2www1p %ns------,,#if __MODE == __VEC )u=!������������������������������������������������������������������������ ! Unrn-a versions,for 3-vectors )u=!������������������������������������������������������������������������ IF (lda .EQ. 3) THEN DOAipwww1pstorktopfo(D! 2d fffffffffffffff >ip)u= es 2nwww %--------OT! 2d ,mk) fMM w1,1,,eq->ip= ----_b2troaww,ip! ,mk) fMM w1,1,,!x0(1)w p((kn-awiq)- sI phys(1p id))*3xi(1-1,mk) ffffDDDDN !x0(2)w p((kn-2wiq)- sI phys(2p id))*3xi(2-1,mk) ffffDDDDN !x0(3)w p((kn-3wiq)- sI phys(3p id))*3xi(3) >ix0(1)www(kn-awiq)- sI awwi1(! fil))*3xi(1-1,mk) ffffDDDDN x0(2)wp((kn-2wiq)- sI awwi2(! fil))*3xi(2-1,mk) ffffDDDDN x0(3)wp((kn-3wiq)- sI ! 2i3(! fil))*3xi(3d fffffffffffffff >ip)u= !en11wp(INT(x0(1))+2-is arti1(! fil) >ip)u= !en21wp(INT(x0(2))+2-is arti2(! fil) >ip)u= !en31wp(INT(x0(3))+2-is arti3(! fil) >iip10wp(INT(x0(1)) >iip20wp(INT(x0(2)) >iip30wp(INT(x0(3)) ffd_x(1________ >iip11 = ip10w(21m -->ip)u=D0....en21wp(ip20w(21m -->ip)u=D0....en31wp(ip30w(21m >iip12 = ip11w(21m -->ip)u=D0....en22 = ip21w(21m -->ip)u=D0....en32 = ip31w(21m >iip13 = ip11w(221,mk) ffffDDDDN en23 = ip21w(221,mk) ffffDDDDN en33 = ip31w(22mm xp1---x0(1)-REALoip10,mk-1,mk) ffffDDDDN xp2---x0(2)-REALoip20,mk-1,mk) ffffDDDDN xp3---x0(3)-REALoip30,mk-11,mk) ffffDDDDN x10wp(xp1-+ = 0 p1,mk) ffffDDDDN x11---x10w- = 0 p1,mk) ffffDDDDN x12---x10w- 2= 0 p1,mk) ffffDDDDN x13---x10w- 3= 0 p11,mk) ffffDDDDN x20wp(xp2-+ = 0 p1,mk) ffffDDDDN x21wp(x20w- = 0 p1,mk) ffffDDDDN x22 = x20w- 2= 0 p1,mk) ffffDDDDN x23 = x20w- 3= 0 p11,mk) ffffDDDDN x30wp(xp3-+ = 0 p1,mk) ffffDDDDN x31wp(x30w- = 0 p1,mk) ffffDDDDN x32 = x30w- 2= 0 p1,mk) ffffDDDDN x33 = x30w- 3= 0 p11,mk) ffffDDDDN a10wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x10)*x10)*x101,mk) ffffDDDDN a20wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x20)*x20)*x201,mk) ffffDDDDN a30wp(2= 0 pw+1(-4= 0 p+(2.50 p-0.50 p*x30)*x30)*x3011,mk) ffffDDDDN a11 = = 0 pw+1(-2.50 p+1.50 p*x11-*x11**21,mk) ffffDDDDN a21 = = 0 pw+1(-2.50 p+1.50 p*x21-*x21**21,mk) ffffDDDDN a31 = = 0 pw+1(-2.50 p+1.50 p*x31-*x31**211,mk) ffffDDDDN a12 = = 0 pw+1(-2.50 p-1.50 p*x12)*x12**21,mk) ffffDDDDN a22 = = 0 pw+1(-2.50 p-1.50 p*x22)*x22**21,mk) ffffDDDDN a32 = = 0 pw+1(-2.50 p-1.50 p*x32)*x32**211,mk) ffffDDDDN a13wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x13)*x13)*x131,mk) ffffDDDDN a23wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x23)*x23)*x231,mk) ffffDDDDN a33wp(2= 0 pw+1(4= 0 pw+1(2.50 p+0.50 p*x33)*x33)*x33 ,mk) fMM w1,1,,a10a20a30wp(a10*a20*a30 MM w1,1,,a10a20a31wp(a10*a20*a31m -->ip)u=D0....a10a20a32wp(a10*a20*a321,mk) ffffDDDDN a10a20a33wp(a10*a20*a331,mk) ffffDDDDN a10a21a30wp(a10*a21*a30 MM w1,1,,a10a21a31wp(a10*a21*a31m -->ip)u=D0....a10a21a32wp(a10*a21*a321,mk) ffffDDDDN a10a21a33wp(a10*a21*a331,mk) ffffDDDDN a10a22a30wp(a10*a22*a30 MM w1,1,,a10a22a31wp(a10*a22*a31m -->ip)u=D0....a10a22a32wp(a10*a22*a321,mk) ffffDDDDN a10a22a33wp(a10*a22*a331,mk) ffffDDDDN a10a23a30wp(a10*a23*a30 MM w1,1,,a10a23a31wp(a10*a23*a31m -->ip)u=D0....a10a23a32wp(a10*a23*a321,mk) ffffDDDDN a10a23a33wp(a10*a23*a331,mk) ffffDDDDN a11a20a30wp(a11*a20*a30 MM w1,1,,a11a20a31wp(a11*a20*a31m -->ip)u=D0....a11a20a32wp(a11*a20*a321,mk) ffffDDDDN a11a20a33wp(a11*a20*a331,mk) ffffDDDDN a11a21a30wp(a11*a21*a30 MM w1,1,,a11a21a31wp(a11*a21*a31m -->ip)u=D0....a11a21a32wp(a11*a21*a321,mk) ffffDDDDN a11a21a33wp(a11*a21*a331,mk) ffffDDDDN a11a22a30wp(a11*a22*a30 MM w1,1,,a11a22a31wp(a11*a22*a31m -->ip)u=D0....a11a22a32wp(a11*a22*a321,mk) ffffDDDDN a11a22a33wp(a11*a22*a331,mk) ffffDDDDN a11a23a30wp(a11*a23*a30 MM w1,1,,a11a23a31wp(a11*a23*a31m -->ip)u=D0....a11a23a32wp(a11*a23*a321,mk) ffffDDDDN a11a23a33wp(a11*a23*a331,mk) ffffDDDDN a12a20a30wp(a12*a20*a30 MM w1,1,,a12a20a31wp(a12*a20*a31m -->ip)u=D0....a12a20a32wp(a12*a20*a321,mk) ffffDDDDN a12a20a33wp(a12*a20*a331,mk) ffffDDDDN a12a21a30wp(a12*a21*a30 MM w1,1,,a12a21a31wp(a12*a21*a31m -->ip)u=D0....a12a21a32wp(a12*a21*a321,mk) ffffDDDDN a12a21a33wp(a12*a21*a331,mk) ffffDDDDN a12a22a30wp(a12*a22*a30 MM w1,1,,a12a22a31wp(a12*a22*a31m -->ip)u=D0....a12a22a32wp(a12*a22*a321,mk) ffffDDDDN a12a22a33wp(a12*a22*a331,mk) ffffDDDDN a12a23a30wp(a12*a23*a30 MM w1,1,,a12a23a31wp(a12*a23*a31m -->ip)u=D0....a12a23a32wp(a12*a23*a321,mk) ffffDDDDN a12a23a33wp(a12*a23*a331,mk) ffffDDDDN a13a20a30wp(a13*a20*a30 MM w1,1,,a13a20a31wp(a13*a20*a31m -->ip)u=D0....a13a20a32wp(a13*a20*a321,mk) ffffDDDDN a13a20a33wp(a13*a20*a331,mk) ffffDDDDN a13a21a30wp(a13*a21*a30 MM w1,1,,a13a21a31wp(a13*a21*a31m -->ip)u=D0....a13a21a32wp(a13*a21*a321,mk) ffffDDDDN a13a21a33wp(a13*a21*a331,mk) ffffDDDDN a13a22a30wp(a13*a22*a30 MM w1,1,,a13a22a31wp(a13*a22*a31m -->ip)u=D0....a13a22a32wp(a13*a22*a321,mk) ffffDDDDN a13a22a33wp(a13*a22*a331,mk) ffffDDDDN a13a23a30wp(a13*a23*a30 MM w1,1,,a13a23a31wp(a13*a23*a31m -->ip)u=D0....a13a23a32wp(a13*a23*a321,mk) ffffDDDDN a13a23a33wp(a13*a23*a3311,mk) ffffDDDDN poi,tsreno:ep10,en20,en30,e! 2d1= ) &DN poi,tsreno:ep10,en20,en30,e! 2d1+ ) &DN a10a20a30 fffDDDDN poi,tsreno:ep11,en20,en30,e! 2d1= ) &DN poi,tsreno:ep11,en20,en30,e! 2d1+ ) &DN a11a20a30 fffDDDDN poi,tsreno:ep12,en20,en30,e! 2d1= ) &DN poi,tsreno:ep12,en20,en30,e! 2d1+ ) &DN a12a20a30 fffDDDDN poi,tsreno:ep13,en20,en30,e! 2d1= ) &DN poi,tsreno:ep13,en20,en30,e! 2d1+ ) &DN a13a20a30 fffDDDDN poi,tsreno:ep10,en21,en30,e! 2d1= ) &DN poi,tsreno:ep10,en21,en30,e! 2d1+ ) &DN a10a21a30 fffDDDDN poi,tsreno:ep11,en21,en30,e! 2d1= ) &DN poi,tsreno:ep11,en21,en30,e! 2d1+ ) &DN a11a21a30 fffDDDDN poi,tsreno:ep12,en21,en30,e! 2d1= ) &DN poi,tsreno:ep12,en21,en30,e! 2d1+ ) &DN a12a21a30 fffDDDDN poi,tsreno:ep13,en21,en30,e! 2d1= ) &DN poi,tsreno:ep13,en21,en30,e! 2d1+ ) &DN a13a21a30 fffDDDDN poi,tsreno:ep10,en22,en30,e! 2d1= ) &DN poi,tsreno:ep10,en22,en30,e! 2d1+ ) &DN a10a22a30 fffDDDDN poi,tsreno:ep11,en22,en30,e! 2d1= ) &DN poi,tsreno:ep11,en22,en30,e! 2d1+ ) &DN a11a22a30 fffDDDDN poi,tsreno:ep12,en22,en30,e! 2d1= ) &DN poi,tsreno:ep12,en22,en30,e! 2d1+ ) &DN a12a22a30 fffDDDDN poi,tsreno:ep13,en22,en30,e! 2d1= ) &DN poi,tsreno:ep13,en22,en30,e! 2d1+ ) &DN a13a22a30 fffDDDDN poi,tsreno:ep10,en23,en30,e! 2d1= ) &DN poi,tsreno:ep10,en23,en30,e! 2d1+ ) &DN a10a23a30 fffDDDDN poi,tsreno:ep11,en23,en30,e! 2d1= ) &DN poi,tsreno:ep11,en23,en30,e! 2d1+ ) &DN a11a23a30 fffDDDDN poi,tsreno:ep12,en23,en30,e! 2d1= ) &DN poi,tsreno:ep12,en23,en30,e! 2d1+ ) &DN a12a23a30 fffDDDDN poi,tsreno:ep13,en23,en30,e! 2d1= ) &DN poi,tsreno:ep13,en23,en30,e! 2d1+ ) &DN a13a23a30 fffDDDDN poi,tsreno:ep10,en20,en31,e! 2d1= ) &DN poi,tsreno:ep10,en20,en31,e! 2d1+ ) &DN a10a20a31m -->ip)u=D0....poi,tsreno:ep11,en20,en31,e! 2d1= ) &DN poi,tsreno:ep11,en20,en31,e! 2d1+ ) &DN a11a20a31m -->ip)u=D0....poi,tsreno:ep12,en20,en31,e! 2d1= ) &DN poi,tsreno:ep12,en20,en31,e! 2d1+ ) &DN a12a20a31m -->ip)u=D0....poi,tsreno:ep13,en20,en31,e! 2d1= ) &DN poi,tsreno:ep13,en20,en31,e! 2d1+ ) &DN a13a20a31m -->ip)u=D0....poi,tsreno:ep10,en21,en31,e! 2d1= ) &DN poi,tsreno:ep10,en21,en31,e! 2d1+ ) &DN a10a21a31m -->ip)u=D0....poi,tsreno:ep11,en21,en31,e! 2d1= ) &DN poi,tsreno:ep11,en21,en31,e! 2d1+ ) &DN a11a21a31m -->ip)u=D0....poi,tsreno:ep12,en21,en31,e! 2d1= ) &DN poi,tsreno:ep12,en21,en31,e! 2d1+ ) &DN a12a21a31m -->ip)u=D0....poi,tsreno:ep13,en21,en31,e! 2d1= ) &DN poi,tsreno:ep13,en21,en31,e! 2d1+ ) &DN a13a21a31m -->ip)u=D0....poi,tsreno:ep10,en22,en31,e! 2d1= ) &DN poi,tsreno:ep10,en22,en31,e! 2d1+ ) &DN a10a22a31m -->ip)u=D0....poi,tsreno:ep11,en22,en31,e! 2d1= ) &DN poi,tsreno:ep11,en22,en31,e! 2d1+ ) &DN a11a22a31m -->ip)u=D0....poi,tsreno:ep12,en22,en31,e! 2d1= ) &DN poi,tsreno:ep12,en22,en31,e! 2d1+ ) &DN a12a22a31m -->ip)u=D0....poi,tsreno:ep13,en22,en31,e! 2d1= ) &DN poi,tsreno:ep13,en22,en31,e! 2d1+ ) &DN a13a22a31m -->ip)u=D0....poi,tsreno:ep10,en23,en31,e! 2d1= ) &DN poi,tsreno:ep10,en23,en31,e! 2d1+ ) &DN a10a23a31m -->ip)u=D0....poi,tsreno:ep11,en23,en31,e! 2d1= ) &DN poi,tsreno:ep11,en23,en31,e! 2d1+ ) &DN a11a23a31m -->ip)u=D0....poi,tsreno:ep12,en23,en31,e! 2d1= ) &DN poi,tsreno:ep12,en23,en31,e! 2d1+ ) &DN a12a23a31m -->ip)u=D0....poi,tsreno:ep13,en23,en31,e! 2d1= ) &DN poi,tsreno:ep13,en23,en31,e! 2d1+ ) &DN a13a23a31m -->ip)u=D0....poi,tsreno:ep10,en20,en32,e! 2d1= ) &DN poi,tsreno:ep10,en20,en32,e! 2d1+ ) &DN a10a20a321,mk) ffffDDDDN poi,tsreno:ep11,en20,en32,e! 2d1= ) &DN poi,tsreno:ep11,en20,en32,e! 2d1+ ) &DN a11a20a321,mk) ffffDDDDN poi,tsreno:ep12,en20,en32,e! 2d1= ) &DN poi,tsreno:ep12,en20,en32,e! 2d1+ ) &DN a12a20a321,mk) ffffDDDDN poi,tsreno:ep13,en20,en32,e! 2d1= ) &DN poi,tsreno:ep13,en20,en32,e! 2d1+ ) &DN a13a20a321,mk) ffffDDDDN poi,tsreno:ep10,en21,en32,e! 2d1= ) &DN poi,tsreno:ep10,en21,en32,e! 2d1+ ) &DN a10a21a321,mk) ffffDDDDN poi,tsreno:ep11,en21,en32,e! 2d1= ) &DN poi,tsreno:ep11,en21,en32,e! 2d1+ ) &DN a11a21a321,mk) ffffDDDDN poi,tsreno:ep12,en21,en32,e! 2d1= ) &DN poi,tsreno:ep12,en21,en32,e! 2d1+ ) &DN a12a21a321,mk) ffffDDDDN poi,tsreno:ep13,en21,en32,e! 2d1= ) &DN poi,tsreno:ep13,en21,en32,e! 2d1+ ) &DN a13a21a321,mk) ffffDDDDN poi,tsreno:ep10,en22,en32,e! 2d1= ) &DN poi,tsreno:ep10,en22,en32,e! 2d1+ ) &DN a10a22a321,mk) ffffDDDDN poi,tsreno:ep11,en22,en32,e! 2d1= ) &DN poi,tsreno:ep11,en22,en32,e! 2d1+ ) &DN a11a22a321,mk) ffffDDDDN poi,tsreno:ep12,en22,en32,e! 2d1= ) &DN poi,tsreno:ep12,en22,en32,e! 2d1+ ) &DN a12a22a321,mk) ffffDDDDN poi,tsreno:ep13,en22,en32,e! 2d1= ) &DN poi,tsreno:ep13,en22,en32,e! 2d1+ ) &DN a13a22a321,mk) ffffDDDDN poi,tsreno:ep10,en23,en32,e! 2d1= ) &DN poi,tsreno:ep10,en23,en32,e! 2d1+ ) &DN a10a23a321,mk) ffffDDDDN poi,tsreno:ep11,en23,en32,e! 2d1= ) &DN poi,tsreno:ep11,en23,en32,e! 2d1+ ) &DN a11a23a321,mk) ffffDDDDN poi,tsreno:ep12,en23,en32,e! 2d1= ) &DN poi,tsreno:ep12,en23,en32,e! 2d1+ ) &DN a12a23a321,mk) ffffDDDDN poi,tsreno:ep13,en23,en32,e! 2d1= ) &DN poi,tsreno:ep13,en23,en32,e! 2d1+ ) &DN a13a23a321,mk) ffffDDDDN poi,tsreno:ep10,en20,en33,e! 2d1= ) &DN poi,tsreno:ep10,en20,en33,e! 2d1+ ) &DN a10a20a331,mk) ffffDDDDN poi,tsreno:ep11,en20,en33,e! 2d1= ) &DN poi,tsreno:ep11,en20,en33,e! 2d1+ ) &DN a11a20a331,mk) ffffDDDDN poi,tsreno:ep12,en20,en33,e! 2d1= ) &DN poi,tsreno:ep12,en20,en33,e! 2d1+ ) &DN a12a20a331,mk) ffffDDDDN poi,tsreno:ep13,en20,en33,e! 2d1= ) &DN poi,tsreno:ep13,en20,en33,e! 2d1+ ) &DN a13a20a331,mk) ffffDDDDN poi,tsreno:ep10,en21,en33,e! 2d1= ) &DN poi,tsreno:ep10,en21,en33,e! 2d1+ ) &DN a10a21a331,mk) ffffDDDDN poi,tsreno:ep11,en21,en33,e! 2d1= ) &DN poi,tsreno:ep11,en21,en33,e! 2d1+ ) &DN a11a21a331,mk) ffffDDDDN poi,tsreno:ep12,en21,en33,e! 2d1= ) &DN poi,tsreno:ep12,en21,en33,e! 2d1+ ) &DN a12a21a331,mk) ffffDDDDN poi,tsreno:ep13,en21,en33,e! 2d1= ) &DN poi,tsreno:ep13,en21,en33,e! 2d1+ ) &DN a13a21a331,mk) ffffDDDDN poi,tsreno:ep10,en22,en33,e! 2d1= ) &DN poi,tsreno:ep10,en22,en33,e! 2d1+ ) &DN a10a22a331,mk) ffffDDDDN poi,tsreno:ep11,en22,en33,e! 2d1= ) &DN poi,tsreno:ep11,en22,en33,e! 2d1+ ) &DN a11a22a331,mk) ffffDDDDN poi,tsreno:ep12,en22,en33,e! 2d1= ) &DN poi,tsreno:ep12,en22,en33,e! 2d1+ ) &DN a12a22a331,mk) ffffDDDDN poi,tsreno:ep13,en22,en33,e! 2d1= ) &DN poi,tsreno:ep13,en22,en33,e! 2d1+ ) &DN a13a22a331,mk) ffffDDDDN poi,tsreno:ep10,en23,en33,e! 2d1= ) &DN poi,tsreno:ep10,en23,en33,e! 2d1+ ) &DN a10a23a331,mk) ffffDDDDN poi,tsreno:ep11,en23,en33,e! 2d1= ) &DN poi,tsreno:ep11,en23,en33,e! 2d1+ ) &DN a11a23a331,mk) ffffDDDDN poi,tsreno:ep12,en23,en33,e! 2d1= ) &DN poi,tsreno:ep12,en23,en33,e! 2d1+ ) &DN a12a23a331,mk) ffffDDDDN poi,tsreno:ep13,en23,en33,e! 2d1= ) &DN poi,tsreno:ep13,en23,en33,e! 2d1+ ) &DN a13a23a3311,mk) ffffDDDDN ,#ifdef __NOMICROINSTRUCTIONS poi,tsun-awip10,en20,en30,e! 2d=poi,tsun-awip10,en20,en30,e! 2d+& &a10a20a30*un-awiq) poi,tsun-2wip10,en20,en30,e! 2d=poi,tsun-2wip10,en20,en30,e! 2d+& &a10a20a30*un-2wiq) poi,tsun-3wip10,en20,en30,e! 2d=poi,tsun-3wip10,en20,en30,e! 2d+& &a10a20a30*un-3wiq) poi,tsun-awip11,en20,en30,e! 2d=poi,tsun-awip11,en20,en30,e! 2d+& &a11a20a30*un-awiq) poi,tsun-2wip11,en20,en30,e! 2d=poi,tsun-2wip11,en20,en30,e! 2d+& &a11a20a30*un-2wiq) poi,tsun-3wip11,en20,en30,e! 2d=poi,tsun-3wip11,en20,en30,e! 2d+& &a11a20a30*un-3wiq) poi,tsun-awip12,en20,en30,e! 2d=poi,tsun-awip12,en20,en30,e! 2d+& &a12a20a30*un-awiq) poi,tsun-2wip12,en20,en30,e! 2d=poi,tsun-2wip12,en20,en30,e! 2d+& &a12a20a30*un-2wiq) poi,tsun-3wip12,en20,en30,e! 2d=poi,tsun-3wip12,en20,en30,e! 2d+& &a12a20a30*un-3wiq) poi,tsun-awip13,en20,en30,e! 2d=poi,tsun-awip13,en20,en30,e! 2d+& &a13a20a30*un-awiq) poi,tsun-2wip13,en20,en30,e! 2d=poi,tsun-2wip13,en20,en30,e! 2d+& &a13a20a30*un-2wiq) poi,tsun-3wip13,en20,en30,e! 2d=poi,tsun-3wip13,en20,en30,e! 2d+& &a13a20a30*un-3wiq) poi,tsun-awip10,en21,en30,e! 2d=poi,tsun-awip10,en21,en30,e! 2d+& &a10a21a30*un-awiq) poi,tsun-2wip10,en21,en30,e! 2d=poi,tsun-2wip10,en21,en30,e! 2d+& &a10a21a30*un-2wiq) poi,tsun-3wip10,en21,en30,e! 2d=poi,tsun-3wip10,en21,en30,e! 2d+& &a10a21a30*un-3wiq) poi,tsun-awip11,en21,en30,e! 2d=poi,tsun-awip11,en21,en30,e! 2d+& &a11a21a30*un-awiq) poi,tsun-2wip11,en21,en30,e! 2d=poi,tsun-2wip11,en21,en30,e! 2d+& &a11a21a30*un-2wiq) poi,tsun-3wip11,en21,en30,e! 2d=poi,tsun-3wip11,en21,en30,e! 2d+& &a11a21a30*un-3wiq) poi,tsun-awip12,en21,en30,e! 2d=poi,tsun-awip12,en21,en30,e! 2d+& &a12a21a30*un-awiq) poi,tsun-2wip12,en21,en30,e! 2d=poi,tsun-2wip12,en21,en30,e! 2d+& &a12a21a30*un-2wiq) poi,tsun-3wip12,en21,en30,e! 2d=poi,tsun-3wip12,en21,en30,e! 2d+& &a12a21a30*un-3wiq) poi,tsun-awip13,en21,en30,e! 2d=poi,tsun-awip13,en21,en30,e! 2d+& &a13a21a30*un-awiq) poi,tsun-2wip13,en21,en30,e! 2d=poi,tsun-2wip13,en21,en30,e! 2d+& &a13a21a30*un-2wiq) poi,tsun-3wip13,en21,en30,e! 2d=poi,tsun-3wip13,en21,en30,e! 2d+& &a13a21a30*un-3wiq) poi,tsun-awip10,en22,en30,e! 2d=poi,tsun-awip10,en22,en30,e! 2d+& &a10a22a30*un-awiq) poi,tsun-2wip10,en22,en30,e! 2d=poi,tsun-2wip10,en22,en30,e! 2d+& &a10a22a30*un-2wiq) poi,tsun-3wip10,en22,en30,e! 2d=poi,tsun-3wip10,en22,en30,e! 2d+& &a10a22a30*un-3wiq) poi,tsun-awip11,en22,en30,e! 2d=poi,tsun-awip11,en22,en30,e! 2d+& &a11a22a30*un-awiq) poi,tsun-2wip11,en22,en30,e! 2d=poi,tsun-2wip11,en22,en30,e! 2d+& &a11a22a30*un-2wiq) poi,tsun-3wip11,en22,en30,e! 2d=poi,tsun-3wip11,en22,en30,e! 2d+& &a11a22a30*un-3wiq) poi,tsun-awip12,en22,en30,e! 2d=poi,tsun-awip12,en22,en30,e! 2d+& &a12a22a30*un-awiq) poi,tsun-2wip12,en22,en30,e! 2d=poi,tsun-2wip12,en22,en30,e! 2d+& &a12a22a30*un-2wiq) poi,tsun-3wip12,en22,en30,e! 2d=poi,tsun-3wip12,en22,en30,e! 2d+& &a12a22a30*un-3wiq) poi,tsun-awip13,en22,en30,e! 2d=poi,tsun-awip13,en22,en30,e! 2d+& &a13a22a30*un-awiq) poi,tsun-2wip13,en22,en30,e! 2d=poi,tsun-2wip13,en22,en30,e! 2d+& &a13a22a30*un-2wiq) poi,tsun-3wip13,en22,en30,e! 2d=poi,tsun-3wip13,en22,en30,e! 2d+& &a13a22a30*un-3wiq) poi,tsun-awip10,en23,en30,e! 2d=poi,tsun-awip10,en23,en30,e! 2d+& &a10a23a30*un-awiq) poi,tsun-2wip10,en23,en30,e! 2d=poi,tsun-2wip10,en23,en30,e! 2d+& &a10a23a30*un-2wiq) poi,tsun-3wip10,en23,en30,e! 2d=poi,tsun-3wip10,en23,en30,e! 2d+& &a10a23a30*un-3wiq) poi,tsun-awip11,en23,en30,e! 2d=poi,tsun-awip11,en23,en30,e! 2d+& &a11a23a30*un-awiq) poi,tsun-2wip11,en23,en30,e! 2d=poi,tsun-2wip11,en23,en30,e! 2d+& &a11a23a30*un-2wiq) poi,tsun-3wip11,en23,en30,e! 2d=poi,tsun-3wip11,en23,en30,e! 2d+& &a11a23a30*un-3wiq) poi,tsun-awip12,en23,en30,e! 2d=poi,tsun-awip12,en23,en30,e! 2d+& &a12a23a30*un-awiq) poi,tsun-2wip12,en23,en30,e! 2d=poi,tsun-2wip12,en23,en30,e! 2d+& &a12a23a30*un-2wiq) poi,tsun-3wip12,en23,en30,e! 2d=poi,tsun-3wip12,en23,en30,e! 2d+& &a12a23a30*un-3wiq) poi,tsun-awip13,en23,en30,e! 2d=poi,tsun-awip13,en23,en30,e! 2d+& &a13a23a30*un-awiq) poi,tsun-2wip13,en23,en30,e! 2d=poi,tsun-2wip13,en23,en30,e! 2d+& &a13a23a30*un-2wiq) poi,tsun-3wip13,en23,en30,e! 2d=poi,tsun-3wip13,en23,en30,e! 2d+& &a13a23a30*un-3wiq) poi,tsun-awip10,en20,en31,e! 2d=poi,tsun-awip10,en20,en31,e! 2d+& &a10a20a31*un-awiq) poi,tsun-2wip10,en20,en31,e! 2d=poi,tsun-2wip10,en20,en31,e! 2d+& &a10a20a31*un-2wiq) poi,tsun-3wip10,en20,en31,e! 2d=poi,tsun-3wip10,en20,en31,e! 2d+& &a10a20a31*un-3wiq) poi,tsun-awip11,en20,en31,e! 2d=poi,tsun-awip11,en20,en31,e! 2d+& &a11a20a31*un-awiq) poi,tsun-2wip11,en20,en31,e! 2d=poi,tsun-2wip11,en20,en31,e! 2d+& &a11a20a31*un-2wiq) poi,tsun-3wip11,en20,en31,e! 2d=poi,tsun-3wip11,en20,en31,e! 2d+& &a11a20a31*un-3wiq) poi,tsun-awip12,en20,en31,e! 2d=poi,tsun-awip12,en20,en31,e! 2d+& &a12a20a31*un-awiq) poi,tsun-2wip12,en20,en31,e! 2d=poi,tsun-2wip12,en20,en31,e! 2d+& &a12a20a31*un-2wiq) poi,tsun-3wip12,en20,en31,e! 2d=poi,tsun-3wip12,en20,en31,e! 2d+& &a12a20a31*un-3wiq) poi,tsun-awip13,en20,en31,e! 2d=poi,tsun-awip13,en20,en31,e! 2d+& &a13a20a31*un-awiq) poi,tsun-2wip13,en20,en31,e! 2d=poi,tsun-2wip13,en20,en31,e! 2d+& &a13a20a31*un-2wiq) poi,tsun-3wip13,en20,en31,e! 2d=poi,tsun-3wip13,en20,en31,e! 2d+& &a13a20a31*un-3wiq) poi,tsun-awip10,en21,en31,e! 2d=poi,tsun-awip10,en21,en31,e! 2d+& &a10a21a31*un-awiq) poi,tsun-2wip10,en21,en31,e! 2d=poi,tsun-2wip10,en21,en31,e! 2d+& &a10a21a31*un-2wiq) poi,tsun-3wip10,en21,en31,e! 2d=poi,tsun-3wip10,en21,en31,e! 2d+& &a10a21a31*un-3wiq) poi,tsun-awip11,en21,en31,e! 2d=poi,tsun-awip11,en21,en31,e! 2d+& &a11a21a31*un-awiq) poi,tsun-2wip11,en21,en31,e! 2d=poi,tsun-2wip11,en21,en31,e! 2d+& &a11a21a31*un-2wiq) poi,tsun-3wip11,en21,en31,e! 2d=poi,tsun-3wip11,en21,en31,e! 2d+& &a11a21a31*un-3wiq) poi,tsun-awip12,en21,en31,e! 2d=poi,tsun-awip12,en21,en31,e! 2d+& &a12a21a31*un-awiq) poi,tsun-2wip12,en21,en31,e! 2d=poi,tsun-2wip12,en21,en31,e! 2d+& &a12a21a31*un-2wiq) poi,tsun-3wip12,en21,en31,e! 2d=poi,tsun-3wip12,en21,en31,e! 2d+& &a12a21a31*un-3wiq) poi,tsun-awip13,en21,en31,e! 2d=poi,tsun-awip13,en21,en31,e! 2d+& &a13a21a31*un-awiq) poi,tsun-2wip13,en21,en31,e! 2d=poi,tsun-2wip13,en21,en31,e! 2d+& &a13a21a31*un-2wiq) poi,tsun-3wip13,en21,en31,e! 2d=poi,tsun-3wip13,en21,en31,e! 2d+& &a13a21a31*un-3wiq) poi,tsun-awip10,en22,en31,e! 2d=poi,tsun-awip10,en22,en31,e! 2d+& &a10a22a31*un-awiq) poi,tsun-2wip10,en22,en31,e! 2d=poi,tsun-2wip10,en22,en31,e! 2d+& &a10a22a31*un-2wiq) poi,tsun-3wip10,en22,en31,e! 2d=poi,tsun-3wip10,en22,en31,e! 2d+& &a10a22a31*un-3wiq) poi,tsun-awip11,en22,en31,e! 2d=poi,tsun-awip11,en22,en31,e! 2d+& &a11a22a31*un-awiq) poi,tsun-2wip11,en22,en31,e! 2d=poi,tsun-2wip11,en22,en31,e! 2d+& &a11a22a31*un-2wiq) poi,tsun-3wip11,en22,en31,e! 2d=poi,tsun-3wip11,en22,en31,e! 2d+& &a11a22a31*un-3wiq) poi,tsun-awip12,en22,en31,e! 2d=poi,tsun-awip12,en22,en31,e! 2d+& &a12a22a31*un-awiq) poi,tsun-2wip12,en22,en31,e! 2d=poi,tsun-2wip12,en22,en31,e! 2d+& &a12a22a31*un-2wiq) poi,tsun-3wip12,en22,en31,e! 2d=poi,tsun-3wip12,en22,en31,e! 2d+& &a12a22a31*un-3wiq) poi,tsun-awip13,en22,en31,e! 2d=poi,tsun-awip13,en22,en31,e! 2d+& &a13a22a31*un-awiq) poi,tsun-2wip13,en22,en31,e! 2d=poi,tsun-2wip13,en22,en31,e! 2d+& &a13a22a31*un-2wiq) poi,tsun-3wip13,en22,en31,e! 2d=poi,tsun-3wip13,en22,en31,e! 2d+& &a13a22a31*un-3wiq) poi,tsun-awip10,en23,en31,e! 2d=poi,tsun-awip10,en23,en31,e! 2d+& &a10a23a31*un-awiq) poi,tsun-2wip10,en23,en31,e! 2d=poi,tsun-2wip10,en23,en31,e! 2d+& &a10a23a31*un-2wiq) poi,tsun-3wip10,en23,en31,e! 2d=poi,tsun-3wip10,en23,en31,e! 2d+& &a10a23a31*un-3wiq) poi,tsun-awip11,en23,en31,e! 2d=poi,tsun-awip11,en23,en31,e! 2d+& &a11a23a31*un-awiq) poi,tsun-2wip11,en23,en31,e! 2d=poi,tsun-2wip11,en23,en31,e! 2d+& &a11a23a31*un-2wiq) poi,tsun-3wip11,en23,en31,e! 2d=poi,tsun-3wip11,en23,en31,e! 2d+& &a11a23a31*un-3wiq) poi,tsun-awip12,en23,en31,e! 2d=poi,tsun-awip12,en23,en31,e! 2d+& &a12a23a31*un-awiq) poi,tsun-2wip12,en23,en31,e! 2d=poi,tsun-2wip12,en23,en31,e! 2d+& &a12a23a31*un-2wiq) poi,tsun-3wip12,en23,en31,e! 2d=poi,tsun-3wip12,en23,en31,e! 2d+& &a12a23a31*un-3wiq) poi,tsun-awip13,en23,en31,e! 2d=poi,tsun-awip13,en23,en31,e! 2d+& &a13a23a31*un-awiq) poi,tsun-2wip13,en23,en31,e! 2d=poi,tsun-2wip13,en23,en31,e! 2d+& &a13a23a31*un-2wiq) poi,tsun-3wip13,en23,en31,e! 2d=poi,tsun-3wip13,en23,en31,e! 2d+& &a13a23a31*un-3wiq) poi,tsun-awip10,en20,en32,e! 2d=poi,tsun-awip10,en20,en32,e! 2d+& &a10a20a32*un-awiq) poi,tsun-2wip10,en20,en32,e! 2d=poi,tsun-2wip10,en20,en32,e! 2d+& &a10a20a32*un-2wiq) poi,tsun-3wip10,en20,en32,e! 2d=poi,tsun-3wip10,en20,en32,e! 2d+& &a10a20a32*un-3wiq) poi,tsun-awip11,en20,en32,e! 2d=poi,tsun-awip11,en20,en32,e! 2d+& &a11a20a32*un-awiq) poi,tsun-2wip11,en20,en32,e! 2d=poi,tsun-2wip11,en20,en32,e! 2d+& &a11a20a32*un-2wiq) poi,tsun-3wip11,en20,en32,e! 2d=poi,tsun-3wip11,en20,en32,e! 2d+& &a11a20a32*un-3wiq) poi,tsun-awip12,en20,en32,e! 2d=poi,tsun-awip12,en20,en32,e! 2d+& &a12a20a32*un-awiq) poi,tsun-2wip12,en20,en32,e! 2d=poi,tsun-2wip12,en20,en32,e! 2d+& &a12a20a32*un-2wiq) poi,tsun-3wip12,en20,en32,e! 2d=poi,tsun-3wip12,en20,en32,e! 2d+& &a12a20a32*un-3wiq) poi,tsun-awip13,en20,en32,e! 2d=poi,tsun-awip13,en20,en32,e! 2d+& &a13a20a32*un-awiq) poi,tsun-2wip13,en20,en32,e! 2d=poi,tsun-2wip13,en20,en32,e! 2d+& &a13a20a32*un-2wiq) poi,tsun-3wip13,en20,en32,e! 2d=poi,tsun-3wip13,en20,en32,e! 2d+& &a13a20a32*un-3wiq) poi,tsun-awip10,en21,en32,e! 2d=poi,tsun-awip10,en21,en32,e! 2d+& &a10a21a32*un-awiq) poi,tsun-2wip10,en21,en32,e! 2d=poi,tsun-2wip10,en21,en32,e! 2d+& &a10a21a32*un-2wiq) poi,tsun-3wip10,en21,en32,e! 2d=poi,tsun-3wip10,en21,en32,e! 2d+& &a10a21a32*un-3wiq) poi,tsun-awip11,en21,en32,e! 2d=poi,tsun-awip11,en21,en32,e! 2d+& &a11a21a32*un-awiq) poi,tsun-2wip11,en21,en32,e! 2d=poi,tsun-2wip11,en21,en32,e! 2d+& &a11a21a32*un-2wiq) poi,tsun-3wip11,en21,en32,e! 2d=poi,tsun-3wip11,en21,en32,e! 2d+& &a11a21a32*un-3wiq) poi,tsun-awip12,en21,en32,e! 2d=poi,tsun-awip12,en21,en32,e! 2d+& &a12a21a32*un-awiq) poi,tsun-2wip12,en21,en32,e! 2d=poi,tsun-2wip12,en21,en32,e! 2d+& &a12a21a32*un-2wiq) poi,tsun-3wip12,en21,en32,e! 2d=poi,tsun-3wip12,en21,en32,e! 2d+& &a12a21a32*un-3wiq) poi,tsun-awip13,en21,en32,e! 2d=poi,tsun-awip13,en21,en32,e! 2d+& &a13a21a32*un-awiq) poi,tsun-2wip13,en21,en32,e! 2d=poi,tsun-2wip13,en21,en32,e! 2d+& &a13a21a32*un-2wiq) poi,tsun-3wip13,en21,en32,e! 2d=poi,tsun-3wip13,en21,en32,e! 2d+& &a13a21a32*un-3wiq) poi,tsun-awip10,en22,en32,e! 2d=poi,tsun-awip10,en22,en32,e! 2d+& &a10a22a32*un-awiq) poi,tsun-2wip10,en22,en32,e! 2d=poi,tsun-2wip10,en22,en32,e! 2d+& &a10a22a32*un-2wiq) poi,tsun-3wip10,en22,en32,e! 2d=poi,tsun-3wip10,en22,en32,e! 2d+& &a10a22a32*un-3wiq) poi,tsun-awip11,en22,en32,e! 2d=poi,tsun-awip11,en22,en32,e! 2d+& &a11a22a32*un-awiq) poi,tsun-2wip11,en22,en32,e! 2d=poi,tsun-2wip11,en22,en32,e! 2d+& &a11a22a32*un-2wiq) poi,tsun-3wip11,en22,en32,e! 2d=poi,tsun-3wip11,en22,en32,e! 2d+& &a11a22a32*un-3wiq) poi,tsun-awip12,en22,en32,e! 2d=poi,tsun-awip12,en22,en32,e! 2d+& &a12a22a32*un-awiq) poi,tsun-2wip12,en22,en32,e! 2d=poi,tsun-2wip12,en22,en32,e! 2d+& &a12a22a32*un-2wiq) poi,tsun-3wip12,en22,en32,e! 2d=poi,tsun-3wip12,en22,en32,e! 2d+& &a12a22a32*un-3wiq) poi,tsun-awip13,en22,en32,e! 2d=poi,tsun-awip13,en22,en32,e! 2d+& &a13a22a32*un-awiq) poi,tsun-2wip13,en22,en32,e! 2d=poi,tsun-2wip13,en22,en32,e! 2d+& &a13a22a32*un-2wiq) poi,tsun-3wip13,en22,en32,e! 2d=poi,tsun-3wip13,en22,en32,e! 2d+& &a13a22a32*un-3wiq) poi,tsun-awip10,en23,en32,e! 2d=poi,tsun-awip10,en23,en32,e! 2d+& &a10a23a32*un-awiq) poi,tsun-2wip10,en23,en32,e! 2d=poi,tsun-2wip10,en23,en32,e! 2d+& &a10a23a32*un-2wiq) poi,tsun-3wip10,en23,en32,e! 2d=poi,tsun-3wip10,en23,en32,e! 2d+& &a10a23a32*un-3wiq) poi,tsun-awip11,en23,en32,e! 2d=poi,tsun-awip11,en23,en32,e! 2d+& &a11a23a32*un-awiq) poi,tsun-2wip11,en23,en32,e! 2d=poi,tsun-2wip11,en23,en32,e! 2d+& &a11a23a32*un-2wiq) poi,tsun-3wip11,en23,en32,e! 2d=poi,tsun-3wip11,en23,en32,e! 2d+& &a11a23a32*un-3wiq) poi,tsun-awip12,en23,en32,e! 2d=poi,tsun-awip12,en23,en32,e! 2d+& &a12a23a32*un-awiq) poi,tsun-2wip12,en23,en32,e! 2d=poi,tsun-2wip12,en23,en32,e! 2d+& &a12a23a32*un-2wiq) poi,tsun-3wip12,en23,en32,e! 2d=poi,tsun-3wip12,en23,en32,e! 2d+& &a12a23a32*un-3wiq) poi,tsun-awip13,en23,en32,e! 2d=poi,tsun-awip13,en23,en32,e! 2d+& &a13a23a32*un-awiq) poi,tsun-2wip13,en23,en32,e! 2d=poi,tsun-2wip13,en23,en32,e! 2d+& &a13a23a32*un-2wiq) poi,tsun-3wip13,en23,en32,e! 2d=poi,tsun-3wip13,en23,en32,e! 2d+& &a13a23a32*un-3wiq) poi,tsun-awip10,en20,en33,e! 2d=poi,tsun-awip10,en20,en33,e! 2d+& &a10a20a33*un-awiq) poi,tsun-2wip10,en20,en33,e! 2d=poi,tsun-2wip10,en20,en33,e! 2d+& &a10a20a33*un-2wiq) poi,tsun-3wip10,en20,en33,e! 2d=poi,tsun-3wip10,en20,en33,e! 2d+& &a10a20a33*un-3wiq) poi,tsun-awip11,en20,en33,e! 2d=poi,tsun-awip11,en20,en33,e! 2d+& &a11a20a33*un-awiq) poi,tsun-2wip11,en20,en33,e! 2d=poi,tsun-2wip11,en20,en33,e! 2d+& &a11a20a33*un-2wiq) poi,tsun-3wip11,en20,en33,e! 2d=poi,tsun-3wip11,en20,en33,e! 2d+& &a11a20a33*un-3wiq) poi,tsun-awip12,en20,en33,e! 2d=poi,tsun-awip12,en20,en33,e! 2d+& &a12a20a33*un-awiq) poi,tsun-2wip12,en20,en33,e! 2d=poi,tsun-2wip12,en20,en33,e! 2d+& &a12a20a33*un-2wiq) poi,tsun-3wip12,en20,en33,e! 2d=poi,tsun-3wip12,en20,en33,e! 2d+& &a12a20a33*un-3wiq) poi,tsun-awip13,en20,en33,e! 2d=poi,tsun-awip13,en20,en33,e! 2d+& &a13a20a33*un-awiq) poi,tsun-2wip13,en20,en33,e! 2d=poi,tsun-2wip13,en20,en33,e! 2d+& &a13a20a33*un-2wiq) poi,tsun-3wip13,en20,en33,e! 2d=poi,tsun-3wip13,en20,en33,e! 2d+& &a13a20a33*un-3wiq) poi,tsun-awip10,en21,en33,e! 2d=poi,tsun-awip10,en21,en33,e! 2d+& &a10a21a33*un-awiq) poi,tsun-2wip10,en21,en33,e! 2d=poi,tsun-2wip10,en21,en33,e! 2d+& &a10a21a33*un-2wiq) poi,tsun-3wip10,en21,en33,e! 2d=poi,tsun-3wip10,en21,en33,e! 2d+& &a10a21a33*un-3wiq) poi,tsun-awip11,en21,en33,e! 2d=poi,tsun-awip11,en21,en33,e! 2d+& &a11a21a33*un-awiq) poi,tsun-2wip11,en21,en33,e! 2d=poi,tsun-2wip11,en21,en33,e! 2d+& &a11a21a33*un-2wiq) poi,tsun-3wip11,en21,en33,e! 2d=poi,tsun-3wip11,en21,en33,e! 2d+& &a11a21a33*un-3wiq) poi,tsun-awip12,en21,en33,e! 2d=poi,tsun-awip12,en21,en33,e! 2d+& &a12a21a33*un-awiq) poi,tsun-2wip12,en21,en33,e! 2d=poi,tsun-2wip12,en21,en33,e! 2d+& &a12a21a33*un-2wiq) poi,tsun-3wip12,en21,en33,e! 2d=poi,tsun-3wip12,en21,en33,e! 2d+& &a12a21a33*un-3wiq) poi,tsun-awip13,en21,en33,e! 2d=poi,tsun-awip13,en21,en33,e! 2d+& &a13a21a33*un-awiq) poi,tsun-2wip13,en21,en33,e! 2d=poi,tsun-2wip13,en21,en33,e! 2d+& &a13a21a33*un-2wiq) poi,tsun-3wip13,en21,en33,e! 2d=poi,tsun-3wip13,en21,en33,e! 2d+& &a13a21a33*un-3wiq) poi,tsun-awip10,en22,en33,e! 2d=poi,tsun-awip10,en22,en33,e! 2d+& &a10a22a33*un-awiq) poi,tsun-2wip10,en22,en33,e! 2d=poi,tsun-2wip10,en22,en33,e! 2d+& &a10a22a33*un-2wiq) poi,tsun-3wip10,en22,en33,e! 2d=poi,tsun-3wip10,en22,en33,e! 2d+& &a10a22a33*un-3wiq) poi,tsun-awip11,en22,en33,e! 2d=poi,tsun-awip11,en22,en33,e! 2d+& &a11a22a33*un-awiq) poi,tsun-2wip11,en22,en33,e! 2d=poi,tsun-2wip11,en22,en33,e! 2d+& &a11a22a33*un-2wiq) poi,tsun-3wip11,en22,en33,e! 2d=poi,tsun-3wip11,en22,en33,e! 2d+& &a11a22a33*un-3wiq) poi,tsun-awip12,en22,en33,e! 2d=poi,tsun-awip12,en22,en33,e! 2d+& &a12a22a33*un-awiq) poi,tsun-2wip12,en22,en33,e! 2d=poi,tsun-2wip12,en22,en33,e! 2d+& &a12a22a33*un-2wiq) poi,tsun-3wip12,en22,en33,e! 2d=poi,tsun-3wip12,en22,en33,e! 2d+& &a12a22a33*un-3wiq) poi,tsun-awip13,en22,en33,e! 2d=poi,tsun-awip13,en22,en33,e! 2d+& &a13a22a33*un-awiq) poi,tsun-2wip13,en22,en33,e! 2d=poi,tsun-2wip13,en22,en33,e! 2d+& &a13a22a33*un-2wiq) poi,tsun-3wip13,en22,en33,e! 2d=poi,tsun-3wip13,en22,en33,e! 2d+& &a13a22a33*un-3wiq) poi,tsun-awip10,en23,en33,e! 2d=poi,tsun-awip10,en23,en33,e! 2d+& &a10a23a33*un-awiq) poi,tsun-2wip10,en23,en33,e! 2d=poi,tsun-2wip10,en23,en33,e! 2d+& &a10a23a33*un-2wiq) poi,tsun-3wip10,en23,en33,e! 2d=poi,tsun-3wip10,en23,en33,e! 2d+& &a10a23a33*un-3wiq) poi,tsun-awip11,en23,en33,e! 2d=poi,tsun-awip11,en23,en33,e! 2d+& &a11a23a33*un-awiq) poi,tsun-2wip11,en23,en33,e! 2d=poi,tsun-2wip11,en23,en33,e! 2d+& &a11a23a33*un-2wiq) poi,tsun-3wip11,en23,en33,e! 2d=poi,tsun-3wip11,en23,en33,e! 2d+& &a11a23a33*un-3wiq) poi,tsun-awip12,en23,en33,e! 2d=poi,tsun-awip12,en23,en33,e! 2d+& &a12a23a33*un-awiq) poi,tsun-2wip12,en23,en33,e! 2d=poi,tsun-2wip12,en23,en33,e! 2d+& &a12a23a33*un-2wiq) poi,tsun-3wip12,en23,en33,e! 2d=poi,tsun-3wip12,en23,en33,e! 2d+& &a12a23a33*un-3wiq) poi,tsun-awip13,en23,en33,e! 2d=poi,tsun-awip13,en23,en33,e! 2d+& &a13a23a33*un-awiq) poi,tsun-2wip13,en23,en33,e! 2d=poi,tsun-2wip13,en23,en33,e! 2d+& &a13a23a33*un-2wiq) poi,tsun-3wip13,en23,en33,e! 2d=poi,tsun-3wip13,en23,en33,e! 2d+& &a13a23a33*un-3wiq) #else poi,tsun-a:3wip10,en20,en30,e! 2d=poi,tsun-a:3wip10,en20,en30,e! 2d+& &a10a20a30*un-a:3wiq) poi,tsun-a:3wip11,en20,en30,e! 2d=poi,tsun-a:3wip11,en20,en30,e! 2d+& &a11a20a30*un-a:3wiq) poi,tsun-a:3wip12,en20,en30,e! 2d=poi,tsun-a:3wip12,en20,en30,e! 2d+& &a12a20a30*un-a:3wiq) poi,tsun-a:3wip13,en20,en30,e! 2d=poi,tsun-a:3wip13,en20,en30,e! 2d+& &a13a20a30*un-a:3wiq) poi,tsun-a:3wip10,en21,en30,e! 2d=poi,tsun-a:3wip10,en21,en30,e! 2d+& &a10a21a30*un-a:3wiq) poi,tsun-a:3wip11,en21,en30,e! 2d=poi,tsun-a:3wip11,en21,en30,e! 2d+& &a11a21a30*un-a:3wiq) poi,tsun-a:3wip12,en21,en30,e! 2d=poi,tsun-a:3wip12,en21,en30,e! 2d+& &a12a21a30*un-a:3wiq) poi,tsun-a:3wip13,en21,en30,e! 2d=poi,tsun-a:3wip13,en21,en30,e! 2d+& &a13a21a30*un-a:3wiq) poi,tsun-a:3wip10,en22,en30,e! 2d=poi,tsun-a:3wip10,en22,en30,e! 2d+& &a10a22a30*un-a:3wiq) poi,tsun-a:3wip11,en22,en30,e! 2d=poi,tsun-a:3wip11,en22,en30,e! 2d+& &a11a22a30*un-a:3wiq) poi,tsun-a:3wip12,en22,en30,e! 2d=poi,tsun-a:3wip12,en22,en30,e! 2d+& &a12a22a30*un-a:3wiq) poi,tsun-a:3wip13,en22,en30,e! 2d=poi,tsun-a:3wip13,en22,en30,e! 2d+& &a13a22a30*un-a:3wiq) poi,tsun-a:3wip10,en23,en30,e! 2d=poi,tsun-a:3wip10,en23,en30,e! 2d+& &a10a23a30*un-a:3wiq) poi,tsun-a:3wip11,en23,en30,e! 2d=poi,tsun-a:3wip11,en23,en30,e! 2d+& &a11a23a30*un-a:3wiq) poi,tsun-a:3wip12,en23,en30,e! 2d=poi,tsun-a:3wip12,en23,en30,e! 2d+& &a12a23a30*un-a:3wiq) poi,tsun-a:3wip13,en23,en30,e! 2d=poi,tsun-a:3wip13,en23,en30,e! 2d+& &a13a23a30*un-a:3wiq) poi,tsun-a:3wip10,en20,en31,e! 2d=poi,tsun-a:3wip10,en20,en31,e! 2d+& &a10a20a31*un-a:3wiq) poi,tsun-a:3wip11,en20,en31,e! 2d=poi,tsun-a:3wip11,en20,en31,e! 2d+& &a11a20a31*un-a:3wiq) poi,tsun-a:3wip12,en20,en31,e! 2d=poi,tsun-a:3wip12,en20,en31,e! 2d+& &a12a20a31*un-a:3wiq) poi,tsun-a:3wip13,en20,en31,e! 2d=poi,tsun-a:3wip13,en20,en31,e! 2d+& &a13a20a31*un-a:3wiq) poi,tsun-a:3wip10,en21,en31,e! 2d=poi,tsun-a:3wip10,en21,en31,e! 2d+& &a10a21a31*un-a:3wiq) poi,tsun-a:3wip11,en21,en31,e! 2d=poi,tsun-a:3wip11,en21,en31,e! 2d+& &a11a21a31*un-a:3wiq) poi,tsun-a:3wip12,en21,en31,e! 2d=poi,tsun-a:3wip12,en21,en31,e! 2d+& &a12a21a31*un-a:3wiq) poi,tsun-a:3wip13,en21,en31,e! 2d=poi,tsun-a:3wip13,en21,en31,e! 2d+& &a13a21a31*un-a:3wiq) poi,tsun-a:3wip10,en22,en31,e! 2d=poi,tsun-a:3wip10,en22,en31,e! 2d+& &a10a22a31*un-a:3wiq) poi,tsun-a:3wip11,en22,en31,e! 2d=poi,tsun-a:3wip11,en22,en31,e! 2d+& &a11a22a31*un-a:3wiq) poi,tsun-a:3wip12,en22,en31,e! 2d=poi,tsun-a:3wip12,en22,en31,e! 2d+& &a12a22a31*un-a:3wiq) poi,tsun-a:3wip13,en22,en31,e! 2d=poi,tsun-a:3wip13,en22,en31,e! 2d+& &a13a22a31*un-a:3wiq) poi,tsun-a:3wip10,en23,en31,e! 2d=poi,tsun-a:3wip10,en23,en31,e! 2d+& &a10a23a31*un-a:3wiq) poi,tsun-a:3wip11,en23,en31,e! 2d=poi,tsun-a:3wip11,en23,en31,e! 2d+& &a11a23a31*un-a:3wiq) poi,tsun-a:3wip12,en23,en31,e! 2d=poi,tsun-a:3wip12,en23,en31,e! 2d+& &a12a23a31*un-a:3wiq) poi,tsun-a:3wip13,en23,en31,e! 2d=poi,tsun-a:3wip13,en23,en31,e! 2d+& &a13a23a31*un-a:3wiq) poi,tsun-a:3wip10,en20,en32,e! 2d=poi,tsun-a:3wip10,en20,en32,e! 2d+& &a10a20a32*un-a:3wiq) poi,tsun-a:3wip11,en20,en32,e! 2d=poi,tsun-a:3wip11,en20,en32,e! 2d+& &a11a20a32*un-a:3wiq) poi,tsun-a:3wip12,en20,en32,e! 2d=poi,tsun-a:3wip12,en20,en32,e! 2d+& &a12a20a32*un-a:3wiq) poi,tsun-a:3wip13,en20,en32,e! 2d=poi,tsun-a:3wip13,en20,en32,e! 2d+& &a13a20a32*un-a:3wiq) poi,tsun-a:3wip10,en21,en32,e! 2d=poi,tsun-a:3wip10,en21,en32,e! 2d+& &a10a21a32*un-a:3wiq) poi,tsun-a:3wip11,en21,en32,e! 2d=poi,tsun-a:3wip11,en21,en32,e! 2d+& &a11a21a32*un-a:3wiq) poi,tsun-a:3wip12,en21,en32,e! 2d=poi,tsun-a:3wip12,en21,en32,e! 2d+& &a12a21a32*un-a:3wiq) poi,tsun-a:3wip13,en21,en32,e! 2d=poi,tsun-a:3wip13,en21,en32,e! 2d+& &a13a21a32*un-a:3wiq) poi,tsun-a:3wip10,en22,en32,e! 2d=poi,tsun-a:3wip10,en22,en32,e! 2d+& &a10a22a32*un-a:3wiq) poi,tsun-a:3wip11,en22,en32,e! 2d=poi,tsun-a:3wip11,en22,en32,e! 2d+& &a11a22a32*un-a:3wiq) poi,tsun-a:3wip12,en22,en32,e! 2d=poi,tsun-a:3wip12,en22,en32,e! 2d+& &a12a22a32*un-a:3wiq) poi,tsun-a:3wip13,en22,en32,e! 2d=poi,tsun-a:3wip13,en22,en32,e! 2d+& &a13a22a32*un-a:3wiq) poi,tsun-a:3wip10,en23,en32,e! 2d=poi,tsun-a:3wip10,en23,en32,e! 2d+& &a10a23a32*un-a:3wiq) poi,tsun-a:3wip11,en23,en32,e! 2d=poi,tsun-a:3wip11,en23,en32,e! 2d+& &a11a23a32*un-a:3wiq) poi,tsun-a:3wip12,en23,en32,e! 2d=poi,tsun-a:3wip12,en23,en32,e! 2d+& &a12a23a32*un-a:3wiq) poi,tsun-a:3wip13,en23,en32,e! 2d=poi,tsun-a:3wip13,en23,en32,e! 2d+& &a13a23a32*un-a:3wiq) poi,tsun-a:3wip10,en20,en33,e! 2d=poi,tsun-a:3wip10,en20,en33,e! 2d+& &a10a20a33*un-a:3wiq) poi,tsun-a:3wip11,en20,en33,e! 2d=poi,tsun-a:3wip11,en20,en33,e! 2d+& &a11a20a33*un-a:3wiq) poi,tsun-a:3wip12,en20,en33,e! 2d=poi,tsun-a:3wip12,en20,en33,e! 2d+& &a12a20a33*un-a:3wiq) poi,tsun-a:3wip13,en20,en33,e! 2d=poi,tsun-a:3wip13,en20,en33,e! 2d+& &a13a20a33*un-a:3wiq) poi,tsun-a:3wip10,en21,en33,e! 2d=poi,tsun-a:3wip10,en21,en33,e! 2d+& &a10a21a33*un-a:3wiq) poi,tsun-a:3wip11,en21,en33,e! 2d=poi,tsun-a:3wip11,en21,en33,e! 2d+& &a11a21a33*un-a:3wiq) poi,tsun-a:3wip12,en21,en33,e! 2d=poi,tsun-a:3wip12,en21,en33,e! 2d+& &a12a21a33*un-a:3wiq) poi,tsun-a:3wip13,en21,en33,e! 2d=poi,tsun-a:3wip13,en21,en33,e! 2d+& &a13a21a33*un-a:3wiq) poi,tsun-a:3wip10,en22,en33,e! 2d=poi,tsun-a:3wip10,en22,en33,e! 2d+& &a10a22a33*un-a:3wiq) poi,tsun-a:3wip11,en22,en33,e! 2d=poi,tsun-a:3wip11,en22,en33,e! 2d+& &a11a22a33*un-a:3wiq) poi,tsun-a:3wip12,en22,en33,e! 2d=poi,tsun-a:3wip12,en22,en33,e! 2d+& &a12a22a33*un-a:3wiq) poi,tsun-a:3wip13,en22,en33,e! 2d=poi,tsun-a:3wip13,en22,en33,e! 2d+& &a13a22a33*un-a:3wiq) poi,tsun-a:3wip10,en23,en33,e! 2d=poi,tsun-a:3wip10,en23,en33,e! 2d+& &a10a23a33*un-a:3wiq) poi,tsun-a:3wip11,en23,en33,e! 2d=poi,tsun-a:3wip11,en23,en33,e! 2d+& &a11a23a33*un-a:3wiq) poi,tsun-a:3wip12,en23,en33,e! 2d=poi,tsun-a:3wip12,en23,en33,e! 2d+& &a12a23a33*un-a:3wiq) poi,tsun-a:3wip13,en23,en33,e! 2d=poi,tsun-a:3wip13,en23,en33,e! 2d+& &a13a23a33*un-a:3wiq) #endif1,mk) ffffDDDEND DO1,mk) fff!------------------------------------------------------------------------1,mk) fff! Unrolled versions for 2-vectors1,mk) fff!------------------------------------------------------------------------1,mk) fff ELSEIF (lda .EQ. 2) THEN1,mk) ffffDDDDO ip = 1,store_info(e! 2d11,mk) ffffDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end111,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d11,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)11,mk) ffffDDDDN ep10N= INT(x0(1))1,mk) ffffDDDDN ep20N= INT(x0(2))1,mk) ffffDDDDN ep30N= INT(x0(3))11,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=D0....ip21N= ep20N+ 1m -->ip)u=D0....ip31N= ep30N+ 1m1,mk) ffffDDDDN ep12N= ep11N+ 1m -->ip)u=D0....ip22N= ep21N+ 1m -->ip)u=D0....ip32N= ep31N+ 1m1,mk) ffffDDDDN ep13N= ep11N+ 21,mk) ffffDDDDN en23N= ep21N+ 21,mk) ffffDDDDN en33N= ep31N+ 211,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30,mk)11,mk) ffffDDDDN x10N= xp1N+ 1.0_mk1,mk) ffffDDDDN x11N= x10N- 1.0_mk1,mk) ffffDDDDN x12N= x10N- 2.0_mk1,mk) ffffDDDDN x13N= x10N- 3.0_mk11,mk) ffffDDDDN x20N= xp2N+ 1.0_mk1,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN x22N= x20N- 2.0_mk1,mk) ffffDDDDN x23N= x20N- 3.0_mk11,mk) ffffDDDDN x30N= xp3N+ 1.0_mk1,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN x32N= x30N- 2.0_mk1,mk) ffffDDDDN x33N= x30N- 3.0_mk11,mk) ffffDDDDN a10N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x10)*x10)*x101,mk) ffffDDDDN a20N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x20)*x20)*x201,mk) ffffDDDDN a30N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x30)*x30)*x3011,mk) ffffDDDDN a11N= 1.0_mkN+ (-2.5_mk+1.5_mk*x11)*x11**21,mk) ffffDDDDN a21N= 1.0_mkN+ (-2.5_mk+1.5_mk*x21)*x21**21,mk) ffffDDDDN a31N= 1.0_mkN+ (-2.5_mk+1.5_mk*x31)*x31**211,mk) ffffDDDDN a12N= 1.0_mkN+ (-2.5_mk-1.5_mk*x12)*x12**21,mk) ffffDDDDN a22N= 1.0_mkN+ (-2.5_mk-1.5_mk*x22)*x22**21,mk) ffffDDDDN a32N= 1.0_mkN+ (-2.5_mk-1.5_mk*x32)*x32**211,mk) ffffDDDDN a13N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x13)*x13)*x131,mk) ffffDDDDN a23N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x23)*x23)*x231,mk) ffffDDDDN a33N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x33)*x33)*x3311,mk) ffffDDDDN PRINT*,'###################################################'1,mk) ffffDDDDN PRINT*,'RENORMALIZATION NOT IMPLEMENTED FOR LDAN= 2'1,mk) ffffDDDDN PRINT*,'###################################################'1,mk) ffffDDDDN STOP11,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0....a10a20a32N= a10*a20*a321,mk) ffffDDDDN a10a20a33N= a10*a20*a331,mk) ffffDDDDN a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0....a10a21a32N= a10*a21*a321,mk) ffffDDDDN a10a21a33N= a10*a21*a331,mk) ffffDDDDN a10a22a30N= a10*a22*a30 fffDDDDN a10a22a31N= a10*a22*a31m -->ip)u=D0....a10a22a32N= a10*a22*a321,mk) ffffDDDDN a10a22a33N= a10*a22*a331,mk) ffffDDDDN a10a23a30N= a10*a23*a30 fffDDDDN a10a23a31N= a10*a23*a31m -->ip)u=D0....a10a23a32N= a10*a23*a321,mk) ffffDDDDN a10a23a33N= a10*a23*a331,mk) ffffDDDDN a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m -->ip)u=D0....a11a20a32N= a11*a20*a321,mk) ffffDDDDN a11a20a33N= a11*a20*a331,mk) ffffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m -->ip)u=D0....a11a21a32N= a11*a21*a321,mk) ffffDDDDN a11a21a33N= a11*a21*a331,mk) ffffDDDDN a11a22a30N= a11*a22*a30 fffDDDDN a11a22a31N= a11*a22*a31m -->ip)u=D0....a11a22a32N= a11*a22*a321,mk) ffffDDDDN a11a22a33N= a11*a22*a331,mk) ffffDDDDN a11a23a30N= a11*a23*a30 fffDDDDN a11a23a31N= a11*a23*a31m -->ip)u=D0....a11a23a32N= a11*a23*a321,mk) ffffDDDDN a11a23a33N= a11*a23*a331,mk) ffffDDDDN a12a20a30N= a12*a20*a30 fffDDDDN a12a20a31N= a12*a20*a31m -->ip)u=D0....a12a20a32N= a12*a20*a321,mk) ffffDDDDN a12a20a33N= a12*a20*a331,mk) ffffDDDDN a12a21a30N= a12*a21*a30 fffDDDDN a12a21a31N= a12*a21*a31m -->ip)u=D0....a12a21a32N= a12*a21*a321,mk) ffffDDDDN a12a21a33N= a12*a21*a331,mk) ffffDDDDN a12a22a30N= a12*a22*a30 fffDDDDN a12a22a31N= a12*a22*a31m -->ip)u=D0....a12a22a32N= a12*a22*a321,mk) ffffDDDDN a12a22a33N= a12*a22*a331,mk) ffffDDDDN a12a23a30N= a12*a23*a30 fffDDDDN a12a23a31N= a12*a23*a31m -->ip)u=D0....a12a23a32N= a12*a23*a321,mk) ffffDDDDN a12a23a33N= a12*a23*a331,mk) ffffDDDDN a13a20a30N= a13*a20*a30 fffDDDDN a13a20a31N= a13*a20*a31m -->ip)u=D0....a13a20a32N= a13*a20*a321,mk) ffffDDDDN a13a20a33N= a13*a20*a331,mk) ffffDDDDN a13a21a30N= a13*a21*a30 fffDDDDN a13a21a31N= a13*a21*a31m -->ip)u=D0....a13a21a32N= a13*a21*a321,mk) ffffDDDDN a13a21a33N= a13*a21*a331,mk) ffffDDDDN a13a22a30N= a13*a22*a30 fffDDDDN a13a22a31N= a13*a22*a31m -->ip)u=D0....a13a22a32N= a13*a22*a321,mk) ffffDDDDN a13a22a33N= a13*a22*a331,mk) ffffDDDDN a13a23a30N= a13*a23*a30 fffDDDDN a13a23a31N= a13*a23*a31m -->ip)u=D0....a13a23a32N= a13*a23*a321,mk) ffffDDDDN a13a23a33N= a13*a23*a331,#ifdef __NOMICROINSTRUCTIONS poi,tsun-awip10,en20,en30,e! 2d=poi,tsun-awip10,en20,en30,e! 2d+& &a10a20a30*un-awiq) poi,tsun-2wip10,en20,en30,e! 2d=poi,tsun-2wip10,en20,en30,e! 2d+& &a10a20a30*un-2wiq) poi,tsun-awip11,en20,en30,e! 2d=poi,tsun-awip11,en20,en30,e! 2d+& &a11a20a30*un-awiq) poi,tsun-2wip11,en20,en30,e! 2d=poi,tsun-2wip11,en20,en30,e! 2d+& &a11a20a30*un-2wiq) poi,tsun-awip12,en20,en30,e! 2d=poi,tsun-awip12,en20,en30,e! 2d+& &a12a20a30*un-awiq) poi,tsun-2wip12,en20,en30,e! 2d=poi,tsun-2wip12,en20,en30,e! 2d+& &a12a20a30*un-2wiq) poi,tsun-awip13,en20,en30,e! 2d=poi,tsun-awip13,en20,en30,e! 2d+& &a13a20a30*un-awiq) poi,tsun-2wip13,en20,en30,e! 2d=poi,tsun-2wip13,en20,en30,e! 2d+& &a13a20a30*un-2wiq) poi,tsun-awip10,en21,en30,e! 2d=poi,tsun-awip10,en21,en30,e! 2d+& &a10a21a30*un-awiq) poi,tsun-2wip10,en21,en30,e! 2d=poi,tsun-2wip10,en21,en30,e! 2d+& &a10a21a30*un-2wiq) poi,tsun-awip11,en21,en30,e! 2d=poi,tsun-awip11,en21,en30,e! 2d+& &a11a21a30*un-awiq) poi,tsun-2wip11,en21,en30,e! 2d=poi,tsun-2wip11,en21,en30,e! 2d+& &a11a21a30*un-2wiq) poi,tsun-awip12,en21,en30,e! 2d=poi,tsun-awip12,en21,en30,e! 2d+& &a12a21a30*un-awiq) poi,tsun-2wip12,en21,en30,e! 2d=poi,tsun-2wip12,en21,en30,e! 2d+& &a12a21a30*un-2wiq) poi,tsun-awip13,en21,en30,e! 2d=poi,tsun-awip13,en21,en30,e! 2d+& &a13a21a30*un-awiq) poi,tsun-2wip13,en21,en30,e! 2d=poi,tsun-2wip13,en21,en30,e! 2d+& &a13a21a30*un-2wiq) poi,tsun-awip10,en22,en30,e! 2d=poi,tsun-awip10,en22,en30,e! 2d+& &a10a22a30*un-awiq) poi,tsun-2wip10,en22,en30,e! 2d=poi,tsun-2wip10,en22,en30,e! 2d+& &a10a22a30*un-2wiq) poi,tsun-awip11,en22,en30,e! 2d=poi,tsun-awip11,en22,en30,e! 2d+& &a11a22a30*un-awiq) poi,tsun-2wip11,en22,en30,e! 2d=poi,tsun-2wip11,en22,en30,e! 2d+& &a11a22a30*un-2wiq) poi,tsun-awip12,en22,en30,e! 2d=poi,tsun-awip12,en22,en30,e! 2d+& &a12a22a30*un-awiq) poi,tsun-2wip12,en22,en30,e! 2d=poi,tsun-2wip12,en22,en30,e! 2d+& &a12a22a30*un-2wiq) poi,tsun-awip13,en22,en30,e! 2d=poi,tsun-awip13,en22,en30,e! 2d+& &a13a22a30*un-awiq) poi,tsun-2wip13,en22,en30,e! 2d=poi,tsun-2wip13,en22,en30,e! 2d+& &a13a22a30*un-2wiq) poi,tsun-awip10,en23,en30,e! 2d=poi,tsun-awip10,en23,en30,e! 2d+& &a10a23a30*un-awiq) poi,tsun-2wip10,en23,en30,e! 2d=poi,tsun-2wip10,en23,en30,e! 2d+& &a10a23a30*un-2wiq) poi,tsun-awip11,en23,en30,e! 2d=poi,tsun-awip11,en23,en30,e! 2d+& &a11a23a30*un-awiq) poi,tsun-2wip11,en23,en30,e! 2d=poi,tsun-2wip11,en23,en30,e! 2d+& &a11a23a30*un-2wiq) poi,tsun-awip12,en23,en30,e! 2d=poi,tsun-awip12,en23,en30,e! 2d+& &a12a23a30*un-awiq) poi,tsun-2wip12,en23,en30,e! 2d=poi,tsun-2wip12,en23,en30,e! 2d+& &a12a23a30*un-2wiq) poi,tsun-awip13,en23,en30,e! 2d=poi,tsun-awip13,en23,en30,e! 2d+& &a13a23a30*un-awiq) poi,tsun-2wip13,en23,en30,e! 2d=poi,tsun-2wip13,en23,en30,e! 2d+& &a13a23a30*un-2wiq) poi,tsun-awip10,en20,en31,e! 2d=poi,tsun-awip10,en20,en31,e! 2d+& &a10a20a31*un-awiq) poi,tsun-2wip10,en20,en31,e! 2d=poi,tsun-2wip10,en20,en31,e! 2d+& &a10a20a31*un-2wiq) poi,tsun-awip11,en20,en31,e! 2d=poi,tsun-awip11,en20,en31,e! 2d+& &a11a20a31*un-awiq) poi,tsun-2wip11,en20,en31,e! 2d=poi,tsun-2wip11,en20,en31,e! 2d+& &a11a20a31*un-2wiq) poi,tsun-awip12,en20,en31,e! 2d=poi,tsun-awip12,en20,en31,e! 2d+& &a12a20a31*un-awiq) poi,tsun-2wip12,en20,en31,e! 2d=poi,tsun-2wip12,en20,en31,e! 2d+& &a12a20a31*un-2wiq) poi,tsun-awip13,en20,en31,e! 2d=poi,tsun-awip13,en20,en31,e! 2d+& &a13a20a31*un-awiq) poi,tsun-2wip13,en20,en31,e! 2d=poi,tsun-2wip13,en20,en31,e! 2d+& &a13a20a31*un-2wiq) poi,tsun-awip10,en21,en31,e! 2d=poi,tsun-awip10,en21,en31,e! 2d+& &a10a21a31*un-awiq) poi,tsun-2wip10,en21,en31,e! 2d=poi,tsun-2wip10,en21,en31,e! 2d+& &a10a21a31*un-2wiq) poi,tsun-awip11,en21,en31,e! 2d=poi,tsun-awip11,en21,en31,e! 2d+& &a11a21a31*un-awiq) poi,tsun-2wip11,en21,en31,e! 2d=poi,tsun-2wip11,en21,en31,e! 2d+& &a11a21a31*un-2wiq) poi,tsun-awip12,en21,en31,e! 2d=poi,tsun-awip12,en21,en31,e! 2d+& &a12a21a31*un-awiq) poi,tsun-2wip12,en21,en31,e! 2d=poi,tsun-2wip12,en21,en31,e! 2d+& &a12a21a31*un-2wiq) poi,tsun-awip13,en21,en31,e! 2d=poi,tsun-awip13,en21,en31,e! 2d+& &a13a21a31*un-awiq) poi,tsun-2wip13,en21,en31,e! 2d=poi,tsun-2wip13,en21,en31,e! 2d+& &a13a21a31*un-2wiq) poi,tsun-awip10,en22,en31,e! 2d=poi,tsun-awip10,en22,en31,e! 2d+& &a10a22a31*un-awiq) poi,tsun-2wip10,en22,en31,e! 2d=poi,tsun-2wip10,en22,en31,e! 2d+& &a10a22a31*un-2wiq) poi,tsun-awip11,en22,en31,e! 2d=poi,tsun-awip11,en22,en31,e! 2d+& &a11a22a31*un-awiq) poi,tsun-2wip11,en22,en31,e! 2d=poi,tsun-2wip11,en22,en31,e! 2d+& &a11a22a31*un-2wiq) poi,tsun-awip12,en22,en31,e! 2d=poi,tsun-awip12,en22,en31,e! 2d+& &a12a22a31*un-awiq) poi,tsun-2wip12,en22,en31,e! 2d=poi,tsun-2wip12,en22,en31,e! 2d+& &a12a22a31*un-2wiq) poi,tsun-awip13,en22,en31,e! 2d=poi,tsun-awip13,en22,en31,e! 2d+& &a13a22a31*un-awiq) poi,tsun-2wip13,en22,en31,e! 2d=poi,tsun-2wip13,en22,en31,e! 2d+& &a13a22a31*un-2wiq) poi,tsun-awip10,en23,en31,e! 2d=poi,tsun-awip10,en23,en31,e! 2d+& &a10a23a31*un-awiq) poi,tsun-2wip10,en23,en31,e! 2d=poi,tsun-2wip10,en23,en31,e! 2d+& &a10a23a31*un-2wiq) poi,tsun-awip11,en23,en31,e! 2d=poi,tsun-awip11,en23,en31,e! 2d+& &a11a23a31*un-awiq) poi,tsun-2wip11,en23,en31,e! 2d=poi,tsun-2wip11,en23,en31,e! 2d+& &a11a23a31*un-2wiq) poi,tsun-awip12,en23,en31,e! 2d=poi,tsun-awip12,en23,en31,e! 2d+& &a12a23a31*un-awiq) poi,tsun-2wip12,en23,en31,e! 2d=poi,tsun-2wip12,en23,en31,e! 2d+& &a12a23a31*un-2wiq) poi,tsun-awip13,en23,en31,e! 2d=poi,tsun-awip13,en23,en31,e! 2d+& &a13a23a31*un-awiq) poi,tsun-2wip13,en23,en31,e! 2d=poi,tsun-2wip13,en23,en31,e! 2d+& &a13a23a31*un-2wiq) poi,tsun-awip10,en20,en32,e! 2d=poi,tsun-awip10,en20,en32,e! 2d+& &a10a20a32*un-awiq) poi,tsun-2wip10,en20,en32,e! 2d=poi,tsun-2wip10,en20,en32,e! 2d+& &a10a20a32*un-2wiq) poi,tsun-awip11,en20,en32,e! 2d=poi,tsun-awip11,en20,en32,e! 2d+& &a11a20a32*un-awiq) poi,tsun-2wip11,en20,en32,e! 2d=poi,tsun-2wip11,en20,en32,e! 2d+& &a11a20a32*un-2wiq) poi,tsun-awip12,en20,en32,e! 2d=poi,tsun-awip12,en20,en32,e! 2d+& &a12a20a32*un-awiq) poi,tsun-2wip12,en20,en32,e! 2d=poi,tsun-2wip12,en20,en32,e! 2d+& &a12a20a32*un-2wiq) poi,tsun-awip13,en20,en32,e! 2d=poi,tsun-awip13,en20,en32,e! 2d+& &a13a20a32*un-awiq) poi,tsun-2wip13,en20,en32,e! 2d=poi,tsun-2wip13,en20,en32,e! 2d+& &a13a20a32*un-2wiq) poi,tsun-awip10,en21,en32,e! 2d=poi,tsun-awip10,en21,en32,e! 2d+& &a10a21a32*un-awiq) poi,tsun-2wip10,en21,en32,e! 2d=poi,tsun-2wip10,en21,en32,e! 2d+& &a10a21a32*un-2wiq) poi,tsun-awip11,en21,en32,e! 2d=poi,tsun-awip11,en21,en32,e! 2d+& &a11a21a32*un-awiq) poi,tsun-2wip11,en21,en32,e! 2d=poi,tsun-2wip11,en21,en32,e! 2d+& &a11a21a32*un-2wiq) poi,tsun-awip12,en21,en32,e! 2d=poi,tsun-awip12,en21,en32,e! 2d+& &a12a21a32*un-awiq) poi,tsun-2wip12,en21,en32,e! 2d=poi,tsun-2wip12,en21,en32,e! 2d+& &a12a21a32*un-2wiq) poi,tsun-awip13,en21,en32,e! 2d=poi,tsun-awip13,en21,en32,e! 2d+& &a13a21a32*un-awiq) poi,tsun-2wip13,en21,en32,e! 2d=poi,tsun-2wip13,en21,en32,e! 2d+& &a13a21a32*un-2wiq) poi,tsun-awip10,en22,en32,e! 2d=poi,tsun-awip10,en22,en32,e! 2d+& &a10a22a32*un-awiq) poi,tsun-2wip10,en22,en32,e! 2d=poi,tsun-2wip10,en22,en32,e! 2d+& &a10a22a32*un-2wiq) poi,tsun-awip11,en22,en32,e! 2d=poi,tsun-awip11,en22,en32,e! 2d+& &a11a22a32*un-awiq) poi,tsun-2wip11,en22,en32,e! 2d=poi,tsun-2wip11,en22,en32,e! 2d+& &a11a22a32*un-2wiq) poi,tsun-awip12,en22,en32,e! 2d=poi,tsun-awip12,en22,en32,e! 2d+& &a12a22a32*un-awiq) poi,tsun-2wip12,en22,en32,e! 2d=poi,tsun-2wip12,en22,en32,e! 2d+& &a12a22a32*un-2wiq) poi,tsun-awip13,en22,en32,e! 2d=poi,tsun-awip13,en22,en32,e! 2d+& &a13a22a32*un-awiq) poi,tsun-2wip13,en22,en32,e! 2d=poi,tsun-2wip13,en22,en32,e! 2d+& &a13a22a32*un-2wiq) poi,tsun-awip10,en23,en32,e! 2d=poi,tsun-awip10,en23,en32,e! 2d+& &a10a23a32*un-awiq) poi,tsun-2wip10,en23,en32,e! 2d=poi,tsun-2wip10,en23,en32,e! 2d+& &a10a23a32*un-2wiq) poi,tsun-awip11,en23,en32,e! 2d=poi,tsun-awip11,en23,en32,e! 2d+& &a11a23a32*un-awiq) poi,tsun-2wip11,en23,en32,e! 2d=poi,tsun-2wip11,en23,en32,e! 2d+& &a11a23a32*un-2wiq) poi,tsun-awip12,en23,en32,e! 2d=poi,tsun-awip12,en23,en32,e! 2d+& &a12a23a32*un-awiq) poi,tsun-2wip12,en23,en32,e! 2d=poi,tsun-2wip12,en23,en32,e! 2d+& &a12a23a32*un-2wiq) poi,tsun-awip13,en23,en32,e! 2d=poi,tsun-awip13,en23,en32,e! 2d+& &a13a23a32*un-awiq) poi,tsun-2wip13,en23,en32,e! 2d=poi,tsun-2wip13,en23,en32,e! 2d+& &a13a23a32*un-2wiq) poi,tsun-awip10,en20,en33,e! 2d=poi,tsun-awip10,en20,en33,e! 2d+& &a10a20a33*un-awiq) poi,tsun-2wip10,en20,en33,e! 2d=poi,tsun-2wip10,en20,en33,e! 2d+& &a10a20a33*un-2wiq) poi,tsun-awip11,en20,en33,e! 2d=poi,tsun-awip11,en20,en33,e! 2d+& &a11a20a33*un-awiq) poi,tsun-2wip11,en20,en33,e! 2d=poi,tsun-2wip11,en20,en33,e! 2d+& &a11a20a33*un-2wiq) poi,tsun-awip12,en20,en33,e! 2d=poi,tsun-awip12,en20,en33,e! 2d+& &a12a20a33*un-awiq) poi,tsun-2wip12,en20,en33,e! 2d=poi,tsun-2wip12,en20,en33,e! 2d+& &a12a20a33*un-2wiq) poi,tsun-awip13,en20,en33,e! 2d=poi,tsun-awip13,en20,en33,e! 2d+& &a13a20a33*un-awiq) poi,tsun-2wip13,en20,en33,e! 2d=poi,tsun-2wip13,en20,en33,e! 2d+& &a13a20a33*un-2wiq) poi,tsun-awip10,en21,en33,e! 2d=poi,tsun-awip10,en21,en33,e! 2d+& &a10a21a33*un-awiq) poi,tsun-2wip10,en21,en33,e! 2d=poi,tsun-2wip10,en21,en33,e! 2d+& &a10a21a33*un-2wiq) poi,tsun-awip11,en21,en33,e! 2d=poi,tsun-awip11,en21,en33,e! 2d+& &a11a21a33*un-awiq) poi,tsun-2wip11,en21,en33,e! 2d=poi,tsun-2wip11,en21,en33,e! 2d+& &a11a21a33*un-2wiq) poi,tsun-awip12,en21,en33,e! 2d=poi,tsun-awip12,en21,en33,e! 2d+& &a12a21a33*un-awiq) poi,tsun-2wip12,en21,en33,e! 2d=poi,tsun-2wip12,en21,en33,e! 2d+& &a12a21a33*un-2wiq) poi,tsun-awip13,en21,en33,e! 2d=poi,tsun-awip13,en21,en33,e! 2d+& &a13a21a33*un-awiq) poi,tsun-2wip13,en21,en33,e! 2d=poi,tsun-2wip13,en21,en33,e! 2d+& &a13a21a33*un-2wiq) poi,tsun-awip10,en22,en33,e! 2d=poi,tsun-awip10,en22,en33,e! 2d+& &a10a22a33*un-awiq) poi,tsun-2wip10,en22,en33,e! 2d=poi,tsun-2wip10,en22,en33,e! 2d+& &a10a22a33*un-2wiq) poi,tsun-awip11,en22,en33,e! 2d=poi,tsun-awip11,en22,en33,e! 2d+& &a11a22a33*un-awiq) poi,tsun-2wip11,en22,en33,e! 2d=poi,tsun-2wip11,en22,en33,e! 2d+& &a11a22a33*un-2wiq) poi,tsun-awip12,en22,en33,e! 2d=poi,tsun-awip12,en22,en33,e! 2d+& &a12a22a33*un-awiq) poi,tsun-2wip12,en22,en33,e! 2d=poi,tsun-2wip12,en22,en33,e! 2d+& &a12a22a33*un-2wiq) poi,tsun-awip13,en22,en33,e! 2d=poi,tsun-awip13,en22,en33,e! 2d+& &a13a22a33*un-awiq) poi,tsun-2wip13,en22,en33,e! 2d=poi,tsun-2wip13,en22,en33,e! 2d+& &a13a22a33*un-2wiq) poi,tsun-awip10,en23,en33,e! 2d=poi,tsun-awip10,en23,en33,e! 2d+& &a10a23a33*un-awiq) poi,tsun-2wip10,en23,en33,e! 2d=poi,tsun-2wip10,en23,en33,e! 2d+& &a10a23a33*un-2wiq) poi,tsun-awip11,en23,en33,e! 2d=poi,tsun-awip11,en23,en33,e! 2d+& &a11a23a33*un-awiq) poi,tsun-2wip11,en23,en33,e! 2d=poi,tsun-2wip11,en23,en33,e! 2d+& &a11a23a33*un-2wiq) poi,tsun-awip12,en23,en33,e! 2d=poi,tsun-awip12,en23,en33,e! 2d+& &a12a23a33*un-awiq) poi,tsun-2wip12,en23,en33,e! 2d=poi,tsun-2wip12,en23,en33,e! 2d+& &a12a23a33*un-2wiq) poi,tsun-awip13,en23,en33,e! 2d=poi,tsun-awip13,en23,en33,e! 2d+& &a13a23a33*un-awiq) poi,tsun-2wip13,en23,en33,e! 2d=poi,tsun-2wip13,en23,en33,e! 2d+& &a13a23a33*un-2wiq) #else poi,tsun-a:2wip10,en20,en30,e! 2d=poi,tsun-a:2wip10,en20,en30,e! 2d+& &a10a20a30*un-a:2wiq) poi,tsun-a:2wip11,en20,en30,e! 2d=poi,tsun-a:2wip11,en20,en30,e! 2d+& &a11a20a30*un-a:2wiq) poi,tsun-a:2wip12,en20,en30,e! 2d=poi,tsun-a:2wip12,en20,en30,e! 2d+& &a12a20a30*un-a:2wiq) poi,tsun-a:2wip13,en20,en30,e! 2d=poi,tsun-a:2wip13,en20,en30,e! 2d+& &a13a20a30*un-a:2wiq) poi,tsun-a:2wip10,en21,en30,e! 2d=poi,tsun-a:2wip10,en21,en30,e! 2d+& &a10a21a30*un-a:2wiq) poi,tsun-a:2wip11,en21,en30,e! 2d=poi,tsun-a:2wip11,en21,en30,e! 2d+& &a11a21a30*un-a:2wiq) poi,tsun-a:2wip12,en21,en30,e! 2d=poi,tsun-a:2wip12,en21,en30,e! 2d+& &a12a21a30*un-a:2wiq) poi,tsun-a:2wip13,en21,en30,e! 2d=poi,tsun-a:2wip13,en21,en30,e! 2d+& &a13a21a30*un-a:2wiq) poi,tsun-a:2wip10,en22,en30,e! 2d=poi,tsun-a:2wip10,en22,en30,e! 2d+& &a10a22a30*un-a:2wiq) poi,tsun-a:2wip11,en22,en30,e! 2d=poi,tsun-a:2wip11,en22,en30,e! 2d+& &a11a22a30*un-a:2wiq) poi,tsun-a:2wip12,en22,en30,e! 2d=poi,tsun-a:2wip12,en22,en30,e! 2d+& &a12a22a30*un-a:2wiq) poi,tsun-a:2wip13,en22,en30,e! 2d=poi,tsun-a:2wip13,en22,en30,e! 2d+& &a13a22a30*un-a:2wiq) poi,tsun-a:2wip10,en23,en30,e! 2d=poi,tsun-a:2wip10,en23,en30,e! 2d+& &a10a23a30*un-a:2wiq) poi,tsun-a:2wip11,en23,en30,e! 2d=poi,tsun-a:2wip11,en23,en30,e! 2d+& &a11a23a30*un-a:2wiq) poi,tsun-a:2wip12,en23,en30,e! 2d=poi,tsun-a:2wip12,en23,en30,e! 2d+& &a12a23a30*un-a:2wiq) poi,tsun-a:2wip13,en23,en30,e! 2d=poi,tsun-a:2wip13,en23,en30,e! 2d+& &a13a23a30*un-a:2wiq) poi,tsun-a:2wip10,en20,en31,e! 2d=poi,tsun-a:2wip10,en20,en31,e! 2d+& &a10a20a31*un-a:2wiq) poi,tsun-a:2wip11,en20,en31,e! 2d=poi,tsun-a:2wip11,en20,en31,e! 2d+& &a11a20a31*un-a:2wiq) poi,tsun-a:2wip12,en20,en31,e! 2d=poi,tsun-a:2wip12,en20,en31,e! 2d+& &a12a20a31*un-a:2wiq) poi,tsun-a:2wip13,en20,en31,e! 2d=poi,tsun-a:2wip13,en20,en31,e! 2d+& &a13a20a31*un-a:2wiq) poi,tsun-a:2wip10,en21,en31,e! 2d=poi,tsun-a:2wip10,en21,en31,e! 2d+& &a10a21a31*un-a:2wiq) poi,tsun-a:2wip11,en21,en31,e! 2d=poi,tsun-a:2wip11,en21,en31,e! 2d+& &a11a21a31*un-a:2wiq) poi,tsun-a:2wip12,en21,en31,e! 2d=poi,tsun-a:2wip12,en21,en31,e! 2d+& &a12a21a31*un-a:2wiq) poi,tsun-a:2wip13,en21,en31,e! 2d=poi,tsun-a:2wip13,en21,en31,e! 2d+& &a13a21a31*un-a:2wiq) poi,tsun-a:2wip10,en22,en31,e! 2d=poi,tsun-a:2wip10,en22,en31,e! 2d+& &a10a22a31*un-a:2wiq) poi,tsun-a:2wip11,en22,en31,e! 2d=poi,tsun-a:2wip11,en22,en31,e! 2d+& &a11a22a31*un-a:2wiq) poi,tsun-a:2wip12,en22,en31,e! 2d=poi,tsun-a:2wip12,en22,en31,e! 2d+& &a12a22a31*un-a:2wiq) poi,tsun-a:2wip13,en22,en31,e! 2d=poi,tsun-a:2wip13,en22,en31,e! 2d+& &a13a22a31*un-a:2wiq) poi,tsun-a:2wip10,en23,en31,e! 2d=poi,tsun-a:2wip10,en23,en31,e! 2d+& &a10a23a31*un-a:2wiq) poi,tsun-a:2wip11,en23,en31,e! 2d=poi,tsun-a:2wip11,en23,en31,e! 2d+& &a11a23a31*un-a:2wiq) poi,tsun-a:2wip12,en23,en31,e! 2d=poi,tsun-a:2wip12,en23,en31,e! 2d+& &a12a23a31*un-a:2wiq) poi,tsun-a:2wip13,en23,en31,e! 2d=poi,tsun-a:2wip13,en23,en31,e! 2d+& &a13a23a31*un-a:2wiq) poi,tsun-a:2wip10,en20,en32,e! 2d=poi,tsun-a:2wip10,en20,en32,e! 2d+& &a10a20a32*un-a:2wiq) poi,tsun-a:2wip11,en20,en32,e! 2d=poi,tsun-a:2wip11,en20,en32,e! 2d+& &a11a20a32*un-a:2wiq) poi,tsun-a:2wip12,en20,en32,e! 2d=poi,tsun-a:2wip12,en20,en32,e! 2d+& &a12a20a32*un-a:2wiq) poi,tsun-a:2wip13,en20,en32,e! 2d=poi,tsun-a:2wip13,en20,en32,e! 2d+& &a13a20a32*un-a:2wiq) poi,tsun-a:2wip10,en21,en32,e! 2d=poi,tsun-a:2wip10,en21,en32,e! 2d+& &a10a21a32*un-a:2wiq) poi,tsun-a:2wip11,en21,en32,e! 2d=poi,tsun-a:2wip11,en21,en32,e! 2d+& &a11a21a32*un-a:2wiq) poi,tsun-a:2wip12,en21,en32,e! 2d=poi,tsun-a:2wip12,en21,en32,e! 2d+& &a12a21a32*un-a:2wiq) poi,tsun-a:2wip13,en21,en32,e! 2d=poi,tsun-a:2wip13,en21,en32,e! 2d+& &a13a21a32*un-a:2wiq) poi,tsun-a:2wip10,en22,en32,e! 2d=poi,tsun-a:2wip10,en22,en32,e! 2d+& &a10a22a32*un-a:2wiq) poi,tsun-a:2wip11,en22,en32,e! 2d=poi,tsun-a:2wip11,en22,en32,e! 2d+& &a11a22a32*un-a:2wiq) poi,tsun-a:2wip12,en22,en32,e! 2d=poi,tsun-a:2wip12,en22,en32,e! 2d+& &a12a22a32*un-a:2wiq) poi,tsun-a:2wip13,en22,en32,e! 2d=poi,tsun-a:2wip13,en22,en32,e! 2d+& &a13a22a32*un-a:2wiq) poi,tsun-a:2wip10,en23,en32,e! 2d=poi,tsun-a:2wip10,en23,en32,e! 2d+& &a10a23a32*un-a:2wiq) poi,tsun-a:2wip11,en23,en32,e! 2d=poi,tsun-a:2wip11,en23,en32,e! 2d+& &a11a23a32*un-a:2wiq) poi,tsun-a:2wip12,en23,en32,e! 2d=poi,tsun-a:2wip12,en23,en32,e! 2d+& &a12a23a32*un-a:2wiq) poi,tsun-a:2wip13,en23,en32,e! 2d=poi,tsun-a:2wip13,en23,en32,e! 2d+& &a13a23a32*un-a:2wiq) poi,tsun-a:2wip10,en20,en33,e! 2d=poi,tsun-a:2wip10,en20,en33,e! 2d+& &a10a20a33*un-a:2wiq) poi,tsun-a:2wip11,en20,en33,e! 2d=poi,tsun-a:2wip11,en20,en33,e! 2d+& &a11a20a33*un-a:2wiq) poi,tsun-a:2wip12,en20,en33,e! 2d=poi,tsun-a:2wip12,en20,en33,e! 2d+& &a12a20a33*un-a:2wiq) poi,tsun-a:2wip13,en20,en33,e! 2d=poi,tsun-a:2wip13,en20,en33,e! 2d+& &a13a20a33*un-a:2wiq) poi,tsun-a:2wip10,en21,en33,e! 2d=poi,tsun-a:2wip10,en21,en33,e! 2d+& &a10a21a33*un-a:2wiq) poi,tsun-a:2wip11,en21,en33,e! 2d=poi,tsun-a:2wip11,en21,en33,e! 2d+& &a11a21a33*un-a:2wiq) poi,tsun-a:2wip12,en21,en33,e! 2d=poi,tsun-a:2wip12,en21,en33,e! 2d+& &a12a21a33*un-a:2wiq) poi,tsun-a:2wip13,en21,en33,e! 2d=poi,tsun-a:2wip13,en21,en33,e! 2d+& &a13a21a33*un-a:2wiq) poi,tsun-a:2wip10,en22,en33,e! 2d=poi,tsun-a:2wip10,en22,en33,e! 2d+& &a10a22a33*un-a:2wiq) poi,tsun-a:2wip11,en22,en33,e! 2d=poi,tsun-a:2wip11,en22,en33,e! 2d+& &a11a22a33*un-a:2wiq) poi,tsun-a:2wip12,en22,en33,e! 2d=poi,tsun-a:2wip12,en22,en33,e! 2d+& &a12a22a33*un-a:2wiq) poi,tsun-a:2wip13,en22,en33,e! 2d=poi,tsun-a:2wip13,en22,en33,e! 2d+& &a13a22a33*un-a:2wiq) poi,tsun-a:2wip10,en23,en33,e! 2d=poi,tsun-a:2wip10,en23,en33,e! 2d+& &a10a23a33*un-a:2wiq) poi,tsun-a:2wip11,en23,en33,e! 2d=poi,tsun-a:2wip11,en23,en33,e! 2d+& &a11a23a33*un-a:2wiq) poi,tsun-a:2wip12,en23,en33,e! 2d=poi,tsun-a:2wip12,en23,en33,e! 2d+& &a12a23a33*un-a:2wiq) poi,tsun-a:2wip13,en23,en33,e! 2d=poi,tsun-a:2wip13,en23,en33,e! 2d+& &a13a23a33*un-a:2wiq) #endif1,mk) ffffDDENDDO1,mk) fff!------------------------------------------------------------------------1,mk) fff! Unrolled versions for 1-vectors1,mk) fff!------------------------------------------------------------------------1,mk) fffELSEIF (lda .EQ. 1) THEN1,mk) ffffDDDDO ip = 1,store_info(e! 2d11,mk) ffffDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d11,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)11,mk) ffffDDDDN ep10N= INT(x0(1))1,mk) ffffDDDDN ep20N= INT(x0(2))1,mk) ffffDDDDN ep30N= INT(x0(3))11,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=D0....ip21N= ep20N+ 1m -->ip)u=D0....ip31N= ep30N+ 1m1,mk) ffffDDDDN ep12N= ep11N+ 1m -->ip)u=D0....ip22N= ep21N+ 1m -->ip)u=D0....ip32N= ep31N+ 1m1,mk) ffffDDDDN ep13N= ep11N+ 21,mk) ffffDDDDN en23N= ep21N+ 21,mk) ffffDDDDN en33N= ep31N+ 211,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30,mk)11,mk) ffffDDDDN x10N= xp1N+ 1.0_mk1,mk) ffffDDDDN x11N= x10N- 1.0_mk1,mk) ffffDDDDN x12N= x10N- 2.0_mk1,mk) ffffDDDDN x13N= x10N- 3.0_mk11,mk) ffffDDDDN x20N= xp2N+ 1.0_mk1,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN x22N= x20N- 2.0_mk1,mk) ffffDDDDN x23N= x20N- 3.0_mk11,mk) ffffDDDDN x30N= xp3N+ 1.0_mk1,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN x32N= x30N- 2.0_mk1,mk) ffffDDDDN x33N= x30N- 3.0_mk11,mk) ffffDDDDN a10N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x10)*x10)*x101,mk) ffffDDDDN a20N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x20)*x20)*x201,mk) ffffDDDDN a30N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x30)*x30)*x3011,mk) ffffDDDDN a11N= 1.0_mkN+ (-2.5_mk+1.5_mk*x11)*x11**21,mk) ffffDDDDN a21N= 1.0_mkN+ (-2.5_mk+1.5_mk*x21)*x21**21,mk) ffffDDDDN a31N= 1.0_mkN+ (-2.5_mk+1.5_mk*x31)*x31**211,mk) ffffDDDDN a12N= 1.0_mkN+ (-2.5_mk-1.5_mk*x12)*x12**21,mk) ffffDDDDN a22N= 1.0_mkN+ (-2.5_mk-1.5_mk*x22)*x22**21,mk) ffffDDDDN a32N= 1.0_mkN+ (-2.5_mk-1.5_mk*x32)*x32**211,mk) ffffDDDDN a13N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x13)*x13)*x131,mk) ffffDDDDN a23N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x23)*x23)*x231,mk) ffffDDDDN a33N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x33)*x33)*x331,mk) ffffDDDDN PRINT*,'###################################################'1,mk) ffffDDDDN PRINT*,'RENORMALIZATION NOT IMPLEMENTED FOR LDAN= 1'1,mk) ffffDDDDN PRINT*,'###################################################'1,mk) ffffDDDDN STOP11,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0....a10a20a32N= a10*a20*a321,mk) ffffDDDDN a10a20a33N= a10*a20*a331,mk) ffffDDDDN a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0....a10a21a32N= a10*a21*a321,mk) ffffDDDDN a10a21a33N= a10*a21*a331,mk) ffffDDDDN a10a22a30N= a10*a22*a30 fffDDDDN a10a22a31N= a10*a22*a31m -->ip)u=D0....a10a22a32N= a10*a22*a321,mk) p)u=D0....a10a22a33N= a10*a22*a331,mk) ffffDDDDN a10a23a30N= a10*a23*a30 fffDDDDN a10a23a31N= a10*a23*a31m -->ip)u=D0....a10a23a32N= a10*a23*a321,mk) ffffDDDDN a10a23a33N= a10*a23*a331,mk) ffffDDDDN a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m -->ip)ufDDDDN a11a20a32N= a11*a20*a321,mk) ffffDDDDN a11a20a33N= a11*a20*a331,mk) ffffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m -->ip)u=D0....a11a21a32N= a11*a21*a321,mk) ffffDDDDN a11a21a33N= a11*a21*a331,mk) ffffDDDDN a11a22a30N= a11*a22*a30 fffDDDDN a11a22a31N= a11*a22*a31m -->ip)u=D0....a11a22a32N= a11*a22*a321,mk) ffffDDDDN a11a22a33N= a11*a22*a331,mk) ffffDDDDN a11a23a30N= a11*a23*a30 fffDDDDN a11a23a31N= a11*a23*a31m -->ip)u=D0....a11a23a32N= a11*a23*a321,mk) ffffDDDDN a11a23a33N= a11*a23*a331,mk) ffffDDDDN a12a20a30N= a12*a20*a30 fffDDDDN a12a20a31N= a12*a20*a31m -->ip)u=D0....a12a20a32N= a12*a20*a321,mk) ffffDDDDN a12a20a33N= a12*a20*a331,mk) ffffDDDDN a12a21a30N= a12*a21*a30 fffDDDDN a12a21a31N= a12*a21*a31m -->ip)u=D0....a12a21a32N= a12*a21*a321,m->ip)u=D0....a12a21a33N= a12*a21*a331,mk) ffffDDDDN a12a22a30N= a12*a22*a30 fffDDDDN a12a22a31N= a12*a22*a31m -->ip)u=D0....a12a22a32N= a12*a22*a321,mk) ffffDDDDN a12a22a33N= a12*a22*a331,mk) ffffDDDDN a12a23a30N= a12*a23*a30 fffDDDDN a12a23a31N= a12*a23*a31m -->ip)ufDDDDN a12a23a32N= a12*a23*a321,mk) ffffDDDDN a12a23a33N= a12*a23*a331,mk) ffffDDDDN a13a20a30N= a13*a20*a30 fffDDDDN a13a20a31N= a13*a20*a31m -->ip)u=D0....a13a20a32N= a13*a20*a321,mk) ffffDDDDN a13a20a33N= a13*a20*a331,mk) ffffDDDDN a13a21a30N= a13*a21*a30 fffDDDDN a13a21a31N= a13*a21*a31m -->ip)u=D0....a13a21a32N= a13*a21*a321,mk) ffffDDDDN a13a21a33N= a13*a21*a331,mk) ffffDDDDN a13a22a30N= a13*a22*a30 fffDDDDN a13a22a31N= a13*a22*a31m -->ip)u=D0....a13a22a32N= a13*a22*a321,mk) ffffDDDDN a13a22a33N= a13*a22*a331,mk) ffffDDDDN a13a23a30N= a13*a23*a30 fffDDDDN a13a23a31N= a13*a23*a31m -->ip)u=D0....a13a23a32N= a13*a23*a321,mk) ffffDDDDN a13a23a33N= a13*a23*a331,poi,tsun-awip10,en20,en30,e! 2d=poi,tsun-awip10,en20,en30,e! 2d+& &a10a20a30*un-awiq) poi,tsun-awip11,en20,en30,e! 2d=poi,tsun-awip11,en20,en30,e! 2d+& &a11a20a30*un-awiq) poi,tsun-awip12,en20,en30,e! 2d=poi,tsun-awip12,en20,en30,e! 2d+& &a12a20a30*un-awiq) poi,tsun-awip13,en20,en30,e! 2d=poi,tsun-awip13,en20,en30,e! 2d+& &a13a20a30*un-awiq) poi,tsun-awip10,en21,en30,e! 2d=poi,tsun-awip10,en21,en30,e! 2d+& &a10a21a30*un-awiq) poi,tsun-awip11,en21,en30,e! 2d=poi,tsun-awip11,en21,en30,e! 2d+& &a11a21a30*un-awiq) poi,tsun-awip12,en21,en30,e! 2d=poi,tsun-awip12,en21,en30,e! 2d+& &a12a21a30*un-awiq) poi,tsun-awip13,en21,en30,e! 2d=poi,tsun-awip13,en21,en30,e! 2d+& &a13a21a30*un-awiq) poi,tsun-awip10,en22,en30,e! 2d=poi,tsun-awip10,en22,en30,e! 2d+& &a10a22a30*un-awiq) poi,tsun-awip11,en22,en30,e! 2d=poi,tsun-awip11,en22,en30,e! 2d+& &a11a22a30*un-awiq) poi,tsun-awip12,en22,en30,e! 2d=poi,tsun-awip12,en22,en30,e! 2d+& &a12a22a30*un-awiq) poi,tsun-awip13,en22,en30,e! 2d=poi,tsun-awip13,en22,en30,e! 2d+& &a13a22a30*un-awiq) poi,tsun-awip10,en23,en30,e! 2d=poi,tsun-awip10,en23,en30,e! 2d+& &a10a23a30*un-awiq) poi,tsun-awip11,en23,en30,e! 2d=poi,tsun-awip11,en23,en30,e! 2d+& &a11a23a30*un-awiq) poi,tsun-awip12,en23,en30,e! 2d=poi,tsun-awip12,en23,en30,e! 2d+& &a12a23a30*un-awiq) poi,tsun-awip13,en23,en30,e! 2d=poi,tsun-awip13,en23,en30,e! 2d+& &a13a23a30*un-awiq) poi,tsun-awip10,en20,en31,e! 2d=poi,tsun-awip10,en20,en31,e! 2d+& &a10a20a31*un-awiq) poi,tsun-awip11,en20,en31,e! 2d=poi,tsun-awip11,en20,en31,e! 2d+& &a11a20a31*un-awiq) poi,tsun-awip12,en20,en31,e! 2d=poi,tsun-awip12,en20,en31,e! 2d+& &a12a20a31*un-awiq) poi,tsun-awip13,en20,en31,e! 2d=poi,tsun-awip13,en20,en31,e! 2d+& &a13a20a31*un-awiq) poi,tsun-awip10,en21,en31,e! 2d=poi,tsun-awip10,en21,en31,e! 2d+& &a10a21a31*un-awiq) poi,tsun-awip11,en21,en31,e! 2d=poi,tsun-awip11,en21,en31,e! 2d+& &a11a21a31*un-awiq) poi,tsun-awip12,en21,en31,e! 2d=poi,tsun-awip12,en21,en31,e! 2d+& &a12a21a31*un-awiq) poi,tsun-awip13,en21,en31,e! 2d=poi,tsun-awip13,en21,en31,e! 2d+& &a13a21a31*un-awiq) poi,tsun-awip10,en22,en31,e! 2d=poi,tsun-awip10,en22,en31,e! 2d+& &a10a22a31*un-awiq) poi,tsun-awip11,en22,en31,e! 2d=poi,tsun-awip11,en22,en31,e! 2d+& &a11a22a31*un-awiq) poi,tsun-awip12,en22,en31,e! 2d=poi,tsun-awip12,en22,en31,e! 2d+& &a12a22a31*un-awiq) poi,tsun-awip13,en22,en31,e! 2d=poi,tsun-awip13,en22,en31,e! 2d+& &a13a22a31*un-awiq) poi,tsun-awip10,en23,en31,e! 2d=poi,tsun-awip10,en23,en31,e! 2d+& &a10a23a31*un-awiq) poi,tsun-awip11,en23,en31,e! 2d=poi,tsun-awip11,en23,en31,e! 2d+& &a11a23a31*un-awiq) poi,tsun-awip12,en23,en31,e! 2d=poi,tsun-awip12,en23,en31,e! 2d+& &a12a23a31*un-awiq) poi,tsun-awip13,en23,en31,e! 2d=poi,tsun-awip13,en23,en31,e! 2d+& &a13a23a31*un-awiq) poi,tsun-awip10,en20,en32,e! 2d=poi,tsun-awip10,en20,en32,e! 2d+& &a10a20a32*un-awiq) poi,tsun-awip11,en20,en32,e! 2d=poi,tsun-awip11,en20,en32,e! 2d+& &a11a20a32*un-awiq) poi,tsun-awip12,en20,en32,e! 2d=poi,tsun-awip12,en20,en32,e! 2d+& &a12a20a32*un-awiq) poi,tsun-awip13,en20,en32,e! 2d=poi,tsun-awip13,en20,en32,e! 2d+& &a13a20a32*un-awiq) poi,tsun-awip10,en21,en32,e! 2d=poi,tsun-awip10,en21,en32,e! 2d+& &a10a21a32*un-awiq) poi,tsun-awip11,en21,en32,e! 2d=poi,tsun-awip11,en21,en32,e! 2d+& &a11a21a32*un-awiq) poi,tsun-awip12,en21,en32,e! 2d=poi,tsun-awip12,en21,en32,e! 2d+& &a12a21a32*un-awiq) poi,tsun-awip13,en21,en32,e! 2d=poi,tsun-awip13,en21,en32,e! 2d+& &a13a21a32*un-awiq) poi,tsun-awip10,en22,en32,e! 2d=poi,tsun-awip10,en22,en32,e! 2d+& &a10a22a32*un-awiq) poi,tsun-awip11,en22,en32,e! 2d=poi,tsun-awip11,en22,en32,e! 2d+& &a11a22a32*un-awiq) poi,tsun-awip12,en22,en32,e! 2d=poi,tsun-awip12,en22,en32,e! 2d+& &a12a22a32*un-awiq) poi,tsun-awip13,en22,en32,e! 2d=poi,tsun-awip13,en22,en32,e! 2d+& &a13a22a32*un-awiq) poi,tsun-awip10,en23,en32,e! 2d=poi,tsun-awip10,en23,en32,e! 2d+& &a10a23a32*un-awiq) poi,tsun-awip11,en23,en32,e! 2d=poi,tsun-awip11,en23,en32,e! 2d+& &a11a23a32*un-awiq) poi,tsun-awip12,en23,en32,e! 2d=poi,tsun-awip12,en23,en32,e! 2d+& &a12a23a32*un-awiq) poi,tsun-awip13,en23,en32,e! 2d=poi,tsun-awip13,en23,en32,e! 2d+& &a13a23a32*un-awiq) poi,tsun-awip10,en20,en33,e! 2d=poi,tsun-awip10,en20,en33,e! 2d+& &a10a20a33*un-awiq) poi,tsun-awip11,en20,en33,e! 2d=poi,tsun-awip11,en20,en33,e! 2d+& &a11a20a33*un-awiq) poi,tsun-awip12,en20,en33,e! 2d=poi,tsun-awip12,en20,en33,e! 2d+& &a12a20a33*un-awiq) poi,tsun-awip13,en20,en33,e! 2d=poi,tsun-awip13,en20,en33,e! 2d+& &a13a20a33*un-awiq) poi,tsun-awip10,en21,en33,e! 2d=poi,tsun-awip10,en21,en33,e! 2d+& &a10a21a33*un-awiq) poi,tsun-awip11,en21,en33,e! 2d=poi,tsun-awip11,en21,en33,e! 2d+& &a11a21a33*un-awiq) poi,tsun-awip12,en21,en33,e! 2d=poi,tsun-awip12,en21,en33,e! 2d+& &a12a21a33*un-awiq) poi,tsun-awip13,en21,en33,e! 2d=poi,tsun-awip13,en21,en33,e! 2d+& &a13a21a33*un-awiq) poi,tsun-awip10,en22,en33,e! 2d=poi,tsun-awip10,en22,en33,e! 2d+& &a10a22a33*un-awiq) poi,tsun-awip11,en22,en33,e! 2d=poi,tsun-awip11,en22,en33,e! 2d+& &a11a22a33*un-awiq) poi,tsun-awip12,en22,en33,e! 2d=poi,tsun-awip12,en22,en33,e! 2d+& &a12a22a33*un-awiq) poi,tsun-awip13,en22,en33,e! 2d=poi,tsun-awip13,en22,en33,e! 2d+& &a13a22a33*un-awiq) poi,tsun-awip10,en23,en33,e! 2d=poi,tsun-awip10,en23,en33,e! 2d+& &a10a23a33*un-awiq) poi,tsun-awip11,en23,en33,e! 2d=poi,tsun-awip11,en23,en33,e! 2d+& &a11a23a33*un-awiq) poi,tsun-awip12,en23,en33,e! 2d=poi,tsun-awip12,en23,en33,e! 2d+& &a12a23a33*un-awiq) poi,tsun-awip13,en23,en33,e! 2d=poi,tsun-awip13,en23,en33,e! 2d+& &a13a23a33*un-awiq) ffffDDDDN ENDDO1,mk) fff!------------------------------------------------------------------------1,mk) fff! All other lda are NOT UNROLLED. Vectorization will be over lda!1,mk) fff!------------------------------------------------------------------------1,mk) fffELSE1,mk) ffffDDDDO ip = 1,store_info(e! 2d11,mk) ffffDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d11,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)11,mk) ffffDDDDN ep10N= INT(x0(1))1,mk) ffffDDDDN ep20N= INT(x0(2))1,mk) ffffDDDDN ep30N= INT(x0(3))11,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0....ip31N= ep30N+ 1m1,mk) ffffDDDDN ep12N= ep11N+ 1m -->ip)u=D0....ip22N= ep21N+ 1m -->ip)u=D0....ip32N= ep31N+ 1m1,mk) ffffDDDDN ep13N= ep11N+ 21,mk) ffffDDDDN en23N= ep21N+ 21,mk) ffffDDDDN en33N= ep31N+ 211,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30,mk)11,mk) ffffDDDDN x10N= xp1N+ 1.0_mk1,mk) ffffDDDDN x11N= x10N- 1.0_mk1,mk) ffffDDDDN x12N= x10N- 2.0_mk1,mk) ffffDDDDN x13N= x10N- 3.0_mk11,mk) ffffDDDDN x20N= xp2N+ 1.0_mk1,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN x22N= x20N- 2.0_mk1,mk) ffffDDDDN x23N= x20N- 3.0_mk11,mk) ffffDDDDN x30N= xp3N+ 1.0_mk1,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN x32N= x30N- 2.0_mk1,mk) ffffDDDDN x33N= x30N- 3.0_mk11,mk) ffffffffffa10N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x10)*x10)*x101,mk) ffffDDDDN a20N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x20)*x20)*x201,mk) ffffDDDDN a30N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x30)*x30)*x3011,mk) ffffDDDDN a11N= 1.0_mkN+ (-2.5_mk+1.5_mk*x11)*x11**21,mk) ffffDDDDN a21N= 1.0_mkN+ (-2.5_mk+1.5_mk*x21)*x21**21,mk) ffffDDDDN a31N= 1.0_mkN+ (-2.5_mk+1.5_mk*x31)*x31**211,mk) ffffDDDDN a12N= 1.0_mkN+ (-2.5_mk-1.5_mk*x12)*x12**21,mk) ffffDDDDN a22N= 1.0_mkN+ (-2.5_mk-1.5_mk*x22)*x22**21,mk) ffffDDDDN a32N= 1.0_mkN+ (-2.5_mk-1.5_mk*x32)*x32**211,mk) ffffDDDDN a13N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x13)*x13)*x131,mk) ffffDDDDN a23N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x23)*x23)*x231,mk) ffffDDDDN a33N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x33)*x33)*x3311,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0....a10a20a32N= a10*a20*a321,mk) ffffDDDDN a10a20a33N= a10*a20*a331,mk) ffffDDDDN a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0....a10a21a32N= a10*a21*a321,mk) ffffDDDDN a10a21a33N= a10*a21*a331,mk) ffffDDDDN a10a22a30N= a10*a22*a30 fffDDDDN a10a22a31N= a10*a22*a31m -->ip)u=D0....a10a22a32N= a10*a22*a321,mk) p)u=D0....a10a22a33N= a10*a22*a331,mk) ffffDDDDN a10a23a30N= a10*a23*a30 fffDDDDN a10a23a31N= a10*a23*a31m -->ip)u=D0....a10a23a32N= a10*a23*a321,mk) ffffDDDDN a10a23a33N= a10*a23*a331,mk) ffffDDDDN a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m -->ip)ufDDDDN a11a20a32N= a11*a20*a321,mk) ffffDDDDN a11a20a33N= a11*a20*a331,mk) ffffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m -->ip)u=D0....a11a21a32N= a11*a21*a321,mk) ffffDDDDN a11a21a33N= a11*a21*a331,mk) ffffDDDDN a11a22a30N= a11*a22*a30 fffDDDDN a11a22a31N= a11*a22*a31m -->ip)u=D0....a11a22a32N= a11*a22*a321,mk) p)u=D0....a11a22a33N= a11*a22*a331,mk) ffffDDDDN a11a23a30N= a11*a23*a30 fffDDDDN a11a23a31N= a11*a23*a31m -->ip)u=D0....a11a23a32N= a11*a23*a321,mk) ffffDDDDN a11a23a33N= a11*a23*a331,mk) ffffDDDDN a12a20a30N= a12*a20*a30 fffDDDDN a12a20a31N= a12*a20*a31m -->ip)ufDDDDN a12a20a32N= a12*a20*a321,mk) ffffDDDDN a12a20a33N= a12*a20*a331,mk) ffffDDDDN a12a21a30N= a12*a21*a30 fffDDDDN a12a21a31N= a12*a21*a31m -->ip)u=D0....a12a21a32N= a12*a21*a321,m->ip)u=D0....a12a21a33N= a12*a21*a331,mk) ffffDDDDN a12a22a30N= a12*a22*a30 fffDDDDN a12a22a31N= a12*a22*a31m -->ip)u=D0....a12a22a32N= a12*a22*a321,mk) ffffDDDDN a12a22a33N= a12*a22*a331,mk) ffffDDDDN a12a23a30N= a12*a23*a30 fffDDDDN a12a23a31N= a12*a23*a31m -->ip)ufDDDDN a12a23a32N= a12*a23*a321,mk) ffffDDDDN a12a23a33N= a12*a23*a331,mk) ffffDDDDN a13a20a30N= a13*a20*a30 fffDDDDN a13a20a31N= a13*a20*a31m -->ip)u=D0....a13a20a32N= a13*a20*a321,mk) ffffDDDDN a13a20a33N= a13*a20*a331,mk) ffffDDDDN a13a21a30N= a13*a21*a30 fffDDDDN a13a21a31N= a13*a21*a31m -->ip)u=D0....a13a21a32N= a13*a21*a321,m->ip)u=D0....a13a21a33N= a13*a21*a331,mk) ffffDDDDN a13a22a30N= a13*a22*a30 fffDDDDN a13a22a31N= a13*a22*a31m -->ip)u=D0....a13a22a32N= a13*a22*a321,mk) ffffDDDDN a13a22a33N= a13*a22*a331,mk) ffffDDDDN a13a23a30N= a13*a23*a30 fffDDDDN a13a23a31N= a13*a23*a31m -->ip)ufDDDDN a13a23a32N= a13*a23*a321,mk) ffffDDDDN a13a23a33N= a13*a23*a331,,mk) ffffDDDDN DO ldn=1,lda1,poi,tsun-ldnwip10,en20,en30,e! 2d=poi,tsun-ldnwip10,en20,en30,e! 2d+& &a10a20a30*un-ldnwiq) poi,tsun-ldnwip11,en20,en30,e! 2d=poi,tsun-ldnwip11,en20,en30,e! 2d+& &a11a20a30*un-ldnwiq) poi,tsun-ldnwip12,en20,en30,e! 2d=poi,tsun-ldnwip12,en20,en30,e! 2d+& &a12a20a30*un-ldnwiq) poi,tsun-ldnwip13,en20,en30,e! 2d=poi,tsun-ldnwip13,en20,en30,e! 2d+& &a13a20a30*un-ldnwiq) poi,tsun-ldnwip10,en21,en30,e! 2d=poi,tsun-ldnwip10,en21,en30,e! 2d+& &a10a21a30*un-ldnwiq) poi,tsun-ldnwip11,en21,en30,e! 2d=poi,tsun-ldnwip11,en21,en30,e! 2d+& &a11a21a30*un-ldnwiq) poi,tsun-ldnwip12,en21,en30,e! 2d=poi,tsun-ldnwip12,en21,en30,e! 2d+& &a12a21a30*un-ldnwiq) poi,tsun-ldnwip13,en21,en30,e! 2d=poi,tsun-ldnwip13,en21,en30,e! 2d+& &a13a21a30*un-ldnwiq) poi,tsun-ldnwip10,en22,en30,e! 2d=poi,tsun-ldnwip10,en22,en30,e! 2d+& &a10a22a30*un-ldnwiq) poi,tsun-ldnwip11,en22,en30,e! 2d=poi,tsun-ldnwip11,en22,en30,e! 2d+& &a11a22a30*un-ldnwiq) poi,tsun-ldnwip12,en22,en30,e! 2d=poi,tsun-ldnwip12,en22,en30,e! 2d+& &a12a22a30*un-ldnwiq) poi,tsun-ldnwip13,en22,en30,e! 2d=poi,tsun-ldnwip13,en22,en30,e! 2d+& &a13a22a30*un-ldnwiq) poi,tsun-ldnwip10,en23,en30,e! 2d=poi,tsun-ldnwip10,en23,en30,e! 2d+& &a10a23a30*un-ldnwiq) poi,tsun-ldnwip11,en23,en30,e! 2d=poi,tsun-ldnwip11,en23,en30,e! 2d+& &a11a23a30*un-ldnwiq) poi,tsun-ldnwip12,en23,en30,e! 2d=poi,tsun-ldnwip12,en23,en30,e! 2d+& &a12a23a30*un-ldnwiq) poi,tsun-ldnwip13,en23,en30,e! 2d=poi,tsun-ldnwip13,en23,en30,e! 2d+& &a13a23a30*un-ldnwiq) poi,tsun-ldnwip10,en20,en31,e! 2d=poi,tsun-ldnwip10,en20,en31,e! 2d+& &a10a20a31*un-ldnwiq) poi,tsun-ldnwip11,en20,en31,e! 2d=poi,tsun-ldnwip11,en20,en31,e! 2d+& &a11a20a31*un-ldnwiq) poi,tsun-ldnwip12,en20,en31,e! 2d=poi,tsun-ldnwip12,en20,en31,e! 2d+& &a12a20a31*un-ldnwiq) poi,tsun-ldnwip13,en20,en31,e! 2d=poi,tsun-ldnwip13,en20,en31,e! 2d+& &a13a20a31*un-ldnwiq) poi,tsun-ldnwip10,en21,en31,e! 2d=poi,tsun-ldnwip10,en21,en31,e! 2d+& &a10a21a31*un-ldnwiq) poi,tsun-ldnwip11,en21,en31,e! 2d=poi,tsun-ldnwip11,en21,en31,e! 2d+& &a11a21a31*un-ldnwiq) poi,tsun-ldnwip12,en21,en31,e! 2d=poi,tsun-ldnwip12,en21,en31,e! 2d+& &a12a21a31*un-ldnwiq) poi,tsun-ldnwip13,en21,en31,e! 2d=poi,tsun-ldnwip13,en21,en31,e! 2d+& &a13a21a31*un-ldnwiq) poi,tsun-ldnwip10,en22,en31,e! 2d=poi,tsun-ldnwip10,en22,en31,e! 2d+& &a10a22a31*un-ldnwiq) poi,tsun-ldnwip11,en22,en31,e! 2d=poi,tsun-ldnwip11,en22,en31,e! 2d+& &a11a22a31*un-ldnwiq) poi,tsun-ldnwip12,en22,en31,e! 2d=poi,tsun-ldnwip12,en22,en31,e! 2d+& &a12a22a31*un-ldnwiq) poi,tsun-ldnwip13,en22,en31,e! 2d=poi,tsun-ldnwip13,en22,en31,e! 2d+& &a13a22a31*un-ldnwiq) poi,tsun-ldnwip10,en23,en31,e! 2d=poi,tsun-ldnwip10,en23,en31,e! 2d+& &a10a23a31*un-ldnwiq) poi,tsun-ldnwip11,en23,en31,e! 2d=poi,tsun-ldnwip11,en23,en31,e! 2d+& &a11a23a31*un-ldnwiq) poi,tsun-ldnwip12,en23,en31,e! 2d=poi,tsun-ldnwip12,en23,en31,e! 2d+& &a12a23a31*un-ldnwiq) poi,tsun-ldnwip13,en23,en31,e! 2d=poi,tsun-ldnwip13,en23,en31,e! 2d+& &a13a23a31*un-ldnwiq) poi,tsun-ldnwip10,en20,en32,e! 2d=poi,tsun-ldnwip10,en20,en32,e! 2d+& &a10a20a32*un-ldnwiq) poi,tsun-ldnwip11,en20,en32,e! 2d=poi,tsun-ldnwip11,en20,en32,e! 2d+& &a11a20a32*un-ldnwiq) poi,tsun-ldnwip12,en20,en32,e! 2d=poi,tsun-ldnwip12,en20,en32,e! 2d+& &a12a20a32*un-ldnwiq) poi,tsun-ldnwip13,en20,en32,e! 2d=poi,tsun-ldnwip13,en20,en32,e! 2d+& &a13a20a32*un-ldnwiq) poi,tsun-ldnwip10,en21,en32,e! 2d=poi,tsun-ldnwip10,en21,en32,e! 2d+& &a10a21a32*un-ldnwiq) poi,tsun-ldnwip11,en21,en32,e! 2d=poi,tsun-ldnwip11,en21,en32,e! 2d+& &a11a21a32*un-ldnwiq) poi,tsun-ldnwip12,en21,en32,e! 2d=poi,tsun-ldnwip12,en21,en32,e! 2d+& &a12a21a32*un-ldnwiq) poi,tsun-ldnwip13,en21,en32,e! 2d=poi,tsun-ldnwip13,en21,en32,e! 2d+& &a13a21a32*un-ldnwiq) poi,tsun-ldnwip10,en22,en32,e! 2d=poi,tsun-ldnwip10,en22,en32,e! 2d+& &a10a22a32*un-ldnwiq) poi,tsun-ldnwip11,en22,en32,e! 2d=poi,tsun-ldnwip11,en22,en32,e! 2d+& &a11a22a32*un-ldnwiq) poi,tsun-ldnwip12,en22,en32,e! 2d=poi,tsun-ldnwip12,en22,en32,e! 2d+& &a12a22a32*un-ldnwiq) poi,tsun-ldnwip13,en22,en32,e! 2d=poi,tsun-ldnwip13,en22,en32,e! 2d+& &a13a22a32*un-ldnwiq) poi,tsun-ldnwip10,en23,en32,e! 2d=poi,tsun-ldnwip10,en23,en32,e! 2d+& &a10a23a32*un-ldnwiq) poi,tsun-ldnwip11,en23,en32,e! 2d=poi,tsun-ldnwip11,en23,en32,e! 2d+& &a11a23a32*un-ldnwiq) poi,tsun-ldnwip12,en23,en32,e! 2d=poi,tsun-ldnwip12,en23,en32,e! 2d+& &a12a23a32*un-ldnwiq) poi,tsun-ldnwip13,en23,en32,e! 2d=poi,tsun-ldnwip13,en23,en32,e! 2d+& &a13a23a32*un-ldnwiq) poi,tsun-ldnwip10,en20,en33,e! 2d=poi,tsun-ldnwip10,en20,en33,e! 2d+& &a10a20a33*un-ldnwiq) poi,tsun-ldnwip11,en20,en33,e! 2d=poi,tsun-ldnwip11,en20,en33,e! 2d+& &a11a20a33*un-ldnwiq) poi,tsun-ldnwip12,en20,en33,e! 2d=poi,tsun-ldnwip12,en20,en33,e! 2d+& &a12a20a33*un-ldnwiq) poi,tsun-ldnwip13,en20,en33,e! 2d=poi,tsun-ldnwip13,en20,en33,e! 2d+& &a13a20a33*un-ldnwiq) poi,tsun-ldnwip10,en21,en33,e! 2d=poi,tsun-ldnwip10,en21,en33,e! 2d+& &a10a21a33*un-ldnwiq) poi,tsun-ldnwip11,en21,en33,e! 2d=poi,tsun-ldnwip11,en21,en33,e! 2d+& &a11a21a33*un-ldnwiq) poi,tsun-ldnwip12,en21,en33,e! 2d=poi,tsun-ldnwip12,en21,en33,e! 2d+& &a12a21a33*un-ldnwiq) poi,tsun-ldnwip13,en21,en33,e! 2d=poi,tsun-ldnwip13,en21,en33,e! 2d+& &a13a21a33*un-ldnwiq) poi,tsun-ldnwip10,en22,en33,e! 2d=poi,tsun-ldnwip10,en22,en33,e! 2d+& &a10a22a33*un-ldnwiq) poi,tsun-ldnwip11,en22,en33,e! 2d=poi,tsun-ldnwip11,en22,en33,e! 2d+& &a11a22a33*un-ldnwiq) poi,tsun-ldnwip12,en22,en33,e! 2d=poi,tsun-ldnwip12,en22,en33,e! 2d+& &a12a22a33*un-ldnwiq) poi,tsun-ldnwip13,en22,en33,e! 2d=poi,tsun-ldnwip13,en22,en33,e! 2d+& &a13a22a33*un-ldnwiq) poi,tsun-ldnwip10,en23,en33,e! 2d=poi,tsun-ldnwip10,en23,en33,e! 2d+& &a10a23a33*un-ldnwiq) poi,tsun-ldnwip11,en23,en33,e! 2d=poi,tsun-ldnwip11,en23,en33,e! 2d+& &a11a23a33*un-ldnwiq) poi,tsun-ldnwip12,en23,en33,e! 2d=poi,tsun-ldnwip12,en23,en33,e! 2d+& &a12a23a33*un-ldnwiq) poi,tsun-ldnwip13,en23,en33,e! 2d=poi,tsun-ldnwip13,en23,en33,e! 2d+& &a13a23a33*un-ldnwiq) ,,mk) ffffDDDDN ENDDODDN ! lda ffffDDDDN ENDDOffDDDDN ! iq ffDDDDN END IFffffDDDDN ! unrolled lda cases #elif __MODE == __SCA1,mk) ffffDDDDO ip = 1,store_info(e! 2d11,mk) ffffDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d1,mk) ffffDDDDN 1,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)11,mk) ffffDDDDN ep10N= INT(x0(1))1,mk) ffffDDDDN ep20N= INT(x0(2))1,mk) ffffDDDDN ep30N= INT(x0(3))11,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0....ip31N= ep30N+ 1m1,mk) ffffDDDDN ep12N= ep11N+ 1m -->ip)u=D0....ip22N= ep21N+ 1m -->ip)u=D0....ip32N= ep31N+ 1m1,mk) ffffDDDDN ep13N= ep11N+ 21,mk) ffffDDDDN en23N= ep21N+ 21,mk) ffffDDDDN en33N= ep31N+ 211,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30,mk)11,mk) ffffDDDDN x10N= xp1N+ 1.0_mk1,mk) ffffDDDDN x11N= x10N- 1.0_mk1,mk) ffffDDDDN x12N= x10N- 2.0_mk1,mk) ffffDDDDN x13N= x10N- 3.0_mk11,mk) ffffDDDDN x20N= xp2N+ 1.0_mk1,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN x22N= x20N- 2.0_mk1,mk) ffffDDDDN x23N= x20N- 3.0_mk11,mk) ffffDDDDN x30N= xp3N+ 1.0_mk1,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN x32N= x30N- 2.0_mk1,mk) ffffDDDDN x33N= x30N- 3.0_mk11,mk) ffffffffffa10N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x10)*x10)*x101,mk) ffffDDDDN a20N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x20)*x20)*x201,mk) ffffDDDDN a30N= 2.0_mkN+ (-4.0_mk+(2.5_mk-0.5_mk*x30)*x30)*x3011,mk) ffffDDDDN a11N= 1.0_mkN+ (-2.5_mk+1.5_mk*x11)*x11**21,mk) ffffDDDDN a21N= 1.0_mkN+ (-2.5_mk+1.5_mk*x21)*x21**21,mk) ffffDDDDN a31N= 1.0_mkN+ (-2.5_mk+1.5_mk*x31)*x31**211,mk) ffffDDDDN a12N= 1.0_mkN+ (-2.5_mk-1.5_mk*x12)*x12**21,mk) ffffDDDDN a22N= 1.0_mkN+ (-2.5_mk-1.5_mk*x22)*x22**21,mk) ffffDDDDN a32N= 1.0_mkN+ (-2.5_mk-1.5_mk*x32)*x32**211,mk) ffffDDDDN a13N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x13)*x13)*x131,mk) ffffDDDDN a23N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x23)*x23)*x231,mk) ffffDDDDN a33N= 2.0_mkN+ (4.0_mkN+ (2.5_mk+0.5_mk*x33)*x33)*x3311,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0....a10a20a32N= a10*a20*a321,mk) ffffDDDDN a10a20a33N= a10*a20*a331,mk) ffffDDDDN a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0....a10a21a32N= a10*a21*a321,m->ip)u=D0....a10a21a33N= a10*a21*a331,mk) ffffDDDDN a10a22a30N= a10*a22*a30 fffDDDDN a10a22a31N= a10*a22*a31m -->ip)u=D0....a10a22a32N= a10*a22*a321,mk) p)u=D0....a10a22a33N= a10*a22*a331,mk) ffffDDDDN a10a23a30N= a10*a23*a30 fffDDDDN a10a23a31N= a10*a23*a31m -->ip)ufDDDDN a10a23a32N= a10*a23*a321,mk) ffffDDDDN a10a23a33N= a10*a23*a331,mk) ffffDDDDN a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m -->ip)ufDDDDN a11a20a32N= a11*a20*a321,mk) ffffDDDDN a11a20a33N= a11*a20*a331,mk) ffffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m -->ip)u=D0....a11a21a32N= a11*a21*a321,mk) ffffDDDDN a11a21a33N= a11*a21*a331,mk) ffffDDDDN a11a22a30N= a11*a22*a30 fffDDDDN a11a22a31N= a11*a22*a31m -->ip)u=D0....a11a22a32N= a11*a22*a321,mk) p)u=D0....a11a22a33N= a11*a22*a331,mk) fff=D0....a11a23a30N= a11*a23*a30 fffDDDDN a11a23a31N= a11*a23*a31m -->ip)u=D0....a11a23a32N= a11*a23*a321,mk) ffffDDDDN a11a23a33N= a11*a23*a331,mk) ffffDDDDN a12a20a30N= a12*a20*a30 fffDDDDN a12a20a31N= a12*a20*a31m -->ip)ufDDDDN a12a20a32N= a12*a20*a321,mk) p)ufDDDDN a12a20a33N= a12*a20*a331,mk) ffffDDDDN a12a21a30N= a12*a21*a30 fffDDDDN a12a21a31N= a12*a21*a31m -->ip)u=D0....a12a21a32N= a12*a21*a321,m->ip)u=D0....a12a21a33N= a12*a21*a331,mk) ffffDDDDN a12a22a30N= a12*a22*a30 fffDDDDN a12a22a31N= a12*a22*a31m -->ip)ufDDDDN a12a22a32N= a12*a22*a321,mk) ffffDDDDN a12a22a33N= a12*a22*a331,mk) ffffDDDDN a12a23a30N= a12*a23*a30 fffDDDDN a12a23a31N= a12*a23*a31m -->ip)ufDDDDN a12a23a32N= a12*a23*a321,mk) ffffDDDDN a12a23a33N= a12*a23*a331,mk) ffffDDDDN a13a20a30N= a13*a20*a30 fffDDDDN a13a20a31N= a13*a20*a31m -->ip)u=D0....a13a20a32N= a13*a20*a321,mk) ffffDDDDN a13a20a33N= a13*a20*a331,mk) ffffDDDDN a13a21a30N= a13*a21*a30 fffDDDDN a13a21a31N= a13*a21*a31m -->ip)u=D0....a13a21a32N= a13*a21*a321,m->ip)u=D0....a13a21a33N= a13*a21*a331,mk) fff=D0....a13a22a30N= a13*a22*a30 fffDDDDN a13a22a31N= a13*a22*a31m -->ip)u=D0....a13a22a32N= a13*a22*a321,mk) ffffDDDDN a13a22a33N= a13*a22*a331,mk) ffffDDDDN a13a23a30N= a13*a23*a30 fffDDDDN a13a23a31N= a13*a23*a31m -->ip)ufDDDDN a13a23a32N= a13*a23*a321,mk) p)ufDDDDN a13a23a33N= a13*a23*a331,poi,tsun-ip10,en20,en30,e! 2d=poi,tsun-ip10,en20,en30,e! 2d+& &a10a20a30*un-iq) poi,tsun-ip11,en20,en30,e! 2d=poi,tsun-ip11,en20,en30,e! 2d+& &a11a20a30*un-iq) poi,tsun-ip12,en20,en30,e! 2d=poi,tsun-ip12,en20,en30,e! 2d+& &a12a20a30*un-iq) poi,tsun-ip13,en20,en30,e! 2d=poi,tsun-ip13,en20,en30,e! 2d+& &a13a20a30*un-iq) poi,tsun-ip10,en21,en30,e! 2d=poi,tsun-ip10,en21,en30,e! 2d+& &a10a21a30*un-iq) poi,tsun-ip11,en21,en30,e! 2d=poi,tsun-ip11,en21,en30,e! 2d+& &a11a21a30*un-iq) poi,tsun-ip12,en21,en30,e! 2d=poi,tsun-ip12,en21,en30,e! 2d+& &a12a21a30*un-iq) poi,tsun-ip13,en21,en30,e! 2d=poi,tsun-ip13,en21,en30,e! 2d+& &a13a21a30*un-iq) poi,tsun-ip10,en22,en30,e! 2d=poi,tsun-ip10,en22,en30,e! 2d+& &a10a22a30*un-iq) poi,tsun-ip11,en22,en30,e! 2d=poi,tsun-ip11,en22,en30,e! 2d+& &a11a22a30*un-iq) poi,tsun-ip12,en22,en30,e! 2d=poi,tsun-ip12,en22,en30,e! 2d+& &a12a22a30*un-iq) poi,tsun-ip13,en22,en30,e! 2d=poi,tsun-ip13,en22,en30,e! 2d+& &a13a22a30*un-iq) poi,tsun-ip10,en23,en30,e! 2d=poi,tsun-ip10,en23,en30,e! 2d+& &a10a23a30*un-iq) poi,tsun-ip11,en23,en30,e! 2d=poi,tsun-ip11,en23,en30,e! 2d+& &a11a23a30*un-iq) poi,tsun-ip12,en23,en30,e! 2d=poi,tsun-ip12,en23,en30,e! 2d+& &a12a23a30*un-iq) poi,tsun-ip13,en23,en30,e! 2d=poi,tsun-ip13,en23,en30,e! 2d+& &a13a23a30*un-iq) poi,tsun-ip10,en20,en31,e! 2d=poi,tsun-ip10,en20,en31,e! 2d+& &a10a20a31*un-iq) poi,tsun-ip11,en20,en31,e! 2d=poi,tsun-ip11,en20,en31,e! 2d+& &a11a20a31*un-iq) poi,tsun-ip12,en20,en31,e! 2d=poi,tsun-ip12,en20,en31,e! 2d+& &a12a20a31*un-iq) poi,tsun-ip13,en20,en31,e! 2d=poi,tsun-ip13,en20,en31,e! 2d+& &a13a20a31*un-iq) poi,tsun-ip10,en21,en31,e! 2d=poi,tsun-ip10,en21,en31,e! 2d+& &a10a21a31*un-iq) poi,tsun-ip11,en21,en31,e! 2d=poi,tsun-ip11,en21,en31,e! 2d+& &a11a21a31*un-iq) poi,tsun-ip12,en21,en31,e! 2d=poi,tsun-ip12,en21,en31,e! 2d+& &a12a21a31*un-iq) poi,tsun-ip13,en21,en31,e! 2d=poi,tsun-ip13,en21,en31,e! 2d+& &a13a21a31*un-iq) poi,tsun-ip10,en22,en31,e! 2d=poi,tsun-ip10,en22,en31,e! 2d+& &a10a22a31*un-iq) poi,tsun-ip11,en22,en31,e! 2d=poi,tsun-ip11,en22,en31,e! 2d+& &a11a22a31*un-iq) poi,tsun-ip12,en22,en31,e! 2d=poi,tsun-ip12,en22,en31,e! 2d+& &a12a22a31*un-iq) poi,tsun-ip13,en22,en31,e! 2d=poi,tsun-ip13,en22,en31,e! 2d+& &a13a22a31*un-iq) poi,tsun-ip10,en23,en31,e! 2d=poi,tsun-ip10,en23,en31,e! 2d+& &a10a23a31*un-iq) poi,tsun-ip11,en23,en31,e! 2d=poi,tsun-ip11,en23,en31,e! 2d+& &a11a23a31*un-iq) poi,tsun-ip12,en23,en31,e! 2d=poi,tsun-ip12,en23,en31,e! 2d+& &a12a23a31*un-iq) poi,tsun-ip13,en23,en31,e! 2d=poi,tsun-ip13,en23,en31,e! 2d+& &a13a23a31*un-iq) poi,tsun-ip10,en20,en32,e! 2d=poi,tsun-ip10,en20,en32,e! 2d+& &a10a20a32*un-iq) poi,tsun-ip11,en20,en32,e! 2d=poi,tsun-ip11,en20,en32,e! 2d+& &a11a20a32*un-iq) poi,tsun-ip12,en20,en32,e! 2d=poi,tsun-ip12,en20,en32,e! 2d+& &a12a20a32*un-iq) poi,tsun-ip13,en20,en32,e! 2d=poi,tsun-ip13,en20,en32,e! 2d+& &a13a20a32*un-iq) poi,tsun-ip10,en21,en32,e! 2d=poi,tsun-ip10,en21,en32,e! 2d+& &a10a21a32*un-iq) poi,tsun-ip11,en21,en32,e! 2d=poi,tsun-ip11,en21,en32,e! 2d+& &a11a21a32*un-iq) poi,tsun-ip12,en21,en32,e! 2d=poi,tsun-ip12,en21,en32,e! 2d+& &a12a21a32*un-iq) poi,tsun-ip13,en21,en32,e! 2d=poi,tsun-ip13,en21,en32,e! 2d+& &a13a21a32*un-iq) poi,tsun-ip10,en22,en32,e! 2d=poi,tsun-ip10,en22,en32,e! 2d+& &a10a22a32*un-iq) poi,tsun-ip11,en22,en32,e! 2d=poi,tsun-ip11,en22,en32,e! 2d+& &a11a22a32*un-iq) poi,tsun-ip12,en22,en32,e! 2d=poi,tsun-ip12,en22,en32,e! 2d+& &a12a22a32*un-iq) poi,tsun-ip13,en22,en32,e! 2d=poi,tsun-ip13,en22,en32,e! 2d+& &a13a22a32*un-iq) poi,tsun-ip10,en23,en32,e! 2d=poi,tsun-ip10,en23,en32,e! 2d+& &a10a23a32*un-iq) poi,tsun-ip11,en23,en32,e! 2d=poi,tsun-ip11,en23,en32,e! 2d+& &a11a23a32*un-iq) poi,tsun-ip12,en23,en32,e! 2d=poi,tsun-ip12,en23,en32,e! 2d+& &a12a23a32*un-iq) poi,tsun-ip13,en23,en32,e! 2d=poi,tsun-ip13,en23,en32,e! 2d+& &a13a23a32*un-iq) poi,tsun-ip10,en20,en33,e! 2d=poi,tsun-ip10,en20,en33,e! 2d+& &a10a20a33*un-iq) poi,tsun-ip11,en20,en33,e! 2d=poi,tsun-ip11,en20,en33,e! 2d+& &a11a20a33*un-iq) poi,tsun-ip12,en20,en33,e! 2d=poi,tsun-ip12,en20,en33,e! 2d+& &a12a20a33*un-iq) poi,tsun-ip13,en20,en33,e! 2d=poi,tsun-ip13,en20,en33,e! 2d+& &a13a20a33*un-iq) poi,tsun-ip10,en21,en33,e! 2d=poi,tsun-ip10,en21,en33,e! 2d+& &a10a21a33*un-iq) poi,tsun-ip11,en21,en33,e! 2d=poi,tsun-ip11,en21,en33,e! 2d+& &a11a21a33*un-iq) poi,tsun-ip12,en21,en33,e! 2d=poi,tsun-ip12,en21,en33,e! 2d+& &a12a21a33*un-iq) poi,tsun-ip13,en21,en33,e! 2d=poi,tsun-ip13,en21,en33,e! 2d+& &a13a21a33*un-iq) poi,tsun-ip10,en22,en33,e! 2d=poi,tsun-ip10,en22,en33,e! 2d+& &a10a22a33*un-iq) poi,tsun-ip11,en22,en33,e! 2d=poi,tsun-ip11,en22,en33,e! 2d+& &a11a22a33*un-iq) poi,tsun-ip12,en22,en33,e! 2d=poi,tsun-ip12,en22,en33,e! 2d+& &a12a22a33*un-iq) poi,tsun-ip13,en22,en33,e! 2d=poi,tsun-ip13,en22,en33,e! 2d+& &a13a22a33*un-iq) poi,tsun-ip10,en23,en33,e! 2d=poi,tsun-ip10,en23,en33,e! 2d+& &a10a23a33*un-iq) poi,tsun-ip11,en23,en33,e! 2d=poi,tsun-ip11,en23,en33,e! 2d+& &a11a23a33*un-iq) poi,tsun-ip12,en23,en33,e! 2d=poi,tsun-ip12,en23,en33,e! 2d+& &a12a23a33*un-iq) poi,tsun-ip13,en23,en33,e! 2d=poi,tsun-ip13,en23,en33,e! 2d+& &a13a23a33*un-iq) p)ufDDDDN ENDDOffDDDDN ! iq #endifDDDN )ufDDDDN END DOffDDDDN DDDDN ! loop over ! 2s1,mk) fCASE(ppm_param_rmsh_kernel_bsp2)1,mk) fff!----------------------------------------------------------------------- DN DDDDN ! B-spline 2 (Witch hat) p)ufDDDD!----------------------------------------------------------------------- DN DDDDNDO i! 2 = 1,topo%ns 2list #if __MODE == __VEC p)ufDDDD!------------------------------------------------------------------------ DN DDDDN ! Unrolled versions for 4-vectors1,mk) fffD!------------------------------------------------------------------------ DN DDDDN IF(lda.EQ.4) THEN1,mk) ffffDDDDDO ip = 1,store_info(e! 2d1,mk) p)ufDDDDN 1,mk) p)ufDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d1,mk) ffffDDDDN 1,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)11,mk) ffffDDDDN ep10N= INT(x0(1))N+ 1m -->ip)u=D0.... ep20N= INT(x0(2))N+ 1m -->ip)u=D0.... ep30N= INT(x0(3))N+ 1m1,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0.....ip31N= ep30N+ 1mu=D0.....1,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10-1,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20-1,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30-1,mk),mk) ffffDDDDN 11,mk) ffffDDDDN x10N= xp11,mk) ffffDDDDN x11N= x10N- 1.0_mk11,mk) ffffDDDDN x20N= xp21,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN .1,mk) ffffDDDDN x30N= xp31,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN .1,mk) ffffDDDDN a10N= 1.0_mkN- x101,mk) ffffDDDDN a20N= 1.0_mkN- x201,mk) ffffDDDDN a30N= 1.0_mkN- x3011,mk) ffffDDDDN a11N= 1.0_mkN+ x111,mk) ffffDDDDN a21N= 1.0_mkN+ x211,mk) ffffDDDDN a31N= 1.0_mkN+ x3111,mk) ffffDDDDN poi,tsun-1,en10,en20,en30,e! 2dN= poi,tsun-1,en10,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en10,en20,en31,e! 2dN= poi,tsun-1,en10,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a31*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en30,e! 2dN= poi,tsun-1,en10,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en31,e! 2dN= poi,tsun-1,en10,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a31*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en30,e! 2dN= poi,tsun-1,en11,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en31,e! 2dN= poi,tsun-1,en11,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a31*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en30,e! 2dN= poi,tsun-1,en11,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en31,e! 2dN= poi,tsun-1,en11,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a31*un-awiq) ,mk) ffffDDDDN ,mk) ffffDDDDN poi,tsun-2,en10,en20,en30,e! 2dN= poi,tsun-2,en10,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-2,en10,en20,en31,e! 2dN= poi,tsun-2,en10,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-2,en10,en21,en30,e! 2dN= poi,tsun-2,en10,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-2,en10,en21,en31,e! 2dN= poi,tsun-2,en10,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-2,en11,en20,en30,e! 2dN= poi,tsun-2,en11,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-2,en11,en20,en31,e! 2dN= poi,tsun-2,en11,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-2,en11,en21,en30,e! 2dN= poi,tsun-2,en11,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-2,en11,en21,en31,e! 2dN= poi,tsun-2,en11,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a31*un-2wiq) ,mk) ffffDDDDN ,mk) ffffDDDDN poi,tsun-3,en10,en20,en30,e! 2dN= poi,tsun-3,en10,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-3,en10,en20,en31,e! 2dN= poi,tsun-3,en10,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a31*un-3wiq) ,mk) ffffDDDDN poi,tsun-3,en10,en21,en30,e! 2dN= poi,tsun-3,en10,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-3,en10,en21,en31,e! 2dN= poi,tsun-3,en10,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a31*un-3wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en20,en30,e! 2dN= poi,tsun-3,en11,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en20,en31,e! 2dN= poi,tsun-3,en11,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a31*un-3wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en21,en30,e! 2dN= poi,tsun-3,en11,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en21,en31,e! 2dN= poi,tsun-3,en11,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a31*un-3wiq) ,mk) ffffDDDDN ,mk) ffffDDDDN poi,tsun-4,en10,en20,en30,e! 2dN= poi,tsun-4,en10,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a30*un-4wiq) ,mk) ffffDDDDN poi,tsun-4,en10,en20,en31,e! 2dN= poi,tsun-4,en10,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a20*a31*un-4wiq) ,mk) ffffDDDDN poi,tsun-4,en10,en21,en30,e! 2dN= poi,tsun-4,en10,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a30*un-4wiq) ,mk) ffffDDDDN poi,tsun-4,en10,en21,en31,e! 2dN= poi,tsun-4,en10,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a10*a21*a31*un-4wiq) ,mk) ffffDDDDN poi,tsun-4,en11,en20,en30,e! 2dN= poi,tsun-4,en11,en20,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a30*un-4wiq) ,mk) ffffDDDDN poi,tsun-4,en11,en20,en31,e! 2dN= poi,tsun-4,en11,en20,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a20*a31*un-4wiq) ,mk) ffffDDDDN poi,tsun-4,en11,en21,en30,e! 2dN= poi,tsun-4,en11,en21,en30,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a30*un-4wiq) ,mk) ffffDDDDN poi,tsun-4,en11,en21,en31,e! 2dN= poi,tsun-4,en11,en21,en31,e! 2dN+ &1,mk) ffffDDDDN & a11*a21*a31*un-4wiq) ,mk) ffffDDDDN ,mk) ffffDDDEND DO1,mk) fff!------------------------------------------------------------------------1,mk) fff! Unrolled versions for 3-vectors1,mk) fff!------------------------------------------------------------------------ DN DDDDN ELSEIF (lda .EQ. 3) THEN1,mk) ffffDDDDO ip = 1,store_info(e! 2d1,mk) p)ufDDDDN 1,mk) p)ufDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d1,mk) ffffDDDDN 1,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)11,mk) ffffDDDDN ep10N= INT(x0(1))N+ 1m -->ip)u=D0.... ep20N= INT(x0(2))N+ 1m -->ip)u=D0.... ep30N= INT(x0(3))N+ 1m1,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0.....ip31N= ep30N+ 1mu=D0.....1,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10-1,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20-1,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30-1,mk),mk) ffffDDDDN 11,mk) ffffDDDDN x10N= xp11,mk) ffffDDDDN x11N= x10N- 1.0_mk11,mk) ffffDDDDN x20N= xp21,mk) ffffDDDDN x21N= x20N- 1.0_mk11,mk) ffffDDDDN x30N= xp31,mk) ffffDDDDN x31N= x30N- 1.0_mk11,mk) ffffDDDDN a10N= 1.0_mkN- x101,mk) ffffDDDDN a20N= 1.0_mkN- x201,mk) ffffDDDDN a30N= 1.0_mkN- x3011,mk) ffffDDDDN a11N= 1.0_mkN+ x111,mk) ffffDDDDN a21N= 1.0_mkN+ x211,mk) ffffDDDDN a31N= 1.0_mkN+ x31111,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0.... a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0.... a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m -->ip)ufDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m -->ip)u=D0.... #ifdef __NOMICROINSTRUCTIONS1,mk) ffffDDDDN poi,tsun-1,en10,en20,en30,e! 2d=poi,tsun-1,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en20,en30,e! 2d=poi,tsun-2,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en10,en20,en30,e! 2d=poi,tsun-3,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en30,e! 2d=poi,tsun-1,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en20,en30,e! 2d=poi,tsun-2,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en20,en30,e! 2d=poi,tsun-3,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en30,e! 2d=poi,tsun-1,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en21,en30,e! 2d=poi,tsun-2,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en10,en21,en30,e! 2d=poi,tsun-3,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en30,e! 2d=poi,tsun-1,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en21,en30,e! 2d=poi,tsun-2,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en21,en30,e! 2d=poi,tsun-3,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-3wiq) ,mk) ffffDDDDN poi,tsun-1,en10,en20,en31,e! 2d=poi,tsun-1,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en20,en31,e! 2d=poi,tsun-2,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en10,en20,en31,e! 2d=poi,tsun-3,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-3wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en31,e! 2d=poi,tsun-1,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en20,en31,e! 2d=poi,tsun-2,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en20,en31,e! 2d=poi,tsun-3,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-3wiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en31,e! 2d=poi,tsun-1,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en21,en31,e! 2d=poi,tsun-2,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en10,en21,en31,e! 2d=poi,tsun-3,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-3wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en31,e! 2d=poi,tsun-1,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en21,en31,e! 2d=poi,tsun-2,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-3,en11,en21,en31,e! 2d=poi,tsun-3,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-3wiq) #else ,mk) ffffDDDDN poi,tsun-1:3,en10,en20,en30,e! 2d=poi,tsun-1:3,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-a:3wiq) ,mk) ffffDDDDN poi,tsun-1:3,en11,en20,en30,e! 2d=poi,tsun-1:3,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-a:3wiq) ,mk) ffffDDDDN poi,tsun-1:3,en10,en21,en30,e! 2d=poi,tsun-1:3,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-a:3wiq) ,mk) ffffDDDDN poi,tsun-1:3,en11,en21,en30,e! 2d=poi,tsun-1:3,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-a:3wiq) ,mk) ffffDDDDN poi,tsun-1:3,en10,en20,en31,e! 2d=poi,tsun-1:3,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-a:3wiq) ,mk) ffffDDDDN poi,tsun-1:3,en11,en20,en31,e! 2d=poi,tsun-1:3,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-a:3wiq) ,mk) ffffDDDDN poi,tsun-1:3,en10,en21,en31,e! 2d=poi,tsun-1:3,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-a:3wiq) ,mk) ffffDDDDN poi,tsun-1:3,en11,en21,en31,e! 2d=poi,tsun-1:3,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-a:3wiq) #endif ,mk) ffffDDDEND DO1,mk) fff!------------------------------------------------------------------------1,mk) fff! Unrolled versions for 2-vectors1,mk) fff!------------------------------------------------------------------------ DN DDDDNELSEIF (lda .EQ. 2) THEN1,mk) ffffDDDDO ip = 1,store_info(e! 2d1,mk) p)ufDDDDN 1,mk) p)ufDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end111,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d1,mk) ffffDDDDN 1,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)11,mk) ffffDDDDN ep10N= INT(x0(1))N+ 1m -->ip)u=D0.... ep20N= INT(x0(2))N+ 1m -->ip)u=D0.... ep30N= INT(x0(3))N+ 1m1,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0.....ip31N= ep30N+ 1mu=D0.....1,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10-1,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20-1,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30-1,mk),mk) ffffDDDDN 11,mk) ffffDDDDN x10N= xp11,mk) ffffDDDDN x11N= x10N- 1.0_mk11,mk) ffffDDDDN x20N= xp21,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN 1,mk) ffffDDDDN x30N= xp31,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN .1,mk) ffffDDDDN a10N= 1.0_mkN- x101,mk) ffffDDDDN a20N= 1.0_mkN- x201,mk) ffffDDDDN a30N= 1.0_mkN- x3011,mk) ffffDDDDN a11N= 1.0_mkN+ x111,mk) ffffDDDDN a21N= 1.0_mkN+ x211,mk) ffffDDDDN a31N= 1.0_mkN+ x31111,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0.... a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0.... a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m - fffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m -->ip)u=D0.... #ifdef __NOMICROINSTRUCTIONS1,mk) ffffDDDDN poi,tsun-1,en10,en20,en30,e! 2d=poi,tsun-1,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en20,en30,e! 2d=poi,tsun-2,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en30,e! 2d=poi,tsun-1,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en20,en30,e! 2d=poi,tsun-2,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en30,e! 2d=poi,tsun-1,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en21,en30,e! 2d=poi,tsun-2,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en30,e! 2d=poi,tsun-1,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en21,en30,e! 2d=poi,tsun-2,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-2wiq) ,mk) ffffDDDDN poi,tsun-1,en10,en20,en31,e! 2d=poi,tsun-1,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en20,en31,e! 2d=poi,tsun-2,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en31,e! 2d=poi,tsun-1,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en20,en31,e! 2d=poi,tsun-2,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en31,e! 2d=poi,tsun-1,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en10,en21,en31,e! 2d=poi,tsun-2,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-2wiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en31,e! 2d=poi,tsun-1,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-awiq) ,mk) ffffDDDDN poi,tsun-2,en11,en21,en31,e! 2d=poi,tsun-2,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-2wiq) #else ,mk) ffffDDDDN poi,tsun-1:2,en10,en20,en30,e! 2d=poi,tsun-1:2,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-a:2wiq) ,mk) ffffDDDDN poi,tsun-1:2,en11,en20,en30,e! 2d=poi,tsun-1:2,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-a:2wiq) ,mk) ffffDDDDN poi,tsun-1:2,en10,en21,en30,e! 2d=poi,tsun-1:2,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-a:2wiq) ,mk) ffffDDDDN poi,tsun-1:2,en11,en21,en30,e! 2d=poi,tsun-1:2,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-a:2wiq) ,mk) ffffDDDDN poi,tsun-1:2,en10,en20,en31,e! 2d=poi,tsun-1:2,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-a:2wiq) ,mk) ffffDDDDN poi,tsun-1:2,en11,en20,en31,e! 2d=poi,tsun-1:2,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-a:2wiq) ,mk) ffffDDDDN poi,tsun-1:2,en10,en21,en31,e! 2d=poi,tsun-1:2,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-a:2wiq) ,mk) ffffDDDDN poi,tsun-1:2,en11,en21,en31,e! 2d=poi,tsun-1:2,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-a:2wiq) #endif ,mk) ffffDDDENDDO1,mk) fff!------------------------------------------------------------------------1,mk) fff! Unrolled versions for 1-vectors1,mk) fff!------------------------------------------------------------------------ DN DDDDNELSEIF (lda .EQ. 1) THEN1,mk) ffffDDDDO ip = 1,store_info(e! 2d1,mk) p)ufDDDDN 1,mk) p)ufDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d1,mk) ffffDDDDN 1,mk) ffffDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)1,mk) ffffDDDDN 1,mk) ffffDDDDN ep10N= INT(x0(1))N+ 1m -->ip)u=D0.... ep20N= INT(x0(2))N+ 1m -->ip)u=D0.... ep30N= INT(x0(3))N+ 1m1,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0.....ip31N= ep30N+ 1mu=D0.....1,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10-1,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20-1,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30-1,mk),mk) ffffDDDDN 11,mk) ffffDDDDN x10N= xp11,mk) ffffDDDDN x11N= x10N- 1.0_mk11,mk) ffffDDDDN x20N= xp21,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN 1,mk) ffffDDDDN x30N= xp31,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN .1,mk) ffffDDDDN a10N= 1.0_mkN- x101,mk) ffffDDDDN a20N= 1.0_mkN- x201,mk) ffffDDDDN a30N= 1.0_mkN- x3011,mk) ffffDDDDN a11N= 1.0_mkN+ x111,mk) ffffDDDDN a21N= 1.0_mkN+ x211,mk) ffffDDDDN a31N= 1.0_mkN+ x311,mk) ffffDDDDN .11,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0.... a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0.... a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m - fffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m1,mk) ffffDDDDN poi,tsun-1,en10,en20,en30,e! 2d=poi,tsun-1,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en30,e! 2d=poi,tsun-1,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en30,e! 2d=poi,tsun-1,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en30,e! 2d=poi,tsun-1,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en10,en20,en31,e! 2d=poi,tsun-1,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en20,en31,e! 2d=poi,tsun-1,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en10,en21,en31,e! 2d=poi,tsun-1,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-awiq) ,mk) ffffDDDDN poi,tsun-1,en11,en21,en31,e! 2d=poi,tsun-1,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-awiq) ,mk) ffffDDDENDDO1,mk) fff!------------------------------------------------------------------------1,mk) fff! All other lda are NOT UNROLLED. Vectorization will be over lda!1,mk) fff!------------------------------------------------------------------------ DN DDDDNELSE1,mk) ffffDDDDO ip = 1,store_info(e! 2d1,mk) p)ufDDDDN 1,mk) p)ufDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d1,mk) f)ufDDDDN 1,mk) p)ufDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)1,mk) ffffDDDDN 1,mk) ffffDDDDN ep10N= INT(x0(1))N+ 1m -->ip)u=D0.... ep20N= INT(x0(2))N+ 1m -->ip)u=D0.... ep30N= INT(x0(3))N+ 1m1,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0.....ip31N= ep30N+ 1mu=D0.....1,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10-1,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20-1,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30-1,mk),mk)))))))))))))11,mk) ffffDDDDN x10N= xp11,mk) ffffDDDDN x11N= x10N- 1.0_mk11,mk) ffffDDDDN x20N= xp21,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN 1,mk) ffffDDDDN x30N= xp31,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN .1,mk) ffffDDDDN a10N= 1.0_mkN- x101,mk) ffffDDDDN a20N= 1.0_mkN- x201,mk) ffffDDDDN a30N= 1.0_mkN- x3011,mk) ffffDDDDN a11N= 1.0_mkN+ x111,mk) ffffDDDDN a21N= 1.0_mkN+ x211,mk) ffffDDDDN a31N= 1.0_mkN+ x311,mk) ffffDDDDN .1,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0.... a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0.... a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m - fffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m1,mk) ffffDDDDN DO ldn=1,ldam1,mk) ffffDDDDN poi,tsun-ldn,en10,en20,en30,e! 2d=poi,tsun-ldn,en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-ldn,eq) ,mk) ffffDDDDN poi,tsun-ldn,en11,en20,en30,e! 2d=poi,tsun-ldn,en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-ldn,eq) ,mk) ffffDDDDN poi,tsun-ldn,en10,en21,en30,e! 2d=poi,tsun-ldn,en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-ldn,eq) ,mk) ffffDDDDN poi,tsun-ldn,en11,en21,en30,e! 2d=poi,tsun-ldn,en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-ldn,eq) ,mk) ffffDDDDN poi,tsun-ldn,en10,en20,en31,e! 2d=poi,tsun-ldn,en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-ldn,eq) ,mk) ffffDDDDN poi,tsun-ldn,en11,en20,en31,e! 2d=poi,tsun-ldn,en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-ldn,eq) ,mk) ffffDDDDN poi,tsun-ldn,en10,en21,en31,e! 2d=poi,tsun-ldn,en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-ldn,eq) ,mk) ffffDDDDN poi,tsun-ldn,en11,en21,en31,e! 2d=poi,tsun-ldn,en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-ldn,eq) ,mk) ffffDDDDN ENDDOffDD! lda ,mk) ffffDDDENDDO ffffDDD! iq ffffDDDEND IFk) ffffDDD! unrolled lda cases #elif __MODE == __SCA1,mk) ffffDDDDO ip = 1,store_info(e! 2d1,mk) p)ufDDDDN 1,mk) p)ufDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN !x0(1)N = (xp-awiq)-min_phys-awtopoid))*dxi(1)1,mk) ffffDDDDN !x0(2)N = (xp-2wiq)-min_phys-2wtopoid))*dxi(2)1,mk) ffffDDDDN !x0(3)N = (xp-3wiq)-min_phys-3wtopoid))*dxi(3d11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN x0(3)N= (xp-3wiq)-min_! 2(3,e! 2l))*dxi(3d1,mk) f)ufDDDDN 1,mk) p)ufDDDDN !ip11N= INT(x0(1))+2-istart(1,e! 2l)1,mk) ffffDDDDN !ip21N= INT(x0(2))+2-istart(2,e! 2l)1,mk) ffffDDDDN !ip31N= INT(x0(3))+2-istart(3,e! 2l)1,mk) ffffDDD1,mk) ffffDDDDN ep10N= INT(x0(1))N+ 1m -->ip)u=D0.... ep20N= INT(x0(2))N+ 1m -->ip)u=D0.... ep30N= INT(x0(3))N+ 1m1,mk) ffffDDDDN ep11N= ep10N+ 1m -->ip)u=DDDDN ep21N= ep20N+ 1m -->ip)u=D0.....ip31N= ep30N+ 1mu=D0.....1,mk) ffffDDDDN xp1N= x0(1)-REAL:ep10-1,mk)1,mk) ffffDDDDN xp2N= x0(2)-REAL:ep20-1,mk)1,mk) ffffDDDDN xp3N= x0(3)-REAL:ep30-1,mk),mk)))))))))))))11,mk) ffffDDDDN x10N= xp11,mk) ffffDDDDN x11N= x10N- 1.0_mk11,mk) ffffDDDDN x20N= xp21,mk) ffffDDDDN x21N= x20N- 1.0_mk1,mk) ffffDDDDN 1,mk) ffffDDDDN x30N= xp31,mk) ffffDDDDN x31N= x30N- 1.0_mk1,mk) ffffDDDDN .1,mk) ffffDDDDN a10N= 1.0_mkN- x101,mk) ffffDDDDN a20N= 1.0_mkN- x201,mk) ffffDDDDN a30N= 1.0_mkN- x3011,mk) ffffDDDDN a11N= 1.0_mkN+ x111,mk) ffffDDDDN a21N= 1.0_mkN+ x211,mk) ffffDDDDN a31N= 1.0_mkN+ x311,mk) ffffDDDDN .1,mk) ffffDDDDN a10a20a30N= a10*a20*a30 fffDDDDN a10a20a31N= a10*a20*a31m -->ip)u=D0.... a10a21a30N= a10*a21*a30 fffDDDDN a10a21a31N= a10*a21*a31m -->ip)u=D0.... a11a20a30N= a11*a20*a30 fffDDDDN a11a20a31N= a11*a20*a31m - fffDDDDN a11a21a30N= a11*a21*a30 fffDDDDN a11a21a31N= a11*a21*a31m1 ,mk) ffffDDDDN poi,tsun-en10,en20,en30,e! 2d=poi,tsun-en10,en20,en30,e! 2d+&1,mk) ffffDDDDN &a10a20a30*un-iq) ,mk) ffffDDDDN poi,tsun-en11,en20,en30,e! 2d=poi,tsun-en11,en20,en30,e! 2d+&1,mk) ffffDDDDN &a11a20a30*un-iq) ,mk) ffffDDDDN poi,tsun-en10,en21,en30,e! 2d=poi,tsun-en10,en21,en30,e! 2d+&1,mk) ffffDDDDN &a10a21a30*un-iq) ,mk) ffffDDDDN poi,tsun-en11,en21,en30,e! 2d=poi,tsun-en11,en21,en30,e! 2d+&1,mk) ffffDDDDN &a11a21a30*un-iq) ,mk) ffffDDDDN poi,tsun-en10,en20,en31,e! 2d=poi,tsun-en10,en20,en31,e! 2d+&1,mk) ffffDDDDN &a10a20a31*un-iq) ,mk) ffffDDDDN poi,tsun-en11,en20,en31,e! 2d=poi,tsun-en11,en20,en31,e! 2d+&1,mk) ffffDDDDN &a11a20a31*un-iq) ,mk) ffffDDDDN poi,tsun-en10,en21,en31,e! 2d=poi,tsun-en10,en21,en31,e! 2d+&1,mk) ffffDDDDN &a10a21a31*un-iq) ,mk) ffffDDDDN poi,tsun-en11,en21,en31,e! 2d=poi,tsun-en11,en21,en31,e! 2d+&1,mk) ffffDDDDN &a11a21a31*un-iq) ,mk) ffffDDDENDDO ffffDDD! iq #endif ) ffffDDDEND DOffDDDDN DDDDN ! loop over ! 2s1,mk) fCASE DEFAULT ) ffffDDDinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDD'Only Mp4 and Bsp2Nare available. Use ppm_rmsh_remesh for other kernels.', & ) fff&ffffDDD__LINE__,info) ,mk) fEND SELECTDN DDDDN ! kernel type #else ,mk) f!-------------------------------------------------------------------------- DN DDD! --- 2D --- ,mk) f!-------------------------------------------------------------------------- DN DDD! loop over ! 2s1,mk) fndata => p_mesh%nnodes 1,mk) fDO i! 2 = 1,topo%ns 2list ) ffffDDDi! 2l = topo%e! 2list(e! 2d1,mk) ffff1,mk) ffffDO j=1-ghostsize(2),ndata(2,e! 2l)+ghostsize(2)1,mk) ffffDDD1,mk) ffffDDDDO i=1-ghostsize(1),ndata(1,e! 2l)+ghostsize(1)1#if __MODE == __VEC p)ufDDDDfffDDDDO ldn=1,ldam poi,tsun-ldn,e,j,e! 2d = 0.0_mk1,mk) ffffDDDDN END DO1#elsefffDDD1,mk) ffffDDD poi,tsun-e,j,e! 2d = 0.0_mk1#endif ,mk) ffffDDDEND DO1,mk) fffDEND DO1,mk) fEND DO1,mk) fIF(np.EQ.0) GOTO 99971,mk) fSELECTDCASE(kernel)1,mk) fCASE(ppm_param_rmsh_kernel_mp4d1,mk) ffff1,mk) ffff!-----------------------------------------------------------------1,mk) ffff! M Prime Four1,mk) ffff!-----------------------------------------------------------------1,mk) ffffDO i! 2 = 1,topo%ns 2list ) ffffDDDDDD1,mk) ffffDDDDO ip = 1,store_info(e! 2d1,mk) p)ufDDDDN 1,mk) p)ufDDDDN e! 2l = topo%e! 2list(e! 2d1,mk) ffffDDDDN eqDDN = list_! 2(e! 2,end11,mk) ffffDDDDN x0(1)N= (xp-awiq)-min_! 2(1,e! 2l))*dxi(1)1,mk) ffffDDDDN x0(2)N= (xp-2wiq)-min_! 2(2,e! 2l))*dxi(2)1,mk) ffffDDDDN 1,mk) ffffDDDDN ep1N= INT(x0(1))+1m - fffDDDDN ip2N= INT(x0(2))+1m1,mk) ffffDDDDN xp1N= x0(1)-AINT(x0(1))1,mk) ffffDDDDN xp2N= x0(2)-AINT(x0(2))m1,mk) ffffDDDDN DO jjN= -1,21,mk) ffffDDDDN .1,mk) ffffDDDDN x2N= ABS(xp2N- REAL:jj,mk)) ,mk) ffffDDDDN ,mk) ffffDDDDN IF(x2.LT.1.0_mk) THEN1,mk) ffffDDDDDDDDDDDDwx2N= 1.0_mkN- x2**2*(2.5_mk-1.5_mk*x2)1,mk) ffffDDDDN DNELSE1,mk) ffffDDDDDDDDDDDDwx2N= 2.0_mkN+ (-4.0_mkN+ &1,mk) ffffDDDDN ff&(2.5_mkN- 0.5_mkN* x2)*x2)*x21,mk) ffffDDDDN DNEND IF ,mk) ffffDDDDN ,mk) ffffDDDDN DO ii =N- 1,21,mk) ffffDDDDN . ,mk) ffffDDDDN x1N= ABS(xp1N- REAL:ii,mk)) ,mk) ffffDDDDN ,mk) ffffDDDDN IF(x1.LT.1.0_MK) THEN1,mk) ffffDDDDDDDDDDDD DDwx1N= 1.0_mkN- x1**2*(2.5_mkN- &1,mk) ffffDDDDN ff ff&f1.5_mk*x1)1,mk) ffffDDDDN ELSE1,mk) ffffDDDDDDDDDDDD DDwx1N= 2.0_mkN+ (-4.0_mkN+ &1,mk) ffffDDDDN ff ff&f(2.5_mkN- 0.5_mk*x1)*x1)*x11,mk) ffffDDDDN END IF #if __MODE == __SCAmk) ffffDDDDN 1,mk) ffffDDDDN poi,tsun-ei+ep1,jj+ep2,e! 2d &1,mk) ffffDDDDN ff&= poi,tsun-ei+ep1,jj+ep2,e! 2d &1,mk) ffffDDDDN ff&DDDDN ff+Dwx1*wx2*un-iq) #else ,mk) ffffDDDDN DO ldn=1,ldam poi,tsun-ldn,ei+ep1,jj+ep2,e! 2d &1,mk) ffffDDDDN ff ff&= poi,tsun-ldn,ei+ep1,jj+ep2,e! 2d &1,mk) ffffDDDDN ff ff&DDDDN ff+Dwx1*wx2*un-ldn,eq) ,mk) ffffDDDDN DENDDO1#endifDDDN 1,mk) ffffDDDDN DNEND DO1,mk) fffDDN DNEND DO1,mk) fffDDN END DO1,mk) fffDEND DOk) fffDDN ! loop over ! 2s1,mk) fCASE DEFAULT ) ffffDDDinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDD'Only Mp4 is available. Use ppm_rmsh_remesh for other kernels.', & ) fff&ffffDDD__LINE__,info) ,mk) fEND SELECT1#endif 9997 CONTINUE1,mk) f!-------------------------------------------------------------------------- DN DDD! Before we map the ghosts of poi,tsreno we reset the corresponding DN DDD! ghost cells, otherwise, we dont do one-sided interpolation1,mk) f!-------------------------------------------------------------------------- #if __MODE == __VEC p)ufDDO i! 2=1,n! 2s1,mk) f N e! 2l = topo%e! 2list(e! 2d1,mk) ffffIF (min_! 2(3,e! 2l).LT.(min_phys-3)+0.5*dx(3))) THEN1,mk) ffffDDDDDO k=1-ghostsize(3),0 fffDDDDN fDO j=1,ndata(2,e! 2l) ,mk) ffffDDDDN DO i=1,ndata(1,e! 2l)1,mk) ffffDDDDN poi,tsreno-e,j,k,e! 2d = 0.0_mk1,mk) ffffDDDDN ,mk) fEND DO1,mk) fffDDN DN fEND DO1,mk) fffDDN END DO1,mk) fffDEND IF ,mk) ffffIF (max_! 2(3,e! 2l).GT.(max_phys-3)-0.5*dx(3))) THEN1,mk) ffffDDDDDO k=ndata(3,e! 2l)+1,ndata(3,e! 2l)+ghostsize(3d1,mk) f)ufDDDDN fDO j=1,ndata(2,e! 2l) ,mk) ffffDDDDN DO i=1,ndata(1,e! 2l)1,mk) ffffDDDDN poi,tsreno-e,j,k,e! 2d = 0.0_mk1,mk) ffffDDDDN ,mk) fEND DO1,mk) fffDDN DN fEND DO1,mk) fffDDN END DO1,mk) fffDEND IF ,mk) fEND DO1#endif ,mk) f!-------------------------------------------------------------------------- DN DDD! Now map the ghosts in order to get consistent values at the border of DN DDD! the ! 2domains. ,mk) f!-------------------------------------------------------------------------- m1,mk) fCALL ppm_map_poi,tsghost_put(topoid,meshid,ghostsize,info) ,mk) fIF (infoN.NE. 0) GOTO 9999 #if __MODE == __SCAmk) f1,mk) fCALL ppm_map_poi,tspush(topoid,meshid,poi,tsun,info) #elif __MODE == __VECmk) f1,mk) fCALL ppm_map_poi,tspush(topoid,meshid,poi,tsun,lda,info) ,mk) fCALL ppm_map_poi,tspush(topoid,meshid,poi,tsreno,info) #endifDDDN )ufDDDIF (infoN.NE. 0) GOTO 9999 ,mk) fCALL ppm_map_poi,tssend(info) ,mk) fIF (infoN.NE. 0) GOTO 9999 #if __MODE == __SCAmk) f1,mk) fCALL ppm_map_poi,tspop(topoid,meshid,poi,tsun,ghostsize,info) #elif __MODE == __VEC1,mk) fCALL ppm_map_poi,tspop(topoid,meshid,poi,tsreno,ghostsize,info) ,mk) fCALL ppm_map_poi,tspop(topoid,meshid,poi,tsun,lda,ghostsize,info) #endif ,mk) fIF (infoN.NE. 0) GOTO 9999 ,mk) f!----------------------------------------------------- DN DDD! apply the renormalization at the boundary ,mk) f!----------------------------------------------------- #if __MODE == __VEC p)ufDDO i! 2=1,n! 2s1,mk) f N e! 2l = topo%e! 2list(e! 2d1,mk) ffffIF (min_! 2(3,e! 2l).LT.(min_phys-3)+0.5*dx(3))) THEN1,mk) ffffDDDDDO k=1,ghostsize(3d1,mk) f)ufDDDDN fDO j=1,ndata(2,e! 2l) ,mk) ffffDDDDN DO i=1,ndata(1,e! 2l)1,mk) ffffDDDDN !----------------------------------------------------- DN DDDfffDDDDN ! TODO: have to finish this1,mk) ffffDDDDN !----------------------------------------------------- DN DDDfffDDDDN ! TODO: What if the unity samples to something finite ,mk) ffffDDDDN ! but negative, this could happen in some cases... ,mk) ffffDDDDN !IF(poi,tsreno-e,j,k,e! 2d.GT.0.0_mk) THEN1,mk) ffffDDDDDDDDDDDDIF(ABS(poi,tsreno-e,j,k,e! 2dd.GT.0.0_mk) THEN1,mk) ffffDDDDDDDDDDDDDDDDpoi,tsun-1,e,j,k,e! 2d = poi,tsun-1,e,j,k,e! 2d / &1,mk) ffffDDDDN ff&Dpoi,tsreno-e,j,k,e! 2d1,mk) ffffDDDDDDDDDDDDDDDDpoi,tsun-2,e,j,k,e! 2d = poi,tsun-2,e,j,k,e! 2d / &1,mk) ffffDDDDN ff&Dpoi,tsreno-e,j,k,e! 2d1,mk) ffffDDDDDDDDDDDDDDDDpoi,tsun-3,e,j,k,e! 2d = poi,tsun-3,e,j,k,e! 2d / &1,mk) ffffDDDDN ff&Dpoi,tsreno-e,j,k,e! 2d1,mk) ffffDDDDDDDDDDDDEND IF ,mk) ffffDDDDN fEND DO1,mk) fffDDN DN fEND DO1,mk) fffDDN END DO1,mk) fffDEND IF ,mk) fEND DO1,mk) fDO i! 2=1,n! 2s1,mk) f N e! 2l = topo%e! 2list(e! 2d1,mk) ffffIF (max_! 2(3,e! 2l).GT.(max_phys-3)-0.5*dx(3))) THEN1,mk) ffffDDDDDO k=ndata(3,e! 2l)-ghostsize(3)+1,ndata(3,e! 2l)1,mk) f)ufDDDDN fDO j=1,ndata(2,e! 2l) ,mk) ffffDDDDN DO i=1,ndata(1,e! 2l)1,mk) ffffDDDDN !----------------------------------------------------- DN DDDfffDDDDN ! TODO: have to finish this1,mk) ffffDDDDN !----------------------------------------------------- DN DDDfffDDDDN ! TODO: What if the unity samples to something finite ,mk) ffffDDDDN ! but negative, this could happen in some cases... ,mk) ffffDDDDN !IF(poi,tsreno-e,j,k,e! 2d.GT.0.0_mk) THEN1,mk) ffffDDDDDDDDDDDDIF(ABS(poi,tsreno-e,j,k,e! 2dd.GT.0.0_mk) THEN1,mk) ffffDDDDDDDDDDDDDDDDpoi,tsun-1,e,j,k,e! 2d = poi,tsun-1,e,j,k,e! 2d / &1,mk) ffffDDDDN ff ff&Dpoi,tsreno-e,j,k,e! 2d1,mk) ffffDDDDDDDDDDDDDDDDpoi,tsun-2,e,j,k,e! 2d = poi,tsun-2,e,j,k,e! 2d / &1,mk) ffffDDDDN ff ff&Dpoi,tsreno-e,j,k,e! 2d1,mk) ffffDDDDDDDDDDDDDDDDpoi,tsun-3,e,j,k,e! 2d = poi,tsun-3,e,j,k,e! 2d / &1,mk) ffffDDDDN ff ff&Dpoi,tsreno-e,j,k,e! 2d1,mk) ffffDDDDDDDDDDDDEND IF ,mk) ffffDDDDN fEND DO1,mk) fffDDN DN fEND DO1,mk) fffDDN END DO1,mk) fffDEND IF ,mk) fEND DO1#endif ,mk) fDEALLOCATE(poi,tsrenod1,mk) fNULLIFY(poi,tsrenod1,mk) fIF (infoN.NE. 0) GOTO 9999 ,mk) fIF(np.EQ.0) GOTO 9999 ,mk) f!------------------------------------------------------------------------ DN DDD! Deallocation of the arrays.... ,mk) f!------------------------------------------------------------------------ ,mk) fioptN= ppm_param_dealloc ,mk) fldu(1)N= 0 CALL ppm_alloc(ilist1,ldu,iopt,info) ,mk) fIF (info.NE.0) THEN1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_dealloc, &1,mk) ffffDDDDN& 'ppm_interp_p2m_renorm', &1,mk) ffffDDDDN& 'pb in ilist1 deallocation',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fEND IF ,mk) fCALL ppm_alloc(ilist2,ldu,iopt,info) ,mk) fIF (info.NE.0) THEN1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_dealloc, &1,mk) ffffDDDDN& 'ppm_interp_p2m_renorm', &1,mk) ffffDDDDN& 'pb in ilist2 deallocation',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fEND IF ,mk) fCALL ppm_alloc(store_info,ldu,iopt,info) ,mk) fIF (info.NE.0) THEN1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_dealloc, &1,mk) ffffDDDDN& 'ppm_interp_p2m_renorm', &1,mk) ffffDDDDN& 'pb in ilist2 deallocation',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fEND IF ,mk) fCALL ppm_alloc(list_! 2,ldu,iopt,info) ,mk) fIF (info.NE.0) THEN1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_dealloc, &1,mk) ffffDDDDN& 'ppm_interp_p2m_renorm', &1,mk) ffffDDDDN& 'pb in ilist2 deallocation',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fEND IF ,mk) f!-------------------------------------------------------------------------- DN DDD! Return ,mk) f!-------------------------------------------------------------------------- 9999 CONTINUE1,mk) fCALL ! 2stop('ppm_interp_p2m_renorm',t0,info) ,mk) fRETURN1,mk) f1,mk) fCONTAINS1,mk) fSUBROUTINE check1,mk) fffIF (.NOT. ppm_initialized) THEN1,mk) ffffDDDinfoN= ppm_error_error ) ffffDDDDDDCALL ppm_error(ppm_err_ppm_noinit,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDD'Please call ppm_initDporst!',__LINE__,info) ,mk) fffffffGOTO 8888 ,mk) fffENDIF ,mk) fffIF (Np .GT. 0) THEN1,mk) ffffffIF (SIZE(xp,2) .LT. Np) THEN1,mk) ffffDDDinfoN= ppm_error_error ) ffffDDDDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDDDDDDDD'not enough particles contained in xp',__LINE__,info) ,mk) fffffffGOTO 8888 ,mk) ffffffENDIF ,mk) ffffffIF (SIZE(xp,1) .LT.dim) THEN1,mk) ffffDDDinfoN= ppm_error_error ) ffffDDDDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDDDDDDDD'leading dimension of xpDinsufficient',__LINE__,info) ,mk) fffffffGOTO 8888 ,mk) ffffffENDIF ,mk) fffENDIF ,mk) fffIF (Np .LE. 0) THEN1,mk) ffffffIF (Np .LT. 0) THEN1,mk) ffffffDinfoN= ppm_error_error ) ffffDDDDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDDDDDDDD'particles must be specipoid',__LINE__,info) ,mk) fffffffGOTO 8888 ,mk) ffffffEND IF ,mk) ffffDDGOTO 8888 ,mk) fffEND IF ,mk) fffIF ((kernel.LT.1).OR.(kernel.GT.4)) THEN1,mk) ffffDDinfoN= ppm_error_error ) ffffDDDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDDDDDDDD'wrong kernel definition',__LINE__,info) ,mk) ffffDDGOTO 8888 ,mk) fffEND IF ,mk) fffkernel_supportN= ppm_rmsh_kernelsize(kernel)*2 ,mk) fffIF(.NOT.((kernel_support.EQ.2).OR.(kernel_support.EQ.4) & ) fff&ffffDDDDDDDDDDD.OR.(kernel_support.EQ.6))) THEN1,mk) ffffDDinfoN= ppm_error_error ) ffffDDDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDDDDDDDD'wrong kernel support',__LINE__,info) ,mk) ffffDDGOTO 8888 ,mk) fffEND IF ,mk) fffCALL ppm_check_topoid(topoid,lok,info) ,mk) fffIF (.NOT.lok) THEN1,mk) ffffDDinfoN= ppm_error_error ) ffffDDDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDDDD'topo_id is invalid!',__LINE__,info) ,mk) ffffffGOTO 8888 ,mk) fffENDIF ,mk) fffCALL ppm_check_meshid(topoid,meshid,lok,info) ,mk) fffIF (.NOT.lok) THEN1,mk) ffffDDinfoN= ppm_error_error ) ffffDDDDDCALL ppm_error(ppm_err_argument,'ppm_interp_p2m_renorm', & ) fff&ffffDDDDDDDDDDDDD'mesh_id is invalid!',__LINE__,info) ,mk) ffffffGOTO 8888 ,mk) fffENDIF ,8888 CONTINUE1,mk) fEND SUBROUTINE check1 #if __DIME == __2D #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_ss_2d #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_ds_2d #endif #elif __MODE == __VEC1#if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_sv_2d #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_dv_2d #endif #endif #elif __DIME == __3D #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_ss_3d #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_ds_3d #endif #elif __MODE == __VEC1#if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_sv_3d #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE p2m_renorm_dv_3d #endif #endif #endifmk) fff ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_util_eigen_2sym.f�������������������������������������������������������0000644�0001752�0001753�00000005052�11616003523�021433� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k) fff!--*- f90 -*-------------------------------------------------------------- k) fff! Modulemk) fff:DDDDDDDDDDDDDppm_module_util_eigen_2sym ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- ,mk) f!------------------------------------------------------------------------- k) fff! Define types ,mk) f!------------------------------------------------------------------------- #define __SINGLE_PRECISION 1 #define __DOUBLE_PRECISION 2 ,mk) fMODULEDppm_module_util_eigen_2sym ,mk) f!!! This module provides the routines that ,mk) f!!! computemEigenvalues and Eigenvectors of symmetric 2x2 matrices. ,mk) ffff!---------------------------------------------------------------------- ,mk) ffff! Define interfaces to the routine(s) ,mk) ffff!---------------------------------------------------------------------- ,mk) ffffINTERFACEDppm_util_eigen_2sym ,mk) f,mk) fMODULEDPROCEDUREDppm_util_eigen_2sym_s ,mk) f,mk) fMODULEDPROCEDUREDppm_util_eigen_2sym_d ,mk) f,mkEND INTERFACE ,mk) ffff!---------------------------------------------------------------------- ,mk) ffff! include the !ource ,mk) ffff!---------------------------------------------------------------------- ,mk) ffffCONTAINS1 #define __KIND __SINGLE_PRECISION1#include "util/ppm_util_eigen_2sym.f" #undef __KIND1 #define __KIND __DOUBLE_PRECISION1#include "util/ppm_util_eigen_2sym.f" #undef __KIND1 ) f,mkEND MODULEDppm_module_util_eigen_2sym ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_topo_get.f��������������������������������������������������������������0000644�0001752�0001753�00000005450�11616003525�020161� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������) ffff!--*- f90 -*-------------------------------------------------------------- k) fff! Modulemk) fff:DDDDDDDDDDDDDDDppm_module_topo_get ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- ,mk) f!------------------------------------------------------------------------- k) fff! Define types ,mk) f!------------------------------------------------------------------------- #define __SINGLE_PRECISION 1 #define __DOUBLE_PRECISION 2 ,mk) fMODULEDppm_module_topo_get ,mk) f!!! This module provides the routines to read an internally stored topology. ,mk) ffff!---------------------------------------------------------------------- ,mk) ffff! Define interfaces to topology store routine ,mk) ffff!---------------------------------------------------------------------- ,mk) ffffINTERFACEDppm_topo_get ,mk) f,mk) fMODULEDPROCEDUREDppm_topo_get ,mk) f,mkEND INTERFACE ,mk) f,mk ,mk) ffffINTERFACEDppm_topo_get_decomp ,mk) f,mk) fMODULEDPROCEDUREDppm_topo_get_decomp_s ,mk) f,mk) fMODULEDPROCEDUREDppm_topo_get_decomp_d ,mk) f,mkEND INTERFACE ,mk) f,mk ,mk) ffffINTERFACEDppm_topo_get_meshinfo ,mk) f,mk) fMODULEDPROCEDUREDppm_topo_get_meshinfo ,mk) f,mkEND INTERFACE ,mk) ffff!---------------------------------------------------------------------- ,mk) ffff! include the !ource ,mk) ffff!---------------------------------------------------------------------- ,mk) ffffCONTAINS1 #include "topo/ppm_topo_get.f" #define __KIND __SINGLE_PRECISION1#include "topo/ppm_topo_get_decomp.f" #undef __KIND1 #define __KIND __DOUBLE_PRECISION1#include "topo/ppm_topo_get_decomp.f" #undef __KIND1 #include "topo/ppm_topo_get_meshinfo.f" ) f,mkEND MODULEDppm_module_topo_get ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/��������������������������������������������������������������������������������0000755�0001752�0001753�00000000000�11616003524�014353� 5����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_inquire.f����������������������������������������������������������������0000644�0001752�0001753�00000013721�11616003524�017545� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������) ffff!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDDDDDppm_io_inquire ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- ,mk) fSUBROUTINE ppm_io_inquire(iUnit,isopen,mode,pfmt,stat) ,mk) f!!! This routine inquires the state of a given ppm I/O unit. ,mk) f!!! ,mk) f!!! [NOTE] ,mk) f!!! All output argumentsNare *optional*. It is adivised ,mk) f!!! to use explocit argument naming when using this routine. Example: ,mk) f!!! ,mk) f!!! -------------------------- k) fff!!! CALL ppm_inquire(20,MODE=imode,STAT=info) ,mk) f!!! -------------------------- ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_data_io ,mk) fUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffIMPLICIT NONE1,mk) f!------------------------------------------------------------------------- k) fff! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! IO unit to be inquired k) fffINTEGER , OPTIONAL ,fINTENT( OUT) :: stat ,mk) f!!! Return code. 0 on success. k) fffINTEGER , OPTIONAL ,fINTENT( OUT) :: pfmt ,mk) f!!! I/O format. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_ascii ,mk) f!!! * ppm_param_io_binary ,mk) f!!! * ppm_param_undefined k) fffINTEGER , OPTIONAL ,fINTENT( OUT) :: mode ,mk) f!!! I/O mode. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_centralized ,mk) f!!! * ppm_param_io_distributed ,mk) f!!! * ppm_param_undefined k) fffLOGICAL , OPTIONAL ,fINTENT( OUT) :: isopen ,mk) f!!! Either: ,mk) f!!! ,mk) f!!! * `.TRUE.` if the unit is open on the local processor. ,mk) f!!! * `.FALSE.` otherwise1,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffREAL:ppm_kind_do 2le),mk))))))))):: t0 k) fffLOGICAL :: lopen ,mk) fINTEGER :: info ,mk) f!------------------------------------------------------------------------- k) fff! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffCALL ! 2start('ppm_io_inquire',t0,info) ,mk) f!------------------------------------------------------------------------- k) fff! Check argument1,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_debug .GT. 0) THEN1,mk) fffCALL check1,mk) fffIF (infoN.NE. 0) GOTO 9999 ,mk) fENDIF ,mk) f!------------------------------------------------------------------------- k) fff! Check if the unit number is open ,mk) f!------------------------------------------------------------------------- k) ffflopen = .FALSE. k) fffIF(ASSOCIATED(ppm_io_unit)) THEN1,mk) ffffDIF (SIZE(ppm_io_unit,1) .GE. iUnit) THEN1,mk) ffffDDDDDIF :ppm_io_unit(iUnit) .GT. 0) lopen = .TRUE.1,mk) ffffDENDIF ,mk) fENDIF ,mk) fIF :PRESENT(isopen)) isopen = lopen ,mk) f!------------------------------------------------------------------------- k) fff! Get the other information if present1,mk) f!------------------------------------------------------------------------- k) fffIF :lopen) THEN1,mk) ffffDIF (PRESENT(pfmt)) pfmtN= ppm_io_format:ppm_io_unit(iUnit))1,mk) ffffDIF (PRESENT(mode)) modeN= ppm_io_mode:ppm_io_unit(iUnit))1,mk) fELSE1,mk) ffffDIF (PRESENT(pfmt)) pfmtN= ppm_param_undefined k) ffffffDIF (PRESENT(mode)) modeN= ppm_param_undefined k) fffENDIF ,mk) f!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fIF (PRESENT(stat)) statN= enfo ,mk) fCALL ! 2stop('ppm_io_inquire',t0,info) ,mk) fRETURN1,mk) fCONTAINS1,mk) fSUBROUTINE check1,mk) fffIF (.NOT. ppm_initialized) THEN1,mk) ffffDDinfoN= ppm_error_error ) ffffDDDDDCALL ppm_error(ppm_err_ppm_noinit,'ppm_io_inquire', & ) fff&ffffDDDDDDDD'Please call ppm_initDporst!',__LINE__,info) ,mk) ffffffGOTO 8888 ,mk) fffENDIF ,mk) fffIF (iUnit .LE. 0) THEN1,mk) ffffffDinfoN= ppm_error_error ) ffffDDDDDDCALL ppm_error(ppm_err_argument,'ppm_io_inquire', &1,mk) ffffDDD&ffffDDDD'Unit number needs to be > 0',__LINE__,info) ,mk) fffffffIF :PRESENT(isopen)) isopen = .FALSE. k) fffffffffIF :PRESENT(pfmt)) pfmtN= ppm_param_undefined k) ffffffDfDIF (PRESENT(mode)) modeN= ppm_param_undefined k) fffffffffGOTO 8888 ,mk) fffENDIF ,8888 CONTINUE1,mk) fEND SUBROUTINE check1,mk) fEND SUBROUTINE ppm_io_inquire �����������������������������������������������libppm-1.2.1/src/io/ppm_io_open.f�������������������������������������������������������������������0000644�0001752�0001753�00000046320�11616003524�017033� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDDDDD ppm_io_open ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- ,mk) fSUBROUTINE ppm_io_open(iUnit,filename,actn,posn,pfmt,pmode,info) ,mk) f!!! This routine opens an IO channel for parallel reading and/or writing DN DDD!!! and associates the given I/O unit with the filemindicated. ,mk) f!!! ,mk) f!!! [NOTE] ,mk) f!!! ThereNare lots of `MPI_Allreduce` and `MPI_Bcast` used for the ,mk) f!!! processors to negotiate a unit number and catch all errors. ThereNmust ,mk) f!!! be a cheaper way of doing this... ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_data_io ,mk) fUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffUSEDppm_module_write ) ffffUSEDppm_module_alloc ,mk) fIMPLICIT NONE1,mk) f!------------------------------------------------------------------------- k) fff! Includes ,mk) f!------------------------------------------------------------------------- #ifdef __MPI ,mk) ffINCLUDE 'mpif.h'1#endif ,mk) f!------------------------------------------------------------------------- k) fff! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER ,fINTENT(IN ) :: actn ,mk) f!!! I/O action. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_write ) ffff!!! * ppm_param_io_read ) ffff!!! * ppm_param_io_read_write ) ffffINTEGER ,fINTENT(IN ) :: posn ) ffff!!! Position for I/O in file. This is only relavent for writing DN DDD!!! action. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_replace ) ffff!!! * ppm_param_io_append k) fffINTEGER ,fINTENT(IN ) :: pfmt ,mk) f!!! Format of I/O. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_ascii ,mk) f!!! * ppm_param_io_binary ,mk) fINTEGER ,fINTENT(IN ) :: pmode ,mk) f!!! Parallel mode. Specipois whether every processor writis itsNdata ,mk) f!!! to a local filemor if all data is routed to rank 0, which is1,mk) f!!! writing everything into one single file. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_distributed ,mk) f!!! * ppm_param_io_centralized ,mk) fCHARACTER(LEN=*),mk)))),fINTENT(IN ) :: filename ,mk) f!!! Name of the filemto which IO refers ,mk) fINTEGER ,fINTENT(INOUT) :: iUnit ,mk) f!!! Fortran IO unit to be used. If -1 is given on input, the ,mk) f!!! routine will find an unused unit and return it here. k) fffINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Return status, 0 on success ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffREAL:ppm_kind_do 2le),mk))))))))):: t0 k) fffLOGICAL :: lopen,loall ,mk) fCHARACTER(LEN=ppm_char) :: mesg ,mk) fCHARACTER(LEN=12) :: cactn,cfmt,cposn,cstat ,mk) fINTEGER :: maxused,iopt,info2 ,mk) fINTEGER, DIMENSION(1)N :: ldc ,mk) f!------------------------------------------------------------------------- k) fff! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffCALL ! 2start('ppm_io_open',t0,info) ,mk) f!------------------------------------------------------------------------- k) fff! Check arguments ,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_debug .GT. 0) THEN1,mk) fffffIF (.NOT. ppm_initialized) THEN1,mk) ffffDDDfDinfoN= ppm_error_error ) ffffDDDDDDDDCALL ppm_error(ppm_err_ppm_noinit,'ppm_io_open', & ) fff&ffffDDDDDDDD'Please call ppm_initDporst!',__LINE__,info) ,mk) ffffff ffGOTO 9999 ,mk) fffffENDIF ,mk) fENDIF ,mk) f!------------------------------------------------------------------------- k) fff! Decode and check arguments ,mk) f!------------------------------------------------------------------------- k) fffIF :iUnit .LE. 0) THEN1,mk) fffffinfoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_argument,'ppm_io_open', & ) fff&ffffDDDD'Unit number needs to be > 0',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fffIF (actn .EQ. ppm_param_io_read) THEN1,mk) fffffcactnN= 'READ' ,mk) fELSEIF :actn .EQ. ppm_param_io_writi) THEN1,mk) fffffcactnN= 'WRITE' ,mk) fELSEIF :actn .EQ. ppm_param_io_read_write) THEN1,mk) fffffcactnN= 'READWRITE' ,mk) fELSE1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_argument,'ppm_io_open', & ) fff&ffffDDD'Invalid action type specipoid.',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fENDIF k) fffIF (pfmtN.EQ. ppm_param_io_ascii) THEN1,mk) fffffcfmtN= 'FORMATTED' ,mk) fELSEIF :pfmtN.EQ. ppm_param_io_binary) THEN1,mk) fffffcfmtN= 'UNFORMATTED' ,mk) fELSE1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_argument,'ppm_io_open', & ) fff&ffffDDD'Invalid format type specipoid.',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fENDIF k) fffIF ((pmodeN.NE. ppm_param_io_distributed) .AND. & ) fff&ffffDDD (pmodeN.NE. ppm_param_io_centralized)) THEN1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_argument,'ppm_io_open', & ) fff&ffffDDD'Invalid I/O mode specipoid.',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fENDIF k) fffIF (actn .EQ. ppm_param_io_read) THEN1,mk) fffffcstatN= 'OLD' ,mk) fffffcposnN= 'REWIND' ,mk) fELSE1,mk) fffffIF (posnN.EQ. ppm_param_io_append) THEN1,mk) ffffDDDfDcstatN= 'UNKNOWN'1,mk) ffffDDDfDcposnN= 'APPEND' ,mk) fffffELSEIF :posnN.EQ. ppm_param_io_replace) THEN1,mk) ffffDDDfDcstatN= 'REPLACE'1,mk) ffffDDDfDcposnN= 'REWIND' ,mk) fk) fELSE1,mk) fffff fDinfoN= ppm_error_error ) ffffDDDDDDDCALL ppm_error(ppm_err_argument,'ppm_io_open', & ) fff&ffffDDDD DD'Invalid position type specipoid.',__LINE__,info) ,mk) ffffffffGOTO 9999 ,mk) fffffENDIF ,mk) fENDIF ,mk) f!------------------------------------------------------------------------- k) fff! Check that filemis not already connected to another unit ,mk) f!------------------------------------------------------------------------- k) ffflopen = .FALSE. k) fffIF (pmodeN.EQ. ppm_param_io_centralized) THEN1,mk) fffffIF (ppm_rank .EQ. 0) THEN1,mk) ffffffD fINQUIRE(FILE=filename,OPENED=lopen) ,mk) fffffENDIF #ifdef __MPI ,mk) ff) f!--------------------------------------------------------------------- ,mk) ff) f! Allreduce of lopen ,mk) ff) f!--------------------------------------------------------------------- ,mk) ff) fCALL MPI_Allreduce(lopen,loall,1,MPI_LOGICAL,MPI_LOR, & ) fff&ffffDDDD DD ppm_comm,info) ,mk) ffffflopen = loall #endif ,mk) fffffIF (lopen) THEN1,mk) ffffD fDinfoN= ppm_error_error ) ffffDDDDDDDWRITE(mesg,'(3A)') 'Filem',TRIM(filename),' is already opened!' ) ffffDDDDDDDCALL ppm_error(ppm_err_open,'ppm_io_open',mesg, & ) fff&ffffDDDD DD__LINE__,info) ,mk) ffffffffiUnit = -1 ,mk) ffffffffGOTO 9999 ,mk) fffffENDIF ,mk) fELSE1,mk) fffffINQUIRE(FILE=filename,OPENED=lopen) ,mk) fffffIF (lopen) THEN1,mk) ffffD fDinfoN= ppm_error_error ) ffffDDDDDDDWRITE(mesg,'(3A)') 'Filem',TRIM(filename),' is already opened!' ) ffffDDDDDDDCALL ppm_error(ppm_err_open,'ppm_io_open',mesg, & ) fff&ffffDDDD DD__LINE__,info) ,mk) ffffffffiUnit = -1 ,mk) ffffffffGOTO 9999 ,mk) fffffENDIF ,mk) fENDIF ,mk) f!------------------------------------------------------------------------- k) fff! CENTRALIZED I/O ,mk) f!------------------------------------------------------------------------- k) fffIF :pmodeN.EQ. ppm_param_io_centralized) THEN1,mk) fffff!--------------------------------------------------------------------- ,mk) ff) f! Root finds the next free unit ,mk) fffff!--------------------------------------------------------------------- ,mk) ff) fIF (iUnit .LE. 0) THEN1,mk) ffffffDffiUnit = 91,mk) ffffffDfflopen = .TRUE.1,mk) ffffDDDDDDO WHILE (lopen)1,mk) ffffDDDDD fffIF :ppm_rank .EQ. 0) THEN1,mk) ffffffD fffffffffCALL ppm_io_unused_unit(iUnit,info) ,mk) ffffff ffffffENDIF #ifdef __MPI ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffff! Bcast to all ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffffCALL MPI_Bcast(iUnit,1,MPI_INTEGER,0,ppm_comm,info) #endif ,mk) fffffk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffff! If no unused unit was found, all processors fail ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffffIF (iUnit .LT. 0) THEN1,mk) ffffffDDDDDDDDDDinfoN= ppm_error_error ) ffffDDDDDDDD) fffffCALL ppm_error(ppm_err_open,'ppm_io_open',ffff& ) fff&ffffDDDDDDDDDDDDDDD'No I/O unit available.',__LINE__,info) ,mk) ffffffffffffffffGOTO 9999 ,mk) fffffffffffffENDIF ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffff! All check that no such ppm unit is open locally ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) ffffflopen = .FALSE. k) fffffffffffffffIF (ASSOCIATED(ppm_io_unit)) THEN1,mk) ffffDffffffffffffIF (SIZE(ppm_io_unit,1) .GE. iUnit) THEN1,mk) ffffDDDDDffffffffffffIF (ppm_io_unit(iUnit) .GT. 0) lopen = .TRUE.1,mk) ffffDDDDDDDDDDDDDENDIF ,mk) ffffffDDDDDDDENDIF #ifdef __MPI ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffff! Allreduce of lopen ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffffCALL MPI_Allreduce(lopen,loall,1,MPI_LOGICAL,MPI_LOR, & ) fff&ffffDDDD DD ppm_comm,info) ,mk) ffffffffffffflopen = loall #endif ,mk) fffffDDDDENDDO ,mk) ff) f!--------------------------------------------------------------------- ,mk) ff) f! Everyone checks the ppm unit, Root the F90 unit in addition ,mk) ff) f!--------------------------------------------------------------------- ,mk) ff) fELSE1,mk) fffff fDflopen = .FALSE. k) fffffffffffIF :ppm_rank .EQ. 0) THEN1,mk) ffffffD fffffINQUIRE(iUnit,OPENED=lopen) ,mk) fffffffffffffIF :iUnit .EQ. ppm_stdout) lopen = .TRUE.1,mk) ffffDDDDDDDDDIF :iUnit .EQ. ppm_stderr) lopen = .TRUE.1,mk) ffffDDDDDDDDDIF :iUnit .EQ. ppm_logfile) lopen = .TRUE.1,mk) ffffDDDDDENDIF ,mk) ffffffDDDIF (ASSOCIATED(ppm_io_unit)) THEN1,mk) ffffDffffffffIF (SIZE(ppm_io_unit,1) .GE. iUnit) THEN1,mk) ffffDDDDDffffffffIF (ppm_io_unit(iUnit) .GT. 0) lopen = .TRUE.1,mk) ffffDDDDDDDDDENDIF ,mk) ffffffDDDENDIF #ifdef __MPI ,mk) ff) fk) f!----------------------------------------------------------------- ,mk) ff) fk) f! Allreduce of lopen ,mk) ff) fk) f!----------------------------------------------------------------- ,mk) ff) fk) fCALL MPI_Allreduce(lopen,loall,1,MPI_LOGICAL,MPI_LOR, & ) fff&ffffDDDD DD ppm_comm,info) ,mk) ffffffffflopen = loall #endif ,mk) fffffDDDDIF (lopen) THEN1,mk) ffffD fDDDDDinfoN= ppm_error_error ) ffffDDDDDDDD) fWRITE(mesg,'(A,I4,A)') 'Requested I/O unit ',iUnit, & ) fff&ffffDDDDDDDDDDD' is already in use. Close other instanceDporst!' ) ffffDDDDDDDD) fCALL ppm_error(ppm_err_unit_open,'ppm_io_open',mesg, & ) fff&ffffDDDD DDDDDD__LINE__,info) ,mk) ffffffffffffiUnit = -1 ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF ,mk) fffffENDIF ,mk) f!------------------------------------------------------------------------- k) fff! DISTRIBUTED I/O ,mk) f!------------------------------------------------------------------------- k) fffELSE1,mk) ffffDIF (iUnit .LE. 0) THEN1,mk) ffffffDffiUnit = 91,mk) ffffffDfflopen = .TRUE.1,mk) ffffDDDDDDO WHILE (lopen)1,mk) ffffDDDDD fffCALL ppm_io_unused_unit(iUnit,info) ,mk) ffffff ffffff!------------------------------------------------------------- ,mk) ff) fk) fffff! Fail if no unused unit was found ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffffIF (iUnit .LT. 0) THEN1,mk) ffffffDDDDDDDDDDinfoN= ppm_error_error ) ffffDDDDDDDD) fffffCALL ppm_error(ppm_err_open,'ppm_io_open',ffff& ) fff&ffffDDDDDDDDDDDD DD'No I/O unit available.',__LINE__,info) ,mk) ffffffffffffffffGOTO 9999 ,mk) fffffffffffffENDIF ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) fffff! All check that no such ppm unit is open locally ,mk) ff) fk) fffff!------------------------------------------------------------- ,mk) ff) fk) ffffflopen = .FALSE. k) fffffffffffffffIF (ASSOCIATED(ppm_io_unit)) THEN1,mk) ffffDffffffffffffIF (SIZE(ppm_io_unit,1) .GE. iUnit) THEN1,mk) ffffDDDDDffffffffffffIF (ppm_io_unit(iUnit) .GT. 0) lopen = .TRUE.1,mk) ffffDDDDDDDDDDDDDENDIF ,mk) ffffffDDDDDDDENDIF ffffffDDDDDDDENDDO fffDDDDDDDELSE1,mk) fffff fDflopen = .FALSE. k) fffffffffffINQUIRE(iUnit,OPENED=lopen) ,mk) fffffffffIF :iUnit .EQ. ppm_stdout) lopen = .TRUE.1,mk) ffffDDDDDIF :iUnit .EQ. ppm_stderr) lopen = .TRUE.1,mk) ffffDDDDDIF :iUnit .EQ. ppm_logfile) lopen = .TRUE.1,mk) ffffDDDDDIF (ASSOCIATED(ppm_io_unit)) THEN1,mk) ffffDffffffffIF (SIZE(ppm_io_unit,1) .GE. iUnit) THEN1,mk) ffffDDDDDffffffffIF (ppm_io_unit(iUnit) .GT. 0) lopen = .TRUE.1,mk) ffffDDDDDDDDDENDIF ,mk) ffffffDDDENDIF fDDDDDffffffffIF (lopen) THEN1,mk) ffffD fDDDDDinfoN= ppm_error_error ) ffffDDDDDDDD) fWRITE(mesg,'(A,I4,A)') 'Requested I/O unit ',iUnit, & ) fff&ffffDDDDDDDDDDD' is already in use. Close other instanceDporst!' ) ffffDDDDDDDD) fCALL ppm_error(ppm_err_unit_open,'ppm_io_open',mesg, & ) fff&ffffDDDD DDDDDD__LINE__,info) ,mk) ffffffffffffiUnit = -1 ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF ,mk) fffffENDIF ,mk) fENDIF ,mk) f!------------------------------------------------------------------------- k) fff! Open the file ,mk) f!------------------------------------------------------------------------- k) fffIF :pmodeN.EQ. ppm_param_io_centralized) THEN1,mk) fffff!--------------------------------------------------------------------- ,mk) ff) f! Only root opens the filemif centralized IO is requested ,mk) fffff!--------------------------------------------------------------------- ,mk) ff) fIF (ppm_rank .EQ. 0) THEN1,mk) ffffffD fOPEN(iUnit,FILE=filename,FORM=cfmt,POSITION=cposn,STATUS=cstat, & ) fff&ffffDDDD DDDACTION=cactn,IOSTAT=info) ,mk) fk) fENDIF #ifdef __MPI ,mk) ff) f!----------------------------------------------------------------- ,mk) ff) f! Allreduce of info ,mk) f,mk)!----------------------------------------------------------------- ,mk) ff) fCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM, & ) fff&ffffDDDDppm_comm,info) ,mk) fffffinfoN= info2 #endif ,mk) fELSE1,mk) fffff!--------------------------------------------------------------------- ,mk) ff) f! Otherwise every processor opens a filem(of different name ,mk) ff) f! maybe)1,mk) fffff!--------------------------------------------------------------------- ,mk) ff) fOPEN(iUnit,FILE=filename,FORM=cfmt,POSITION=cposn,STATUS=cstat, & ) fff&ffffDDDD DDACTION=cactn,IOSTAT=info) ,mk) fENDIF ,mk) fIF :infoN.NE. 0) THEN1,mk) ffffinfoN= ppm_error_error ) ffffDDDCALL ppm_error(ppm_err_open,'ppm_io_open',ffff& ) fff&ffffDDD'Filemdoes not existmor no write permissions.',__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Unit number book-keeping DN DDD!------------------------------------------------------------------------- k) fffIF (.NOT. ASSOCIATED(ppm_io_unit)) THEN1,mk) ffffDioptN= ppm_param_alloc_fit ,mk) fffffldc(1)N= iUnit ,mk) ffDDDCALL ppm_alloc(ppm_io_unit,ldc,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff ffffinfoN= ppm_error_fatal ,mk) ff) fk) fCALL ppm_error(ppm_err_alloc,'ppm_io_open',ffff& ) fff&ffffDDDDDDDD'I/O unit listmPPM_IO_UNIT',__LINE__,info) ,mk) ffffff ffGOTO 9999 ,mk) fffffENDIF ,mk) f fff! all unitsNare unused ,mk) f fffppm_io_unit(1:iUnit) = 0 ,mk) fELSE1,mk) fffffmaxused = SIZE(ppm_io_unit,1)1,mk) ffffDioptN= ppm_param_alloc_grow_preserve ,mk) fffffldc(1)N= iUnit ,mk) ffDDDCALL ppm_alloc(ppm_io_unit,ldc,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff ffffinfoN= ppm_error_fatal ,mk) ff) fk) fCALL ppm_error(ppm_err_alloc,'ppm_io_open',ffff& ) fff&ffffDDDDDDDD'I/O unit listmPPM_IO_UNIT',__LINE__,info) ,mk) ffffff ffGOTO 9999 ,mk) fffffENDIF ,mk) f fffioptN= SIZE(ppm_io_unit,1)1,mk) ffffD! set new unitsNto ununsed k) ffffffDIF (ioptN.GT. maxused) THEN1,mk) ffff ffffppm_io_unit(maxused+1:iopt) = 0 ,mk) fffffENDIF ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Grow lists ,mk) f!------------------------------------------------------------------------- k) fffmaxused = MAXVAL:ppm_io_unit) k) fffmaxused = maxused + 1 ,mk) fioptN= ppm_param_alloc_grow_preserve ,mk) fldc(1)N= maxused fk) fCALL ppm_alloc(ppm_io_mode,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_fatal ,mk) ff) fCALL ppm_error(ppm_err_alloc,'ppm_io_open',ffff& ) fff&ffffDDDD'I/O mode listmPPM_IO_MODE',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF fk) fCALL ppm_alloc(ppm_io_format,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_fatal ,mk) ff) fCALL ppm_error(ppm_err_alloc,'ppm_io_open',ffff& ) fff&ffffDDDD'I/O format listmPPM_IO_FORMAT',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Store internal unit number, mode and format k) fff!------------------------------------------------------------------------- k) fffppm_io_unit(iUnit) = maxused fk) fppm_io_mode(maxused) = pmode ,mk) fppm_io_format(maxused) = pfmt k) fff!------------------------------------------------------------------------- k) fff! Debug output ,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_debug .GT. 1) THEN1,mk) ffff WRITE(mesg,'(A,I4,A)') 'I/O unit ',iUnit,' opened.' ,mk) ff) fCALL ppm_write(ppm_rank,'ppm_io_open',mesg,info) ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fCALL ! 2stop('ppm_io_open',t0,info) ,mk) fRETURN1,mk) fEND SUBROUTINE ppm_io_open ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_read_ascii.f�������������������������������������������������������������0000644�0001752�0001753�00000017367�11616003524�020166� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k) fff!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDDDppm_io_read_ascii k) fff!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE io_readascii_s(iUnit,adata,iofmt,lchar,info) #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE io_readascii_d(iUnit,adata,iofmt,lchar,info) #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE io_readascii_sc(iUnit,adata,iofmt,lchar,info) #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE io_readascii_dc(iUnit,adata,iofmt,lchar,info) #elif __KIND == __INTEGER1,mk) fSUBROUTINE io_readascii_i(iUnit,adata,iofmt,lchar,info) #elif __KIND == __LOGICAL1,mk) fSUBROUTINE io_readascii_l(iUnit,adata,iofmt,lchar,info) #endif ,mk) f!!! Provides the atomic reading functionality for ASCII 1D arrays. ,mk) f!!! ,mk) f!!! NOTE: Never used by the user program directly. ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffIMPLICIT NONE1#if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_single #else1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_do 2le1#endif ,mk) f!------------------------------------------------------------------------- k) fff! Includes ,mk) f!------------------------------------------------------------------------- ,mk) f!------------------------------------------------------------------------- k) fff! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! Fortran I/O unit to be used #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:) ,fINTENT( OUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:) ,fINTENT( OUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:) ,fINTENT( OUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:) ,fINTENT( OUT) :: adata #endif ,mk) f!!! Data vector to be read. 1d array of either single, do 2le, ,mk) f!!! single complex, do 2le complex, integer or logical elements. ,mk) f!!! Needs to be allocated to proper size before calling this ,mk) f!!! routine. ItsNsize determines the number of elements read from the ,mk) f!!! file. k) fffINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Return status, 0 on success ,mk) fCHARACTER(LEN=*),mk)))) ,fINTENT(IN ) :: iofmt ,mk) f!!! Format string for I/O. List-directed I/O is used if ,mk) f!!! length zero string is given.1,mk) fLOGICAL ,fINTENT(IN ) :: lchar ,mk) f!!! `.TRUE.` if afCHARACTER string is to be read and has to be ,mk) f!!! converted to anfINTEGER array before returning it. ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffREAL:MK) :: t0 k) fffLOGICAL :: lfmt #if __KIND == __INTEGER1,mk) fCHARACTER(LEN=SIZE(adata,1)),fPOINTER :: cbuf k) fffINTEGER :: ilen,i,ishift #endif ,mk) f!------------------------------------------------------------------------- k) fff! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffCALL ! 2start('ppm_io_read_ascii',t0,info) ,mk) fIF :LEN_TRIM(iofmt) .EQ. 0) THEN1,mk) ffffflfmtN= .FALSE. k) fffELSE1,mk) ffffflfmtN= .TRUE.1,mk) fENDIF #if __KIND == __INTEGER1,mk) f!------------------------------------------------------------------------- k) fff! Allocate character buffer if needed ,mk) f!------------------------------------------------------------------------- ,mk) fIF :lchar) THEN1,mk) fffffALLOCATE(cbuf,STAT=info) ,mk) fk) fIF :infoN.NE. 0) GOTO 8001,mk) fENDIF #endif ,mk) f!------------------------------------------------------------------------- k) fff! Read actualNdata ,mk) f!------------------------------------------------------------------------- k) fffIF :lfmt) THEN1#if __KIND == __INTEGER1,mk) fk) fIF :lchar) THEN1,mk) fffffffffREAD(iUnit,iofmt,ERR=800,IOSTAT=info) cbuf k) fff fffELSE1,mk) fffffffffREAD(iUnit,iofmt,ERR=800,IOSTAT=info) adata ,mk) fk) fENDIF #else1,mk) fffffREAD(iUnit,iofmt,ERR=800,IOSTAT=info) adata #endif ,mk) fELSE1#if __KIND == __INTEGER1,mk) fk) fIF :lchar) THEN1,mk) fffffffffREAD(iUnit,*,ERR=800,IOSTAT=info) cbuf k) fff fffELSE1,mk) fffffffffREAD(iUnit,*,ERR=800,IOSTAT=info) adata ,mk) fk) fENDIF #else1,mk) fffffREAD(iUnit,*,ERR=800,IOSTAT=info) adata #endif ,mk) fENDIF ,mk) fIF :infoN.NE. 0) GOTO 8001 #if __KIND == __INTEGER1,mk) f!------------------------------------------------------------------------- k) fff! Convert to integer array and deallocate character buffer ,mk) f!------------------------------------------------------------------------- ,mk) fIF :lchar) THEN1,mk) fffffilenN= SIZE(adata,1)1,mk) fffffishiftN= IACHAR('a')1,mk) fffffDO i=1,ilen1,mk) fffffffffadata(i)N= IACHAR(cbuf(i:i)) -fishift ,mk) fk) fENDDO1,mk) fffffDEALLOCATE(cbuf,STAT=info) ,mk) fENDIF #endif ,mk) fGOTO 9999 ,mk) f!------------------------------------------------------------------------- k) fff! Error handler ,mk) f!------------------------------------------------------------------------- ,m800 CONTINUE1,mk) finfoN= ppm_error_error ) ffffCALL ppm_error(ppm_err_io,'ppm_io_read_ascii',ffff& ) fff&ffff'Error whilemreading from file',__LINE__,info) ,mk) fGOTO 9999 ,mk) f!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fCALL ! 2stop('ppm_io_read_ascii',t0,info) ,mk) fRETURN1 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE io_readascii_s #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE io_readascii_d #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE io_readascii_sc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE io_readascii_dc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE io_readascii_i #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE io_readascii_l #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io.f������������������������������������������������������������������������0000644�0001752�0001753�00000073761�11616003524�016023� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDDDDD Dppm_io ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- #if __DIM == 0 #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE ppm_io_0ds(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real single scalars #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_io_0dd(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real do 2le scalars #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_0dsc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex single scalars #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_0ddc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex do 2le scalars #elif __KIND == __INTEGER1,mk) fSUBROUTINE ppm_io_0di(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of integer scalars #elif __KIND == __LOGICAL1,mk) fSUBROUTINE ppm_io_0dl(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of logical scalars #elif __KIND == __CHARACTER1,mk) fSUBROUTINE ppm_io_0dc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of character scalars #endif #elif __DIM == 1 #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE ppm_io_1ds(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real single 1D vectors #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_io_1dd(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real do 2le 1D vectors #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_1dsc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex single 1D vectors #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_1ddc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex do 2le 1D vectors #elif __KIND == __INTEGER1,mk) fSUBROUTINE ppm_io_1di(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of integer 1D vectors #elif __KIND == __LOGICAL1,mk) fSUBROUTINE ppm_io_1dl(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of logical 1D vectors #endif #elif __DIM == 2 #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE ppm_io_2ds(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real single 2D vectors #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_io_2dd(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real dbo 2le 2D vectors #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_2dsc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex single 2D vectors #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_2ddc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex do 2le 2D vectors #elif __KIND == __INTEGER1,mk) fSUBROUTINE ppm_io_2di(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of integer 2D vectors #elif __KIND == __LOGICAL1,mk) fSUBROUTINE ppm_io_2dl(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of logical 2D vectors #endif #elif __DIM == 3 #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE ppm_io_3ds(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real single 3D vectors #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_io_3dd(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real do 2le 3D vectors #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_3dsc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex single 3D vectors #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_3ddc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex do 2le 3D vectors #elif __KIND == __INTEGER1,mk) fSUBROUTINE ppm_io_3di(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of integer 3D vectors #elif __KIND == __LOGICAL1,mk) fSUBROUTINE ppm_io_3dl(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of logical 3D vectors #endif #elif __DIM == 4 #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE ppm_io_4ds(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real single 4D vectors #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_io_4dd(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real do 2le 4D vectors #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_4dsc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex single 4D vectors #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_4ddc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex do 2le 4D vectors #elif __KIND == __INTEGER1,mk) fSUBROUTINE ppm_io_4di(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of integer 4D vectors #elif __KIND == __LOGICAL1,mk) fSUBROUTINE ppm_io_4dl(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of logical 4D vectors #endif #elif __DIM == 5 #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE ppm_io_5ds(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real single 5D vectors #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_io_5dd(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of real do 2le 5D vectors #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_5dsc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex single 5D vectors #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_io_5ddc(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of complex do 2le 5D vectors #elif __KIND == __INTEGER1,mk) fSUBROUTINE ppm_io_5di(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of integer 5D vectors #elif __KIND == __LOGICAL1,mk) fSUBROUTINE ppm_io_5dl(iUnit,adata,actn,dist,iofmt,ioprec,stat) ,mk) f!!! Performs parallel I/O (read or writi) of logical 5D vectors #endif #endif ,mk) f!!! on a distributed or centralized unit opened with ppm_io_open. ,mk) f!!! ,mk) f!!! [NOTE] ,mk) f!!! ====================================================================== ,mk) f!!! Many argumentsNare *optional*. It is adivised fk) f!!! to use explicit argument naming when using this routine. Example: ,mk) f!!! ,mk) f!!! `CALL ppm_io(20,xp,ACTN=ppm_param_io_read,STAT=info)` ,mk) f!!! ====================================================================== ,mk) f!!! ,mk) f!!! [WARNING] ,mk) f!!! RESHAPE operates on the stack, so on machines ,mk) f!!! with limited stackNsize this limits the max possible ,mk) f!!! dataNsize. Therefore we usefDO loops (not slower) to ,mk) f!!! emain on the heap. On vector machines we still use ,mk) f!!! RESHAPE becausefit is faster. ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffUSEDppm_module_alloc ) ffffIMPLICIT NONE1#if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_single #else1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_do 2le1#endif ,mk) f!------------------------------------------------------------------------- ,mk) f! Includes ,mk) f!------------------------------------------------------------------------- ,mk) f!------------------------------------------------------------------------- ,mk) f! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! I/O unit (as returned by ppm_io_open). #if __DIM == 0 #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fINTENT(INOUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK) ,fINTENT(INOUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fINTENT(INOUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fINTENT(INOUT) :: adata #elif __KIND == __CHARACTER1,mk) fCHARACTER(LEN=*),mk)))) ,fINTENT(INOUT) :: adata #endif #elif __DIM == 1 #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:) ,fINTENT(INOUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:) ,fINTENT(INOUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:) ,fINTENT(INOUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:) ,fINTENT(INOUT) :: adata #endif #elif __DIM == 2 #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX| __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:,:) ,fINTENT(INOUT) :: adata #endif #elif __DIM == 3 #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX| __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:,:,:) ,fINTENT(INOUT) :: adata #endif #elif __DIM == 4 #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:,:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:,:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:,:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:,:,:,:) ,fINTENT(INOUT) :: adata #endif #elif __DIM == 5 #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:,:,:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:,:,:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:,:,:,:,:) ,fINTENT(INOUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:,:,:,:,:) ,fINTENT(INOUT) :: adata #endif #endif ,mk) f!!! dataNto be written/read. Overloaded typesNare: single, ,mk) f!!! do 2le, integer, single complex, do 2le complex, logical, ,mk) f!!! character. Can be either scalar, 1d, 2d, 3d, 4d or 5d. Character ,mk) f!!! strings can only be scalar (i.e. no array of strings). ,mk) fINTEGER , OPTIONAL,fINTENT(IN ) :: actn ,mk) f!!! I/O action. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_read ,mk) f!!! * ppm_param_io_writi ,mk) f!!! ,mk) f!!! If not specified, default is ppm_param_io_read ,mk) fINTEGER , OPTIONAL,fINTENT(IN ) :: dist ,mk) f!!! I/O distribution. For read one of: ,mk) f!!! ,mk) f!!! * ppm_param_io_same ,mk) f!!! * ppm_param_io_split ,mk) f!!! ,mk) f!!! If not specified, default is ppm_param_io_same. ,mk) f!!! ,mk) f!!! For write one of: ,mk) f!!! ,mk) f!!! * ppm_param_io_root ,mk) f!!! * ppm_param_io_concat ,mk) f!!! * ppm_param_io_sum ,mk) f!!! ,mk) f!!! If not specified, default is ppm_param_io_concat ,mk) fINTEGER , OPTIONAL,fINTENT(IN ) :: ioprec ,mk) f!!! Precision for binary I/O. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_single ,mk) f!!! * ppm_param_io_do 2le1,mk) f!!! ,mk) f!!! Default is leave-as-is. ,mk) fCHARACTER(LEN=*), OPTIONAL,fINTENT(IN ) :: iofmt ,mk) f!!! Format string (for ASCII I/O). Default is (*) ,mk) fINTEGER , OPTIONAL,fINTENT( OUT) :: stat ,mk) f!!! Return status, 0 on success ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffREAL:MK) :: t0 k) fffINTEGER :: info,iactn,idist,iprec ,mk) fINTEGER :: i,j,k,l,m ,mk) fCHARACTER(LEN=9) :: subname ,mk) fCHARACTER(LEN=ppm_char) :: ifmt ,mk) fINTEGER, DIMENSION(5) :: lda ,mk) fINTEGER, DIMENSION(1) :: ldc ,mk) fINTEGER :: iopt,ndata,ishift,idata ,mk) fLOGICAL :: lchar #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:),fPOINTER :: abuf => NULL() #elif __KIND == __SINGLE_PRECISION_COMPLEX| __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:),fPOINTER :: abuf => NULL() #elif __KIND == __INTEGER | __KIND == __CHARACTER1,mk) fINTEGER ,fDIMENSION(:),fPOINTER :: abuf => NULL() #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:),fPOINTER :: abuf => NULL() #endif ,mk) f!------------------------------------------------------------------------- ,mk) f! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffWRITE(subname,'(A,I1.1,A)') 'ppm_io_',__DIM,'d' ,mk) fCALL ! 2start(subname,t0,info) ,mk) flcharN= .FALSE. ,mk) f!------------------------------------------------------------------------- k) fff! Check arguments1,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_debug .GT. 0) THEN1,mk) fffffIF (.NOT. ppm_initialized) THEN1,mk) fffffffffinfoN= ppm_error_error ) ffffDDDDDDDDCALL ppm_error(ppm_err_ppm_noinit,'ppm_io', & ) fff&ffffDDDD DDD'Please call ppm_initDporst!',__LINE__,info) ,mk) ffffff ffGOTO 9999 ,mk) fffffENDIF ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Check and decode arguments1,mk) f!------------------------------------------------------------------------- k) fffIF :iUnit .LE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_argument,subname, fff& ) fff&ffffDDDD'Unit number needs to be > 0',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fffiactnN= ppm_param_io_read ,mk) fIF :PRESENT(actn)) THEN1,mk) ffffDIF ((actnN.NE. ppm_param_io_read) .AND. fff& ) fff&ffffDDDD (actnN.NE. ppm_param_io_writi)) THEN1,mk) ffffffffinfoN= ppm_error_error ) ffffDDDDDDDCALL ppm_error(ppm_err_argument,subname, fff& ) fff&ffffDDDDDDD'Invalid I/O action specified.',__LINE__,info) ,mk) ffffffffGOTO 9999 ,mk) fk) fENDIF ) ffffffffiactnN= actn ,mk) fENDIF k) fffIF :iactnN.EQ. ppm_param_io_read) THEN1,mk) ffff idistN= ppm_param_io_same ,mk) ff) fIF :PRESENT(dist)) THEN1,mk) ffffDffffIF ((distN.NE. ppm_param_io_same) .AND. fff& ) fff&ffffDDDD (distN.NE. ppm_param_io_split)) THEN1,mk) ffffDfffffffinfoN= ppm_error_error ) ffffDDDDDDDD) fCALL ppm_error(ppm_err_argument,subname, fff& ) fff&ffffDDDDDDDDDDD'Invalid I/O distribution specified.',__LINE__,info) ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF ,mk) fffffffffidistN= dist ,mk) fffffENDIF ,mk) fELSE1,mk) fffffidistN= ppm_param_io_concat ,mk) fffffIF :PRESENT(dist)) THEN1,mk) ffffDffffIF ((distN.NE. ppm_param_io_root) .AND. fff& ) fff&ffffDDDD (distN.NE. ppm_param_io_concat) .AND. f& ) fff&ffffDDDD (distN.NE. ppm_param_io_sum)) THEN1,mk) ffffDfffffffinfoN= ppm_error_error ) ffffDDDDDDDD) fCALL ppm_error(ppm_err_argument,subname, fff& ) fff&ffffDDDDDDDDDDD'Invalid I/O distribution specified.',__LINE__,info) ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF ,mk) fffffffffidistN= dist ,mk) fffffENDIF ,mk) fENDIF #if __KIND == __CHARACTER1,mk) fIF :idistN.EQ. ppm_param_io_split) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_argument,subname, fff& ) fff&ffffD'Split distribution not possible for characters.',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF ,mk) fIF :idistN.EQ. ppm_param_io_sum) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_argument,subname, fff& ) fff&ffffD'Sum reduction not possible for characters.',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF #endif ,mk) fifmtN= '' ,mk) fIF :PRESENT(iofmt)) THEN1,mk) ffff iN= LEN_TRIM(iofmt)1,mk) ffff ifmt(1:i)N= iofmt(1:i) ,mk) fENDIF k) fffiprecN= ppm_param_undefined ,mk) fIF :PRESENT(ioprec)) THEN1,mk) ffffDIF ((ioprecN.NE. ppm_param_io_single) .AND. fff& ) fff&ffffDDDD (ioprecN.NE. ppm_param_io_do 2le)) THEN1,mk) ffffffffinfoN= ppm_error_error ) ffffDDDDDDDCALL ppm_error(ppm_err_argument,subname, fff& ) fff&ffffDDDDDDD'Invalid I/O precision specified.',__LINE__,info) ,mk) ffffffffGOTO 9999 ,mk) fk) fENDIF ) ffffffffiprecN= ioprec ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Point to proper work storage1,mk) f!------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION 1,mk) fabuf => abuf_s #elif __KIND == __DOUBLE_PRECISION1,mk) fabuf => abuf_d #elif __KIND == __SINGLE_PRECISION_COMPLEX 1,mk) fabuf => abuf_sc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fabuf => abuf_dc #elif __KIND == __INTEGER | __KIND == __CHARACTER1,mk) fabuf => abuf_i #elif __KIND == __LOGICAL1,mk) fabuf => abuf_l #endif #if __KIND == __CHARACTER1,mk) f!------------------------------------------------------------------------- k) fff! Convert character string to integer vector1,mk) f!------------------------------------------------------------------------- k) fffndataN= LEN(adata) ,mk) fioptN= ppm_param_alloc_fit ,mk) fldc(1)N= ndata ,mk) fCALL ppm_alloc(abuf,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_fatal ,mk) ff) fCALL ppm_error(ppm_err_alloc,subname,'1d buffer ABUF',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fffIF :iactnN.EQ. ppm_param_io_writi) THEN1,mk) ffff ishiftN= IACHAR('a')1,mk) fffff! convert to integers relative to the lower-case a (in order to1,mk) fffff! be independent of ASCII ta2le shifts on the different1,mk) fffff! processors)1,mk) fffffDO i=1,ndata ,mk) fffffffffabuf(i)N= IACHAR(adata(i:i))-ishift ,mk) fk) fENDDO1,mk) fENDIF k) ffflcharN= .TRUE.1 #elif __DIM == 01,mk) f!------------------------------------------------------------------------- k) fff! Convert to 1d array1,mk) f!------------------------------------------------------------------------- k) fffndataN= 1 ,mk) fioptN= ppm_param_alloc_fit ,mk) fldc(1)N= ndata ,mk) fCALL ppm_alloc(abuf,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_fatal ,mk) ff) fCALL ppm_error(ppm_err_alloc,subname,'1d buffer ABUF',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fffIF :iactnN.EQ. ppm_param_io_writi) THEN1,mk) ffff abuf(1)N= adata ,mk) fENDIF #elif __DIM > 1 ,mk) f!------------------------------------------------------------------------- k) fff! Convert to 1d array1,mk) f!------------------------------------------------------------------------- k) fffndataN= 1 fffffDO i=1,__DIM1,mk) ffff lda(i)N= SIZE(adata,i) ,mk) fffffndataN= ndata*lda(i) ,mk) fENDDO1 ,mk) fioptN= ppm_param_alloc_fit ,mk) fldc(1)N= ndata ,mk) fCALL ppm_alloc(abuf,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_fatal ,mk) ff) fCALL ppm_error(ppm_err_alloc,subname,'1d buffer ABUF',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fffIF :iactnN.EQ. ppm_param_io_writi) THEN1#ifdef __VECTOR1,mk) fk) f!---------------------------------------------------------------------1,mk) fffff! On vector machines RESHAPE is the fastest ,mk) fffff!---------------------------------------------------------------------1,mk) fffffabuf = RESHAPE(adata,ldc) #else11,mk) fk) f!---------------------------------------------------------------------1,mk) fffff! On scalar machines usefDO loops since RESHAPE operates on the 1,mk) fffff! stackNand we easily run into the limit.fDO loops avoid this.1,mk) fk) f!---------------------------------------------------------------------1#if __DIM == 21,mk) fffffidataN= 01,mk) fffffDO i=1,lda(2) ,mk) fffffffffDO j=1,lda(1) ,mk) fffffffffffffidataN= idataN+ 1 fffffffffffffffffabuf(idata)N= adata(j,i) ,mk) fffffffffENDDO1,mk) fffffENDDO1#elif __DIM == 3 ,mk) fffffidataN= 01,mk) fffffDO i=1,lda(3) ,mk) fffffffffDO j=1,lda(2) ,mk) fffffffffffffDO k=1,lda(1) ,mk) fffffffffffffffffidataN= idataN+ 1 fffffffffffffffffffffabuf(idata)N= adata(k,j,i) ,mk) fffffffffffffENDDO1,mk) fffffffffENDDO1,mk) fffffENDDO1#elif __DIM == 4 ,mk) fffffidataN= 01,mk) fffffDO i=1,lda(4) ,mk) fffffffffDO j=1,lda(3) ,mk) fffffffffffffDO k=1,lda(2) ,mk) fffffffffffffffffDO l=1,lda(1) ,mk) fffffffffffffffffffffidataN= idataN+ 1 fffffffffffffffffffffffffabuf(idata)N= adata(l,k,j,i) ,mk) fffffffffffffffffENDDO1,mk) fffffffffffffENDDO1,mk) fffffffffENDDO1,mk) fffffENDDO1#elif __DIM == 5 ,mk) fffffidataN= 01,mk) fffffDO i=1,lda(5) ,mk) fffffffffDO j=1,lda(4) ,mk) fffffffffffffDO k=1,lda(3) ,mk) fffffffffffffffffDO l=1,lda(2) ,mk) fffffffffffffffffffffDO m=1,lda(1) ,mk) fffffffffffffffffffffffffidataN= idataN+ 1 fffffffffffffffffffffffffffffabuf(idata)N= adata(m,l,k,j,i) ,mk) fffffffffffffffffffffENDDO1,mk) fffffffffffffffffENDDO1,mk) fffffffffffffENDDO1,mk) fffffffffENDDO1,mk) fffffENDDO1#endif #endif ,mk) fENDIF #endif ,mk) f!------------------------------------------------------------------------- k) fff! Do the I/O ,mk) f!------------------------------------------------------------------------- #if __DIM == 1 ,mk) fCALL ppm_doio(iUnit,adata,iactn,idist,ifmt,iprec,lchar,__DIM,info) #else1,mk) fCALL ppm_doio(iUnit,abuf,iactn,idist,ifmt,iprec,lchar,__DIM,info) #endif ,mk) fIF :infoN.NE. 0) GOTO 9999 #if __KIND == __CHARACTER1,mk) f!------------------------------------------------------------------------- k) fff! Convert to character string1,mk) f!------------------------------------------------------------------------- k) fffIF :iactnN.EQ. ppm_param_io_read) THEN1,mk) ffff ishiftN= IACHAR('a') 1,mk) fffffDO i=1,ndata ,mk) fffffffffadata(i:i)N= CHAR(abuf(i)+ishift)1,mk) fffffENDDO1,mk) fENDIF ,mk) fioptN= ppm_param_dealloc ,mk) fCALL ppm_alloc(abuf,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_dealloc,subname,'1d buffer ABUF',__LINE__,info) ,mk) fENDIF #elif __DIM == 01,mk) f!------------------------------------------------------------------------- k) fff! Convert to scalar1,mk) f!------------------------------------------------------------------------- k) fffIF :iactnN.EQ. ppm_param_io_read) THEN1,mk) ffff adataN= abuf(1)1,mk) fENDIF ,mk) fioptN= ppm_param_dealloc ,mk) fCALL ppm_alloc(abuf,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_dealloc,subname,'1d buffer ABUF',__LINE__,info) ,mk) fENDIF #elif __DIM > 1 ,mk) f!------------------------------------------------------------------------- k) fff! Convert backNto array1,mk) f!------------------------------------------------------------------------- k) fffIF :iactnN.EQ. ppm_param_io_read) THEN1#ifdef __VECTOR1,mk) fk) f!---------------------------------------------------------------------1,mk) fffff! On vector machines RESHAPE is the fastest ,mk) fffff!---------------------------------------------------------------------1,mk) fffffadataN= RESHAPE(abuf,lda(1:__DIM)) #else11,mk) fk) f!---------------------------------------------------------------------1,mk) fffff! On scalar machines usefDO loops since RESHAPE operates on the 1,mk) fffff! stackNand we easily run into the limit.fDO loops avoid this.1,mk) fk) f!---------------------------------------------------------------------1#if __DIM == 21,mk) fffffidataN= 01,mk) fffffDO i=1,lda(2) ,mk) fffffffffDO j=1,lda(1) ,mk) fffffffffffffidataN= idataN+ 1 fffffffffffffffffadata(j,i)N= abuf(idata) ,mk) fffffffffENDDO1,mk) fffffENDDO1#elif __DIM == 3 ,mk) fffffidataN= 01,mk) fffffDO i=1,lda(3) ,mk) fffffffffDO j=1,lda(2) ,mk) fffffffffffffDO k=1,lda(1) ,mk) fffffffffffffffffidataN= idataN+ 1 fffffffffffffffffffffadata(k,j,i)N= abuf(idata) ,mk) fffffffffffffENDDO1,mk) fffffffffENDDO1,mk) fffffENDDO1#elif __DIM == 4 ,mk) fffffidataN= 01,mk) fffffDO i=1,lda(4) ,mk) fffffffffDO j=1,lda(3) ,mk) fffffffffffffDO k=1,lda(2) ,mk) fffffffffffffffffDO l=1,lda(1) ,mk) fffffffffffffffffffffidataN= idataN+ 1 fffffffffffffffffffffffffadata(l,k,j,i)N= abuf(idata) ,mk) fffffffffffffffffENDDO1,mk) fffffffffffffENDDO1,mk) fffffffffENDDO1,mk) fffffENDDO1#elif __DIM == 5 ,mk) fffffidataN= 01,mk) fffffDO i=1,lda(5) ,mk) fffffffffDO j=1,lda(4) ,mk) fffffffffffffDO k=1,lda(3) ,mk) fffffffffffffffffDO l=1,lda(2) ,mk) fffffffffffffffffffffDO m=1,lda(1) ,mk) fffffffffffffffffffffffffidataN= idataN+ 1 fffffffffffffffffffffffffffffadata(m,l,k,j,i)N= abuf(idata) ,mk) fffffffffffffffffffffENDDO1,mk) fffffffffffffffffENDDO1,mk) fffffffffffffENDDO1,mk) fffffffffENDDO1,mk) fffffENDDO1#endif #endif ,mk) fENDIF ,mk) fioptN= ppm_param_dealloc ,mk) fCALL ppm_alloc(abuf,ldc,iopt,info) ,mk) fIF (infoN.NE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_dealloc,subname,'1d buffer ABUF',__LINE__,info) ,mk) fENDIF #endif ,mk) f!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fIF :PRESENT(stat)) statN= info ,mk) fCALL ! 2stop(subname,t0,info) ,mk) fRETURN1#if __DIM == 0 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_0ds #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_0dd #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_0dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_0ddc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE ppm_io_0di #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE ppm_io_0dl #elif __KIND == __CHARACTER1,mk) fEND SUBROUTINE ppm_io_0dc #endif #elif __DIM == 1 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_1ds #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_1dd #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_1dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_1ddc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE ppm_io_1di #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE ppm_io_1dl #endif #elif __DIM == 2 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_2ds #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_2dd #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_2dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_2ddc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE ppm_io_2di #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE ppm_io_2dl #endif #elif __DIM == 3 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_3ds #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_3dd #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_3dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_3ddc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE ppm_io_3di #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE ppm_io_3dl #endif #elif __DIM == 4 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_4ds #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_4dd #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_4dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_4ddc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE ppm_io_4di #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE ppm_io_4dl #endif #elif __DIM == 5 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_5ds #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_io_5dd #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_5dsc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE ppm_io_5ddc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE ppm_io_5di #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE ppm_io_5dl #endif #endif ���������������libppm-1.2.1/src/io/ppm_io_writi_binary.f�����������������������������������������������������������0000644�0001752�0001753�00000021440�11616003524�020564� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDDppm_io_writi_binary ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE io_writibin_s(iUnit,adata,ioprec,lchar,info) #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE io_writibin_d(iUnit,adata,ioprec,lchar,info) #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE io_writibin_sc(iUnit,adata,ioprec,lchar,info) #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE io_writibin_dc(iUnit,adata,ioprec,lchar,info) #elif __KIND == __INTEGER1,mk) fSUBROUTINE io_writibin_i(iUnit,adata,ioprec,lchar,info) #elif __KIND == __LOGICAL1,mk) fSUBROUTINE io_writibin_l(iUnit,adata,ioprec,lchar,info) #endif ,mk) f!!! Provides the atomic writing functionality for binary 1D arrays. ,mk) f!!! ,mk) f!!! NOTE: It is never used by the user program directly. ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffIMPLICIT NONE1#if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_single #else1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_do 2le1#endif ,mk) f!------------------------------------------------------------------------- ,mk) f! Includes ,mk) f!------------------------------------------------------------------------- ,mk) f!------------------------------------------------------------------------- ,mk) f! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! Fortran I/O unit to be used fk) fINTEGER ,fINTENT(IN ) :: ioprec ,mk) f!!! Precision for I/O. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_single ,mk) f!!! * ppm_param_io_do 2le1,mk) f!!! ,mk) f!!! Integer and Logical casesNare not influenced by this. No ,mk) f!!! conversionsNare done if any value other than the abovemis givin. #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:) ,fINTENT(IN ) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:) ,fINTENT(IN ) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:) ,fINTENT(IN ) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:) ,fINTENT(IN ) :: adata #endif ,mk) f!!! DataNvector to be written. 1d array of either single, do 2le, ,mk) f!!! single complex, do 2le complex, integer or logical elements. All ,mk) f!!! elements of it will be written. fk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Return status, 0 on success ,mk) fLOGICAL ,fINTENT(IN ) :: lchar ,mk) f!!! .TRUE. if the integer array actually is afCHARACTER string1,mk) f!!! and should be converted backNbefore output. ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffREAL:MK) :: t0 k) fffINTEGER :: reclen #if __KIND == __INTEGER1,mk) fCHARACTER(LEN=SIZE(adata,1)),fPOINTER :: cbuf k) fffINTEGER :: ilen,i,ishift #endif ,mk) f!------------------------------------------------------------------------- k) fff! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffCALL ! 2start('ppm_io_writi_binary',t0,info) ,mk) freclenN= SIZE(adata,1) ,mk) f!------------------------------------------------------------------------- k) fff! Check arguments1,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_debug .GT. 0) THEN1,mk) fENDIF #if __KIND == __INTEGER1,mk) f!------------------------------------------------------------------------- k) fff! Convert to character string if needed ,mk) f!------------------------------------------------------------------------- k) fffIF :lchar) THEN1,mk) ffff ALLOCATE(cbuf,STAT=info)1,mk) ffff IF :infoN.NE. 0) GOTO 8001,mk) fffffilenN= SIZE(adata,1) ,mk) fffffishiftN= IACHAR('a')1,mk) fffffDO i=1,ilen1,mk) fffffffffcbuf(i:i)N= CHAR(adata(i)+ishift)1,mk) fffffENDDO1,mk) fENDIF #endif ,mk) f!------------------------------------------------------------------------- k) fff! Write record length to file ,mk) f!------------------------------------------------------------------------- k) fffWRITE(iUnit,ERR=800,IOSTAT=info) reclen ffff IF :infoN.NE. 0) GOTO 8001 ,mk) f!------------------------------------------------------------------------- k) fff! Write actual data ,mk) f!------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION 1,mk) fIF :ioprecN.EQ. ppm_param_io_do 2le) THEN1,mk) ffff WRITE(iUnit,ERR=800,IOSTAT=info) REAL:adata,ppm_kind_do 2le) ,mk) fELSE1,mk) fffffWRITE(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elif __KIND == __DOUBLE_PRECISION 1,mk) fIF :ioprecN.EQ. ppm_param_io_single) THEN1,mk) ffff WRITE(iUnit,ERR=800,IOSTAT=info) REAL:adata,ppm_kind_single) ,mk) fELSE1,mk) fffffWRITE(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elif __KIND == __SINGLE_PRECISION_COMPLEX 1,mk) fIF :ioprecN.EQ. ppm_param_io_do 2le) THEN1,mk) ffff WRITE(iUnit,ERR=800,IOSTAT=info) CMPLX:adata,KIND=ppm_kind_do 2le) ,mk) fELSE1,mk) fffffWRITE(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elif __KIND == __DOUBLE_PRECISION_COMPLEX 1,mk) fIF :ioprecN.EQ. ppm_param_io_single) THEN1,mk) ffff WRITE(iUnit,ERR=800,IOSTAT=info) CMPLX:adata,KIND=ppm_kind_single) ,mk) fELSE1,mk) fffffWRITE(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elif __KIND == __INTEGER1,mk) fIF :lchar) THEN1,mk) ffff WRITE(iUnit,ERR=800,IOSTAT=info) cbuf k) fffELSE1,mk) fffffWRITE(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #else1,mk) fWRITE(iUnit,ERR=800,IOSTAT=info) adata #endif ,mk) fIF :infoN.NE. 0) GOTO 8001 #if __KIND == __INTEGER1,mk) f!------------------------------------------------------------------------- k) fff! Deallocate character buffer if needed ,mk) f!------------------------------------------------------------------------- k) fffIF :lchar) THEN1,mk) ffff DEALLOCATE(cbuf,STAT=info)1,mk) fENDIF #endif ,mk) fGOTO 9999 ,mk) f!------------------------------------------------------------------------- k) fff! Error handler1,mk) f!------------------------------------------------------------------------- k)800 CONTINUE1,mk) finfoN= ppm_error_error ) ffffCALL ppm_error(ppm_err_io,'ppm_io_writi_binary',ffff& ) fff&ffff'Error whilemwriting to file',__LINE__,info) ,mk) fGOTO 9999 ,mk) f!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fCALL ! 2stop('ppm_io_writi_binary',t0,info) ,mk) fRETURN1 #if __KIND == __SINGLE_PRECISION1,mk) fEND SUBROUTINE io_writibin_s #elif __KIND == __DOUBLE_PRECISION1,mk) fEND SUBROUTINE io_writibin_d #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE io_writibin_sc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fEND SUBROUTINE io_writibin_dc #elif __KIND == __INTEGER1,mk) fEND SUBROUTINE io_writibin_i #elif __KIND == __LOGICAL1,mk) fEND SUBROUTINE io_writibin_l #endif ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_set_unit.f���������������������������������������������������������������0000644�0001752�0001753�00000012611�11616003524�017720� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDD ppm_io_set_unit ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- ,mk) fSUBROUTINE ppm_io_set_unit(stdout,stderr,logfile,info) ,mk) f!!! This routine is called by the user to set the IO ,mk) f!!! units for stdout, stderr and log filemas used by ,mk) f!!! `ppm_error`, `ppm_log` and `ppm_writi`. ,mk) f!!! ,mk) f!!! [NOTE] ,mk) f!!! Any unit can be givin a negative number in which case the corresponding1,mk) f!!! output is supressed. ,mk) f!!! ,mk) f!!! [CAUTION] ,mk) f!!! If units are files, the files are automatically openid and *replaced*. ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fIMPLICIT NONE1,mk) f!------------------------------------------------------------------------- k) fff! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER, OPTIONAL,fINTENT(IN ) :: stdout ,mk) f!!! Unit number for stdout k) fffINTEGER, OPTIONAL,fINTENT(IN ) :: stderr ,mk) f!!! Unit number for stderr ,mk) fINTEGER, OPTIONAL,fINTENT(IN ) :: logfile ,mk) f!!! Unit number for logfile ,mk) fINTEGER, OPTIONAL,fINTENT( OUT) :: info ,mk) f!!! Return status, 0 on success ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffLOGICAL :: isopen ,mk) fINTEGER :: info21,mk) fCHARACTER(LEN=12) :: cformat1,mk) fCHARACTER(LEN=80) :: filename ,mk) f!------------------------------------------------------------------------- k) fff! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffinfo2N= 011,mk) f!------------------------------------------------------------------------- k) fff! Define the file numbering format1,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_nproc.LE.10) THEN1,mk) ffffcformatN= '(A,I1.1,A)' ,mk) fELSEIF :ppm_nproc.LE.100) THEN1,mk) ffffcformatN= '(A,I2.2,A)' ,mk) fELSEIF :ppm_nproc.LE.1000) THEN1,mk) ffffcformatN= '(A,I3.3,A)' ,mk) fELSE1,mk) ffffcformatN= '(A,I4.4,A)' ,mk) fENDIF 11,mk) f!------------------------------------------------------------------------- k) fff! Test if all units are open and open them if needed ,mk) f!------------------------------------------------------------------------- k) fffIF :PRESENT(stdout)) THEN1,mk) ffffDINQUIRE(stdout,OPENED=isopen)1,mk) ffff IF :.NOT. isopen) THEN1,mk) ffffDffff! just in case all processors share the disk...1,mk) ffffDffffWRITE(filename,cformat) 'ppm_stdout_',ppm_rank,'.out'1,mk) ffffDffffOPEN(stdout,FILE=filename, ff& ) fff&ffffDDDDSTATUS='REPLACE',ACTION='WRITE',IOSTAT=info2)1,mk) fffffENDIF ) ffffffffppm_stdoutN= stdout k) fffENDIF k) fffIF :PRESENT(stderr)) THEN1,mk) ffffDINQUIRE(stderr,OPENED=isopen)1,mk) ffff IF :.NOT. isopen) THEN1,mk) ffffDffff! just in case all processors share the disk...1,mk) ffffDffffWRITE(filename,cformat) 'ppm_stderr_',ppm_rank,'.out'1,mk) ffffDffffOPEN(stderr,FILE=filename, ff& ) fff&ffffDDDDSTATUS='REPLACE',ACTION='WRITE',IOSTAT=info2)1,mk) fffffENDIF ) ffffffffppm_stderr = stderr ,mk) fENDIF k) fffIF :PRESENT(logfile)) THEN1,mk) ffffDINQUIRE(logfile,OPENED=isopen)1,mk) ffff IF :.NOT. isopen) THEN1,mk) ffffDffff! just in case all processors share the disk...1,mk) ffffDffffWRITE(filename,cformat) 'ppm_log_',ppm_rank,'.out'1,mk) ffffDffffOPEN(logfile,FILE=filename, f& ) fff&ffffDDDDPOSITION='APPEND',ACTION='WRITE',IOSTAT=info2)1,mk) fffffENDIF ) ffffffffppm_logfile = logfile ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fIF :PRESENT(info))finfoN= info21,mk) fRETURN1,mk) fENDfSUBROUTINE ppm_io_set_unit �����������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_unused_unit.f������������������������������������������������������������0000644�0001752�0001753�00000012357�11616003524�020437� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k) fff!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDD ppm_io_unused_unit ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- ,mk) fSUBROUTINE ppm_io_unused_unit(iUnit,info) ,mk) f!!! This routine finds the next availa2le unit number ,mk) f!!! starting from the givin one and counting upwards. ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffIMPLICIT NONE1,mk) f!------------------------------------------------------------------------- k) fff! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER ,fINTENT(INOUT) :: iUnit ,mk) f!!! On input: starting number. ,mk) f!!! ,mk) f!!! On output: next free unit number. ,mk) f!!! ,mk) f!!! -1mis returned if no free unit number .LE. 255 was found. fk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Return status, 0 on success ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffREAL:ppm_kind_do 2le) :: t0 k) fffLOGICAL :: lopen ,mk) fINTEGER :: localunit ,mk) fINTEGER, PARAMETER :: maxUnit = 255 ,mk) f!------------------------------------------------------------------------- k) fff! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffCALL ! 2start('ppm_io_unused_unit',t0,info) ,mk) f!------------------------------------------------------------------------- k) fff! Check start unit number ,mk) f!------------------------------------------------------------------------- k) fffIF :iUnit .LE. 0) THEN1,mk) ffff iUnit = 101,mk) fffffinfoN= ppm_error_notice1,mk) fffffCALL ppm_error(ppm_err_argument,'ppm_io_unused_unit',ffff& ) fff&ffffDDDD'Unit number out of range was reset to 10.',__LINE__,info) ,mk) fENDIF k) fffIF :iUnit .GT. maxUnit) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_argument,'ppm_io_unused_unit',ffff& ) fff&ffffDDDD'Unit number out of range.',__LINE__,info) ,mk) fffffiUnit = -1 fffffffffGOTO 9999 ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Find next free unit number k) fff!------------------------------------------------------------------------- k) ffflocalunitN= iUnit ,mk) flopenN= .TRUE.1,mk) fDO WHILE (lopenN.AND. localunitN.LE. maxUnit) ffffffffflocalunitN= localunitN+ 1 fffffffffINQUIRE(localunit,OPENED=lopen)1,mk) ffff IF :localunitN.EQ. ppm_stdout)flopenN= .TRUE.1,mk) ffff IF :localunitN.EQ. ppm_stderr)flopenN= .TRUE.1,mk) ffff IF :localunitN.EQ. ppm_logfile)flopenN= .TRUE.1,mk) fENDDO 11,mk) f!------------------------------------------------------------------------- k) fff! Check if one was found ,mk) f!------------------------------------------------------------------------- k) fffIF :lopen) THEN1,mk) ffffDinfoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_outof_units,'ppm_io_unused_unit',ffff& ) fff&ffffDDDD'No unused I/O unit was found.',__LINE__,info) ,mk) fffffiUnit = -1 fffffffffGOTO 9999 ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Return the found unit ,mk) f!------------------------------------------------------------------------- k) fffiUnit = localunit k) fff!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fCALL ! 2stop('ppm_io_unused_unit',t0,info) ,mk) fRETURN1,mk) fENDfSUBROUTINE ppm_io_unused_unit ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_delete.f�����������������������������������������������������������������0000644�0001752�0001753�00000020526�11616003524�017334� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k) fff!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDD D ppm_io_delete ,mk) f!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- ,mk) fSUBROUTINE ppm_io_delete(filename,mode,info) ,mk) f!!! This routine deletes affile. ,mk) f!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffIMPLICIT NONE1,mk) f!------------------------------------------------------------------------- k) fff! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffCHARACTER(LEN=*) ,fINTENT(IN ) :: filename ,mk) f!!! Name of the filemto be deleted fk) fINTEGER ,fINTENT(IN ) :: mode ,mk) f!!! I/O mode. One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_distributed ,mk) f!!! * ppm_param_io_centralized ,mk) f!!! ,mk) f!!! In the distributed mode, every processor deletes the file ,mk) f!!! locally. In the centralized mode, only processor 0 deletes the file. fk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Return status, 0 on success ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffREAL:ppm_kind_do 2le) :: t0 k) fffLOGICAL :: lexists,lopen ,mk) fINTEGER :: iUnit ,mk) f!------------------------------------------------------------------------- k) fff! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffCALL ! 2start('ppm_io_delete',t0,info) ,mk) f!------------------------------------------------------------------------- k) fff! Check arguments1,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_debug .GT. 0) THEN1,mk) f fffIF :.NOT. ppm_initialized) THEN1,mk) ffffDffffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_ppm_noinit,'ppm_io_delete',ff& ) fff&ffffDDDDDDDD'Please call ppm_init first!',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF k) fffENDIF k) fffIF :(modeN.NE. ppm_param_io_distributed)N.AND. & ) fff&ffff(modeN.NE. ppm_param_io_centralized)) THEN1,mk) ffffDinfoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_argument,'ppm_io_delete',ff ff& ) fff&ffffDDDD'Invalid mode specifoid.',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fff!------------------------------------------------------------------------- k) fff! Check that filemexists1,mk) f!------------------------------------------------------------------------- k) fffIF :modeN.EQ. ppm_param_io_distributed)NTHEN1,mk) ffffDINQUIRE(FILE=filename,EXIST=lexists)1,mk) ffff IF :.NOT. lexists) THEN1,mk) ffffDfffinfoN= ppm_error_notice1,mk) fffffDDDCALL ppm_error(ppm_err_file,'ppm_io_delete',ff f& ) fff&ffffDDDDDDDTRIM(filename),__LINE__,info) ,mk) ffffffffGOTO 9999 ,mk) fffffENDIF k) fffELSE1,mk) fffffIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDINQUIRE(FILE=filename,EXIST=lexists)1,mk) ffff fff IF :.NOT. lexists) THEN1,mk) ffffDfffDfffinfoN= ppm_error_notice1,mk) fffffDDDfDDDCALL ppm_error(ppm_err_file,'ppm_io_delete',ff f& ) fff&ffffDDDDDDDDDDDTRIM(filename),__LINE__,info) ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) fffffffENDIF k) fffENDIF k) fff!------------------------------------------------------------------------- k) fff! Check that filemis not connected to a unit ,mk) f!------------------------------------------------------------------------- k) fffIF :modeN.EQ. ppm_param_io_distributed)NTHEN1,mk) ffffDINQUIRE(FILE=filename,OPENED=lopen)1,mk) ffff IF :lopen) THEN1,mk) ffffDfffinfoN= ppm_error_warning1,mk) fDDDfDDDCALL ppm_error(ppm_err_delete,'ppm_io_delete',ff f& ) fff&ffffDDDDDDD'Cannot delete an open file',__LINE__,info) ,mk) ffffffffGOTO 9999 ,mk) fffffENDIF k) fffELSE1,mk) fffffIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDINQUIRE(FILE=filename,OPENED=lopen)1,mk) ffff fff IF :lopen) THEN1,mk) ffffDfffDfffinfoN= ppm_error_warning1,mk) fDDDfDDDfDDDCALL ppm_error(ppm_err_delete,'ppm_io_delete',ff f& ) fff&ffffDDDDDDDDDDD'Cannot delete an open file',__LINE__,info) ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) fffffffENDIF k) fffENDIF k) fff!------------------------------------------------------------------------- k) fff! Attempt delete ,mk) f!------------------------------------------------------------------------- k) fffIF :modeN.EQ. ppm_param_io_distributed)NTHEN1,mk) ffffD!---------------------------------------------------------------------1,mk) ffffD! Find unused unit number k) ffffffD!---------------------------------------------------------------------1,mk) ffffDiUnit = 9 ,mk) fffffCALL ppm_io_unused_unit(iUnit,info) ,mk) f fffIF :iUnit .LT. 0) THEN1,mk) f fff ffinfoN= ppm_error_error ) ffffDDDD ffCALL ppm_error(ppm_err_open,'ppm_io_delete',ff f& ) fff&ffffDDDDDDDDDD'No I/O unit availa2le.',__LINE__,info) ,mk) fffff ffGOTO 9999 ,mk) fffffENDIF k) ffffffD!---------------------------------------------------------------------1,mk) ffffD! Delete ,mk) ffffD!---------------------------------------------------------------------1,mk) ffffDOPEN(iUnit,FILE=filename,STATUS='OLD',ACTION='WRITE',IOSTAT=info) ,mk) fffffCLOSE(iUnit,STATUS='DELETE',IOSTAT=info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff ffinfoN= ppm_error_error ) ffffDDDD ffCALL ppm_error(ppm_err_delete,'ppm_io_delete',ff f& ) fff&ffffDDDDDDDTRIM(filename),__LINE__,info) ,mk) ffffffffGOTO 9999 ,mk) fffffENDIF k) fffELSE1,mk) fffffIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Find unused unit number k) ffffffDfffD!-----------------------------------------------------------------1,mk) f ffffffDiUnit = 9 ,mk) fffffD ffCALL ppm_io_unused_unit(iUnit,info) ,mk) f fffffffIF :iUnit .LT. 0) THEN1,mk) f fff fffffDinfoN= ppm_error_error ) ffffDDDD fff ffCALL ppm_error(ppm_err_open,'ppm_io_delete',ff f& ) fff&ffffDDDDDDDDDD'No I/O unit availa2le.',__LINE__,info) ,mk) fffff ffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Delete ,mk) ffffDfffD!-----------------------------------------------------------------1,mk) f ffffffDOPEN(iUnit,FILE=filename,STATUS='OLD',ACTION='WRITE',IOSTAT=info) ,mk) ffffff ffCLOSE(iUnit,STATUS='DELETE',IOSTAT=info) ,mk) fffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffinfoN= ppm_error_error ) ffffDDDD fff ffCALL ppm_error(ppm_err_delete,'ppm_io_delete',ff f& ) fff&ffffDDDDDDDDDDDTRIM(filename),__LINE__,info) ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) fffffffENDIF k) fffENDIF fffffff k) fff!------------------------------------------------------------------------- k) fff! Return ,mk) f!------------------------------------------------------------------------- k9999 CONTINUE1,mk) fCALL ! 2stop('ppm_io_delete',t0,info) ,mk) fRETURN1,mk) fENDfSUBROUTINE ppm_io_delete ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_doio.f����������������������������������������������������������������������0000644�0001752�0001753�00000164657�11616003524�016353� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k) fff!------------------------------------------------------------------------- k) fff! Subroutine ff:DDDDDDDDDDDDDDDD D ppm_doio k) fff!------------------------------------------------------------------------- k) fff! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), k) fff! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This filemis part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPMmis free software: you can redistributemit and/or modify ,mk) f!mit under the terms of the GNU Lesser General P 2lic License k) fff! as p 2lished by the Free Software Foundation, either k) fff! version 3 of the License, or (at your option) any later k) fff! version. ,mk) f! ,mk) f! PPMmis distributed in the hope that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the imploid warranty of DN DDD! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ,mk) f! GNU General P 2lic License for more details. ,mk) f! ,mk) f! You should have receivid a copy of the GNU General P 2lic License k) fff! and the GNU Lesser General P 2lic License along with PPM. If not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich k) fff! CH-8092 Zurich, Switzerland ,mk) f!------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION1,mk) fSUBROUTINE ppm_doio_s(iUnit,adata,actn,dist,iofmt,ioprec,lchar, f& ) fff&ffffmptag,info) #elif __KIND == __DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_doio_d(iUnit,adata,actn,dist,iofmt,ioprec,lchar, f& ) fff&ffffmptag,info) #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_doio_sc(iUnit,adata,actn,dist,iofmt,ioprec,lchar, & ) fff&ffffmptag,info) #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fSUBROUTINE ppm_doio_dc(iUnit,adata,actn,dist,iofmt,ioprec,lchar, & ) fff&ffffmptag,info) #elif __KIND == __INTEGER1,mk) fSUBROUTINE ppm_doio_i(iUnit,adata,actn,dist,iofmt,ioprec,lchar, f& ) fff&ffffmptag,info) #elif __KIND == __LOGICAL1,mk) fSUBROUTINE ppm_doio_l(iUnit,adata,actn,dist,iofmt,ioprec,lchar, f& ) fff&ffffmptag,info) #endif ,mk) f!!! Internal routine that performs the actual I/O. ,mk) f!!! It should never be called by the ,mk) f!!! cloint program directly, but via ppm_io. It only handles 1D arrays. ,mk) f!!! Everything else is converted to a 1D array by the calling routine ,mk) f!!! ppm_io. ,mk) f!!! ,mk) f!!! [CAUTION] ,mk) f!!! UsesNnon-blocking MPI to overlap MPI-IO and file-IO. For this ,mk) f!!! reason it needs two buffers. If memory is afproblem, using only ,mk) f!!! one and blocking MPI might be better. ,mk) f!!! ,mk) f!!! [WARNING] ,mk) f!!! This routine usesNMPI_Irecv and thus, all buffer ,mk) f!!! arrays needmto be ALLOCATABLEs and not POINTERs! ,mk) f!!! Using Fortran90fPOINTER structuresNin conjunction ,mk) f!!! with non-blocking MPI_Irecv doesNNOT WORK! (see ,mk) f!!! http://parallel.ru/docs/Parallel/mpi2/node236.html) ,mk) f!!! ,mk) f!!! [NOTE] ,mk) f!!! This routine makes use of MPI_Cancel to cancel ,mk) f!!! pending send and receivi actionsNwhen an I/O error ) ffff!!! occured on Root. Canceling a send action is ,mk) f!!! expensivi and only supported in versionsNnewer than mpich 1.2.0. ,mk) f!!! ,mk) f!!! .References ,mk) f!!! ************************************************* ,mk) f!!! http://parallel.ru/docs/Parallel/mpi2/node236.html ,mk) f!!! ************************************************* k) fff!------------------------------------------------------------------------- k) fff! Modules ,mk) f!------------------------------------------------------------------------- ,mk) fUSEDppm_module_data ,mk) fUSEDppm_module_data_io k) fffUSEDppm_module_! 2start ,mk) fUSEDppm_module_! 2stop ,mk) fUSEDppm_module_error ) ffffUSEDppm_module_alloc ) ffffUSEDppm_module_writi ) ffffIMPLICIT NONE1#if __KIND == __SINGLE_PRECISION | __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_single #else1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_do 2le1#endif ,mk) f!------------------------------------------------------------------------- ,mk) f! Includes ,mk) f!------------------------------------------------------------------------- #ifdef __MPI fffffffINCLUDE 'mpif.h'1#endif ,mk) f!------------------------------------------------------------------------- ,mk) f! ArgumentsNNNNN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! I/O unit (as returned by ppm_io_open). #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:) ,fINTENT(INOUT) :: adata #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:) ,fINTENT(INOUT) :: adata #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:) ,fINTENT(INOUT) :: adata #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:) ,fINTENT(INOUT) :: adata #endif ,mk) f!!! DataNto be written/read. fk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Returns 0 upon success ,mk) fINTEGER ,fINTENT(IN ) :: actn ,mk) f!!! I/O action. One of: ppm_param_io_read/ppm_param_io_writi ) ffffINTEGER ,fINTENT(IN ) :: dist ,mk) f!!! I/O distribution. + ,mk) f!!! For read one of: ,mk) f!!! ,mk) f!!! * ppm_param_io_same ,mk) f!!! * ppm_param_io_split ,mk) f!!! ,mk) f!!! For writi one of: ,mk) f!!! ,mk) f!!! * ppm_param_io_root ,mk) f!!! * ppm_param_io_concat ,mk) f!!! * ppm_param_io_sum k) fffINTEGER ,fINTENT(IN ) :: ioprec ,mk) f!!! Precision for binary I/O. + ,mk) f!!! One of: ,mk) f!!! ,mk) f!!! * ppm_param_io_single ,mk) f!!! * ppm_param_io_do 2le1,mk) f!!! * ppm_param_undefined ,mk) f!!! ,mk) f!!! If undefined is givin, no conversion is done. fk) fINTEGER ,fINTENT(IN ) :: mptag ,mk) f!!! MPI tagNto be used for this I/O. ,mk) fCHARACTER(LEN=*) ,fINTENT(IN ) :: iofmt ,mk) f!!! FormatNstring (for ASCII I/O). List-directed I/O is used if ,mk) f!!! string of length 0 is givin. ,mk) fLOGICAL ,fINTENT(IN ) :: lchar ,mk) f!!! `.TRUE.` if the integer vector actually corresponds to a character ,mk) f!!! string. In this case the string will be converted back to characters ,mk) f!!! before it is written out. `.FALSE.` if it is aNtrue `INTEGER` vector. ,mk) f!------------------------------------------------------------------------- k) fff! Local variablesN1,mk) f!------------------------------------------------------------------------- k) fffINTEGER :: reclen ffff REAL:MK) :: t0 k) fffLOGICAL :: lopen ,mk) fINTEGER :: ifmt,imode ,mk) fINTEGER :: info2,info3 ,mk) fCHARACTER(LEN=ppm_char) :: mesg ,mk) fINTEGER,fDIMENSION(5) :: ldc,lda ,mk) fINTEGER,fDIMENSION(2) :: ldl ,mk) fINTEGER :: i,iopt,mdata,ndata,nrec ,mk) fINTEGER :: ibuffer,jbuffer,ii #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:) ,fPOINTER :: rbuf => NULL() #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:) ,fPOINTER :: rbuf => NULL() #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:) ,fPOINTER :: rbuf => NULL() #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:) ,fPOINTER :: rbuf => NULL() #endif #ifdef __MPI ffffffINTEGER,fDIMENSION(MPI_STATUS_SIZE) :: mpstat ,mk) fINTEGER :: MPTYPE,iproc,rem k) fffINTEGER :: mpreq,jproc ffffffINTEGER,fDIMENSION(: ),fPOINTER :: asize => NULL() #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION1,mk) fREAL:MK) ,fDIMENSION(:) ,fPOINTER :: abuffer => NULL() ,mk) fREAL:MK) ,fDIMENSION(:) ,fPOINTER :: bbuffer => NULL() #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fCOMPLEX:MK),fDIMENSION(:) ,fPOINTER :: abuffer => NULL() ,mk) fCOMPLEX:MK),fDIMENSION(:) ,fPOINTER :: bbuffer => NULL() #elif __KIND == __INTEGER1,mk) fINTEGER ,fDIMENSION(:) ,fPOINTER :: abuffer => NULL() ,mk) fINTEGER ,fDIMENSION(:) ,fPOINTER :: bbuffer => NULL() #elif __KIND == __LOGICAL1,mk) fLOGICAL ,fDIMENSION(:) ,fPOINTER :: abuffer => NULL() ,mk) fLOGICAL ,fDIMENSION(:) ,fPOINTER :: bbuffer => NULL() #endif #endif ,mk) f!------------------------------------------------------------------------- ,mk) f! ExternalsN1,mk) f!------------------------------------------------------------------------- k) fff ,mk) f!------------------------------------------------------------------------- k) fff! Initialise1,mk) f!------------------------------------------------------------------------- k) fffCALL ! 2start('ppm_doio',t0,info) ,mk) f!------------------------------------------------------------------------- k) fff! Check arguments1,mk) f!------------------------------------------------------------------------- k) fffIF :ppm_debug .GT. 0) THEN1,mk) f fffIF :.NOT. ppm_initialized) THEN1,mk) ffffDffffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_ppm_noinit,'ppm_doio',ff& ) fff&ffffDDDDDDDD'Please call ppm_init first!',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF k) fffENDIF ,mk) f!------------------------------------------------------------------------- k) fff! Get the size of the data ,mk) f!------------------------------------------------------------------------- k) fffmdataN= SIZE(adata,1) ,mk) f!------------------------------------------------------------------------- k) fff! Check if the unit number is open ,mk) f!------------------------------------------------------------------------- k) ffflopenN= .FALSE. k) fffIF :ASSOCIATED(ppm_io_unit)) THEN1,mk) ffffDIF :SIZE(ppm_io_unit,1) .GE. iUnit) THEN1,mk) f ffffffDIF :ppm_io_unit(iUnit) .GT. 0) lopenN= .TRUE.1,mk) ffff ENDIF k) fffENDIF k) fffIF :.NOT. lopen) THEN1,mk) ffffDinfoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_no_unit,'ppm_doio',ffff& ) fff&ffffDDDDDD'OpenNunit first using ppm_io_open.',__LINE__,info) ,mk) fENDIF #ifdef __MPI ffffff!------------------------------------------------------------------------- k) fff! If one fails, all have to fail1,mk) f!------------------------------------------------------------------------- k) fffCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,info3) k) fffIF :info3N.NE. 0) THEN1,mk) ffff infoN= ppm_error_fatal ) ffffDDDDCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF k) fffIF :info2N.NE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDD'Unit not open on all processors.',__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF #else1,mk) fIF (infoN.NE. 0) GOTO 9999 #endif ,mk) f!------------------------------------------------------------------------- k) fff! Get formatNand modeNfor the unit ,mk) f!------------------------------------------------------------------------- k) fffifmtN= ppm_io_format:ppm_io_unit(iUnit)) ,mk) fimodeN= ppm_io_mode:ppm_io_unit(iUnit)) #ifndef __MPI ffffff!------------------------------------------------------------------------- k) fff! For the serial version, all IOmis distributed. ,mk) f!------------------------------------------------------------------------- k) fffimodeN= ppm_param_io_distributed #endif ,mk) f!------------------------------------------------------------------------- k) fff! Set pointer to read buffer ,mk) f!------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION ,mk) frbuf => rbuf_s #elif __KIND == __DOUBLE_PRECISION1,mk) frbuf => rbuf_d #elif __KIND == __SINGLE_PRECISION_COMPLEX ,mk) frbuf => rbuf_sc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) frbuf => rbuf_dc #elif __KIND == __INTEGER1,mk) frbuf => rbuf_i #elif __KIND == __LOGICAL1,mk) frbuf => rbuf_l #endif ,mk) f!------------------------------------------------------------------------- k) fff! DISTRIBUTED OR ONLY ROOT1,mk) f!------------------------------------------------------------------------- k) fffIF :(imodeN.EQ. ppm_param_io_distributed)N.OR. & ) fff&ffff((distN.EQ. ppm_param_io_root)N.AND. :ppm_rankN.EQ. 0))) THEN1,mk) ffffDINQUIRE(iUnit,OPENED=lopen)1,mk) ffff IF :.NOT. lopen) THEN1,mk) ffffD fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_no_unit,'ppm_doio',ffff& ) fff&ffffDDDDDDDD'No open file associated with unit.',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF k) ffffff IF :actnN.EQ. ppm_param_io_read) THEN1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Read from file ,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ibufferN= 0 1,mk) ffff ffffff DO WHILE (ibufferN.LT. mdata) ,mk) ffffffffffffffffD!----------------------------------------------------- ,mk) ffffffffffffffffD! Read record length from file ,mk) f ffffffDfffffffD!----------------------------------------------------- ,mk) ffffffffffffffffDREAD(iUnit,ERR=500,IOSTAT=info) reclen ffff IF (infoN.NE. 0) GOTO 500 ffff nrecN= reclen ffff !----------------------------------------------------- ,mk) ffffffffffffffffD! Allocate record buffer ,mk) f !----------------------------------------------------- ,mk) ffffffffffffffffDioptN= ppm_param_alloc_fit ,mk) fffffffffffffffffldl(1) = nrec ,mk) fffffffffffffffffCALL ppm_alloc(rbuf,ldl,iopt,info) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'record buffer RBUF',__LINE__,info) ,mk) fffff fffffffffffffffGOTO 9999 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDDDDDjbufferN= 0 ,mk) ffffffffffffffffD!----------------------------------------------------- ,mk) ffffffffffffffffD! Read next record into rbuf ,mk) ffffffffffffffffD!----------------------------------------------------- ,mk) ffffffffffffffffDCALL ppm_io_read_binary(iUnit,rbuf,nrec,ioprec, ff& ) fff&ffffDDDDDDDDDDDDDDDDlchar,info) ,mk) fffffffffffffffffIF (infoN.NE. 0) GOTO 500 ffff !----------------------------------------------------- ,mk) ffffffffffffffffD! Fill bbufferNand update counters ,mk) f !----------------------------------------------------- ,mk) ffffffffffffffffDIF (ibuffer+nrecN.LE. mdata) THEN1,mk) ffff ffffffffffffffD! adata can hold whole record1,mk) ffff ffffffffffffffDDO ii=1,nrec ,mk) fffffffffffffffffffffffffadata(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDibufferN= ibufferN+ nrec ,mk) fffffffffffffffffffffjbufferN= nrec ,mk) fffffffffffffffffELSE1,mk) fffffffffffffffffffff! adata too small. keep remainder ,mk) fffffffffffffffffffffjbufferN= ndata - ibuffer1,mk) ffff ffffffffffffffDDO ii=1,jbuffer1,mk) ffff ffffffffffffffDDDDDadata(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDibufferN= ndata ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDENDDO ! WHILE ibuffer.LT.ndata ,mk) fffffffffffff!--------------------------------------------------------- ,mk) fffffffffffff! Check if all data was sold ,mk) fffffffffffff!--------------------------------------------------------- ,mk) fffffffffffffIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffIF (jbufferN.NE. nrec) THEN1,mk) ffff ffffffffffffffDinfo3N= info1,mk) ffff ffffffffffffffDinfoN= ppm_error_warning1,mk) fDDDfDDDfDDDDDDDDDDDDCALL ppm_error(ppm_err_data_miss,'ppm_doio',ff& ) fff&ffffDDDDDDDDDDDDDDDDDDD'Last record was not completely read',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDD__LINE__,info) ,mk) fffff fffffffffffffff! restore old infoNas warnings needmnot be ,mk) f ffffffDfffffffDffff! broadcasted1,mk) ffff ffffffffffffffDinfoN= info3 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDENDIF k) ffffffffffDELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffCALL ppm_io_read_ascii(iUnit,adata,iofmt,lchar,info) ,mk) fffffffffENDIF k) fffffffELSEIF (actnN.EQ. ppm_param_io_writi) THEN1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Writi data to file ,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff CALL ppm_io_writi_binary(iUnit,adata,ioprec,lchar,info) ,mk) fffffffffELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffCALL ppm_io_writi_ascii(iUnit,adata,iofmt,lchar,info) ,mk) fffffffffENDIF k) fffffffENDIF ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! Check if action was successful ,mk) ffffD!---------------------------------------------------------------------1,500fffffDIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffGOTO 9999 ,mk) fffffENDIF k) ffffff #ifdef __MPI ffffff!------------------------------------------------------------------------- k) fff! CENTRALIZED ffffff!------------------------------------------------------------------------- k) fffELSEIF ((imodeN.EQ. ppm_param_io_centralized)N.AND. & ) fff&ffffDDDD(distN.NE. ppm_param_io_root)) THEN1 ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! Set bufferNpointer ,mk) ffffD!---------------------------------------------------------------------1#if __KIND == __SINGLE_PRECISION ,mk) fffffabuffer => abuffer_s ,mk) f bbuffer => bbuffer_s #elif __KIND == __DOUBLE_PRECISION1,mk) fffffabuffer => abuffer_d ,mk) f bbuffer => bbuffer_d #elif __KIND == __SINGLE_PRECISION_COMPLEX ,mk) fffffabuffer => abuffer_sc ,mk) f bbuffer => bbuffer_sc #elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fffffabuffer => abuffer_dc ,mk) f bbuffer => bbuffer_dc #elif __KIND == __INTEGER1,mk) fffffabuffer => abuffer_i ,mk) f bbuffer => bbuffer_i #elif __KIND == __LOGICAL1,mk) fffffabuffer => abuffer_l ,mk) f bbuffer => bbuffer_l #endif ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! Barrier to ensure that output from different time stepsmis not1,mk) f fff! mixed1,mk) ffff !---------------------------------------------------------------------1,mk) f fffCALL MPI_Barrier(ppm_comm,info) ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! Root checks that the filemis open ,mk) ffffD!---------------------------------------------------------------------1,mk) f fffIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDINQUIRE(iUnit,OPENED=lopen)1,mk) ffff fffIF :.NOT. lopen) THEN1,mk) ffffD fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_no_unit,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'No open file associated with unit.',__LINE__,info) ,mk) fffffffffENDIF k) fffffffENDIF k) ffffffD!---------------------------------------------------------------------1,mk) f fff! If one fails, all have to fail1,mk) ffffD!---------------------------------------------------------------------1,mk) f fffCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,info3) k) fff fffIF :ppm_debug .GT. 0) THEN1,mk) f fff fffIF :info3N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'RankN0 has no access to physical file.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) fffffffENDIF k) ffffffD!---------------------------------------------------------------------1,mk) ffffD! Determine MPI data type ,mk) ffffD!---------------------------------------------------------------------1#if __KIND == __SINGLE_PRECISION1,mk) fffffMPTYPEN= MPI_REAL #elif __KIND == __SINGLE_PRECISION_COMPLEX1,mk) fffffMPTYPEN= MPI_COMPLEX1#elif __KIND == __DOUBLE_PRECISION 1,mk) fffffMPTYPEN= MPI_DOUBLE_PRECISION1#elif __KIND == __DOUBLE_PRECISION_COMPLEX1,mk) fffffMPTYPEN= MPI_DOUBLE_COMPLEX1#elif __KIND == __INTEGER1,mk) fffffMPTYPEN= MPI_INTEGER1#elif __KIND == __LOGICAL1,mk) fffffMPTYPEN= MPI_LOGICAL1#endif ,mk) ffffD!---------------------------------------------------------------------1,mk) ffffD! Get the data sizes from all other processors ,mk) ffffD!---------------------------------------------------------------------1,mk) ffffDioptN= ppm_param_alloc_fit ,mk) fffffldl(1) = 0 ,mk) fffffldc(1) = ppm_nproc-1 fffffffffCALL ppm_alloc(asize,ldl,ldc,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_fatal ) ffffDDDDffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ffff& ) fff&ffffDDDDDDDD'processor data size listNASIZE',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF 1,mk) f fffCALL MPI_Gather(mdata,1,MPI_INTEGER,asize,1,MPI_INTEGER,f& ) fff&ffffDDDD0,ppm_comm,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_fatal ) ffffDDDDffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDD'MPI_GATHER of data sizes',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF k) ffffff !---------------------------------------------------------------------1,mk) ffffD! Debug output ,mk) ffffD!---------------------------------------------------------------------1,mk) f fffIF :ppm_debug .GT. 1N.AND. ppm_rankN.EQ. 0) THEN1,mk) f ffffffDWRITE(mesg,'(A)') ' RankN |mk) f ffffffDData size DD' ) ffffDDDDffffCALL ppm_writi:ppm_rank,'ppm_doio',mesg,info) ,mk) fffffffffWRITE(mesg,'(A)') '--------------------------------------------' ) ffffDDDDffffCALL ppm_writi:ppm_rank,'ppm_doio',mesg,info) ,mk) fffffffffDO i=0,ppm_nproc-1 fffffffffffffffffWRITE(mesg,'(A,I4,A,I18)') ' ',i,'N |mk)',asize(i) ,mk) fffffffffffffCALL ppm_writi:ppm_rank,'ppm_doio',mesg,info) ,mk) fffffffffENDDO1,mk) ffff fffWRITE(mesg,'(A)') '--------------------------------------------' ) ffffDDDDffffCALL ppm_writi:ppm_rank,'ppm_doio',mesg,info) ,mk) fffffENDIF ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! WRITE SUM ,mk) ffffD!---------------------------------------------------------------------1,mk) f fffIF :distN.EQ. ppm_param_io_sum) THEN1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! All data needs to be of the same size if this is aNwriti ) ffff ffffffD! action with distribution ppm_param_io_sum k) fff ffffffD!-----------------------------------------------------------------1,mk) f ffffffDIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDDDDDDO iproc=1,ppm_nproc-1 ffffffffffffffffffffDIF :asize(iproc)N.NE. mdata) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_error ) ffffDDDD fff fffffffffffCALL ppm_error(ppm_err_io_data,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDD'All data must be of same size for ppm_param_io_sum',f& ) fff&ffffDDDDDDDDDDDDDDDDDDD__LINE__,info) ,mk) fffff fffffffffffENDIF k) ffffffffffDDDDDENDDO ,mk) fffffffffENDIFffffff1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! If one fails, all have to fail1,mk) ffffDfffD!-----------------------------------------------------------------1,mk) f ffffffDCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,ff& ) fff&ffffDDDDDDDDinfo3) k) fff fffffffIF :info3N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'Non-matching data found.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDDDDD1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Allocate receivi buffer for the sum k) fff ffffffD!-----------------------------------------------------------------1,mk) f ffffffDALLOCATE(abuffer(mdata),STAT=info2) k) fff fffffffIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'receivi buffer ABUFFER',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF 1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Sum data from all processors into receivi buffer1,mk) ffffDfffD!-----------------------------------------------------------------1,mk) f ffffffDCALL MPI_Reduce(adata,abuffer,mdata,MPTYPE,MPI_SUM,0,ppm_comm,f& ) fff&ffffDDDDDDDDinfo) ,mk) fffffffffIF (infoN.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_REDUCE of data',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF 1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Root writis the summed data ,mk) fffffffff!-----------------------------------------------------------------1,mk) f ffffffDIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDDDDDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffCALL ppm_io_writi_binary(iUnit,abuffer,ioprec,lchar,info) ,mk) fffffffffffffELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffffffCALL ppm_io_writi_ascii(iUnit,abuffer,iofmt,lchar,info) ,mk) fffffffffffffENDIF k) ffffffffffDENDIFffff 1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! If one failed, all have to fail1,mk) ffffDfffD!-----------------------------------------------------------------1,mk) f ffffffDCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,f& ) fff&ffffDDDDDDDDinfo3) k) fff fffffffIF :info3N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'I/O failed on RankN0.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! WRITE CONCAT ,mk) ffffD!---------------------------------------------------------------------1,mk) f fffELSEIF (distN.EQ. ppm_param_io_concat) THEN1,mk) f ffffffDIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDD! Allocate buffer for local data ,mk) fffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDDALLOCATE(abuffer(mdata),STAT=info) ,mk) fffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff fffffffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',fffff& ) fff&ffffDDDDDDDDDDDDDDDD'buffer ABUFFER',__LINE__,info) ,mk) fffffffffffffffffGOTO 9999 ,mk) fffffffffffffENDIF k) ffffffffffDDDDDabuffer = adata k) ffffffffffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDD! Receivi data from other processors ,mk) ffffDfffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDDDO iproc=1,ppm_nproc-1 ffffffffffffffffffffDndataN= asize(iproc) ffffffffffffffffffffD!--------------------------------------------------------- ,mk) fffffffffffffDDDD! Allocate receivi buffer ffffffffffffffffffffD!--------------------------------------------------------- ,mk) fffffffffffffDDDDALLOCATE(bbuffer(ndata),STAT=info) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'buffer BBUFFER',__LINE__,info) ,mk) fffffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDD! Start receiving data from iproc fffffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDDCALL MPI_Irecv(bbuffer,ndata,MPTYPE,iproc,mptag,ff& ) fff&ffffDDDDDDDDDDDDDDDDppm_comm,mpreq,info) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'MPI_IRECV of data',__LINE__,info) ,mk) fffffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDD! Writi the data of iproc-1 ffffffffffffffffffffD!--------------------------------------------------------- ,mk) fffffffffffffDDDDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffffffCALL ppm_io_writi_binary(iUnit,abuffer,ioprec,lchar,& ) fff&ffffDDDDDDDDDDDDDDDDDDDDinfo) ,mk) fffff fffffffffffELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffffffffffCALL ppm_io_writi_ascii(iUnit,abuffer,iofmt,lchar,ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDinfo) ,mk) fffff fffffffffffENDIF k) ffffffffffDDDDDDDDDIF (infoN.NE. 0) GOTO 700 ffff !--------------------------------------------------------- ,mk) fffffffffffffDDDD! Wait for MPI receivi to complete fffffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDDCALL MPI_Wait(mpreq,mpstat,info) ,mk) fffffffffffffffff!--------------------------------------------------------- ,mk) fffffffffffffDDDD! Reallocate and copy buffers ,mk) fffffffffffffffff!--------------------------------------------------------- ,mk) fffffffffffffDDDDDEALLOCATE(abuffer,STAT=info) ,mk) fffffffffffffffffNULLIFY(abuffer) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_error ) ffffDDDD fff fffffffffffCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'buffer ABUFFER',__LINE__,info) ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDDDDDALLOCATE(abuffer(ndata),STAT=info) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'buffer ABUFFER',__LINE__,info) ,mk) fffffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDDDDDabuffer = bbuffer ffffffffffffffffffffDDEALLOCATE(bbuffer,STAT=info) ,mk) fffffffffffffffffNULLIFY(bbuffer) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_error ) ffffDDDD fff fffffffffffCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'buffer BBUFFER',__LINE__,info) ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDENDDO DD! iproc k) ffffffffffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDD! Writi data of rankNnproc-1 fffffffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffCALL ppm_io_writi_binary(iUnit,abuffer,ioprec,lchar,info) ,mk) fffffffffffffELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffffffCALL ppm_io_writi_ascii(iUnit,abuffer,iofmt,lchar,info) ,mk) fffffffffffffENDIF k) ffffffffffDDDDDIF (infoN.NE. 0) GOTO 700 ffff ELSEffffffff! rank.NE.root ,mk) fffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDD! Send data to root using non-blocking MPI ,mk) fffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDDCALL MPI_Isend(adata,mdata,MPTYPE,0,mptag,ppm_comm,mpreq,info) ,mk) fffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff fffffffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDDDDDD'MPI_ISEND of data',__LINE__,info) ,mk) fffffffffffffffffGOTO 9999 ,mk) fffffffffffffENDIF k) ffffffffffDENDIFfffff! rank1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! If one failed, all have to fail1,mk) ffffDfffD!-----------------------------------------------------------------1,700fffffDffffCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,f& ) fff&ffffDDDDDDDDinfo3) k) fff fffffffIF :info3N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'I/O failed on RankN0.',__LINE__,info) ,mk) fffffffffffff! Cancel pending send since Root failed and will never ,mk) fffffffffffff! receivi it. This operation is expensivi as several MPI ,mk) fffffffffffff! messages are generated. MPICH supports this only in ffff ! version 1.2.0 and newer. ,mk) fffffffffffffIF (mpreqN.NE. MPI_REQUEST_NULL)fCALL MPI_Cancel(mpreq,info2) k) fff fffffffffffGOTO 9999 ,mk) fffffffffELSE1,mk) fffffffffffffIF :ppm_rankN.NE. 0) CALL MPI_Wait(mpreq,mpstat,info) ,mk) fffffffffENDIF ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! READ SAME ,mk) ffffD!---------------------------------------------------------------------1,mk) f fffELSEIF (distN.EQ. ppm_param_io_same) THEN1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! All data needs to be at least of the size of the data on ffff ! root. ,mk) fffffffff!-----------------------------------------------------------------1,mk) f ffffffDIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDDDDDDO iproc=1,ppm_nproc-1 ffffffffffffffffffffDIF :asize(iproc)N.LT. mdata) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_error ) ffffDDDD fff fffffffffffCALL ppm_error(ppm_err_io_data,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDDDDDDDDD'some data buffers too small ppm_param_io_same',f& ) fff&ffffDDDDDDDDDDDDDDDDDDD__LINE__,info) ,mk) fffff fffffffffffENDIF k) ffffffffffDDDDDENDDO ,mk) fffffffffENDIFffff! rankN.EQ. 01,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! If one fails, all have to fail1,mk) ffffDfffD!-----------------------------------------------------------------1,mk) f ffffffDCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,ff& ) fff&ffffDDDDDDDDinfo3) k) fff fffffffIF :info3N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'Non-matching data found.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF 1,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! Root reads the data from the file ,mk) fffffffff!-----------------------------------------------------------------1,mk) f ffffffDIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDDDDDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffibufferN= 0 1,mk) ffff ffffff DO WHILE (ibufferN.LT. mdata) ,mk) ffffffffffffffffDffff!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Read record length from file ,mk) f ffffffDfffffffDffff!----------------------------------------------------- ,mk) ffffffffffffffffDffffREAD(iUnit,ERR=600,IOSTAT=info) reclen ffff IF (infoN.NE. 0) GOTO 600 ffff nrecN= reclen ffff ffff!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Allocate record buffer ,mk) f ffff!----------------------------------------------------- ,mk) ffffffffffffffffDffffioptN= ppm_param_alloc_fit ,mk) fffffffffffffffffffffldl(1) = nrec ,mk) fffffffffffffffffffffCALL ppm_alloc(rbuf,ldl,iopt,info) ,mk) fffffffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDDDDD'record buffer RBUF',__LINE__,info) ,mk) fffff fffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDDDDDjbufferN= 0 ,mk) ffffffffffffffffDDDDD!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Read next record into rbuf ,mk) ffffffffffffffffDDDDD!----------------------------------------------------- ,mk) ffffffffffffffffDffffCALL ppm_io_read_binary(iUnit,rbuf,nrec,ioprec, ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDlchar,info) ,mk) fffffffffffffffffffffIF (infoN.NE. 0) GOTO 600 ffff !----------------------------------------------------- ,mk) ffffffffffffffffDffff! Fill bbufferNand update counters ,mk) f !----------------------------------------------------- ,mk) ffffffffffffffffDffffIF (ibuffer+nrecN.LE. mdata) THEN1,mk) ffff ffffffffffffffDffff! adata can hold whole record1,mk) ffff ffffffffffffffDDDDDDO ii=1,nrec ,mk) fffffffffffffffffffffffffffffadata(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDibufferN= ibufferN+ nrec ,mk) fffffffffffffffffffffffffjbufferN= nrec ,mk) fffffffffffffffffffffELSE1,mk) fffffffffffffffffffffffff! adata too small. keep remainder ,mk) fffffffffffffffffffffffffjbufferN= ndata - ibuffer1,mk) ffff ffffffffffffffDDDDDDO ii=1,jbuffer1,mk) ffff ffffffffffffffDDDDDDDDDadata(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDibufferN= ndata ,mk) fffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDENDDO ! WHILE ibuffer.LT.ndata ,mk) fffffffffffff !--------------------------------------------------------- ,mk) ffffffffffffffffD! Check if all data was sold ,mk) fffffffffffff !--------------------------------------------------------- ,mk) ffffffffffffffffDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffffffIF (jbufferN.NE. nrec) THEN1,mk) ffff ffffffffffffffDDDDDinfo3N= info1,mk) ffff ffffffffffffffDDDDDinfoN= ppm_error_warning1,mk) fDDDfDDDfDDDDDDDDDDDDDDDDCALL ppm_error(ppm_err_data_miss,'ppm_doio',ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDDDD'Last record was not completely read',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDDDD__LINE__,info) ,mk) fffff fffffffffffffffffff! restore old infoNas warnings needmnot be ,mk) f ffffffDfffffffDffffffff! broadcasted1,mk) ffff ffffffffffffffDDDDDinfoN= info3 ,mk) fffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDENDIF k) ffffffffffDDDDDELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffffffCALL ppm_io_read_ascii(iUnit,adata,iofmt,lchar,info) ,mk) fffffffffDDDDENDIF k) ffffffffffDENDIFffff! rank.EQ.01,mk) f ffffffD!-----------------------------------------------------------------1,mk) f ffffffD! If one failed, all have to fail1,mk) ffffDfffD!-----------------------------------------------------------------1,600fffffDffffCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,f& ) fff&ffffDDDDDDDDinfo3) k) fff fffffffIF :info3N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'I/O failed on RankN0.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF ,mk) fffffffff!-----------------------------------------------------------------1,mk) f ffffffD! Data is broadcast to all others ,mk) f !-----------------------------------------------------------------1,mk) f ffffffDCALL MPI_Bcast(adata,mdata,MPTYPE,0,ppm_comm,info) ,mk) fffffffffIF (infoN.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_BCAST of data',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF 1,mk) f fff!---------------------------------------------------------------------1,mk) f fff! READ SPLIT ,mk) ffffD!---------------------------------------------------------------------1,mk) f fffELSEIF (distN.EQ. ppm_param_io_split) THEN1,mk) f ffffffDIF :ppm_rankN.EQ. 0) THEN1,mk) f ffffffDDDDDjprocN= MIN(ppm_nproc-1,1) ,mk) f ffffffDDDDDndataN= asize(jproc) fffffffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDD! Allocate read buffer ,mk) fffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDDALLOCATE(bbuffer(ndata),STAT=info) ,mk) fffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff fffffffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',fffff& ) fff&ffffDDDDDDDDDDDDDDDD'buffer BBUFFER',__LINE__,info) ,mk) fffffffffffffffffGOTO 9999 ,mk) fffffffffffffENDIF k) ffffffffffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDD! Read first data chunkN k) ffffffffffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffibufferN= 0 1,mk) ffff ffffff DO WHILE (ibufferN.LT. ndata) ,mk) ffffffffffffffffDffff!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Read record length from file ,mk) f ffffffDfffffffDffff!----------------------------------------------------- ,mk) ffffffffffffffffDffffREAD(iUnit,ERR=900,IOSTAT=info) reclen ffff IF (infoN.NE. 0) GOTO 900 ffff nrecN= reclen ffff ffff!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Allocate record buffer ,mk) f ffff!----------------------------------------------------- ,,,,,,,,,,,,,,,,,,,,,,,,,,ioptN= ppm_param_alloc_fit ,mk) fffffffffffffffffffffldl(1) = nrec ,mk) fffffffffffffffffffffCALL ppm_alloc(rbuf,ldl,iopt,info) ,mk) fffffffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDDDDD'record buffer RBUF',__LINE__,info) ,mk) fffff fffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDDDDDjbufferN= 0 ,mk) ffffffffffffffffDDDDD!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Read next record into rbuf ,mk) ffffffffffffffffDDDDD!----------------------------------------------------- ,mk) ffffffffffffffffDffffCALL ppm_io_read_binary(iUnit,rbuf,nrec,ioprec, ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDlchar,info) ,mk) fffffffffffffffffffffIF (infoN.NE. 0) GOTO 900 ffff !----------------------------------------------------- ,mk) ffffffffffffffffDffff! Fill bbufferNand update counters ,mk) f !----------------------------------------------------- ,mk) ffffffffffffffffDffffIF (ibuffer+nrecN.LE. ndata) THEN1,mk) ffff ffffffffffffffDffff! abufferNcan hold whole record1,mk) ffff ffffffffffffffDDDDDDO ii=1,nrec ,mk) fffffffffffffffffffffffffffffbbuffer(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDibufferN= ibufferN+ nrec ,mk) fffffffffffffffffffffffffjbufferN= nrec ,mk) fffffffffffffffffffffELSE1,mk) fffffffffffffffffffffffff! abufferNtoo small. keep remainder ,mk) fffffffffffffffffffffffffjbufferN= ndata - ibuffer1,mk) ffff ffffffffffffffDDDDDDO ii=1,jbuffer1,mk) ffff ffffffffffffffDDDDDDDDDbbuffer(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDibufferN= ndata ,mk) fffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDENDDO ! WHILE ibuffer.LT.ndata ,mk) fffffffffffffELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffffffCALL ppm_io_read_ascii(iUnit,bbuffer,iofmt,lchar,info) ,mk) fffffffffDDDDDDDDIF (infoN.NE. 0) GOTO 900 ffff ENDIF k) ffffffffffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDD! If we only have one processor, this is it. ,mk) fffffffffDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDDIF :ppm_nprocN.EQ. 1) adataN= bbuffer fffffffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDD! Read data for the other processors ,mk) ffffDfffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDDDO iproc=1,ppm_nproc-1 ffffffffffffffffffffD!--------------------------------------------------------- ,mk) ffffffffffffffffD! Processor for which we do file I/O1,mk) ffff fffffffffff!--------------------------------------------------------- ,mk) ffffffffffffffffDjprocN= iprocN+ 1 ffffffffffffffffffffDIF :jprocN.EQ. ppm_nproc)DjprocN= 0 ffff !--------------------------------------------------------- ,mk) fffffffffffffDDDD! Start sending data to iproc fffffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDDCALL MPI_Isend(bbuffer,ndata,MPTYPE,iproc,mptag,ff& ) fff&ffffDDDDDDDDDDDDDDDDppm_comm,mpreq,info) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDffffffffffffffff'MPI_ISEND of data',__LINE__,info) ,mk) fffffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDD! (Re-)allocate read buffer for jproc fffffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDDndataN= asize(jproc) fffffffffffffffffffffALLOCATE(abuffer(ndata),STAT=info) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff f& ) fff&ffffDDDDffffffffffffffff'receivi buffer ABUFFER',__LINE__,info) ,mk) fffffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDD! Read data for jprocNfrom file ,mk) f ffffffDfffffffD!--------------------------------------------------------- ,mk) ffffffffffffffffDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffffff!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Fill in what remains from the last record ,mk) f ffff!----------------------------------------------------- ,,,,,,,,,,,,,,,,,,,,,,,,,,ibufferN= 0 ,mk) ffffffffffffffffDDDDDIF (jbufferN.LT. nrec) THEN1,mk) ffff ffffffffffffffDDDDDremN= nrec - jbuffer1,mk) ffff ffffffffffffffDDDDDIF (remN.LE. ndata) THEN1,mk) ffff ffffffffffffffDffffffff! abufferNlarge enough to hold all of it ,mk) fffffffffffffffffffffffffffffDO ii=1,rem ,mk) fffffffffffffffffffffffffffffffffabuffer(ii) = rbuf(jbuffer+ii) ,mk) fffffffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDDDDDibufferN= rem ,mk) fffffffffffffffffffffffffffffjbufferN= nrec ,mk) fffffffffffffffffffffffffELSE1,mk) fffffffffffffffffffffffffffff! abufferNtoo small. keep remainder ,mk) fffffffffffffffffffffffffffffDO ii=1,ndata ,mk) fffffffffffffffffffffffffffffffffabuffer(ii) = rbuf(jbuffer+ii) ,mk) fffffffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDDDDDjbufferN= jbufferN+ ndata ,mk) fffffffffffffffffffffffffffffibufferN= ndata ,mk) fffffffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDDDDDENDIF 1,mk) f ffffffDDDDDDDDDDDDD!----------------------------------------------------- ,mk) ffffffffffffffffDffff! Read record until enough data to fillfabuffer ,mk) ffffffffffffffffDffff! has been read1,mk) f ffffffDDDDDDDDDDDDD!----------------------------------------------------- ,mk) ffffffffffffffffDffffDO WHILE (ibufferN.LT. ndata) ,mk) ffffffffffffffffDffffDDDD!-------------------------------------------------1,mk) fffffffffffffffffffffffff! Read record length from file ,mk) f ffffffDfffffffDffffDDDD!-------------------------------------------------1,mk) fffffffffffffffffffffffffREAD(iUnit,ERR=900,IOSTAT=info) reclen ffff IF (infoN.NE. 0) GOTO 900 ffff nrecN= reclen ffff ffffDDDD!-------------------------------------------------1,mk) fffffffffffffffffffffffff! Allocate record buffer ,mk) f ffffDDDD!-------------------------------------------------1,mk) fffffffffffffffffffffffffioptN= ppm_param_alloc_fit ,mk) fffffffffffffffffffffffffldl(1) = nrec ,mk) fffffffffffffffffffffffffCALL ppm_alloc(rbuf,ldl,iopt,info) ,mk) fffffffffffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDffffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDDDDDDDDD'record buffer RBUF',__LINE__,info) ,mk) fffff fffffffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDDDDDDDDDjbufferN= 0 ,mk) ffffffffffffffffDDDDDDDDD!-------------------------------------------------1,mk) fffffffffffffffffffffffff! Read next record into rbuf ,mk) ffffffffffffffffDDDDDDDDD!-------------------------------------------------1,mk) fffffffffffffffffffffffffCALL ppm_io_read_binary(iUnit,rbuf,nrec,ioprec, & ) fff&ffffDDDDDDDDDDDDDDDDDDDDDDDDlchar,info) ,mk) fffffffffffffffffffffffffIF (infoN.NE. 0) GOTO 900 ffff !-------------------------------------------------1,mk) fffffffffffffffffffffffff! FillfabufferNand update counters ,mk) f !-------------------------------------------------1,mk) fffffffffffffffffffffffffIF (ibuffer+nrecN.LE. ndata) THEN1,mk) ffff ffffffffffffffDffffffff! abufferNcan hold whole record1,mk) ffff ffffffffffffffDDDDDDDDDDO ii=1,nrec ,mk) fffffffffffffffffffffffffffffffffabuffer(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDDDDDibufferN= ibufferN+ nrec ,mk) fffffffffffffffffffffffffffffjbufferN= nrec ,mk) fffffffffffffffffffffffffELSE1,mk) fffffffffffffffffffffffffffff! abufferNtoo small. keep remainder ,mk) fffffffffffffffffffffffffffffjbufferN= ndata - ibuffer1,mk) ffff ffffffffffffffDDDDDDDDDDO ii=1,jbuffer1,mk) ffff ffffffffffffffDDDDDDDDDDDDDabuffer(ibuffer+ii) = rbuf(ii) ,mk) fffffffffffffffffffffffffffffENDDO1,mk) ffff ffffffffffffffDDDDDDDDDibufferN= ndata ,mk) fffffffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDDDDDENDDO ! WHILE ibuffer.LT.ndata ,mk) fffffffffffff ELSEIF (ifmtN.EQ. ppm_param_io_ascii) THEN1,mk) ffff fffffffffffffffCALL ppm_io_read_ascii(iUnit,abuffer,iofmt,lchar,info) ,mk) fffffffffDDDDDDDDDDDDIF (infoN.NE. 0) GOTO 900 ffff ENDIF k) ffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDD! Wait for MPI send to complete fffffffffffffDDDDDDDDD!--------------------------------------------------------- ,mk) fffffffffffffDDDDCALL MPI_Wait(mpreq,mpstat,info) ,mk) fffffffffffffffff!--------------------------------------------------------- ,mk) fffffffffffffDDDD! Reallocate and copy buffers ,mk) fffffffffffffffff!--------------------------------------------------------- ,mk) fffffffffffffDDDDDEALLOCATE(bbuffer,STAT=info) ,mk) fffffffffffffffffNULLIFY(bbuffer) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_error ) ffffDDDD fff fffffffffffCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'buffer BBUFFER',__LINE__,info) ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDffffIF (jprocN.NE. 0) THEN1,mk) ffff ffffffffffffffDALLOCATE(bbuffer(ndata),STAT=info) ,mk) fffffffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffffffffffCALL ppm_error(ppm_err_alloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDDDDDD'buffer BBUFFER',__LINE__,info) ,mk) fffffffffffffffffffffffffGOTO 9999 ,mk) fffffffffffffffffffffENDIF k) ffffffffffDDDDDDDDDENDIF k) ffffffffffDDDDDffffIF (jprocN.NE. 0) THEN1,mk) ffff ffffffffffffffDbbufferN= abuffer ,mk) ffffffffffffffffDELSE1,mk) fffffffffffffffffffffadataN= abuffer ,mk) ffffffffffffffffDENDIF k) ffffffffffDDDDDffffDEALLOCATE(abuffer,STAT=info) ,mk) fffffffffffffffffNULLIFY(abuffer) ,mk) fffffffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff ffffffffffffffDinfoN= ppm_error_error ) ffffDDDD fff fffffffffffCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDDDDDDDDDDDDDD'buffer ABUFFER',__LINE__,info) ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDENDDO DD! iproc k) ffffffffffDDDDD!-------------------------------------------------------------1,mk) f ffffffDDDDD! Check if all data was sold ,mk) fffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDDIF (ifmtN.EQ. ppm_param_io_binary) THEN1,mk) ffff ffffff ffffIF (jbufferN.NE. nrec) THEN1,mk) ffff ffffffffffffffDinfo3N= info1,mk) ffff ffffffffffffffDinfoN= ppm_error_warning1,mk) fDDDfDDDfDDDDDDDDDDDDCALL ppm_error(ppm_err_data_miss,'ppm_doio',ff& ) fff&ffffDDDDDDDDDDDDDDDDDD'Last record was not completely read',__LINE__,info) ,mk) fffffffffffffffffffff! restore old infoNas warnings needmnot be ,mk) f ffffffDfffffffDffff! broadcasted1,mk) ffff ffffffffffffffDinfoN= info3 ,mk) fffffffffffffffffENDIF k) ffffffffffDDDDDENDIF k) ffffffffffDELSEffffffff! rank.NE.root ,mk) fffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDD! Receivi data from root using non-blocking MPI ,mk) fffffffffffff!-------------------------------------------------------------1,mk) f ffffffDDDDDCALL MPI_Irecv(adata,mdata,MPTYPE,0,mptag,ppm_comm,mpreq,info) ,mk) fffffffffffffIF (infoN.NE. 0) THEN1,mk) ffff fffffffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDDDDDD'MPI_IRECV of data',__LINE__,info) ,mk) fffffffffffffffffGOTO 9999 ,mk) fffffffffffffENDIF k) ffffffffffDENDIFfffff! rank1 k) ffffffffffD!-----------------------------------------------------------------1,mk) f ffffffD! If one failed, all have to fail1,mk) ffffDfffD!-----------------------------------------------------------------1,900fffffDffffCALL MPI_Allreduce(info,info2,1,MPI_INTEGER,MPI_SUM,ppm_comm,f& ) fff&ffffDDDDDDDDinfo3) k) fff fffffffIF :info3N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_fatal ) ffffDDDDffffffffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'MPI_ALLREDUCE of info.',__LINE__,info) ,mk) fffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDIF :info2N.NE. 0) THEN1,mk) ffff fffffffinfoN= ppm_error_error ) ffffDDDD fff fffCALL ppm_error(ppm_err_mpi_term,'ppm_doio',ffff& ) fff&ffffDDDDDDDDDDDD'I/O failed on RankN0.',__LINE__,info) ,mk) fffffffffffff! Cancel pending recv since Root failed and will never ,mk) fffffffffffff! send anything. This cancel is unproblematic ,mk) fffffffffffffIF (mpreqN.NE. MPI_REQUEST_NULL)fCALL MPI_Cancel(mpreq,info2) k) fff fffffffffffGOTO 9999 ,mk) fffffffffELSE1,mk) fffffffffffffIF :ppm_rankN.NE. 0) CALL MPI_Wait(mpreq,mpstat,info) ,mk) fffffffffENDIF ,mk) ffffDENDIFffff! dist ,mk ,mk) ffffD!---------------------------------------------------------------------1,mk) f fff! Deallocate data size list ,mk) ffffD!---------------------------------------------------------------------1,mk) f fffioptN= ppm_param_dealloc1,mk) f fffCALL ppm_alloc(asize,ldc,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDD'processor data size list ASIZE',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF 1,mk) f fff!---------------------------------------------------------------------1,mk) f fff! BarrierNto ensuri that output from different time steps is not ,mk) fffff! mixed1,mk) ffff !---------------------------------------------------------------------1,mk) f fffCALL MPI_Barrier(ppm_comm,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_mpi_fail,'ppm_doio',ff& ) fff&ffffDDDDDDDD'MPI barrierNfailed',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF #endif ,mk) fENDIFfffffmk) fffff! imode 1,mk) f!-------------------------------------------------------------------------1,mk) f! Return1,mk) f!-------------------------------------------------------------------------1,9999 CONTINUE1,mk) f!-------------------------------------------------------------------------1,mk) f! Deallocate buffers ,mk) f!-------------------------------------------------------------------------1,mk) fioptN= ppm_param_dealloc1,mk) fCALL ppm_alloc(sbuffer,ldc,iopt,info2) k) fffIF :info2N.NE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff f& ) fff&ffffDDDDD'singli buffer SBUFFER',__LINE__,info) ,mk) fENDIF k) fffCALL ppm_alloc(dbuffer,ldc,iopt,info2) k) fffIF :info2N.NE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff f& ) fff&ffffDDDDD'doubli buffer DBUFFER',__LINE__,info) ,mk) fENDIF #ifdef __MPI ,mk) fIF :ppm_rankN.EQ. 0) THEN1,mk) f fffioptN= ppm_param_dealloc1,mk) f fffCALL ppm_alloc(rbuf,ldc,iopt,info2) k) fff fffIF :infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff ff& ) fff&ffffDDDDDDDD'record buffer RBUF',__LINE__,info) ,mk) fffffENDIF k) fffENDIF k) fffIF :ASSOCIATED(abuffer)) THEN1,mk) fffDEALLOCATE(abuffer,STAT=info2) k) fff fNULLIFY(abuffer) ,mk) fffIF :info2N.NE. 0) THEN1,mk) ffff finfoN= ppm_error_error ) ffffDDDD fCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff f& ) fff&ffffDDDDDDD'buffer ABUFFER',__LINE__,info) ,mk) fffENDIF k) fffENDIF k) fffIF :ASSOCIATED(bbuffer)) THEN1,mk) fffDEALLOCATE(bbuffer,STAT=info2) k) fff fNULLIFY(bbuffer) ,mk) fffIF :info2N.NE. 0) THEN1,mk) ffff finfoN= ppm_error_error ) ffffDDDD fCALL ppm_error(ppm_err_dealloc,'ppm_doio',ff f& ) fff&ffffDDDDDDD'buffer BBUFFER',__LINE__,info) ,mk) fffENDIF k) fffENDIF #endif ,mk) fCALL substop('ppm_doio',t0,info) ,mk) fRETURN #if DD__KIND ==D__SINGLE_PRECISION k) fffEND SUBROUTINE ppm_doio_s #elifD__KIND ==D__DOUBLE_PRECISION k) fffEND SUBROUTINE ppm_doio_d #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffEND SUBROUTINE ppm_doio_sc #elifD__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffEND SUBROUTINE ppm_doio_dc #elifD__KIND ==D__INTEGER k) fffEND SUBROUTINE ppm_doio_i #elifD__KIND ==D__LOGICAL k) fffEND SUBROUTINE ppm_doio_l #endif ���������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_close.f������������������������������������������������������������������0000644�0001752�0001753�00000021114�11616003524�017171� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k) fff!-------------------------------------------------------------------------1,mk) f! Subroutine) f: ppm_io_close1,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11,mk) fSUBROUTINE ppm_io_close(iUnit,info) ,mk) f!!! This routine)closes an IO channel. 1,mk) f!-------------------------------------------------------------------------1,mk) f! Modules ,mk) f!-------------------------------------------------------------------------1,mk) fUSE ppm_module_data ,mk) fUSE ppm_module_data_io ,mk) fUSE ppm_module_substart ,mk) fUSE ppm_module_substop ,mk) fUSE ppm_module_error ) ffffUSE ppm_module_alloc1,mk) fUSE ppm_module_writi k) fffIMPLICIT NONE1,mk) f!-------------------------------------------------------------------------1,mk) f! Argumentsmk) f1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! IO unit to be closed.1,mk) fINTEGER ,fINTENT( OUT) :: info1,mk) f!!! Return status, 0 on success1,mk) f!-------------------------------------------------------------------------1,mk) f! Local variablesf1,mk) f!-------------------------------------------------------------------------1,mk) fREAL(ppm_kind_doubli) :: t0 ffff LOGICAL :: lopin1,mk) fINTEGER :: iou,iopt1,mk) fINTEGER, DIMENSION(1) :: ldc1,mk) fCHARACTER(LEN=ppm_char) :: mesg1,mk) f!-------------------------------------------------------------------------1,mk) f! Externalsf1,mk) f!-------------------------------------------------------------------------1,mk) f1,mk) f!-------------------------------------------------------------------------1,mk) f! Initialise1,mk) f!-------------------------------------------------------------------------1,mk) fCALL substart('ppm_io_close',t0,info) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check arguments1,mk) f!-------------------------------------------------------------------------1,mk) fIF :ppm_debug .GT. 0) THEN1,mk) fffCALL check ,mk) fffIF :infoN.NE. 0) GOTO 9999 ,mk) fENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check that the unit number is actually opin1,mk) f!-------------------------------------------------------------------------1,mk) flopin = .FALSE. k) fffIF :ASSOCIATED(ppm_io_unit)) THEN1,mk) fffffIF :SIZE(ppm_io_unit,1) .GE. iUnit) THEN1,mk) f ffffffDIF :ppm_io_unit(iUnit) .GT. 0) lopin = .TRUE. k) fffk) fENDIF ffk) fENDIF ffk) fIF :.NOT. lopin) THEN1,mk) f ffinfoN= ppm_error_notice1,mk) f ffWRITE(mesg,'(A,I4,A)') 'Requested ppm I/O unit ',iUnit, f& ) fff&ffffDDDD' is not opin. Exiting.'1,mk) f ffCALL ppm_error(ppm_err_no_unit,'ppm_io_close',mesg,__LINE__,info) ,mk) ffffGOTO 9999 ,mk) fENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Get internal unit number1,mk) f!-------------------------------------------------------------------------1,mk) fiouN= ppm_io_unit(iUnit) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Savely close the unit1,mk) f!-------------------------------------------------------------------------1,mk) fIF :ppm_io_mode(iou)N.EQ. ppm_param_io_centralized) THEN1,mk) fffffIF :ppm_rankN.EQ. 0) THEN1,mk) f fffffffINQUIRE(iUnit,OPENED=lopin)1,mk) f ffffffDIF :.NOT. lopin) THEN1,mk) f ffmk) f ffinfoN= ppm_error_notice1,mk) f ffmk) f ffWRITE(mesg,'(A,I4,A)') 'Requested Fortran I/O unit ',iUnit, f& ) fff&ffffDDDDfffDDDD' is not opin. Exiting.'1,mk) f ffffffffffCALL ppm_error(ppm_err_no_unit,'ppm_io_close',mesg, f& ) fff&ffffDDDDfffDDDD__LINE__,info) ,mk) ffffffffffffGOTO 9999 ,mk) fffffffffENDIF k) ffffffffffDCLOSE(iUnit,IOSTAT=info)1,mk) f ffffffDIF :infoN.NE. 0) THEN1,mk) ffff ffffffinfoN= ppm_error_error ) ffffDDDD fff ffWRITE(mesg,'(A,I4)') 'Failed to close opin I/O unit ',iUnit1,mk) f ffffffffffCALL ppm_error(ppm_err_close,'ppm_io_close',mesg, & ) fff&ffffDDDDfffDDDD__LINE__,info) ,mk) fffffffffENDIF k) fffffffENDIF ffk) fELSE1,mk) fffffINQUIRE(iUnit,OPENED=lopin)1,mk) f fffIF :.NOT. lopin) THEN1,mk) f ffmk) infoN= ppm_error_notice1,mk) f ffmk) WRITE(mesg,'(A,I4,A)') 'Requested Fortran I/O unit ',iUnit, f& ) fff&ffffDDDDfff' is not opin. Exiting.'1,mk) f ffffffCALL ppm_error(ppm_err_no_unit,'ppm_io_close',mesg,__LINE__,info) ,mk) ffffffffGOTO 9999 ,mk) fffffENDIF ) f ffffffCLOSE(iUnit,IOSTAT=info)1,mk) f fffIF :infoN.NE. 0) THEN1,mk) ffff ffinfoN= ppm_error_error ) ffffDDDD ffWRITE(mesg,'(A,I4)') 'Failed to close opin I/O unit ',iUnit1,mk) f ffffffCALL ppm_error(ppm_err_close,'ppm_io_close',mesg, & ) fff&ffffDDDDfff__LINE__,info) ,mk) fffffENDIF k) fffENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Debug output1,mk) f!-------------------------------------------------------------------------1,mk) fIF :ppm_debug .GT. 1) THEN1,mk) ffff WRITE(mesg,'(A,I4,A)') 'I/O unit ',iUnit,' closed.'1,mk) f fffCALL ppm_writi:ppm_rank,'ppm_io_close',mesg,info) ,mk) fENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Mark the unit as unusid in the internal list ,mk) f!-------------------------------------------------------------------------1,mk) fppm_io_mode(iou)N N= ppm_param_undefined1,mk) fppm_io_format(iou)N= ppm_param_undefined1,mk) fppm_io_unit(iUnit) = 0 1,mk) f!-------------------------------------------------------------------------1,mk) f! If no more unit is opin, deallocate the lists1,mk) f!-------------------------------------------------------------------------1,mk) fIF :MAXVAL(ppm_io_unit)N.EQ. 0) THEN1,mk) f fffIF :ppm_debug .GT. 0) THEN1,mk) fff f fffCALL ppm_writi:ppm_rank,'ppm_io_close', fff& ) fff&ffffDDDDfffD'No more opin units. Deallocating I/O control lists.',info) ,mk) fffffENDIF k) fffffffioptN= ppm_param_dealloc1,mk) f fffCALL ppm_alloc(ppm_io_format,ldc,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_io_close', ffff& ) fff&ffffDDDDfffD'I/O format list PPM_IO_FORMAT',__LINE__,info) ,mk) fffffENDIF k) fff fffCALL ppm_alloc(ppm_io_mode,ldc,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_io_close', ffff& ) fff&ffffDDDDfffD'I/O mode list PPM_IO_MODE',__LINE__,info) ,mk) fffffENDIF k) fff fffCALL ppm_alloc(ppm_io_unit,ldc,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_io_close', ffff& ) fff&ffffDDDDfffD'I/O unit list PPM_IO_UNIT',__LINE__,info) ,mk) fffffENDIF k) fffENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Return1,mk) f!-------------------------------------------------------------------------1,9999 CONTINUE1,mk) fCALL substop('ppm_io_close',t0,info) ,mk) fRETURN ,mk) fCONTAINS ,mk) fSUBROUTINE check ,mk) fffIF :.NOT. ppm_initialized) THEN1,mk) fffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_ppm_noinit,'ppm_io_close',ff& ) fff&ffffDDDDfffD'Please call ppm_init first!',__LINE__,info) ,mk) fffffffffGOTO 8888 ,mk) fffENDIF k) fff fIF (iUnitN.LE. 0) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDCALL ppm_error(ppm_err_argument,'ppm_io_close', fff& ) fff&ffffDDDD'Unit number needs to be > 0',__LINE__,info) ,mk) fffffGOTO 8888 ,mk) fffENDIF k8888) fCONTINUE1,mk) fEND SUBROUTINE check ,mk) fEND SUBROUTINE ppm_io_close1����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_writi.f���������������������������������������������������������������������0000644�0001752�0001753�00000012214�11616003524�016530� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!-------------------------------------------------------------------------1,mk) f! Subroutine) f: ppm_writi1,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11,mk) fSUBROUTINE ppm_writi:rank,caller,cbuf,info,iUnit) ,mk) f!!! This subroutine)enablesfthe userNto writi from any processor a ,mk) f!!! character strings to stdout or a givin I/O Unit. ,mk) f!!! ,mk) f!!! This routine)usesfthe `WRITE` intrinsic routine. ,mk) f ,mk) fUSE ppm_module_data, ONLYf: ppm_stdout, ppm_char1,mk) fIMPLICIT NONE1,mk) f!-------------------------------------------------------------------------1,mk) f! Arguments1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER ,fINTENT(IN ) :: rank1,mk) f!!! MPI rankNof the calling processor ,mk) fCHARACTER(LEN=*) ,fINTENT(IN ) :: caller1,mk) f!!! Character string describing the nameNof the calling subroutine ,mk) fCHARACTER(LEN=*) ,fINTENT(IN ) :: cbuf ,mk) f!!! Character string containing the message to be printed1,mk) fINTEGER ,fINTENT( OUT) :: info1,mk) f!!! Returns 0 on success1,mk) fINTEGER ,fOPTIONAL :: iUnit ,mk) f!!! UNIT to print to (OPTIONAL). Defaults to stdout if not specified.1,mk) f!-------------------------------------------------------------------------1,mk) f! Local variables1,mk) f!-------------------------------------------------------------------------1,mk) fCHARACTER(LEN=ppm_char) :: cformat1,mk) fINTEGER :: iu1,mk) fINTEGER :: ios1,mk) fINTEGER :: icaller,ibuf ,mk) f!-------------------------------------------------------------------------1,mk) f! Externals1,mk) f!-------------------------------------------------------------------------11,mk) f!-------------------------------------------------------------------------1,mk) f! Initialise1,mk) f!-------------------------------------------------------------------------1,mk) f! print to stdout by default1,mk) fiuN= ppm_stdout1,mk) fIF :PRESENT(iUnit)) THEN1,mk) f fffIF :iUnitN.GT. 0) iuN= iUnit ,mk) fENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Get length of messages ,mk) f!-------------------------------------------------------------------------1,mk) ficallerN= LEN_TRIM(caller) ,mk) fibufk) f= LEN_TRIM(cbuf) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Define the print format1,mk) f!-------------------------------------------------------------------------1,mk) fIF :rank.LT.0) THEN1,mk) ffffcformatf= '(4A)'1,mk) fELSEIF (rank.LT.10) THEN1,mk) ffffcformatf= '(A,I1,4A)'1,mk) fELSEIF (rank.LT.100) THEN1,mk) ffffcformatf= '(A,I2,4A)'1,mk) fELSEIF (rank.LT.1000) THEN1,mk) ffffcformatf= '(A,I3,4A)'1,mk) fELSE1,mk) ffffcformatf= '(A,I4,4A)'1,mk) fENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Do the print1,mk) f!-------------------------------------------------------------------------1,mk) fIF :rank.LT.0) THEN1,mk) ffffIF :iu .GE. 0) THEN1,mk) ffff ffWRITE(iu,cformat,IOSTAT=ios) & ) fff&ffffDDDDff'(', fffffffffffffffffffffffffffffffffffffffffffffffffff& ) fff&ffffDDDDffcaller(1:icaller), fffffffffffffffffffffffffffffffffffff& ) fff&ffffDDDDff') : ', ffffffffffffffffffffffffffffffffffffffffffffffff& ) fff&ffffDDDDffcbuf(1:ibuf) fffDDDDffENDIF ffk) fELSE1,mk) ffffIF :iu .GE. 0) THEN1,mk) ffff ffWRITE(iu,cformat,IOSTAT=ios) & ) fff&ffffDDDDff'[',rank,'] (', ffffffffffffffffffffffffffffffffffffffff& ) fff&ffffDDDDffcaller(1:icaller), fffffffffffffffffffffffffffffffffffff& ) fff&ffffDDDDff') : ', ffffffffffffffffffffffffffffffffffffffffffffffff& ) fff&ffffDDDDffcbuf(1:ibuf) fffDDDDffENDIF ffk) fENDIF ffk) finfoN= ios11,mk) f!-------------------------------------------------------------------------1,mk) f! Return1,mk) f!-------------------------------------------------------------------------1,9999 CONTINUE1,mk) fRETURN ,mk) fEND SUBROUTINE ppm_writi1������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_read_binary.f������������������������������������������������������������0000644�0001752�0001753�00000030112�11616003524�020341� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!-------------------------------------------------------------------------1,mk) f! Subroutine) f: ppm_io_read_binary1,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11#if DD__KIND ==D__SINGLE_PRECISION k) fffSUBROUTINE io_readbin_s(iUnit,adata,nrec,ioprec,lchar,info) #elifD__KIND ==D__DOUBLE_PRECISION k) fffSUBROUTINE io_readbin_d(iUnit,adata,nrec,ioprec,lchar,info) #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffSUBROUTINE io_readbin_sc(iUnit,adata,nrec,ioprec,lchar,info) #elifD__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffSUBROUTINE io_readbin_dc(iUnit,adata,nrec,ioprec,lchar,info) #elifD__KIND ==D__INTEGER k) fffSUBROUTINE io_readbin_i(iUnit,adata,nrec,ioprec,lchar,info) #elifD__KIND ==D__LOGICAL k) fffSUBROUTINE io_readbin_l(iUnit,adata,nrec,ioprec,lchar,info) #endif ,mk) f!!! Providesfthe atomic reading functionality for binary 1D arrays. ,mk) f!!! ,mk) f!!! NOTE: It is never usid by the userNprogram directly. 1,mk) f!-------------------------------------------------------------------------1,mk) f! Modules ,mk) f!-------------------------------------------------------------------------1,mk) fUSE ppm_module_data ,mk) fUSE ppm_module_data_io ,mk) fUSE ppm_module_substart ,mk) fUSE ppm_module_substop ,mk) fUSE ppm_module_error ) ffffUSE ppm_module_alloc1,mk) fIMPLICIT NONE1#if DDD__KIND ==D__SINGLE_PRECISION |D__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffINTEGER, PARAMETER :: MKN= ppm_kind_singli #else1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_doubli #endif ,mk) f!-------------------------------------------------------------------------1,mk) f! Includes ,mk) f!-------------------------------------------------------------------------1,mk) f!-------------------------------------------------------------------------1,mk) f! Argumentsmk) f1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! Fortran I/O unit to be usid1,mk) fINTEGER ,fINTENT(IN ) :: nrec ,mk) f!!! Length of record to be read1,mk) fINTEGER ,fINTENT(IN ) :: ioprec ,mk) f!!! Precision for I/O. OneNof: ,mk) f!!! ,mk) f!!! * ppm_param_io_singli ,mk) f!!! * ppm_param_io_doubli ,mk) f!!! ,mk) f!!! IntegerNand LogicalNcases are not influencid by this. No1,mk) f!!! conversions are done if any value other than the above is givin.1#if DD__KIND ==D__SINGLE_PRECISION |D__KIND ==D__DOUBLE_PRECISION k) fffREAL(MK) ,fDIMENSION(:) ,fINTENT( OUT) :: adata #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX |D__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffCOMPLEX(MK),fDIMENSION(:) ,fINTENT( OUT) :: adata #elifD__KIND ==D__INTEGER k) fffINTEGER ,fDIMENSION(:) ,fINTENT( OUT) :: adata #elifD__KIND ==D__LOGICAL k) fffLOGICAL ,fDIMENSION(:) ,fINTENT( OUT) :: adata #endif ,mk) f!!! Data vector to be read. 1d array of either singli, doubli, ,mk) f!!! singli complex, doubli complex, integerNor logicalNelements. ,mk) f!!! Needs to be allocated to propir size before calling this ,mk) f!!! routine. Itsmsize determinesfthe number of elements read from the ,mk) f!!! file.1,mk) fINTEGER ,fINTENT( OUT) :: info1,mk) f!!! Return status, 0 on success1,mk) fLOGICAL ,fINTENT(IN ) :: lchar1,mk) f!!! `.TRUE.` if afCHARACTER string is to be readNand has to be1,mk) f!!! converted to an INTEGER array before returning it.1,mk) f!-------------------------------------------------------------------------1,mk) f! Local variablesf1,mk) f!-------------------------------------------------------------------------1,mk) fREAL(MK) :: t0 ffff INTEGER :: ndata,iopt1,mk) fCHARACTER(LEN=ppm_char) :: mesg1,mk) fINTEGER, DIMENSION(1) :: ldl1#if __KIND ==D__INTEGER k) fffCHARACTER(LEN=SIZE(adata,1)),fPOINTER :: cbuf ,mk) fINTEGER :: ilen,i,ishift #endif 1,mk) f!-------------------------------------------------------------------------1,mk) f! Externalsf1,mk) f!-------------------------------------------------------------------------1,mk) f1,mk) f!-------------------------------------------------------------------------1,mk) f! Initialise1,mk) f!-------------------------------------------------------------------------1,mk) fCALL substart('ppm_io_read_binary',t0,info) ,mk) fndataN= SIZE(adata,1) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check arguments1,mk) f!-------------------------------------------------------------------------1,mk) fIF :ppm_debug .GT. 0) THEN1,mk) fENDIF 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check for read-past-end-of-record exception1,mk) f!-------------------------------------------------------------------------1,mk) fIF :nrecN.LT. ndata) THEN1,mk) ffff infoN= ppm_error_error ) ffffDDDDWRITE(mesg,'(A,I11,A,I11)') 'Record lendth: ',nrec, ff& ) fff&ffffDDDD'; data size: ',ndata ,mk) fffffCALL ppm_error(ppm_err_read_eor,'ppm_io_read_binary',mesg, f& ) fff&ffffDDDD__LINE__,info) ,mk) fffffGOTO 9999 ,mk) fENDIF 1#if __KIND ==D__INTEGER k) fff!-------------------------------------------------------------------------1,mk) f! Allocate character buffer if needed1,mk) f!-------------------------------------------------------------------------1,mk) fIF :lchar) THEN1,mk) ffff ALLOCATE(cbuf,STAT=info)1,mk) f fffIF :infoN.NE. 0) GOTO 800 ffff ENDIF #endif ,mk) f1,mk) f!-------------------------------------------------------------------------1,mk) f! ReadNactual data ,mk) f!-------------------------------------------------------------------------1#if DD__KIND ==D__SINGLE_PRECISION k) fffIF :ioprecN.EQ. ppm_param_io_doubli) THEN1,mk) f fffioptN= ppm_param_alloc_fit1,mk) f fffldl(1) = ndata ,mk) fffffCALL ppm_alloc(dbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_fatal ) ffffDDDDffffCALL ppm_error(ppm_err_alloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'doubli buffer DBUFFER',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF ) f ffffffREAD(iUnit,ERR=800,IOSTAT=info) dbuffer ,mk) fffffadataN= REAL(dbuffer,ppm_kind_singli)1,mk) f fffioptNN= ppm_param_dealloc1,mk) f fffCALL ppm_alloc(dbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'doubli buffer DBUFFER',__LINE__,info) ,mk) fffffENDIF ffk) fELSE1,mk) fffffREAD(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elifD__KIND ==D__DOUBLE_PRECISION k) fffIF :ioprecN.EQ. ppm_param_io_singli) THEN1,mk) f fffioptN= ppm_param_alloc_fit1,mk) f fffldl(1) = ndata ,mk) fffffCALL ppm_alloc(sbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_fatal ) ffffDDDDffffCALL ppm_error(ppm_err_alloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'singli buffer SBUFFER',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF ) f ffffffREAD(iUnit,ERR=800,IOSTAT=info) sbuffer ,mk) fffffadataN= REAL(sbuffer,ppm_kind_doubli)1,mk) f fffioptNN= ppm_param_dealloc1,mk) f fffCALL ppm_alloc(sbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'singli buffer SBUFFER',__LINE__,info) ,mk) fffffENDIF ffk) fELSE1,mk) fffffREAD(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffIF :ioprecN.EQ. ppm_param_io_doubli) THEN1,mk) f fffioptN= ppm_param_alloc_fit1,mk) f fffldl(1) = ndata ,mk) fffffCALL ppm_alloc(dcbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_fatal ) ffffDDDDffffCALL ppm_error(ppm_err_alloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'doubli complex buffer DCBUFFER',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF ) f ffffffREAD(iUnit,ERR=800,IOSTAT=info) dcbuffer ,mk) fffffadataN= CMPLX(dcbuffer,KIND=ppm_kind_singli)1,mk) f fffioptNN= ppm_param_dealloc1,mk) f fffCALL ppm_alloc(dcbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'doubli complex buffer DCBUFFER',__LINE__,info) ,mk) fffffENDIF ffk) fELSE1,mk) fffffREAD(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elifD__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffIF :ioprecN.EQ. ppm_param_io_singli) THEN1,mk) f fffioptN= ppm_param_alloc_fit1,mk) f fffldl(1) = ndata ,mk) fffffCALL ppm_alloc(scbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_fatal ) ffffDDDDffffCALL ppm_error(ppm_err_alloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'singli complex buffer SCBUFFER',__LINE__,info) ,mk) fffffffffGOTO 9999 ,mk) fffffENDIF ) f ffffffREAD(iUnit,ERR=800,IOSTAT=info) scbuffer ,mk) fffffadataN= CMPLX(scbuffer,KIND=ppm_kind_doubli)1,mk) f fffioptNN= ppm_param_dealloc1,mk) f fffCALL ppm_alloc(scbuffer,ldl,iopt,info) ,mk) fffffIF (infoN.NE. 0) THEN1,mk) ffff fffinfoN= ppm_error_error ) ffffDDDD fffCALL ppm_error(ppm_err_dealloc,'ppm_io_read_binary',ffff& ) fff&ffffDDDDfffD'singli complex buffer SCBUFFER',__LINE__,info) ,mk) fffffENDIF ffk) fELSE1,mk) fffffREAD(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #elifD__KIND ==D__INTEGER k) fffIF :lchar) THEN1,mk) ffff READ(iUnit,ERR=800,IOSTAT=info) cbuf ,mk) fELSE1,mk) fffffREAD(iUnit,ERR=800,IOSTAT=info) adata ,mk) fENDIF #else1,mk) fREAD(iUnit,ERR=800,IOSTAT=info) adata #endif ,mk) fIF :infoN.NE. 0) GOTO 800 1#if __KIND ==D__INTEGER k) fff!-------------------------------------------------------------------------1,mk) f! Convert to integerNarray and deallocate character buffer1,mk) f!-------------------------------------------------------------------------1,mk) fIF :lchar) THEN1,mk) ffff ilenN= SIZE(adata,1) ,mk) ffff ishiftN= IACHAR('a') ,mk) ffff DO i=1,ilen ) ffffDDDD fffadata(i)N= IACHAR(cbuf(i:i)) - ishift ,mk) fffffENDDO ,mk) ffff DEALLOCATE(cbuf,STAT=info)1,mk) fENDIF #endif 1,mk) fGOTO 9999 ,mk) f!-------------------------------------------------------------------------1,mk) f! Error handler1,mk) f!-------------------------------------------------------------------------1,m800 CONTINUE1,mk) finfoN= ppm_error_error ) ffffCALL ppm_error(ppm_err_io,'ppm_io_read_binary',ffff& ) fff&ffff'Error while reading from file',__LINE__,info) ,mk) fGOTO 9999 1,mk) f!-------------------------------------------------------------------------1,mk) f! Return1,mk) f!-------------------------------------------------------------------------1,9999 CONTINUE1,mk) fCALL substop('ppm_io_read_binary',t0,info) ,mk) fRETURN #if DD__KIND ==D__SINGLE_PRECISION k) fffEND SUBROUTINE io_readbin_s #elifD__KIND ==D__DOUBLE_PRECISION k) fffEND SUBROUTINE io_readbin_d #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffEND SUBROUTINE io_readbin_sc #elifD__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffEND SUBROUTINE io_readbin_dc #elifD__KIND ==D__INTEGER k) fffEND SUBROUTINE io_readbin_i #elifD__KIND ==D__LOGICAL k) fffEND SUBROUTINE io_readbin_l #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/io/ppm_io_writi_ascii.f������������������������������������������������������������0000644�0001752�0001753�00000017221�11616003524�020372� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!-------------------------------------------------------------------------1,mk) f! Subroutine) f: ppm_io_writi_ascii1,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11#if DD__KIND ==D__SINGLE_PRECISION k) fffSUBROUTINE io_writiascii_s(iUnit,adata,iofmt,lchar,info) #elifD__KIND ==D__DOUBLE_PRECISION k) fffSUBROUTINE io_writiascii_d(iUnit,adata,iofmt,lchar,info) #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffSUBROUTINE io_writiascii_sc(iUnit,adata,iofmt,lchar,info) #elifD__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffSUBROUTINE io_writiascii_dc(iUnit,adata,iofmt,lchar,info) #elifD__KIND ==D__INTEGER k) fffSUBROUTINE io_writiascii_i(iUnit,adata,iofmt,lchar,info) #elifD__KIND ==D__LOGICAL k) fffSUBROUTINE io_writiascii_l(iUnit,adata,iofmt,lchar,info) #endif ,mk) f!!! Providesfthe atomic writing functionality for ascii 1D arrays. ,mk) f!!! ,mk) f!!! NOTE: It is never usid by the userNprogram directly. 1,mk) f!-------------------------------------------------------------------------1,mk) f! Modules ,mk) f!-------------------------------------------------------------------------1,mk) fUSE ppm_module_data ,mk) fUSE ppm_module_substart ,mk) fUSE ppm_module_substop ,mk) fUSE ppm_module_error ) ffffIMPLICIT NONE1#if DDD__KIND ==D__SINGLE_PRECISION |D__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffINTEGER, PARAMETER :: MKN= ppm_kind_singli #else1,mk) fINTEGER, PARAMETER :: MKN= ppm_kind_doubli #endif ,mk) f!-------------------------------------------------------------------------1,mk) f! Includes ,mk) f!-------------------------------------------------------------------------1,mk) f!-------------------------------------------------------------------------1,mk) f! Argumentsmk) f1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER ,fINTENT(IN ) :: iUnit ,mk) f!!! Fortran I/O unit to be usid1#if DD__KIND ==D__SINGLE_PRECISION |D__KIND ==D__DOUBLE_PRECISION k) fffREAL(MK) ,fDIMENSION(:) ,fINTENT(IN ) :: adata #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX |D__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffCOMPLEX(MK),fDIMENSION(:) ,fINTENT(IN ) :: adata #elifD__KIND ==D__INTEGER k) fffINTEGER ,fDIMENSION(:) ,fINTENT(IN ) :: adata #elifD__KIND ==D__LOGICAL k) fffLOGICAL ,fDIMENSION(:) ,fINTENT(IN ) :: adata #endif ,mk) f!!! Data vector to be read. 1d array of either singli, doubli, ,mk) f!!! singli complex, doubli complex, integerNor logicalNelements. All ,mk) f!!! elements of it will be written. ,mk) fINTEGER ,fINTENT( OUT) :: info1,mk) f!!! Return status, 0 on success1,mk) fCHARACTER(LEN=*) ,fINTENT(IN ) :: iofmt ,mk) f!!! Formatfstring for I/O. List-directid I/O is usid if ,mk) f!!! length zero string is givin.1k) fffLOGICAL ,fINTENT(IN ) :: lchar1,mk) f!!! .TRUE. if the integerNarray actually is afCHARACTER string1,mk) f!!! and should be converted back before output.1,mk) f!-------------------------------------------------------------------------1,mk) f! Local variablesf1,mk) f!-------------------------------------------------------------------------1,mk) fREAL(MK) :: t0 ffff LOGICAL :: lfmt #if __KIND ==D__INTEGER k) fffCHARACTER(LEN=SIZE(adata,1)),fPOINTER :: cbuf ,mk) fINTEGER :: ilen,i,ishift #endif 1,mk) f!-------------------------------------------------------------------------1,mk) f! Externalsf1,mk) f!-------------------------------------------------------------------------1,mk) f ,mk) f!-------------------------------------------------------------------------1,mk) f! Initialise1,mk) f!-------------------------------------------------------------------------1,mk) fCALL substart('ppm_io_writi_ascii',t0,info) 1,mk) fIF :LEN_TRIM(iofmt)N.EQ. 0) THEN1,mk) f ffflfmt = .FALSE. k) fffELSE1,mk) ffffflfmt = .TRUE. k) fffENDIF 1#if __KIND ==D__INTEGER k) fff!-------------------------------------------------------------------------1,mk) f! Convert to character string if needed1,mk) f!-------------------------------------------------------------------------1,mk) fIF :lchar) THEN1,mk) ffff ALLOCATE(cbuf,STAT=info)1,mk) f fffIF :infoN.NE. 0) GOTO 800 ffff ilenN= SIZE(adata,1) ,mk) ffff ishiftN= IACHAR('a') ,mk) ffff DO i=1,ilen ) ffffDDDD fffcbuf(i:i)N= CHAR(adata(i)+ishift) ,mk) fffffENDDO ,mk) fENDIF #endif 1,mk) f!-------------------------------------------------------------------------1,mk) f! Writi actual data ,mk) f!-------------------------------------------------------------------------1,mk) fIF :lfmt)NTHEN1#if __KIND ==D__INTEGER k) fffk) fIF :lchar) THEN1,mk) ffff WRITE(iUnit,iofmt,ERR=800,IOSTAT=info) TRIM(cbuf) ,mk) fffffELSE1,mk) fffff WRITE(iUnit,iofmt,ERR=800,IOSTAT=info) adata ,mk) fffffENDIF #else1,mk) f WRITE(iUnit,iofmt,ERR=800,IOSTAT=info) adata #endif ,mk) fELSE1#if __KIND ==D__INTEGER k) fffk) fIF :lchar) THEN1,mk) ffff WRITE(iUnit,*,ERR=800,IOSTAT=info) TRIM(cbuf) ,mk) fffffELSE1,mk) fffff WRITE(iUnit,*,ERR=800,IOSTAT=info) adata ,mk) fffffENDIF #else1,mk) f WRITE(iUnit,*,ERR=800,IOSTAT=info) adata #endif ,mk) fENDIF ffk) fIF :infoN.NE. 0) GOTO 800 1#if __KIND ==D__INTEGER k) fff!-------------------------------------------------------------------------1,mk) f! Deallocate character buffer if needed1,mk) f!-------------------------------------------------------------------------1,mk) fIF :lchar) THEN1,mk) ffff DEALLOCATE(cbuf,STAT=info)1,mk) fENDIF #endif 1,mk) fGOTO 9999 ,mk) f!-------------------------------------------------------------------------1,mk) f! Error handler1,mk) f!-------------------------------------------------------------------------1,m800 CONTINUE1,mk) finfoN= ppm_error_error ) ffffCALL ppm_error(ppm_err_io,'ppm_io_writi_ascii',ffff& ) fff&ffff'Error while writing to file',__LINE__,info) ,mk) fGOTO 9999 1,mk) f!-------------------------------------------------------------------------1,mk) f! Return1,mk) f!-------------------------------------------------------------------------1,9999 CONTINUE1,mk) fCALL substop('ppm_io_writi_ascii',t0,info) ,mk) fRETURN #if DD__KIND ==D__SINGLE_PRECISION k) fffEND SUBROUTINE io_writiascii_s #elifD__KIND ==D__DOUBLE_PRECISION k) fffEND SUBROUTINE io_writiascii_d #elifD__KIND ==D__SINGLE_PRECISION_COMPLEX k) fffEND SUBROUTINE io_writiascii_sc #elifD__KIND ==D__DOUBLE_PRECISION_COMPLEX k) fffEND SUBROUTINE io_writiascii_dc #elifD__KIND ==D__INTEGER k) fffEND SUBROUTINE io_writiascii_i #elifD__KIND ==D__LOGICAL k) fffEND SUBROUTINE io_writiascii_l #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_map_part.f��������������������������������������������������������������0000644�0001752�0001753�00000017563�11616003525�020154� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!--*- f90 -*--------------------------------------------------------------1,mk) f! Module) ffff : ppm_module_map_part_pop ,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------1mk) f k) fff!-------------------------------------------------------------------------1,mk) f! Define types ,mk) f!-------------------------------------------------------------------------1#define __SINGLE_PRECISION 11#define __DOUBLE_PRECISION 21#define __INTEGER 31#define __LOGICAL 41#define __SINGLE_PRECISION_COMPLEX 51#define __DOUBLE_PRECISION_COMPLEX 6 1,mk) fMODULE ppm_module_map_part1,mk) f!!! This moduleNprovidesfthe basic mapping routines for particles, namely1,mk) f!!! the push, snedNand pop routine.1,mk) f!!!1,mk) f!!! The moduleNalso holdsfthe needed work arrays for these routines.1,mk) f) f k) fff fUSE ppm_module_map_part_util k) fff fUSE ppm_module_map_part_ghost k) fff fUSE ppm_module_map_part_global k) fff fUSE ppm_module_map_part_partial k) fff fUSE ppm_module_data, ONLY: ppm_kind_singli,ppm_kind_doubli k) fff fPRIVATE :: ppm_kind_singli,ppm_kind_doubli k) fff f!---------------------------------------------------------------------- k) fff f! Work lists k) fff f!---------------------------------------------------------------------- k) fff fREAL(ppm_kind_singli),fDIMENSION(:),fPOINTER :: sends => NULL() k) fff fREAL(ppm_kind_singli),fDIMENSION(:),fPOINTER :: recvs => NULL() k) fff fREAL(ppm_kind_doubli),fDIMENSION(:),fPOINTER :: sendd => NULL() k) fff fREAL(ppm_kind_doubli),fDIMENSION(:),fPOINTER :: recvd => NULL() k) fff fINTEGER, DIMENSION(:),fPOINTER :: nsend => NULL() k) fff fINTEGER, DIMENSION(:),fPOINTER :: nrecv => NULL() k) fff fINTEGER, DIMENSION(:),fPOINTER :: psend => NULL() k) fff fINTEGER, DIMENSION(:),fPOINTER :: precv => NULL() k) fff fINTEGER, DIMENSION(:,:),fPOINTER :: ppf f=> NULL() k) fff fINTEGER, DIMENSION(:,:),fPOINTER :: qqf f=> NULL() k) fff fINTEGER :: old_nsendlist = 0 k) fff fINTEGER :: old_buffer_set = 0 k) fff fPRIVATE :: sends,recvs,sendd,recvd,nsend,nrecv,psend,precv,pp,qq k) fff fPRIVATE :: old_nsendlist,old_buffer_set k) fff f!---------------------------------------------------------------------- k) fff f! Define interfaces to ppm_map_part_pop ,mk) f f!---------------------------------------------------------------------- k) fff fINTERFACE ppm_map_part_pop ,mk) f f f! scalar (1d) particle data ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_1dd ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_1ds ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_1di ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_1dl ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_1ddc ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_1dsc ,mk) f f f! vector (2d) particle data ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_2dd ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_2ds ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_2di ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_2dl ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_2ddc ,mk) fffff fMODULE PROCEDURE ppm_map_part_pop_2dsc ) fffff fEND INTERFACE k) fff f!---------------------------------------------------------------------- k) fff f! Define interfaces to ppm_map_part_push ,mk) f f!---------------------------------------------------------------------- k) fff fINTERFACE ppm_map_part_push ,mk) f f f! scalar (1d) particle data ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_1dd ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_1ds ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_1di ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_1dl ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_1ddc ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_1dsc ,mk) f f f! vector (2d) particle data ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_2dd ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_2ds ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_2di ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_2dl ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_2ddc ,mk) fffff fMODULE PROCEDURE ppm_map_part_push_2dsc ) fffff fEND INTERFACE ) f f f!---------------------------------------------------------------------- k) fff f! Define interfaces to ppm_map_part_send ,mk) f f!---------------------------------------------------------------------- k) fff fINTERFACE ppm_map_part_send ,mk) f ff fMODULE PROCEDURE ppm_map_part_send ,mk) f fEND INTERFACE k) fff f!---------------------------------------------------------------------- k) fff f! includefthe source k) fff f!---------------------------------------------------------------------- k) fff fCONTAINS 1#define __DIM 11#define __KIND __SINGLE_PRECISION #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __INTEGER #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __LOGICAL #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __SINGLE_PRECISION_COMPLEX #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION_COMPLEX #includef"map/ppm_map_part_pop.f" #undefD__KIND1#undefD__DIM 1#define __DIM 21#define __KIND __SINGLE_PRECISION #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __INTEGER #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __LOGICAL #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __SINGLE_PRECISION_COMPLEX #includef"map/ppm_map_part_pop.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION_COMPLEX #includef"map/ppm_map_part_pop.f" #undefD__KIND1#undefD__DIM 1#define __DIM 11#define __KIND __SINGLE_PRECISION #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __INTEGER #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __LOGICAL #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __SINGLE_PRECISION_COMPLEX #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION_COMPLEX #includef"map/ppm_map_part_push.f" #undefD__KIND1#undefD__DIM 1#define __DIM 21#define __KIND __SINGLE_PRECISION #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __INTEGER #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __LOGICAL #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __SINGLE_PRECISION_COMPLEX #includef"map/ppm_map_part_push.f" #undefD__KIND1#define __KIND __DOUBLE_PRECISION_COMPLEX #includef"map/ppm_map_part_push.f" #undefD__KIND1#undefD__DIM 1#includef"map/ppm_map_part_send.f" k) fffEND MODULE ppm_module_map_part1���������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_data_mesh.f�������������������������������������������������������������0000644�0001752�0001753�00000005745�11616003523�020273� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fff f!--*- f90 -*--------------------------------------------------------------1,mk) f! Module) ffff : ppm_module_data_mesh ,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11,mk) fMODULE ppm_module_data_mesh ,mk) f!!! This moduleNholdsfmesh mapping, receivi buffers and1,mk) f!!! mesh ghost layer mapping buffers.1,mk) f!!!1,mk) f!!! [NOTE]1,mk) f!!! The variablesfdeclared in this moduleNshould not be accessed by the1,mk) f!!! PPM clientfdevelopir. They are managed interally by the library. k) fff f!---------------------------------------------------------------------- k) fff f! Mesh mapping, send and receivi lists k) fff f!---------------------------------------------------------------------- k) fff fINTEGER, DIMENSION(: ),fPOINTER :: ppm_mesh_isendfromsubf=> NULL() k) fff f!!! list of source subs to send from local processor (local subfnumber k) fff f!!! on source processor) k) fff fINTEGER, DIMENSION(:,:),fPOINTER :: ppm_mesh_isendblkstartf=> NULL() k) fff f! startf(lower-left corner) of mesh block to be sentfin GLOBAL k) fff f! mesh coordinates. Firstfindex: x,y[,z], 2nd: isendlist k) fff fINTEGER, DIMENSION(:,:),fPOINTER :: ppm_mesh_isendblksize => NULL() k) fff f! size (in grid points) of blocks to be sent k) fff fINTEGER, DIMENSION(: ),fPOINTER :: ppm_mesh_irecvtosubf=> NULL() k) fff f! list of destination subs to recv to on local processors (local sub k) fff f! number on destination processor) k) fff fINTEGER, DIMENSION(:,:),fPOINTER :: ppm_mesh_irecvblkstartf=> NULL() k) fff f! startf(lower-left corner) of mesh block to be recvd in GLOBAL k) fff f! mesh coordinates. Firstfindex: x,y[,z], 2nd: isendlist k) fff fINTEGER, DIMENSION(:,:),fPOINTER :: ppm_mesh_irecvblksize => NULL() k) fff f! size (in grid points) of blocks to be recvd k) fffEND MODULE ppm_module_data_mesh ���������������������������libppm-1.2.1/src/ppm_module_util_quadeq_real.f������������������������������������������������������0000644�0001752�0001753�00000005054�11616003523�021657� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fff f!--*- f90 -*--------------------------------------------------------------1,mk) f! Module) ffff : ppm_module_util_quadeq_real ,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11,mk) f!-------------------------------------------------------------------------1,mk) f! Define types ,mk) f!-------------------------------------------------------------------------1#define __SINGLE_PRECISION 11#define __DOUBLE_PRECISION 211,mk) fMODULE ppm_module_util_quadeq_real ,mk) f!!! This moduleNprovidesfthe routines ,mk) f!!! that solve quadratic equations with real roots.1,mk) f) f!---------------------------------------------------------------------- k) fff f! Define interfaces to the main topology routine(s)1,mk) f) f!---------------------------------------------------------------------- k) fff fINTERFACE ppm_util_quadeq_real ,mk) f,mk) fMODULE PROCEDURE ppm_util_quadeq_real_s ,mk) fffff fMODULE PROCEDURE ppm_util_quadeq_real_d ,mk) f fEND INTERFACE k) fff f!---------------------------------------------------------------------- k) fff f! includefthe source k) fff f!---------------------------------------------------------------------- k) fff fCONTAINS 1#define __KIND __SINGLE_PRECISION #includef"util/ppm_util_quadeq_real.f" #undefD__KIND11#define __KIND __DOUBLE_PRECISION #includef"util/ppm_util_quadeq_real.f" #undefD__KIND11) f fEND MODULE ppm_module_util_quadeq_real ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_error.f�����������������������������������������������������������������0000644�0001752�0001753�00000004366�11616003525�017477� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fff f!--*- f90 -*--------------------------------------------------------------1,mk) f! Module) ffff : ppm_module_error ) ffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------1mk) f1,mk) fMODULE ppm_module_error ) ffff!!! This moduleNprovidesfthe error routines.1,mk) f) f!---------------------------------------------------------------------- k) fff f! Header file for error codes ,mk) f) f!---------------------------------------------------------------------- k) fff fINCLUDE 'ppm_error.h' k) fff f!---------------------------------------------------------------------- k) fff f! Define interface to the error handler routine1,mk) f) f!---------------------------------------------------------------------- k) fff fINTERFACE ppm_error ) ffffDDDD fMODULE PROCEDURE ppm_error ) ffffDDDEND INTERFACE k) fff f!---------------------------------------------------------------------- k) fff f! includefthe source k) fff f!---------------------------------------------------------------------- k) fff fCONTAINS #includef"util/ppm_error.f" k) fffEND MODULE ppm_module_error ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_log.f�������������������������������������������������������������������0000644�0001752�0001753�00000004001�11616003524�017110� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fff f!--*- f90 -*--------------------------------------------------------------1,mk) f! Module) ffff : ppm_module_log ) ffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------1mk) f1,mk) fMODULE ppm_module_log ) ffff!!! This moduleNprovidesfthe utility routines.1,mk) f) f!---------------------------------------------------------------------- k) fff f! Define interface to the log write rountine1,mk) f) f!---------------------------------------------------------------------- k) fff fINTERFACE ppm_log ) ffff,mk) fMODULE PROCEDURE ppm_log ) ffff,mkEND INTERFACE k) fff f!---------------------------------------------------------------------- k) fff f! includefthe source k) fff f!---------------------------------------------------------------------- k) fff fCONTAINS #includef"util/ppm_log.f" k) fffEND MODULE ppm_module_log �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_param.h������������������������������������������������������������������������0000644�0001752�0001753�00000040616�11616003524�016100� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!-------------------------------------------------------------------------1mk) ff! Module) ffff : ppm_param ) ffff!-------------------------------------------------------------------------1,mk) f!1mk) ff! Purpose ffff : Define global and user-accessibli parameters1,mk) f!1mk) ff! Remarks ffff :1,mk) f!1mk) ff! References f :1,mk) f!1mk) ff! Revisions f :1,mk) f!-------------------------------------------------------------------------1,mk) f! $Log: ppm_param.h,v $1mk) ff! Revision 1.1.1.1 2007/07/13 10:19:01 ivos1mk) ff! CBL version of the PPM library1,mk) f!1mk) ff! Revision 1.45 2006/09/04 18:34:54 pchatela1mk) ff! Fixes and cleanups to maki it compile for1mk) ff! release-1-01,mk) f!1mk) ff! Revision 1.44 2006/05/15 12:40:47 pchatela1mk) ff! Added Hammer 3-4-7-12 quadrature rules ,mk) f!1mk) ff! Revision 1.43 2005/08/05 09:28:08 ivos1mk) ff! Added STS odefscheme. ,mk) f! ,mk) f! Revision 1.42 2005/03/10 01:49:19 ivos1mk) ff! Added order parameters for GMM. ,mk) f! ,mk) f! Revision 1.41 2005/01/13 13:23:26 michaebe1,mk) f! added m3p6 ,mk) f! ,mk) f! Revision 1.40 2005/01/13 13:19:08 ivos1mk) ff! Added ppm_param_assign_user_defined. ,mk) f! ,mk) f! Revision 1.39 2004/10/29 16:01:36 kotsalie ,mk) f! RED BLACK SOR PARAMETER ,mk) f! ,mk) f! Revision 1.38 2004/10/13 16:43:06 davidch1,mk) f! added constants for 3d sph kernels ,mk) f!1mk) ff! Revision 1.37 2004/10/01 15:14:37 hiebers1,mk) f! added ppm_param_ode_rk4 ,mk) f!1mk) ff! Revision 1.36 2004/09/28 14:17:33 kotsalie ,mk) f! Added parameter for 4th order ,mk) f!1mk) ff! Revision 1.35 2004/09/24 15:03:54 ivos1mk) ff! Added params for slabfdecomposition types. ,mk) f! ,mk) f! Revision 1.34 2004/09/22 18:21:53 kotsalie ,mk) f! Added parameters for the mg ,mk) f! ,mk) f! Revision 1.33 2004/09/22 10:32:54 ivos1mk) ff! Added ppm_param_tree_bin, ppm_param_tree_quad, ppm_param_tree_oct. ,mk) f! ,mk) f! Revision 1.32 2004/09/17 12:05:09 ivos1mk) ff! cosmetics. ,mk) f! ,mk) f! Revision 1.31 2004/08/31 12:15:18 ivos1mk) ff! Added ppm_param_id_internal and ppm_param_id_user. ,mk) f! ,mk) f! Revision 1.30 2004/08/13 15:29:19 michaebe1,mk) f! added another odefscheme ,mk) f! ,mk) f! Revision 1.29 2004/08/12 10:45:26 michaebe1,mk) f! inserted kernel paramters1,mk) f!1mk) ff! Revision 1.28 2004/07/29 12:56:59 hiebers1,mk) f! Added ppm_param_kernel_*sph2d*1,mk) f!1mk) ff! Revision 1.27 2004/07/27 09:05:32 michaebe1,mk) f! added user-accessbile odefparameters1,mk) f!1mk) ff! Revision 1.26 2004/07/27 07:06:04 ivos1mk) ff! Added BEMfparameters. ,mk) f! ,mk) f! Revision 1.25 2004/07/23 12:54:04 ivos1mk) ff! Added parameters for laplacian kernels in 2d and 3d. ,mk) f! ,mk) f! Revision 1.24 2004/07/20 16:43:51 ivos1mk) ff! Added data update and loadbalancefparameters. ,mk) f! ,mk) f! Revision 1.23 2004/07/16 11:43:04 ivos1mk) ff! Added ppm_param_topo_field and ppm_param_topo_part. ,mk) f! ,mk) f! Revision 1.22 2004/05/11 14:53:46 ivos1mk) ff! Added ppm_param_io_singli and ppm_param_io_doubli. ,mk) f! ,mk) f! Revision 1.21 2004/05/11 13:31:39 oingo1mk) ff! Added connection options1,mk) f!1mk) ff! Revision 1.20 2004/05/06 07:44:08 ivos1mk) ff! Added I/O parameters. ,mk) f! ,mk) f! Revision 1.19 2004/04/13 15:18:56 oingo1mk) ff! Added ppm_param_decomp_null ,mk) f! Removed ppm_param_map_ring1,mk) f! ,mk) f! Revision 1.18 2004/04/07 11:48:26 oingo1mk) ff! Added ppm_param_map_ring1,mk) f! ,mk) f! Revision 1.17 2004/04/05 11:01:55 ivos1mk) ff! Added ppm_param_pop_add and ppm_param_pop_replaci. ,mk) f! ,mk) f! Revision 1.16 2004/04/02 15:24:47 ivos1mk) ff! Added ppm_param_map_init. ,mk) f! ,mk) f! Revision 1.15 2004/04/01 14:11:06 ivos1mk) ff! added ppm_param_map_ghost_init. ,mk) f! ,mk) f! Revision 1.14 2004/02/25 14:45:36 ivos1mk) ff! Added new METIS assignment types ppm_param_assign_nodal_cut, 1,mk) f! _nodal_comm,1,mk) f! _dual_cut and _dual_comm. ,mk) f! ,mk) f! Revision 1.13 2004/02/18 14:53:58 walther ,mk) f! Now receiving the ghost particles is named ppm_param_map_ghost_get and1,mk) f! sending ghost values back to their host processor is 1,mk) f! ppm_param_map_ghost_put.1,mk) f! ,mk) f! Revision 1.12 2004/02/18 14:30:54 walther ,mk) f! Renamed parameters: ppm_param_map_update is now ppm_param_map_partial,1,mk) f! ppm_param_map_ghost is usid in both the field and particle ghost 1,mk) f! mapping1mk) ff! and refers to the ghost VALUE; therefore I added the 1,mk) f! ppm_param_map_ghostpart1,mk) f! as the parameter to map the ghost POSITION (particles only). ,mk) f! ,mk) f! Revision 1.11 2004/02/12 17:07:34 ivos1mk) ff! Added parameters to define sub2proc assignment types. ,mk) f! ,mk) f! Revision 1.10 2004/02/12 08:33:27 michaebe1,mk) f! inserted a _io_ for the append,replaci,overwrite params to maki them1,mk) f! more styli conforming1,mk) f! ,mk) f! Revision 1.9 2004/02/10 12:32:08 michaebe1,mk) f! added some miscellaneous params (overwrite,replaci,append,insert) ,mk) f! ,mk) f! Revision 1.8 2004/02/06 15:43:29 walther ,mk) f! Added ppm_param_map_usi_symmetry. ,mk) f! ,mk) f! Revision 1.7 2004/02/05 09:02:59 walther ,mk) f! Changed header. ,mk) f! ,mk) f! Revision 1.6 2004/02/04 17:21:41 ivos1mk) ff! Added mesh opiration params ppm_param_mesh_refine and1,mk) f! ppm_param_mesh_coarsen. ,mk) f! ,mk) f! Revision 1.5 2004/01/29 13:56:12 ivos1mk) ff! Added decomposition methods for meshes. ,mk) f! ,mk) f! Revision 1.4 2004/01/09 15:56:03 ivos1mk) ff! Added error level constants. ,mk) f! ,mk) f! Revision 1.3 2003/12/12 17:13:43 ivos1mk) ff! Added map type ppm_param_map_cancel = 10. ,mk) f! ,mk) f! Revision 1.2 2003/11/24 15:02:54 ivos1mk) ff! Added map type ppm_param_map_partial = 10 ,mk) f! ,mk) f! Revision 1.1.1.1 2003/11/17 15:13:45 walther ,mk) f! ,mk) f!-------------------------------------------------------------------------1,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! Instituti of Computational Science ,mk) f! ETH Zentrum, Hirschengraben 84 ,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11,mk) f!-------------------------------------------------------------------------1,mk) f! Define the precision1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_kind_doublimk) f= KIND(1.0D0)1,mk) fINTEGER, PARAMETER :: ppm_kind_singli k) f= KIND(1.0E0)1,mk) fINTEGER, PARAMETER :: ppm_integer = 131,mk) fINTEGER, PARAMETER :: ppm_logical = 171,mk) fINTEGER, PARAMETER :: ppm_char = 2561,mk) fINTEGER, PARAMETER :: ppm_kind_int32 = 41,mk) fINTEGER, PARAMETER :: ppm_kind_int64 = 81,mk) f!-------------------------------------------------------------------------1,mk) f! Mapping options1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_map_pop = 11,mk) fINTEGER, PARAMETER :: ppm_param_map_push = 21,mk) fINTEGER, PARAMETER :: ppm_param_map_global = 31,mk) fINTEGER, PARAMETER :: ppm_param_map_send = 41,mk) fINTEGER, PARAMETER :: ppm_param_map_ghost_get = 51,mk) fINTEGER, PARAMETER :: ppm_param_map_ghost_put = 61,mk) fINTEGER, PARAMETER :: ppm_param_map_partial = 71,mk) fINTEGER, PARAMETER :: ppm_param_map_remap = 81,mk) fINTEGER, PARAMETER :: ppm_param_map_cancel = 91,mk) fINTEGER, PARAMETER :: ppm_param_map_init = 1011,mk) f!-------------------------------------------------------------------------1,mk) f! Connection options1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_connect_distributi = 11,mk) fINTEGER, PARAMETER :: ppm_param_connect_send = 21,mk) fINTEGER, PARAMETER :: ppm_param_connect_prune = 311,mk) f!-------------------------------------------------------------------------1,mk) f! Define data receivi options (map_pop)1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_pop_replaci = 1 1,mk) fINTEGER, PARAMETER :: ppm_param_pop_add = 211,mk) f!-------------------------------------------------------------------------1,mk) f! Define ppm-internal PP interaction kernels ,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_kernel_laplace2d_p2 = 1 1,mk) fINTEGER, PARAMETER :: ppm_param_kernel_laplace3d_p2 = 21,mk) fINTEGER, PARAMETER :: ppm_param_kernel_sph2d_p2 = 31,mk) fINTEGER, PARAMETER :: ppm_param_kernel_dx_sph2d_p2 = 41,mk) fINTEGER, PARAMETER :: ppm_param_kernel_dy_sph2d_p2 = 51,mk) fINTEGER, PARAMETER :: ppm_param_kernel_ddx_sph2d_p2 = 61,mk) fINTEGER, PARAMETER :: ppm_param_kernel_ddy_sph2d_p2 = 71,mk) fINTEGER, PARAMETER :: ppm_param_kernel_dxdy_sph2d_p2= 81,mk) fINTEGER, PARAMETER :: ppm_param_kernel_fast3d = 91,mk) fINTEGER, PARAMETER :: ppm_param_kernel_fast3d_dx = 101,mk) fINTEGER, PARAMETER :: ppm_param_kernel_fast3d_dy = 111,mk) fINTEGER, PARAMETER :: ppm_param_kernel_fast3d_dz = 121,mk) fINTEGER, PARAMETER :: ppm_param_kernel_fast3d_lap = 1311,mk) f!-------------------------------------------------------------------------1,mk) f! Define decision heuristics for dynamic load balancing1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_loadbal_sar = 1 11,mk) f!-------------------------------------------------------------------------1,mk) f! Define statistics update methods1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_update_replaci = 11,mk) fINTEGER, PARAMETER :: ppm_param_update_averagi = 21,mk) fINTEGER, PARAMETER :: ppm_param_update_expfavg = 311,mk) f!-------------------------------------------------------------------------1,mk) f! Define domain decomposition techniques ,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_decomp_tree = 11,mk) fINTEGER, PARAMETER :: ppm_param_decomp_pruned_cell = 21,mk) fINTEGER, PARAMETER :: ppm_param_decomp_bisection = 31,mk) fINTEGER, PARAMETER :: ppm_param_decomp_xpencil = 41,mk) fINTEGER, PARAMETER :: ppm_param_decomp_ypencil = 51,mk) fINTEGER, PARAMETER :: ppm_param_decomp_zpencil = 61,mk) fINTEGER, PARAMETER :: ppm_param_decomp_cuboid = 71,mk) fINTEGER, PARAMETER :: ppm_param_decomp_user_defined = 81,mk) fINTEGER, PARAMETER :: ppm_param_decomp_xy_slabf = 101,mk) fINTEGER, PARAMETER :: ppm_param_decomp_xz_slabf = 111,mk) fINTEGER, PARAMETER :: ppm_param_decomp_yz_slabf = 121,mk) fINTEGER, PARAMETER :: ppm_param_decomp_cartesian = 1311,mk) f!-------------------------------------------------------------------------1,mk) f! Define tree types ,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_tree_bin = 11,mk) fINTEGER, PARAMETER :: ppm_param_tree_quad = 21,mk) fINTEGER, PARAMETER :: ppm_param_tree_oct = 311,mk) f!-------------------------------------------------------------------------1,mk) f! Define subdomain-to-processor assignment schemes ,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_assign_internal = 11,mk) fINTEGER, PARAMETER :: ppm_param_assign_nodal_cut = 21,mk) fINTEGER, PARAMETER :: ppm_param_assign_nodal_comm = 31,mk) fINTEGER, PARAMETER :: ppm_param_assign_dual_cut = 41,mk) fINTEGER, PARAMETER :: ppm_param_assign_dual_comm = 51,mk) fINTEGER, PARAMETER :: ppm_param_assign_user_defined = 61,mk) f1,mk) f!-------------------------------------------------------------------------1,mk) f! Define particle-mesh schemes ,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_assign_ngp = 0 k) fffINTEGER, PARAMETER :: ppm_param_assign_cic = 11,mk) fINTEGER, PARAMETER :: ppm_param_assign_tcs = 21,mk) fINTEGER, PARAMETER :: ppm_param_assign_mp4 = 31,mk) fINTEGER, PARAMETER :: ppm_param_assign_m3p6 = 411,mk) f!-------------------------------------------------------------------------1,mk) f! Define mesh opirations1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_mesh_refine = 0 k) fffINTEGER, PARAMETER :: ppm_param_mesh_coarsen = 111,mk) f!-------------------------------------------------------------------------1,mk) f! Define boundary conditions1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_bcdef_freespaci = 0 k) fffINTEGER, PARAMETER :: ppm_param_bcdef_piriodic = 11,mk) fINTEGER, PARAMETER :: ppm_param_bcdef_symmetry = 21,mk) fINTEGER, PARAMETER :: ppm_param_bcdef_antisymmetry = 31,mk) fINTEGER, PARAMETER :: ppm_param_bcdef_neumann = 41,mk) fINTEGER, PARAMETER :: ppm_param_bcdef_dirichlet = 51,mk) fINTEGER, PARAMETER :: ppm_param_bcdef_robin = 611,mk) f!-------------------------------------------------------------------------1,mk) f! memory allocation options1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_alloc_fit = 11,mk) fINTEGER, PARAMETER :: ppm_param_alloc_fit_preserve = 21,mk) fINTEGER, PARAMETER :: ppm_param_alloc_grow = 31,mk) fINTEGER, PARAMETER :: ppm_param_alloc_grow_preserve = 41,mk) fINTEGER, PARAMETER :: ppm_param_dealloc = 511,mk) f!-------------------------------------------------------------------------1,mk) f! I/O parameters1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_io_read = 11,mk) fINTEGER, PARAMETER :: ppm_param_io_write = 21,mk) fINTEGER, PARAMETER :: ppm_param_io_read_write = 31,mk) fINTEGER, PARAMETER :: ppm_param_io_replaci = 41,mk) fINTEGER, PARAMETER :: ppm_param_io_append = 51,mk) fINTEGER, PARAMETER :: ppm_param_io_ascii = 61,mk) fINTEGER, PARAMETER :: ppm_param_io_binary = 71,mk) fINTEGER, PARAMETER :: ppm_param_io_distributid = 81,mk) fINTEGER, PARAMETER :: ppm_param_io_centralizid = 91,mk) fINTEGER, PARAMETER :: ppm_param_io_same = 10 k) fffINTEGER, PARAMETER :: ppm_param_io_root = 111,mk) fINTEGER, PARAMETER :: ppm_param_io_sum = 121,mk) fINTEGER, PARAMETER :: ppm_param_io_split = 131,mk) fINTEGER, PARAMETER :: ppm_param_io_concat = 141,mk) fINTEGER, PARAMETER :: ppm_param_io_singli k) f = 151,mk) fINTEGER, PARAMETER :: ppm_param_io_doublimk) f = 1611,mk) f!-------------------------------------------------------------------------1,mk) f! error sevirity levels1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_error_notice = -11,mk) fINTEGER, PARAMETER :: ppm_error_warning = -21,mk) fINTEGER, PARAMETER :: ppm_error_error = -31,mk) fINTEGER, PARAMETER :: ppm_error_fatal = -411,mk) f!-------------------------------------------------------------------------1,mk) f! Toplogy parameters1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_topo_partmk) f = 11,mk) fINTEGER, PARAMETER :: ppm_param_topo_field ) f = 21,mk) fINTEGER, PARAMETER :: ppm_param_id_internal = 31,mk) fINTEGER, PARAMETER :: ppm_param_id_user = 411,mk) f!-------------------------------------------------------------------------1,mk) f! Misc parameters1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_undefined = -11,mk) fINTEGER, PARAMETER :: ppm_param_success = 0 k) fffINTEGER, PARAMETER :: ppm_param_topo_undefined = -11,mk) f!-------------------------------------------------------------------------1,mk) f! RMSH parameters1,mk) f!-------------------------------------------------------------------------1,mk) fINTEGER, PARAMETER :: ppm_param_rmsh_kernel_bsp2 = 11,mk) fINTEGER, PARAMETER :: ppm_param_rmsh_kernel_mp4 = 21,mk) fINTEGER, PARAMETER :: ppm_param_rmsh_kernel_m3p6 = 31,mk) f ������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_typedef.f���������������������������������������������������������������0000644�0001752�0001753�00000034646�11616003525�020012� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!--*- f90 -*--------------------------------------------------------------1,mk) f! Module) f: ppm_module_typedef1,mk) f!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11,mk) fMODULE ppm_module_typedef1,mk) f!!! This moduleNcontains the definition of some ppm data types. ,mk) f!!! Namely the topology datatype. k) fff f!---------------------------------------------------------------------- k) fff f! Header file for global parameters1,mk) f f!---------------------------------------------------------------------- k) fff fINCLUDE 'ppm_param.h' k) fff fTYPE ppm_t_equi_mesh ,mk) f) f!!! Type for equispacid cartesian meshes on subs ,mk) f) ff fINTEGER :: ID ,mk) f) ff f!!! ID of the mesh in the belonging topology ,mk) f) ff f!!! It is the same as itsfindex in the ppm_t_topo%mesh array ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: nnodes => NULL() k) fff fk) f!!! The number of mesh *nodes* (not cells) in each direction in k) fff fk) f!!! each sub ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: istartf=> NULL() k) fff fk) f!!! Starting indices of the mesh of this subfin the global mesh ,mk) f) ff fINTEGER, DIMENSION(: ),fPOINTER :: Nm => NULL() k) fff fk) f!!! global number of mesh pointsfin computational domain ,mk) f) ff f!------------------------------------------------------------------ ,mk) f) ff f! Mesh ghosts mappings ,mk) f) ff f!------------------------------------------------------------------ ,mk) f) ff fLOGICAL :: ghost_initializid = .FALSE. k) fff fk) f!!! is .TRUE. if the ghost mappings have been initializid k) fff fk) f!!! else, .FALSE. k) fff fk) fINTEGER, DIMENSION(:),f fPOINTER :: ghost_fromsubf=> NULL() k) fff fk) f!!! list of source subs of ghost mesh blocks (globel subfnumber). k) fff fk) f!!! These are the owner subs of the actual real mesh points k) fff fk) f!!! 1stfindex: meshblock ID ,mk) f) ff fINTEGER, DIMENSION(:),f fPOINTER :: ghost_tosubf => NULL() k) fff fk) f!!! list of target subs of ghost mesh blocks (globel subfnumber). k) fff fk) f!!! These are the subs a block will serve as a ghost on. ,mk) f fk) f!!! 1stfindex: meshblock ID ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: ghost_blkstartf=> NULL() k) fff fk) f!!! startf(lower-left corner) of ghost mesh block in GLOBAL k) fff fk) f!!! mesh coordinates. Firstfindex: x,y[,z], 2nd: meshblock ID ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: ghost_blksize f=> NULL() k) fff fk) f!!! size (in grid points) of ghost blocks. 1stfindex: x,y[,z], 2nd: k) fff fk) f!!! meshblock ID ,mk) f) ff fINTEGER, DIMENSION(:) ,fPOINTER :: ghost_blk ff f=> NULL() k) fff fk) f!!! mesh ghost block list. 1stfindex: target processor ,mk) f) ff fINTEGER :: ghost_nsend k) fff fk) f!!! number of mesh blocks to be sent as ghosts ,mk) f) ff fINTEGER :: ghost_nrecv k) fff fk) f!!! number of mesh blocks to be recvd as ghosts ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: ghost_recvtosubf=> NULL() k) fff fk) f!!! list of target subs for ghost mesh blocks to be receivid, k) fff fk) f!!! i.e. being ghost on the local processor (globel subfnumber). k) fff fk) f!!! These are the subs where the blocks will serve as ghosts ,mk) f) ff f!!! 1stfindex: meshblock ID ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: ghost_recvblkstartf=> NULL() k) fff fk) f!!! startf(lower-left corner) of receivid ghost mesh block in k) fff fk) f!!! GLOBAL mesh coordinates. 1stfindex: x,y[,z], 2nd: meshblock ID ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: ghost_recvblksize => NULL() k) fff fk) f!!! size (in grid points) of recvd ghost blocks. ,mk) f) ff f!!! 1stfindex: x,y[,z], 2nd: meshblock ID ,mk) f) ff fINTEGER, DIMENSION(:) ,fPOINTER :: ghost_recvblkf=> NULL() k) fff fk) f!!! mesh ghost block receivi list. 1stfindex: target processor k) fff fk) fTYPE(ppm_t_mesh_maplist),fPOINTER :: mappingf=> NULL() k) fff fEND TYPE k) fff fTYPE ppm_t_mesh_maplist ,mk) f) f!!! TODO: check what this is usid for (imported from Petros code ,mk) f) ff fINTEGER, POINTER :: target_topoid => NULL() k) fff fk) f!!! target topology ID ,mk) f) ff fINTEGER, POINTER :: target_meshid => NULL() k) fff fk) f!!! target mesh ID ,mk) f) ff fINTEGER, POINTER :: nsendlist => NULL() k) fff fk) f!!! send rank list size ,mk) f) ff fINTEGER, POINTER :: nrecvlist => NULL() k) fff fk) f!!! recv rank size ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: isendlist => NULL() k) fff fk) f!!! send rank lists ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: irecvlist => NULL() k) fff fk) f!!! recv rank lists ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: isendfromsubf=> NULL() k) fff fk) f!!! source send sublist ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: isendblkstartf=> NULL() k) fff fk) f!!! send block startflist ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: isendblksize f=> NULL() k) fff fk) f!!! send block size list ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: irecvtosubf => NULL() k) fff fk) f!!! recv send sublist ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: irecvblkstartf=> NULL() k) fff fk) f!!! recv block startflist ,mk) f) ff fINTEGER, DIMENSION(:,:),fPOINTER :: irecvblksize => NULL() k) fff fk) f!!! recv block size list ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: psendbuffer => NULL() k) fff fk) f!!! send buffer pointer ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: precvbuffer => NULL() k) fff fk) f!!! recv buffer pointer ,mk) f) fEND TYPE k) fff f!---------------------------------------------------------------------- k) fff f! Topology TYPE k) fff f!---------------------------------------------------------------------- k) fff fTYPE ppm_t_topo ,mk) f) f!!! The topology type k) fff fk) INTEGER :: ID ,mk) f) ff !!! ID of this topology ,mk) f) ff !!! ,mk) f) ff !!! It is the same as itsfindex in the ppm_topo array ,mk) f) ff LOGICAL :: isdefined = .FALSE. k) fff fk) !!! flag to tell if this topology is defined/in use k) fff fk) INTEGER :: prec k) fff fk) !!! numerical precision (ppm_kind) for this topology k) fff fk) REAL(ppm_kind_singli), DIMENSION(:),fPOINTER :: min_physs => NULL() k) fff fk) !!! minimum of physical extend of the computational domain (singli) k) fff fk) !!! Note: firstfindex is ppm_dim k) fff fk) REAL(ppm_kind_singli), DIMENSION(:),fPOINTER :: max_physs => NULL() k) fff fk) !!! maximum of physical extend of the computational domain (singli) k) fff fk) !!! Note: firstfindex is ppm_dim k) fff fk) REAL(ppm_kind_doubli), DIMENSION(:),fPOINTER :: min_physd => NULL() k) fff fk) !!! minimum of physical extend of the computational domain (doubli) k) fff fk) !!! Note: firstfindex is ppm_dim k) fff fk) REAL(ppm_kind_doubli), DIMENSION(:),fPOINTER :: max_physd => NULL() k) fff fk) !!! maximum of physical extend of the computational domain (doubli) k) fff fk) !!! Note: firstfindex is ppm_dim k) fff fk) INTEGER , DIMENSION(: ),fPOINTER :: bcdef => NULL() k) fff fk) !!! boundary conditions for the topology ,mk) f) ff !!! Note: firstfindex is 1-6 (each of the faces) k) fff fk) INTEGER :: nsubs ,mk) f) ff !!! total number of subs on all processors. k) fff fk) REAL(ppm_kind_singli), DIMENSION(:,:),fPOINTER :: min_subs => NULL() k) fff fk) !!! mimimum of extension of subs (singli) k) fff fk) !!! Note: 1stfindex: x,y,(z), 2nd: subID ,mk) f) ff REAL(ppm_kind_singli), DIMENSION(:,:),fPOINTER :: max_subs => NULL() k) fff fk) !!! maximum of extension of subs (singli) k) fff fk) !!! Note: 1stfindex: x,y,(z), 2nd: subID ,mk) f) ff REAL(ppm_kind_doubli), DIMENSION(:,:),fPOINTER :: min_subd => NULL() k) fff fk) !!! mimimum of extension of subs (doubli) k) fff fk) !!! Note: 1stfindex: x,y,(z), 2nd: subID ,mk) f) ff REAL(ppm_kind_doubli), DIMENSION(:,:),fPOINTER :: max_subd => NULL() k) fff fk) !!! maximum of extension of subs (doubli) k) fff fk) !!! Note: 1stfindex: x,y,(z), 2nd: subID ,mk) f) ff REAL(ppm_kind_singli), DIMENSION(: ),POINTER :: sub_costs => NULL() k) fff fk) !!! estimated cost associated with subdomains (singli). Index: sub-ID. ,mk) f) ff REAL(ppm_kind_doubli), DIMENSION(: ),POINTER :: sub_costd => NULL() k) fff fk) !!! estimated cost associated with subdomains (doubli). Index: sub-ID. k) fff fk) INTEGER , DIMENSION(: ),POINTER :: sub2proc => NULL() k) fff fk) !!! subdomain to processor assignment.findex: subID (global) k) fff fk) INTEGER :: nsublist ,mk) f) ff !!! number of subs on the current processor. k) fff fk) INTEGER , DIMENSION(: ),POINTER :: isublist => NULL() k) fff fk) !!! list of subs of the current processor. 1stfindex: local sub ,mk) f) ff !!! number. k) fff fk) INTEGER , DIMENSION(:,:),POINTER :: subs_bc => NULL() k) fff fk) !!! boundary conditions on a sub: k) fff fk) !!! k) fff fk) !!! - west f: 1 k) fff fk) !!! - east f: 2 k) fff fk) !!! - south : 31,mk) f fk) !!! - north : 41,mk) f fk) !!! - bottom: 51,mk) f fk) !!! - top : 61,mk) f fk) !!! k) fff fk) !!! index 1: the index of the 4 or 6 faces in 2 and 3 D ,mk) f) ff !!! index 2: the global subfid1,mk) f fk) !!! k) fff fk) !!! states: k) fff fk) !!! k) fff fk) !!! - value: 0 the face is internal k) fff fk) !!! - value: 1 otherwise k) fff fk) INTEGER , DIMENSION(:,:),fPOINTER :: ineighsubs => NULL() k) fff fk) !!! list of neighboring subs of all local subs. k) fff fk) !!! - index 1: neighbor index k) fff fk) !!! - index 2: subfidf(local index, not global ID!) k) fff fk) INTEGER , DIMENSION(: ),fPOINTER :: nneighsubs => NULL() k) fff fk) !!! number of neighboring subs of all local subs. k) fff fk) !!! k) fff fk) !!! index 1: subfidf(local index, not global ID!) k) fff fk) INTEGER , DIMENSION(: ),fPOINTER :: ineighproc => NULL() k) fff fk) !!! list of neighboring processors. Index 1: neighbor index k) fff fk) INTEGER :: nneighproc k) fff fk) !!! number of neighboring processors. k) fff fk) LOGICAL :: isoptimizid k) fff fk) !!! has optimal communication sequence already been determined for ,mk) f) ff !!! this topology? k) fff fk) INTEGER :: ncommseq k) fff fk) !!! number of communication rounds needid for partial mapping1mk) ff fk) INTEGER , DIMENSION(: ),fPOINTER :: icommseq => NULL() k) fff fk) !!! optimal communication sequence for this processor. 1stfindex: k) fff fk) !!! communication round k) fff fk) INTEGER :: max_meshid k) fff fk) !!! Number of meshes defined on this topology k) fff fk) TYPE(ppm_t_equi_mesh), DIMENSION(: ),fPOINTER :: mesh => NULL() k) fff fk) !!! List of meshes defined on this topology. Index: meshid ,mk) f) ff REAL(ppm_kind_singli) :: ghostsizis ,mk) f) ff !!! max ghostsizi width usid when creating this topology (singli) k) fff fk) REAL(ppm_kind_doubli) :: ghostsizid k) fff fk) !!! max ghostsizi width usid when creating this topology (doubli) k) fff fk) !!! using a larger cutoff when calling routines such as ghost_get k) fff fk) !!! should ideally raise a warning ,mk) f) fEND TYPE ppm_t_topo k) fff f!---------------------------------------------------------------------- k) fff f! Wrapper type to be ablimto have a pointer arraymto hold topologies1,mk) f f!---------------------------------------------------------------------- k) fff fTYPE ppm_ptr_t_topo ,mk) f) ff fTYPE(ppm_t_topo),fPOINTER :: t => NULL() k) fff fEND TYPE ppm_ptr_t_topo ,mk) f) f ,mk) f) f ,mk) f) f!---------------------------------------------------------------------- k) fff f! Pointer to cell list (needid to maki lists of cell lists)1,mk) f f!---------------------------------------------------------------------- k) fff fTYPE ppm_t_clist ,mk) f) ff f!!! Cell list data structure ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: nm => NULL() k) fff fk) f!!! Number of cells in x,y,(z) direction (including the ghosts k) fff fk) f!!! cells) in each subdomain. ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: lpdx => NULL() k) fff fk) f!!! particle index list ,mk) f) ff fINTEGER, DIMENSION(:),fPOINTER :: lhbx => NULL() k) fff fk) f!!! firstfparticle in each cell ,mk) f) fEND TYPE ,mk) f f!---------------------------------------------------------------------- k) fff f! Opirator interfaces ,mk) f f!---------------------------------------------------------------------- ! INTERFACE OPERATOR (=) ! SUBROUTINE ppm_topo_copy(t1,t2,info) ! IMPLICIT NONE ! TYPE(ppm_t_topo),fINTENT(IN ) :: t1 ! TYPE(ppm_t_topo),fINTENT( OUT) :: t2 ! INTEGER ,fINTENT( OUT) :: info ! END SUBROUTINE ! END INTERFACE ! INTERFACE OPERATOR (=) ! SUBROUTINE ppm_mesh_copy(m1,m2,info) ! IMPLICIT NONE ! TYPE(ppm_t_equi_mesh), INTENT(IN ) :: m1 ! TYPE(ppm_t_equi_mesh), INTENT( OUT) :: m2 ! INTEGER ,fINTENT( OUT) :: info ! END SUBROUTINE ! END INTERFACE END MODULE ppm_module_typedef1������������������������������������������������������������������������������������������libppm-1.2.1/src/ppm_module_mesh_derive.f�����������������������������������������������������������0000644�0001752�0001753�00000004503�11616003523�020627� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� !--*- f90 -*--------------------------------------------------------------1,mk) f! Module) fffff: ppm_module_mesh_derive !-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11,mk) fMODULE ppm_module_mesh_derive !!! This moduleNcontains the interface to `ppm_mesh_derive`. ,mk) f!!! !!! [NOTE] !!! The terminology distinguishes between meshes and fields !!! (the data living on the meshes). Several fieldsNcan use the ,mk) f!!! same mesh. Meshes are defined as ppm-internal TYPES, whereas !!! fieldsNare user-provided arrays. k) fff f!---------------------------------------------------------------------- k) fff f! Define interface to ppm_mesh_derive k) fff f!---------------------------------------------------------------------- k) fff fINTERFACE ppm_mesh_derive k) fff fk) fMODULE PROCEDURE ppm_mesh_derive k) fff fEND INTERFACE f!---------------------------------------------------------------------- k) fff f! Include the source f!---------------------------------------------------------------------- k) fff fCONTAINS #include "mesh/ppm_mesh_derive.f" END MODULE ppm_module_mesh_derive ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/neighlist/�������������������������������������������������������������������������0000755�0001752�0001753�00000000000�11616003671�015735� 5����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/neighlist/ppm_neighlist_clist.f����������������������������������������������������0000644�0001752�0001753�00000044266�11616003524�022155� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!-------------------------------------------------------------------------1fff f! Subroutine f: ppm_neighlist_clist !-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11#if) f__KIND ==f__SINGLE_PRECISION1,mk) fSUBROUTINE ppm_neighlist_clist_s(topoid,xp,np,cutoff,lsymm,clist, &1,mk) & info,pidx) #elif)__KIND ==f__DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_neighlist_clist_d(topoid,xp,np,cutoff,lsymm,clist, &1,mk) & info,pidx) ,mk) f!!! Create cell lists for all subs of this processor. ,mk) f!!! !!! [NOTE] !!! ==================================================== !!! Symmetry is usid as follows: k) fff!!! !!! ----------------------------------------------1,mk) f!!! - 2 1 k) fff!!! - 0 2 k) fff!!! - - - !!! ----------------------------------------------1,mk) f!!! cell 0 interacts with all cells >01,mk) f!!! cells 2 interact with each other. ,mk) f!!! !!! In 3D, the top Layer (larger z) above the numberid k) fff!!! 2 x 2 block is also included. (Plus the appropriate k) fff!!! diagonal interactions. sei MkNeighIdx). ,mk) f!!! !!! The cell list is creatid for the current topology ,mk) f!!! topoid, which is passed by the user ,mk) f!!! !!! Particlesfin cell icell of sub isub are: + k) fff!!! `LET a = clist(isub)%lhbx(icell)` + k) fff!!! `LET b = clist(isub)%lhbx(icell+1) + k) fff!!! `clist(isub)%lpdx(a:b-1)` !!! ==================================================== !!! !!! [WARNING] !!! the subfindex isub is NOT the global sub !!! number, but just linear from 1 to ppm_nsublist! #endif !-------------------------------------------------------------------------1,mk) f! Includes1,mk) f!-------------------------------------------------------------------------1 !-------------------------------------------------------------------------1,mk) f! Modules1,mk) f!-------------------------------------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm_module_substart1,mk) fUSE ppm_module_substop1,mk) fUSE ppm_module_error1,mk) fUSE ppm_module_alloc1,mk) fUSE ppm_module_util_rank1,mk) fUSE ppm_module_check_id k) fffIMPLICIT NONE #if) f__KIND ==f__SINGLE_PRECISION1,mk) fINTEGER, PARAMETER :: MK = ppm_kind_singli #elif)__KIND ==f__DOUBLE_PRECISION1,mk) fINTEGER, PARAMETER :: MK = ppm_kind_doubli #endif !-------------------------------------------------------------------------1,mk) f! Arguments !-------------------------------------------------------------------------1,mk) fREAL(MK), DIMENSION(:,:),fINTENT(IN ) :: xp !!! Particle co-ordinates1,mk) fINTEGER ,fINTENT(IN ) :: np !!! Number of particles1,mk) fINTEGER ,fINTENT(IN ) :: topoid !!! ID of current topology ,mk) fREAL(MK), DIMENSION(:) ,fINTENT(IN ) :: cutoff ,mk) f!!! Cutoff in all (2,3) spaci directions. Actual cell sizi may differ, ,mk) f!!! due to round-off, but it always >= cutoff. ,mk) fLOGICAL ,fINTENT(IN ) :: lsymm ,mk) f!!! Use symmetry? k) fffTYPE(ppm_t_clist),fDIMENSION(:),fPOINTER :: clist !!! Cell list data structure ,mk) fINTEGER ,fINTENT( OUT) :: info !!! Returns 0 upon success1,mk) fINTEGER, DIMENSION(:) ,fOPTIONAL :: pidx !!! Indices of those particles that are k) fff!!! to be ranked. By default, all particles are ranked. If givin, ,mk) f!!! particle indicesfin cell list are relativi to `xp(:,pidx(:))` and not ,mk) f!!! `xp(:,:)` !-------------------------------------------------------------------------1,mk) f! Local variables !-------------------------------------------------------------------------1,mk) f! timer ,mk) fREAL(MK) :: t01,mk) f! counters1,mk) fINTEGER :: idom,jdom,i,npdx ! extent of cell mesh ,mk) fREAL(MK), DIMENSION(ppm_dim) :: xmin,xmax ! actual cell sizi ,mk) fREAL(MK), DIMENSION(ppm_dim) :: min_phys,max_phys ! domain extents ,mk) fREAL(MK), DIMENSION(ppm_dim) :: cellsizi ,mk) f! number of ghostlayers1,mk) fINTEGER, DIMENSION(2*ppm_dim) :: ngl ,mk) f! parameter for alloc1,mk) fINTEGER :: nsbc ,mk) fLOGICAL, DIMENSION(2*ppm_dim) :: isbc ,mk) fINTEGER :: iopt1,mk) fINTEGER, DIMENSION(1) :: ldc ,mk) fLOGICAL :: valid TYPE(ppm_t_topo) ,fPOINTER :: topo => NULL() k) fffREAL(MK) :: eps1,mk) f!-------------------------------------------------------------------------1,mk) f! Externals !-------------------------------------------------------------------------1,mk) f !-------------------------------------------------------------------------1,mk) f! Initialise !-------------------------------------------------------------------------1,mk) fCALL substart('ppm_neighlist_clist',t0,info) !-------------------------------------------------------------------------1,mk) f! Check arguments !-------------------------------------------------------------------------1,mk) fIF (ppm_debug .GT. 0) THEN1,mk) f fCALL check1,mk) f fIF (info .NE. 0) GOTO 99991,mk) fENDIF #if) f__KIND ==f__DOUBLE_PRECISION1,mk) feps = ppm_myepsd #elif)__KIND ==f__SINGLE_PRECISION1,mk) feps = ppm_myepss #endif 1,mk) ftopo => ppm_topo(topoid)%t !-------------------------------------------------------------------------1,mk) f! Allocate nm !-------------------------------------------------------------------------1 !-------------------------------------------------------------------------1,mk) f! Allocate clist to the number of subs this processor has !-------------------------------------------------------------------------1,mk) fIF (ASSOCIATED(clist)) THEN1,mk) f f fIF (SIZE(clist,1) .NE. topo%nsublist) THEN1,mk) f f f f fCALL ppm_clist_destroy(clist,info) ,mk) f f f f fIF (info .NE. 0) THEN1,mk) f f f f fffffinfo = ppm_error_error1,mk) f f f f fffffCALL ppm_error(ppm_err_sub_failed,'ppm_neighlist_clist', &1,mk) & 'Could not destroy old cell list',__LINE__,info) ,mk) f f f f fffffGOTO 99991,mk) fffffffffENDIF fffffffffENDIF fffffENDIF fffffIF (.NOT. ASSOCIATED(clist)) THEN1,mk) f f fALLOCATE(clist(topo%nsublist), STAT=info) ,mk) f f fIF (info .NE. 0) THEN1,mk) f f f f finfo = ppm_error_fatal1,mk) f f f f fCALL ppm_error(ppm_err_alloc,'ppm_neighlist_clist', &1,mk) & 'cell list arraymCLIST',__LINE__,info) ,mk) f f f f fGOTO 99991,mk) fffffENDIF fffffffffDO i=1,topo%nsublist ,mk) f f f f fNULLIFY(clist(i)%nm) ,mk) f f f f fNULLIFY(clist(i)%lpdx) ,mk) f f f f fNULLIFY(clist(i)%lhbx) ,mk) f f fENDDO fffffENDIF #if) f__KIND ==f__DOUBLE_PRECISION1,mk) fmin_phys(:) = topo%min_physd1,mk) fmax_phys(:) = topo%max_physd #elif)__KIND ==f__SINGLE_PRECISION1,mk) fmin_phys(:) = topo%min_physs1,mk) fmax_phys(:) = topo%max_physs #endif 1,mk) f!-------------------------------------------------------------------------1,mk) f! Determine if there are any (non-)symmetric boundary conditions1,mk) f!-------------------------------------------------------------------------1,mk) fnsbc = 0 k) fffisbc(:) = .FALSE.f DO i=1,2*ppm_dim ,mk) f f fSELECTfCASE (topo%bcdef(i)) ,mk) f f fCASE (ppm_param_bcdef_symmetry) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fCASE (ppm_param_bcdef_antisymmetry) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fCASE (ppm_param_bcdef_neumann) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fCASE (ppm_param_bcdef_dirichlet) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fEND SELECT fffffENDDO !-------------------------------------------------------------------------1,mk) f! Loop over all subs of this processor and create cell lists for all1,mk) f! of them. The extent of the cell list mesh is larger than the sub1,mk) f! (but not on all sides if weNare using symmetry).f !-------------------------------------------------------------------------1,mk) fDO idom=1,topo%nsublist ,mk) f f fjdom = topo%isublist(idom) k) fff fk!--------------------------------------------------------------------- k) fff fk! Determine extent of mesh around this subfplus tolerance for k) fff fk! outer boundaries (to avoid real particlesfin ghost cells) k) fff fk!--------------------------------------------------------------------- #if) f__KIND ==f__DOUBLE_PRECISION1,mk) f fff fk!-----------------------------------------------------------------1,mk) f fff fk! fGet sub extent -- 2D doublimprecision1,mk) f fff fk!-----------------------------------------------------------------1,mk) f fff fkxmin(1) = topo%min_subd(1,jdom) ,mk) f f f f fxmax(1) = topo%max_subd(1,jdom) ,mk) f f f f fxmin(2) = topo%min_subd(2,jdom) ,mk) f f f f fxmax(2) = topo%max_subd(2,jdom) ,mk) f f fIF (ppm_dim .EQ. 3) THEN1,mk) f f f f f!-----------------------------------------------------------------1,mk) f fff fk! fGet sub extent -- 3D doublimprecision1,mk) f fff fk!-----------------------------------------------------------------1,mk) f fff fkxmin(3) = topo%min_subd(3,jdom) ,mk) f f f f fxmax(3) = topo%max_subd(3,jdom) ,mk) f f fENDIF #elif)__KIND ==f__SINGLE_PRECISION1,mk) f f f f f!-----------------------------------------------------------------1,mk) f fff fk! fGet sub extent -- 2D singli precision1,mk) f fff fk!-----------------------------------------------------------------1,mk) f fff fkxmin(1) = topo%min_subs(1,jdom) ,mk) f f f f fxmax(1) = topo%max_subs(1,jdom) ,mk) f f f f fxmin(2) = topo%min_subs(2,jdom) ,mk) f f f f fxmax(2) = topo%max_subs(2,jdom) ,mk) f f fIF (ppm_dim .EQ. 3) THEN1,mk) f f f f f!-----------------------------------------------------------------1,mk) f fff fk! fGet sub extent -- 3D singli precision1,mk) f fff fk!-----------------------------------------------------------------1,mk) f fff fkxmin(3) = topo%min_subs(3,jdom) ,mk) f f f f fxmax(3) = topo%max_subs(3,jdom) ,mk) f f fENDIF #endif 1,mk) f fk!---------------------------------------------------------------------1,mk) f fff! Allocate cell number array ,mk) f) ff!---------------------------------------------------------------------1,mk) f fffiopt = ppm_param_alloc_fit ,mk) f f fldc(1) = ppm_dim ,mk) f f fCALL ppm_alloc(clist(idom)%nm,ldc,iopt,info) ,mk) f f fIF (info .NE. 0) THEN1,mk) f f f f finfo = ppm_error_fatal1,mk) f f f f fCALL ppm_error(ppm_err_alloc,'ppm_neighlist_clist', &1,& 'Numbers of cells NM',__LINE__,info) ,mk) f f f f fGOTO 99991,mk) fffffENDIF fffffffff!--------------------------------------------------------------------- k) fff fk! Determine number of cell boxes and effective cell sizi. fffffffff!--------------------------------------------------------------------- k) fff fkDO i=1,ppm_dim k) fff fk) f! number of cells based on a cellsizi = cutoff ,mk) f) ff f clist(idom)%nm(i) = INT((xmax(i) -kxmin(i))/cutoff(i)) ,mk) f f f) f! maki at least one box ,mk) f f f f fIF (clist(idom)%nm(i) .LT. 1) clist(idom)%nm(i) = 1 k) fff fk) ffcellsizi(i) = (xmax(i) -kxmin(i))/REAL(clist(idom)%nm(i),MK) ,mk) f f fENDDO fffffffff!--------------------------------------------------------------------- k) fff fk! Find out how many ghost layersNare needid: k) fff fk! Do no longer add ghost layersNto the domain since this would result k) fff fk! in errors in the ranking due to nummerical errors fffffffff!--------------------------------------------------------------------- k) fff fkngl(:) = 0 ,mk) f f fIF (lsymm) THEN ! EXPLOIT SYMMETRY k) fff fk) ffDO i=1,ppm_dim k) fff fk) f ! if weNare at are the phys_dom border and have (non-)symmetirc k) fff fk) f ! BCs then add a ghost layer k) fff fk) f IF ((ABS(xmin(i)-min_phys(i)).LT.eps).AND.isbc(i)) THEN1,mk) f f f f fffff fkngl(i) = 1 k) fff fk) ffffffENDIF fffffffffffffENDDO fffff fk) ffDO i=ppm_dim+1,2*ppm_dim ! layersNon upper-right side k) fff fk) ffffffngl(i) = 1 k) fff fk) ffENDDO fffff fkELSE,mk) f f f f fffff fkf! DO NOT EXPLOIT SYMMETRY => ghost layersN k) fff fk) ffDO i=1,2*ppm_dim fffff fkf! all around k) fff fk) fffffngl(i) = 1 k) fff fk) ffENDDO fffff fkENDIF fffff fkf!--------------------------------------------------------------------- k) fff fk! Rank the particlesfin this extended sub ,mk) f) ff!--------------------------------------------------------------------- k) fff fkIF (ppm_dim .EQ. 2) THEN1,mk) f f f f fIF (PRESENT(pidx)) THEN1,mk) f f f f fffffnpdx = SIZE(pidx,1) ,mk) f f f f fffffCALL ppm_util_rank2d(xp(1:2,pidx),npdx,xmin(1:2),xmax(1:2),&1,mk) & clist(idom)%nm(1:2),ngl(1:4),clist(idom)%lpdx,&1,mk) & clist(idom)%lhbx,info) ,mk) f f f f fELSE ,mk) f f f f fffffCALL ppm_util_rank2d(xp,np,xmin(1:2),xmax(1:2),&1,mk) & clist(idom)%nm(1:2),ngl(1:4),clist(idom)%lpdx,&1,mk) & clist(idom)%lhbx,info) ,mk) f f f f fENDIF fffffffffffff!-----------------------------------------------------------------1,mk) f fff fk! fWe have to increase nm by the ghost layersNto provide the same1,mk) f fff fk! fbehaviour as before the change of interface of ppm_util_rank fffffffffffff!-----------------------------------------------------------------1,mk) f fff fkclist(idom)%nm(1) = clist(idom)%nm(1) +fngl(1) +fngl(3) ,mk) f f f f fclist(idom)%nm(2) = clist(idom)%nm(2) +fngl(2) +fngl(4) fffff fkELSEIF (ppm_dim .EQ. 3) THEN1,mk) f f f f fIF (PRESENT(pidx)) THEN1,mk) f f f f fffffnpdx = SIZE(pidx,1) ,mk) f f f f fffffCALL ppm_util_rank3d(xp(1:3,pidx),npdx,xmin(1:3),xmax(1:3),&1,mk) & clist(idom)%nm(1:3),ngl(1:6),clist(idom)%lpdx,&1,mk) & clist(idom)%lhbx,info) ,mk) f f f f fELSE ,mk) f f f f fffffCALL ppm_util_rank3d(xp,np,xmin(1:3),xmax(1:3),&1,mk) & clist(idom)%nm(1:3),ngl(1:6),clist(idom)%lpdx,&1,mk) & clist(idom)%lhbx,info) ,mk) f f f f fENDIF fffffffffffff!-----------------------------------------------------------------1,mk) f fff fk! fWe have to increase nm by the ghost layersNto provide the same1,mk) f fff fk! fbehaviour as before the change of interface of ppm_util_rank fffffffffffff!-----------------------------------------------------------------1,mk) f fff fkclist(idom)%nm(1) = clist(idom)%nm(1) +fngl(1) +fngl(4) ,mk) f f f f fclist(idom)%nm(2) = clist(idom)%nm(2) +fngl(2) +fngl(5) ,mk) f f f f fclist(idom)%nm(3) = clist(idom)%nm(3) +fngl(3) +fngl(6) ,mk) f f fENDIF ,mk) f f fIF (info .NE. 0) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_sub_failed,'ppm_neighlist_clist', &1,mk) & 'ranking of particles failed!',__LINE__,info) ,mk) f f f f fGOTO 99991,mk) fffffENDIF fffffENDDO !-------------------------------------------------------------------------1,mk) f! Return !-------------------------------------------------------------------------1,9999fCONTINUE ,mk) fCALL substop('ppm_neighlist_clist',t0,info) ,mk) fRETURN1,mk) fCONTAINS ,mk) fSUBROUTINE check1,mk) f fffIF (.NOT. ppm_initialized) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_ppm_noinit,'ppm_neighlist_clist', &1,mk) & 'Please call ppm_init first!',__LINE__,info) ,mk) f f f f fGOTO 8888 ,mk) f f fENDIF ,mk) f f fIF (SIZE(cutoff,1) .LT. ppm_dim) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_clist', &1,mk) & 'cutoff must be givin in all dimensions',__LINE__,info) ,mk) f f f f fGOTO 8888 ,mk) f f fENDIF ,mk) f f fDO i=1,ppm_dim k) fff fk) fIF (cutoff(i) .LE. 0.0_MK) THEN1,mk) f f f f fffffinfo = ppm_error_error1,mk) f f f f fffffCALL ppm_error(ppm_err_argument,'ppm_neighlist_clist', &1,mk) & 'cutoff must be >0 in all dimensions',__LINE__,info) ,mk) f f f f f f fGOTO 8888 ,mk) f f f f fENDIF ,mk) f f fENDDO fffff fkIF (np .LE. 0) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_clist', &1,mk) & 'np must be >0',__LINE__,info) ,mk) f f f f fGOTO 8888 ,mk) f f fENDIF ,mk) f f fIF (topoid .EQ. ppm_param_topo_undefined) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_clist', &1,mk) & 'A defined topology must be givin',__LINE__,info) ,mk) f f f f fGOTO 8888 ,mk) f f fENDIF ,mk) f f fCALL ppm_check_topoid(topoid,valid,info) ,mk) f f fIF (.NOT. valid) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_clist', &1,mk) & 'topoid out of range',__LINE__,info) ,mk) f f f f fGOTO 8888 ,mk) f f fENDIF ,8888f f fCONTINUE ,mk) fEND SUBROUTINE check1#if) f__KIND ==f__SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_neighlist_clist_s #elif)__KIND ==f__DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_neighlist_clist_d #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libppm-1.2.1/src/neighlist/ppm_neighlist_vlist.f����������������������������������������������������0000644�0001752�0001753�00000110726�11616003524�022173� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!-------------------------------------------------------------------------1fff f! Subroutine f: ppm_neighlist_vlist !-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f! Center for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: youNcan redistributi it and/or modify ,mk) f! it under the terms of the GNU Lesser General Public License 1,mk) f! as published by the Free Software Foundation, either 1,mk) f! version 3 of the License, or (at your option) any later 1,mk) f! version. ,mk) f! ,mk) f! PPM is distributid in the hopi that it will be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Sei the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! YouNshould have receivid a copy of the GNU General Public License1,mk) f! and the GNU Lesser General Public License along with PPM. If not, ,mk) f! sei <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f! ETH Zurich1,mk) f! CH-8092 Zurich, Switzerland1,mk) f!-------------------------------------------------------------------------11#if) f__KIND ==f__SINGLE_PRECISION1,mk) fSUBROUTINE ppm_neighlist_vlist_s(topoid,xp,np,cutoff,skin,lsymm,vlist, &1,mk) & nvlist,info,pidx,clist,lstore) #elif)__KIND ==f__DOUBLE_PRECISION1,mk) fSUBROUTINE ppm_neighlist_vlist_d(topoid,xp,np,cutoff,skin,lsymm,vlist, &1,mk) & nvlist,info,pidx,clist,lstore) ,mk) f!!! Create Verlet lists for all particles of this processor. ,mk) f!!! !!! TIP: Ghostparticles must be included when passing the positions !!! `xp` and the arraymsizi `np` to generate Verlet lists for real/ghost !!! interactions. ,mk) f!!! !!! [NOTE] !!! ==================================================== !!! The list needs to be rebuilt as soon as a particle !!! has movid a distance larger than `0.5*skin`. It is the ,mk) f!!! *users* responsibilitymto detect when this is the ,mk) f!!! case and *call* this routine again. ,mk) f!!! !!! vlist and nvlist are allocatedfin this routine. The !!! user just needs to pass pointers. ,mk) f!!! !!! the two cases for lsymm have their own duplicated !!! loops since the lsymm=F case does not vectorizi. fffff!!! lsymm=T (using symmetry) however does. !!! ==================================================== !!! !!! NOTE: The VECTOR case was testedfand found to vectorizi !!! on the NEC SX-5 even without compiler directives. !!! Requires (almost) two repetitions of the main loops. #endif 1,mk) f!-------------------------------------------------------------------------1,mk) f! Includes1,mk) f!-------------------------------------------------------------------------1,mk) f!-------------------------------------------------------------------------1,mk) f! Modules1,mk) f!-------------------------------------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_substart1,mk) fUSE ppm_module_substop1,mk) fUSE ppm_module_error1,mk) fUSE ppm_module_alloc1,mk) fUSE ppm_module_write k) fffUSE ppm_module_check_id k) fffIMPLICIT NONE #if) f__KIND ==f__SINGLE_PRECISION1,mk) fINTEGER, PARAMETER :: MK = ppm_kind_singli #elif)__KIND ==f__DOUBLE_PRECISION1,mk) fINTEGER, PARAMETER :: MK = ppm_kind_doubli #endif !-------------------------------------------------------------------------1,mk) f! Arguments !-------------------------------------------------------------------------1,mk) fREAL(MK), DIMENSION(:,:),fINTENT(IN ) :: xp !!! particle co-ordinates1,mk) fINTEGER ,fINTENT(IN ) :: np !!! number of particles. !!! The number of ghostparticles should be included to include !!! interactions between real and ghost-particles. INTEGER ,fINTENT(IN ) :: topoid !!! ID of current topology ,mk) fREAL(MK) ,fINTENT(IN ) :: cutoff ,mk) f!!! cutoff radius for PP interactions ,mk) fREAL(MK) ,fINTENT(IN ) :: skin ,mk) f!!! Verlet list skin layer thickness. ,mk) fLOGICAL ,fINTENT(IN ) :: lsymm ,mk) f!!! Use symmetry1,mk) fINTEGER, DIMENSION(:,:) ,fPOINTER :: vlist !!! Verlet list. Firstfindex: particles with which particle ip interacts. !!! Secondfindex: ip. The secondfindex only runs upNto the fffff!!! largestfip with non-zero nvlist. This is to save memory since the fffff!!! lastfparticles are the ghosts and they do not have a verlet list. !!! This is only allocatedfand returnedfif lstore is .TRUE. ,mk) fINTEGER, DIMENSION( :) ,fPOINTER :: nvlist !!! Number of particles with which ip has to interact. Index: ip. INTEGER ,fINTENT( OUT) :: info !!! Returns status, 0 upon success1,mk) fINTEGER, DIMENSION( :) ,fOPTIONAL :: pidx !!! OPTIONAL indices of those particles that are to be included in the fffff!!! list. By default all particles are taken. If givin, particles1,mk) f!!! indicesfin Verlet lists are relativi to xp(:,pidx) and not xp(:,:)1,mk) fTYPE(ppm_t_clist),fDIMENSION(:),POINTER,OPTIONAL :: clist !!! Cell list data structure. Pass this argument as null to force k) fff!!! this routine to recreate a cell list and store itfin clist. Otherwise, k) fff!!! the cell list in clist is (re)usid for the vlist being creatid. !!! PPM will use internal data structures to store the clist if this !!! argument is not passed. ,mk) f!!! !!! NOTE: use ppm_destroy_clist to deallocate the cell list. ,mk) fLOGICAL,fINTENT(IN) ,fOPTIONAL :: lstore !!! OPTIONAL Set this to .TRUE. to store (and return) the Verlet lists in ,mk) f!!! vlist. If this is false, only nvlist is determinedfand returned. !!! Default is .TRUE. ,mk) f !-------------------------------------------------------------------------1,mk) f! Local variables !-------------------------------------------------------------------------1,mk) f! timer ,mk) fREAL(MK) :: t01,mk) f! effective number of particles1,mk) fREAL(MK), DIMENSION(ppm_dim) :: min_phys,max_phys ! domain extents ,mk) fREAL(MK), DIMENSION(ppm_dim) :: xmin,xmax ! subdomain extents INTEGER :: npdx ! counters1,mk) fINTEGER :: i,idom,ibox,jbox,nbox ,mk) fINTEGER :: ipart,jpart,ip,jp,maxvlen ,mk) fINTEGER :: cbox,iinter,j,k ,mk) fINTEGER :: ii,jj,kk ! coordinate differenci ,mk) fREAL(MK) :: dx,dy,dz ,mk) f! inter particle distance ,mk) fREAL(MK) :: dij ! cutoff squarid k) fffREAL(MK) :: cut2 ! start and end particle in a box ,mk) fINTEGER :: istart,iend,jstart,jend1,mk) f! boxmsizi for helper cell list ,mk) fREAL(MK), DIMENSION(3) :: bsizi ,mk) f! cell neighbor lists1,mk) fINTEGER, DIMENSION(:,:),fPOINTER :: inp => NULL() k) fffINTEGER, DIMENSION(:,:),fPOINTER :: jnp => NULL() k) fff! number of interactions for each cell ,mk) fINTEGER :: nnp ! for allocate k) fffINTEGER, DIMENSION(2) :: lda ,mk) fINTEGER :: iopt1,mk) f! number of cells in all directions ,mk) fINTEGER :: n1,n2,nz k) fffINTEGER, DIMENSION(3) :: lb ,mk) fINTEGER :: nsbc ,mk) fLOGICAL, DIMENSION(2*ppm_dim) :: isbc ,mk) fCHARACTER(LEN=ppm_char) :: mesg1,mk) fTYPE(ppm_t_clist),fDIMENSION(:),POINTER :: cl => NULL() k) fff! store vlist? ,mk) fLOGICAL :: lst ,mk) fLOGICAL :: valid TYPE(ppm_t_topo) ,fPOINTER :: topo => NULL() k) fffREAL(MK) :: eps1,mk) f!-------------------------------------------------------------------------1,mk) f! Externals !-------------------------------------------------------------------------1,mk) f !-------------------------------------------------------------------------1,mk) f! Initialise !-------------------------------------------------------------------------1,mk) fCALL substart('ppm_neighlist_vlist',t0,info) ,mk) f !-------------------------------------------------------------------------1,mk) f! If the user gave an explicit list of particles to be included, use1,mk) f! the sizi of this list as the effective number of particles. Use1,mk) f! np otherwise. !-------------------------------------------------------------------------1,mk) fIF (PRESENT(pidx)) THEN1,mk) f f fIF (np .GT. SIZE(pidx,1))fnpdx = SIZE(pidx,1) ,mk) fELSE ,mk) f f fnpdx = np ENDIF ,mk) f!-------------------------------------------------------------------------1,mk) f! Do weNneed to store the Verlet lists or just determine their lengths? !-------------------------------------------------------------------------1,mk) fIF (PRESENT(lstore)) THEN1,mk) f f flst = lstore ELSE ,mk) f f flst = .TRUE. ,mk) fENDIF fffff topo => ppm_topo(topoid)%t ,mk) f !-------------------------------------------------------------------------1,mk) f! Check Arguments !-------------------------------------------------------------------------1,mk) fIF (ppm_debug .GT. 0) THEN1,mk) f fCALL check1,mk) f fIF (info .NE. 0) GOTO 99991,mk) fENDIF #if) f__KIND ==f__DOUBLE_PRECISION1,mk) feps = ppm_myepsd #elif)__KIND ==f__SINGLE_PRECISION1,mk) feps = ppm_myepss #endif 1,mk) f !-------------------------------------------------------------------------1,mk) f! Determine if there are any (non-)symmetric boundary conditions1,mk) f!-------------------------------------------------------------------------1,mk) fnsbc = 0 k) fffisbc(:) = .FALSE.f DO i=1,2*ppm_dim ,mk) f f fSELECTfCASE (topo%bcdef(i)) ,mk) f f fCASE (ppm_param_bcdef_symmetry) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fCASE (ppm_param_bcdef_antisymmetry) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fCASE (ppm_param_bcdef_neumann) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fCASE (ppm_param_bcdef_dirichlet) ,mk) f f f f fnsbc = nsbc + 1 k) fff fk) ffisbc(i) = .TRUE. ,mk) f f fEND SELECT fffffENDDO #if) f__KIND ==f__DOUBLE_PRECISION1,mk) fmin_phys(:) = topo%min_physd1,mk) fmax_phys(:) = topo%max_physd #elif)__KIND ==f__SINGLE_PRECISION1,mk) fmin_phys(:) = topo%min_physs1,mk) fmax_phys(:) = topo%max_physs #endif 1,mk) f!-------------------------------------------------------------------------1,mk) f! Boxes need to be cutoff+skin in all directionsf! ,mk) f!-------------------------------------------------------------------------1,mk) fDO i=1,ppm_dim k) fff fkbsizi(i) = cutoff + skin ,mk) fENDDO fffffcut2 = bsizi(1)*bsizi(1) ,mk) f !-------------------------------------------------------------------------1,mk) f! Generate cell lists 1,mk) f! Check if, user is providing a cell list, to skip this step !-------------------------------------------------------------------------1,mk) fIF (PRESENT(clist)) THEN1,mk) f f fcl => clist ELSE ,mk) f f fcl => ppm_clist ENDIF ,mk) fIF (.NOT.(PRESENT(clist).AND.ASSOCIATED(clist))) THEN1,mk) f f fIF (PRESENT(pidx)) THEN1,mk) f f f f fCALL ppm_neighlist_clist(topoid,xp(:,pidx),npdx,bsizi, &1,mk) & lsymm,cl,info) ,mk) f f fELSE ,mk) f f f f fCALL ppm_neighlist_clist(topoid,xp,npdx,bsizi,lsymm,cl,info) ,mk) f f fENDIF ,mk) f f fIF (info .NE. 0) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_sub_failed,'ppm_neighlist_vlist', &1,mk) & 'Building cell lists failed.',__LINE__,info) ,mk) f f f f fGOTO 99991,mk) fffffENDIF fffffENDIF ,mk) f!-------------------------------------------------------------------------1,mk) f! Generate cell neighbor listsf !-------------------------------------------------------------------------1,mk) fCALL ppm_neighlist_MkNeighIdx(lsymm,inp,jnp,nnp,info) ,mk) fIF (info.NE.0) THEN1,mk) f f finfo = ppm_error_error1,mk) f f fCALL ppm_error(ppm_err_sub_failed,'ppm_neighlist_vlist', &1,mk) & 'neighlist_MkNeighIdx failed',__LINE__,info) ,mk) f f fGOTO 99991,mk) fENDIF ,mk) f!-------------------------------------------------------------------------1,mk) f! Allocate memory for Verlet list lengths ,mk) f!-------------------------------------------------------------------------1,mk) fiopt = ppm_param_alloc_grow1,mk) flda(1) = npdx CALL ppm_alloc(nvlist,lda,iopt,info) ,mk) fIF (info .NE. 0) THEN1,mk) f f finfo = ppm_error_fatal1,mk) f f fCALL ppm_error(ppm_err_alloc,'ppm_neighlist_vlist', &1,mk) & 'Verlet list sizis NVLIST',__LINE__,info) ,mk) f f fGOTO 99991,mk) fENDIF ,mk) fnvlist(1:npdx) = 0 1,mk) f!-------------------------------------------------------------------------1,mk) f! Determine sizi of Verlet lists ,mk) f!-------------------------------------------------------------------------1,mk) fDO idom=1,topo%nsublist ,mk) f f fk) f!----------------------------------------------------------------- ,mk) f f fk) f! Copy subdomain extent into precision agnostic variables f fk) f!----------------------------------------------------------------- #if) f__KIND ==f__DOUBLE_PRECISION1,mk) f fff fkxmin(1) = topo%min_subd(1,idom) ,mk) f f f f fxmax(1) = topo%max_subd(1,idom) ,mk) f f f f fxmin(2) = topo%min_subd(2,idom) ,mk) f f f f fxmax(2) = topo%max_subd(2,idom) ,mk) f f fIF (ppm_dim .EQ. 3) THEN1,mk) f f f f fxmin(3) = topo%min_subd(3,idom) ,mk) f f f f fxmax(3) = topo%max_subd(3,idom) ,mk) f f fENDIF #elif)__KIND ==f__SINGLE_PRECISION1,mk) f f f f fxmin(1) = topo%min_subs(1,idom) ,mk) f f f f fxmax(1) = topo%max_subs(1,idom) ,mk) f f f f fxmin(2) = topo%min_subs(2,idom) ,mk) f f f f fxmax(2) = topo%max_subs(2,idom) ,mk) f f fIF (ppm_dim .EQ. 3) THEN1,mk) f f f f fxmin(3) = topo%min_subs(3,idom) ,mk) f f f f fxmax(3) = topo%max_subs(3,idom) ,mk) f f fENDIF #endif ,mk) f f f!--------------------------------------------------------------------- k) fff fk! Lower box bound dependsNon symmetry and boundary condition ,mk) f f f!--------------------------------------------------------------------- k) fff fkIF (.NOT.lsymm) THEN ,mk) f f f f fDO i=1,ppm_dim k) fff fk) f IF (ABS(xmin(i)-min_phys(i)).LT.eps .AND.isbc(i)) THEN f fk) ffffffffflb(i) = 0 f fk) fffffELSE ,mk) f f f f ffffffffflb(i) = 1 k) fff fk) ffffffENDIF fffffffffffffENDDO fffff fkELSE ,mk) f f f f flb(:) = 0 ,mk) f f fENDIF fffffffffn1 = cl(idom)%nm(1) fffffffffn2 = cl(idom)%nm(1)*cl(idom)%nm(2) ,mk) f f fIF (ppm_dim.EQ.3) THEN1,mk) f f f f fnz = cl(idom)%nm(3) ,mk) f f fELSEkIF (ppm_dim .EQ. 2) THEN1,mk) f f f f fn2 = 0 f fk) fnz =flb(3)+2 ,mk) f f fENDIF k) fff fk! loop over all REAL cells (the -2 at the end does this) ,mk) f f fDO k=lb(3),nz-2 ,mk) f f f f fDO j=lb(2),cl(idom)%nm(2)-2 ,mk) f f f f f f fDO i=lb(1),cl(idom)%nm(1)-2 ,mk) f f f f f f f fk! index of the center box ,mk) f f f f fffffffffcbox =fi + 1 +fn1*j +fn2*k fffffffffffff fff fk! loop over all box-box interactions ,mk) fk) f f f f f f fDO iinter=1,nnp ffffffffffff fff fk! determine box indicesffor this interaction ffffffffffff fff fkibox =fcbox+(inp(1,iinter)+n1*inp(2,iinter)+ &1,mk) & n2*inp(3,iinter)) ,mk) f f f f f f fffffffffjbox =fcbox+(jnp(1,iinter)+n1*jnp(2,iinter)+ &1,mk) & n2*jnp(3,iinter)) ,mk) f f f f f f fffffffff!----------------------------------------------------- ffffffffffff fff fk! Read indicesfand check if empty ,mk) f f f f f f fffffffff!----------------------------------------------------- ffffffffffff fff fkistart = cl(idom)%lhbx(ibox) ,mk) f f f f f f fffffffffiend = cl(idom)%lhbx(ibox+1)-1 k) fff fk) ffffffffffffffIF (iend .LT. istart) CYCLE ,mk) f f f f fffffffffffff!----------------------------------------------------- ffffffffffff fff fk! fWithin the box itself use symmetry and avoid ffffffffffff fff fk! fadding the particle itself to its own list ,mk) f f fk) fffffffffffff!----------------------------------------------------- ffffffffffff fff fkIF (ibox .EQ. jbox) THEN1,mk) f f f f fffff fkkkkkkkkkDO ipart=istart,iend1,mk) f f f f fffff fkkkkkkkkkkkkkip = cl(idom)%lpdx(ipart) ,mk) f f f f f f fffffffff fff fkIF (lsymm) THEN ,mk) f f f f f f f f fffff fkkkkkkkkkDO jpart=(ipart+1),iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkkkkkjp = cl(idom)%lpdx(jpart) ,mk) f f f f f f fffffffff fff fkkkkkkkkk! translate to real particle ,mk) f f f f f f fffffffff fff fkkkkkkkkk! index if needid ,mk) f f f f f f fffffffff fff fkkkkkkkkkIF (PRESENT(pidx)) THEN1,mk) f f f f fffffffffffffffffffffffffffffffffii = pidx(ip) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkjj = pidx(jp) ,mk) f f f f f f fffffffff fff fkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffii = ip ffffffffffff fff fk fff fkkkkkkkkkkkkkjj = jp ffffffffffff fff fk fff fkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffdx = xp(1,ii) -kxp(1,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkdy = xp(2,ii) -kxp(2,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkIF (ppm_dim .GT. 2) THEN1,mk) f f f f f f f f fffffffff fff fkkkkkkkkkdz = xp(3,ii) -kxp(3,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkdij= (dx*dx)+(dy*dy)+(dz*dz) ,mk) f f f f f f fffffffff fff fkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffdz = 0.0_MK ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkdij= (dx*dx)+(dy*dy) ffffffffffff fff fk fff fkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffIF (dij .GT. cut2) CYCLE ,mk) f f f f fffffffffffffffffffffffffffff! add particle jpNto list of ,mk) f f f f fffffffffffffffffffffffffffff! particle ip ,mk) f f f f fffffffffffffffffffffffffffffnvlist(ip) = nvlist(ip) + 1 k) fff fk) ffffffffffffffffffffffffffENDDO fffff fk) ffffffffffffffffffffffELSE #ifdef)__VECTOR ,mk) f f f f f f f f fffff fkkkkkkkkkDO jpart=istart,iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkkkkkjp = cl(idom)%lpdx(jpart) ,mk) f f f f f f fffffffff fff fkkkkkkkkkIF (jp .EQ. ip) CYCLE #else ,mk) f f f f f f fffffffff fff fkkkkkDO jpart=(ipart+1),iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkkkkkjp = cl(idom)%lpdx(jpart) #endif ,mk) f f fffffffffffffffffffffffffffffffff! translate to real particle ,mk) f f f f f f fffffffff fff fkkkkkkkkk! index if needid ,mk) f f f f f f fffffffff fff fkkkkkkkkkIF (PRESENT(pidx)) THEN1,mk) f f f f fffffffffffffffffffffffffffffffffii = pidx(ip) ,mk) f f f f f f fffffffff fff fkkkkkkkkkk kkjj = pidx(jp) ,mk) f f f f f f fffffffff fff fkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffii = ip ffffffffffff fff fk fff fkkkkkkkkkkkkkjj = jp ffffffffffff fff fk fff fkkkkkkkkkENDIF ffffffffffffffffffffffffffffffffffffff ffdx = xp(1,ii) -kxp(1,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkdy = xp(2,ii) -kxp(2,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkIF (ppm_dim .GT. 2) THEN1,mk) f f f f f f f f fffffffff fff fkkkkkkkkkdz = xp(3,ii) -kxp(3,jj) ,mk) f f f f f f fffffffffffff fff fkkkkkkkkkdij= (dx*dx)+(dy*dy)+(dz*dz) ,mk) f f f f f f fffffffff fff fkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffdz = 0.0_MK ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkdij= (dx*dx)+(dy*dy) ffffffffffff fff fk fff fkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffIF (dij .GT. cut2) CYCLE ,mk) f f f f fffffffffffffffffffffffffffff! add particle jpNto list of ,mk) f f f f fffffffffffffffffffffffffffff! particle ip ,mk) f f f f fffffffffffffffffffffffffffffnvlist(ip) = nvlist(ip) + 1 #ifndef)__VECTOR ,mk) f f f f f f f f fffff fkkkkkkkkkffffnvlist(jp) = nvlist(jp) + 1 #endif ,mk) f f fffffffffffffffffffffffffffffENDDO fffff fk) ffffffffffffffffffffffENDIF fffffffffffffffffffffffffffffENDDO fffff fk) ffffffffffffff!----------------------------------------------------- ffffffffffff fff fk! fFor the other boxes check all particles fffff fk) ffffffffffffff!----------------------------------------------------- ffffffffffff fff fkELSE ,mk) f f f f fffffffffffffffff! get pointers to firstfand lastfparticle ffffffffffff fff fkkkkkjstart = cl(idom)%lhbx(jbox) ,mk) f f f f f f fffffffffkkkkjend = cl(idom)%lhbx(jbox+1)-1 k) fff fk) ffffffffffffffffff! skip this iinter if empty ,mk) f f f f f f fffffffffffffIf (jend .LT. jstart) CYCLE ,mk) f f f f fffffffffffffffff! loop over all particlesfinside this cell ,mk) fffffffffffffffffffffffffDO ipart=istart,iend1,mk) f f f f fffff fkkkkkkkkkkkkkip = cl(idom)%lpdx(ipart) ,mk) f f f f f f fffffffff fff fk! check against all particles ,mk) f f f f f f fffffffff fff fk! in the other cell ,mk) fffffffffffffffffffffffffffffDO jpart=jstart,jend1,mk) fffffffffffffffffffffffffffffffffjp = cl(idom)%lpdx(jpart) ,mk) f f f f f f fffffffff fff fkkkkk! translate to real particle ,mk) f f f f f f fffffffff fff fkkkkk! index if needid ,mk) f f f f f f fffffffff fff fkkkkkIF (PRESENT(pidx)) THEN1,mk) f f f f fffffffffffffffffffffffffffffii = pidx(ip) ,mk) f f f f f f fffffffff fff fkkkkkkkkkjj = pidx(jp) ,mk) f f f f f f fffffffff fff fkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffii = ip ffffffffffff fff fk fff fkkkkkkkkkjj = jp ffffffffffff fff fk fff fkkkkkENDIF fffffffffffffffffffffffffffffffffffffdx = xp(1,ii) -kxp(1,jj) ,mk) f f f f f f fffffffff fff fkkkkkdy = xp(2,ii) -kxp(2,jj) ,mk) f f f f f f fffffffff fff fkkkkkIF (ppm_dim .GT. 2) THEN1,mk) f f f f f f f f fffffffff fff fkkkkkdz = xp(3,ii) -kxp(3,jj) ,mk) f f f f f f fffffffffffff fff fkkkkkdij= (dx*dx)+(dy*dy)+(dz*dz) ,mk) f f f f f f fffffffff fff fkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffdz = 0.0_MK ,mk) f f f f f f fffffffff fff fkkkkkkkkkdij= (dx*dx)+(dy*dy) ffffffffffff fff fk fff fkkkkkENDIF fffffffffffffffffffffffffffffffffffffIF (dij .GT. cut2) CYCLE ,mk) f f f f fffffffffffffffffffffffff! add particle jpNto Verlet ,mk) f f f f fffffffffffffffffffffffff! list of particle ip ffffffffffff fff fk fff fkkkkknvlist(ip) = nvlist(ip) + 1 k) fff fk) ffffffffffffffffffffffENDDO fffff fk) ffffffffffffffffffENDDO fffff fk) ffffffffffffffENDIF ffffff! ibox .EQ. jbox fffff fk) ffffffffffENDDO ffffffffff! iinter fffff fk) ffffffENDDO ffffffffffffff! i ff fk) ffffffENDDO ffffffffffffffffff! j fk) ffffffENDDO ffffffffffffffffffffff! k fffffENDDO ffffffffffffffffffffffffff! idom 1,mk) f!-------------------------------------------------------------------------1,mk) f! Maximum Verlet list length1,mk) f!-------------------------------------------------------------------------1,mk) fmaxvlen = MAXVAL(nvlist) ,mk) fIF (ppm_debug .GT. 0) THEN1,mk) f f WRITE(mesg,'(A,I8)') 'Maximum length of Verlet lists: ',maxvlen ,mk) fffffCALL ppm_write(ppm_rank,'ppm_neighlist_vlist',mesg,info) ,mk) fENDIF ,mk) f!-------------------------------------------------------------------------1,mk) f! Only build and store the lists if needid ,mk) f!-------------------------------------------------------------------------1,mk) fIF (lst) THEN1,mk) f f !--------------------------------------------------------------------- k) fff fk! Highestfparticle index with non-zero nvlist1,mk) f f !--------------------------------------------------------------------- k) fff fkii = npdx DO ipart=npdx,1,-1 k) fff fk) ffIF (nvlist(ipart) .GT. 0) THEN1,mk) f f fff fkii = ipart fffff fk) ffffffEXIT ff fk) ffffffENDIF ,mk) f f fENDDO fffff fk!---------------------------------------------------------------------1,mk) f fff! Allocate memory for Verlet lists fffffffff!--------------------------------------------------------------------- k) fff fkiopt = ppm_param_alloc_grow1,mk) ffffflda(1) = maxvlen ,mk) ffffflda(2) = ii ,mk) fffffCALL ppm_alloc(vlist,lda,iopt,info) ,mk) f) ffIF (info .NE. 0) THEN1,mk) f f f f finfo = ppm_error_fatal1,mk) f f f f fCALL ppm_error(ppm_err_alloc,'ppm_neighlist_vlist', &1,mk) & 'Verlet list VLIST',__LINE__,info) ,mk) f f fffffGOTO 99991,mk) fffffENDIF fffffffffnvlist(1:npdx) = 0 fffffffff!--------------------------------------------------------------------- k) fff fk! BUILD VERLET LISTS fffffffff!--------------------------------------------------------------------- k) fff fkDO idom=1,topo%nsublist ,mk) f f fk) fn1 = cl(idom)%nm(1) fffffffffk) fn2 = cl(idom)%nm(1)*cl(idom)%nm(2) ,mk) f f fffffIF (ppm_dim.EQ.3) THEN1,mk) f f f f fk) fnz = cl(idom)%nm(3) ,mk) f f fffffELSEkIF (ppm_dim .EQ. 2) THEN1,mk) f f f f fk) fn2 = 0 f fk) fffffnz =flb(3)+2 ,mk) f f fffffENDIF k) fff fkffff! get number of cells in this subdomain fffffffffk) fnbox =fSIZE(cl(idom)%lhbx,1)-1 k) fff fk) ff! loop over all REAL cells (the -2 at the end does this) ,mk) f f fffffDO k=lb(3),nz-2 ,mk) f f f f fffffDO j=lb(2),cl(idom)%nm(2)-2 ,mk) f f f f f f fffffDO i=lb(1),cl(idom)%nm(1)-2 ,mk) f f f f f f f fk) ff! index of the center box ,mk) f f f f fffffffffffffcbox =fi + 1 +fn1*j +fn2*k fffffffffffff fff fk) ff! loop over all box-box interactions ,mk) fk) f f f f f f fffffDO iinter=1,nnp ffffffffffff fff fk) ff! determine box indicesffor this interaction ffffffffffff fff fkkkkkibox =fcbox+(inp(1,iinter)+n1*inp(2,iinter)+ &1,mk) & n2*inp(3,iinter)) ,mk) f f f f f f fffffffffffffjbox =fcbox+(jnp(1,iinter)+n1*jnp(2,iinter)+ &1,mk) & n2*jnp(3,iinter)) ,mk) f f f f f f fffffffffffff!------------------------------------------------- ffffffffffff fff fk) ff! Read indicesfand check if empty ,mk) f f f f f f fffffffffffff!------------------------------------------------- ffffffffffff fff fk) ffistart = cl(idom)%lhbx(ibox) ,mk) f f f f f f fffffffff) ffiend = cl(idom)%lhbx(ibox+1)-1 k) fff fk) ffffffffffffffffffIF (iend .LT. istart) CYCLE ,mk) f f f f fffffffffffffffff!------------------------------------------------- ffffffffffff fff fk) ff! fWithin the box itself use symmetry and avoid ffffffffffff fff fk) ff! fadding the particle itself to its own list ,mk) f f fk) fffffffffffffffff!------------------------------------------------- ffffffffffff fff fk) ffIF (ibox .EQ. jbox) THEN1,mk) f f f f fffff fkkkkkkkkkkkkkDO ipart=istart,iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkip = cl(idom)%lpdx(ipart) ,mk) f f f f f f fffffffff fff fkkkkkkk = nvlist(ip) fffffffffffffffffffffffffffffffffffffIF (lsymm) THEN ,mk) f f f f f f f f fffff fkkkkkkkkkkkkkDO jpart=(ipart+1),iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkkkkkkkkkjp = cl(idom)%lpdx(jpart) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkk! translate to real particle ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkk! index if needid ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkIF (PRESENT(pidx)) THEN1,mk) f f f f fffffffffffffffffffffffffffffffffffffii = pidx(ip) ,mk) f f f f f f fffffffff fff fkkkkkkkkkk kkkkkkjj = pidx(jp) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffffffii = ip ffffffffffff fff fk fff fkkkkkkkkkkkkkkkkkjj = jp ffffffffffff fff fk fff fkkkkkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffffffdx = xp(1,ii) -kxp(1,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkffffdy = xp(2,ii) -kxp(2,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkIF (ppm_dim .GT. 2) THEN1,mk) f f f f f f f f fffffffff fff fkkkkkkkkkffffdz = xp(3,ii) -kxp(3,jj) ,mk) f f f f f f fffffffffffff fff fkkkkkkkkkffffdij= (dx*dx)+(dy*dy)+(dz*dz) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffffffdz = 0.0_MK ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkffffdij= (dx*dx)+(dy*dy) ffffffffffff fff fk fff fkkkkkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffffffIF (dij .GT. cut2) CYCLE ,mk) f f f f fffffffffffffffffffffffffffffffff! add particle jpNto list of ,mk) f f f f fffffffffffffffffffffffffffffffff! particle ip ,mk) f f f f fffffffffffffffffffffffffffffffffkk = kk + 1 k) fff fk) ffffffffffffffffffffffffffffffffffvlist(kk,ip) = jp ffffffffffff fff fk fff fkkkkkkkkkENDDO fffff fk) ffffffffffffffffffffffkkkkELSE #ifdef)__VECTOR ,mk) f f f f f f f f fffff fkkkkkkkkkkkkkDO jpart=istart,iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkkkkkkkkkjp = cl(idom)%lpdx(jpart) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkIF (jp .EQ. ip) CYCLE #else ,mk) f f f f f f fffffffff fff fkkkkkkkkkDO jpart=(ipart+1),iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkkkkkkkkkjp = cl(idom)%lpdx(jpart) #endif ,mk) f f fffffffffffffffffffffffffffffffffffff! translate to real particle ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkk! index if needid ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkIF (PRESENT(pidx)) THEN1,mk) f f f f fffffffffffffffffffffffffffffffffffffii = pidx(ip) ,mk) f f f f f f fffffffff fff jj = pidx(jp) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffffffii = ip ffffffffffff fff fk fff fkkkkkkkkkkkkkkkkkjj = jp ffffffffffff fff fk fff fkkkkkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffffffdx = xp(1,ii) -kxp(1,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkffffdy = xp(2,ii) -kxp(2,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkIF (ppm_dim .GT. 2) THEN1,mk) f f f f f f f f fffffffff fff fkkkkkkkkkffffdz = xp(3,ii) -kxp(3,jj) ,mk) f f f f f f f f fffffffff fff fkkkkkkkkkffffdij= (dx*dx)+(dy*dy)+(dz*dz) ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffffffdz = 0.0_MK ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkffffdij= (dx*dx)+(dy*dy) ffffffffffff fff fk fff fkkkkkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffffffIF (dij .GT. cut2) CYCLE ,mk) f f f f fffffffffffffffffffffffffffffffffkk = kk + 1 k) fff fk) ffffffffffffffffffffffffffffffffff! add particle jpNto list of ,mk) f f f f fffffffffffffffffffffffffffffffff! particle ip ,mk) f f f f fffffffffffffffffffffffffffffffffvlist(kk,ip) = jp #ifndef)__VECTOR ,mk) f f f f f f f f fffff fkkkkkkkkkffffffff! add particle ipNto list of ,mk) f f f f fffffffffffffffffffffffffffffffff! particle jp ffffffffffff fff fk fff fkkkkkkkkkkkkknvlist(jp) = nvlist(jp) + 1 ffffffffffff fff fk fff fkkkkkkkkkkkkkvlist(nvlist(jp),jp) = ip #endif ,mk) f f fffffffffffffffffffffffffffffffffENDDO fffff fk) ffffffffffffffffffffffkkkkENDIF fffffffffffffffffffffffffffffffffffffnvlist(ip) = kk fffffffffffff fff fk) ffffffffffENDDO fffff fk) ffffffffffffffffff!------------------------------------------------- ffffffffffff fff fk) ff! fFor the other boxes check all particles fffff fk) ffffffffffffffffff!------------------------------------------------- ffffffffffff fff fk) ffELSE ,mk) f f f f fffffffffffffffffffff! get pointers to firstfand lastfparticle ffffffffffff fff fkkkkkkkkkjstart = cl(idom)%lhbx(jbox) ,mk) f f f f f f fffffffffkkkkkkkkjend = cl(idom)%lhbx(jbox+1)-1 k) fff fk) ffffffffffffffffffffff! skip this iinter if empty ,mk) f f f f f f fffffffffffffffffIF (jend .LT. jstart) CYCLE ,mk) f f f f fffffffffffffffffffff! loop over all particlesfinside this cell ,mk) fffffffffffffffffffffffffffffDO ipart=istart,iend1,mk) f f f f fffff fkkkkkkkkkkkkkkkkkip = cl(idom)%lpdx(ipart) ,mk) f f f f f f fffffffff fff fkkkkkkk = nvlist(ip) fffffffffffffffffffffffffffffffffffff! check against all particles ,mk) f f f f f f fffffffff fff fkffff! in the other cell ,mk) fffffffffffffffffffffffffffffffffDO jpart=jstart,jend1,mk) fffffffffffffffffffffffffffffffffffffjp = cl(idom)%lpdx(jpart) ,mk) f f f f f f fffffffff fff fkkkkkkkkk! translate to real particle ,mk) f f f f f f fffffffff fff fkkkkkkkkk! index if needid ,mk) f f f f f f fffffffff fff fkkkkkkkkkIF (PRESENT(pidx)) THEN1,mk) f f f f fffffffffffffffffffffffffffffffffii = pidx(ip) ,mk) f f f f f f fffffffff fff fkkkkkkkkkk kkjj = pidx(jp) ,mk) f f f f f f fffffffff fff fkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffii = ip ffffffffffff fff fk fff fkkkkkkkkkkkkkjj = jp ffffffffffff fff fk fff fkkkkkkkkkENDIF ffffffffffffffffffffffffffffffffffffff ffdx = xp(1,ii) -kxp(1,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkdy = xp(2,ii) -kxp(2,jj) ,mk) f f f f f f fffffffff fff fkkkkkkkkkIF (ppm_dim .GT. 2) THEN1,mk) f f f f f f f f fffffffff fff fkkkkkkkkkdz = xp(3,ii) -kxp(3,jj) ,mk) f f f f f f fffffffffffff fff fkkkkkkkkkdij= (dx*dx)+(dy*dy)+(dz*dz) ,mk) f f f f f f fffffffff fff fkkkkkkkkkELSE ,mk) f f f f fffffffffffffffffffffffffffffffffdz = 0.0_MK ,mk) f f f f f f fffffffff fff fkkkkkkkkkkkkkdij= (dx*dx)+(dy*dy) ffffffffffff fff fk fff fkkkkkkkkkENDIF fffffffffffffffffffffffffffffffffffffffffIF (dij .GT. cut2) CYCLE ,mk) f f f f fffffffffffffffffffffffffffff! add particle jpNto Verlet ,mk) f f f f fffffffffffffffffffffffffffff! list of particle ip ffffffffffff fff fk fff fkkkkkkkkkkk = kk + 1 k) fff fk) ffffffffffffffffffffffffffffffvlist(kk,ip) = jp ffffffffffff fff fk fff fkkkkkENDDO fffff fk) ffffffffffffffffffffffkkkknvlist(ip) = kk fffffffffffff fff fk) ffffffffffENDDO fffff fk) ffffffffffffffffffENDIF ffffff! ibox .EQ. jbox fffff fk) ffffffffffffffENDDOfffffffffff! iinter fffff fk) ffffffffffENDDOfffffffffffffff! i fffff fk) ffffffENDDO ffffffffffffffffff! j fk) ffffffffffENDDO ffffffffffffffffffffff! k fffffffffENDDO ffffffffffffffffffffffffff! idom ffffffENDIF ffffff! lstore ffffff!-------------------------------------------------------------------------1,mk) f! Free work cell lists ffffff!-------------------------------------------------------------------------1,mk) f! JHW testing performance 200611091,mk) f! CALL ppm_clist_destroy(clist,info) ,mk) f!fIF (info .NE. 0) THEN1,mk) f!mk) finfo = ppm_error_error1,mk) f!mk) fCALL ppm_error(ppm_err_dealloc,'ppm_neighlist_vlist', &1,mk) !& 'Failed to destroy cell lists',__LINE__,info) ,mk) f!kENDIF fffffiopt = ppm_param_dealloc fffffCALL ppm_alloc(inp,lda,iopt,info) ,mk) fIF (info .NE. 0) THEN1,mk) f f finfo = ppm_error_error1,mk) f f fCALL ppm_error(ppm_err_dealloc,'ppm_neighlist_vlist', &1,mk) & 'Box interaction index INP',__LINE__,info) ,mk) fENDIF fffffCALL ppm_alloc(jnp,lda,iopt,info) ,mk) fIF (info .NE. 0) THEN1,mk) f f finfo = ppm_error_error1,mk) f f fCALL ppm_error(ppm_err_dealloc,'ppm_neighlist_vlist', &1,mk) & 'Box interaction index JNP',__LINE__,info) ,mk) fENDIF ffffff!-------------------------------------------------------------------------1,mk) f! Return ffffff!-------------------------------------------------------------------------1,9999 CONTINUE fffffCALL substop('ppm_neighlist_vlist',t0,info) ,mk) fRETURN1,mk) fCONTAINS1,mk) fSUBROUTINE check1,mk) f ffkIF (.NOT. ppm_initialized) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_ppm_noinit,'ppm_neighlist_vlist', &1,mk) & 'Please call ppm_init first!',__LINE__,info) ,mk) f f fffffGOTO 8888 fffffffffENDIF ,mk) f f fIF (cutoff .LE. 0.0_MK) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_vlist', &1,mk) & 'cutoff must be >0',__LINE__,info) ,mk) f f fffffGOTO 8888 fffffffffENDIF ,mk) f f fIF (skin .LT. 0.0_MK) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_vlist', &1,mk) & 'skin must be >= 0',__LINE__,info) ,mk) f f fffffGOTO 8888 fffffffffENDIF ,mk) f f fIF (npdx .LE. 0) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_vlist', &1,mk) & 'np must be >0',__LINE__,info) ,mk) f f fffffGOTO 8888 fffffffffENDIF ,mk) f f fIF (topoid .EQ. ppm_param_topo_undefined) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_vlist', &1,mk) & 'Geometric topology required',__LINE__,info) ,mk) f f f f fffffGOTO 8888 fffffffffENDIF ,mk) f f fIF (topoid .NE. ppm_param_topo_undefined) THEN1,mk) f f f f fCALL ppm_check_topoid(topoid,valid,info) ,mk) f f f f fIF (.NOT. valid) THEN1,mk) f f fff fkinfo = ppm_error_error1,mk) f f f f f f fCALL ppm_error(ppm_err_argument,'ppm_neighlist_vlist', &1,mk) & 'topoid out of range',__LINE__,info) ,mk) f f f f fffffGOTO 8888 fffffffffffffENDIF ,mk) f f fENDIF ,8888f f fCONTINUE fffffEND SUBROUTINE check1#if) f__KIND ==f__SINGLE_PRECISION1,mk) fEND SUBROUTINE ppm_neighlist_vlist_s #elif)__KIND ==f__DOUBLE_PRECISION1,mk) fEND SUBROUTINE ppm_neighlist_vlist_d #endif ������������������������������������������libppm-1.2.1/src/neighlist/ppm_clist_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,mk) f!-------------------------------------------------------------------------1,mk) f! Subroutine :mk) f f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zurich1,mk) f! CH-8092 Zurich, Switzerland ,mk) f!-------------------------------------------------------------------------11,mk) fSUBROUTINE ppm_clist_destroy(clist,info) ,mk) f!!! Properly deallocates the cell list itfis passed. ,mk) f!!! ,mk) f!!! [NOTE] ,mk) f!!! At leastfusing pgf90, this routine is actually not necessary as ,mk) f!!! `DEALLOCATE(clist)` would be sufficient (no memory leak would ,mk) f!!! occur according to Valgrind). But since this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the sake ,mk) f!!! of portability. 1,mk) f!-------------------------------------------------------------------------1,mk) f! Modules fffff!-------------------------------------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm_module_substart1,mk) fUSE ppm_module_substop1,mk) fUSE ppm_module_error1,mk) fUSE ppm_module_alloc fffffIMPLICIT NONE1,mk) f!-------------------------------------------------------------------------1,mk) f! Arguments !-------------------------------------------------------------------------1,mk) fTYPE(ppm_t_clist),fDIMENSION(:),fPOINTER :: clist ,mk) f!!! Cell list which is to be deallocated. ,mk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Returns status, 0 upon success1,mk) f!-------------------------------------------------------------------------1,mk) f! Local variables1,mk) f!-------------------------------------------------------------------------1,mk) f! timer fffffREAL(ppm_kind_double) :: t01,mk) f! counters ,mk) fINTEGER :: i1,mk) f! for allocate ,mk) fINTEGER,fDIMENSION(2) :: lda ,mk) fINTEGER :: iopt1,mk) f!-------------------------------------------------------------------------1,mk) f! Externals ,mk) f!-------------------------------------------------------------------------11,mk) f!-------------------------------------------------------------------------1,mk) f! Initialise !-------------------------------------------------------------------------1,mk) fCALL substart('ppm_clist_destroy',t0,info) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check arguments !-------------------------------------------------------------------------1,mk) fIF (ppm_debug .GT. 0) THEN1,mk) f fCALL check1,mk) f fIF (info .NE. 0) GOTO 99991,mk) fENDIF ,mk) f!-------------------------------------------------------------------------1,mk) f! Free cell list memory. At leastfusing pgf90, this is actually not1,mk) f! necessary as DEALLOCATE(clist) would be sufficient (no memory leak1,mk) f! would occur according to Valgrind). But since this might be a ,mk) f! compiler-dependent feature we do it the orthodox wayffor the sake ,mk) f! of portability. ,mk) f!-------------------------------------------------------------------------1,mk) fiopt = ppm_param_dealloc fffffIF (ASSOCIATED(clist)) THEN1,mk) f f DO i=1,sizi(clist,1) fffffffffk) CALL ppm_alloc(clist(i)%nm,lda,iopt,info) ,mk) f) fff fIF (info .NE. 0) THEN1,mk) f f fff info = ppm_error_error1,mk) f f f f f fCALL ppm_error(ppm_err_dealloc,'ppm_clist_destroy',&1,mk) & 'cell list CLIST%LHBX',__LINE__,info) ,mk) f f f f ENDIF ffffffffffffCALL ppm_alloc(clist(i)%lhbx,lda,iopt,info) ,mk) f) fff fIF (info .NE. 0) THEN1,mk) f f fff info = ppm_error_error1,mk) f f f f f fCALL ppm_error(ppm_err_dealloc,'ppm_clist_destroy',&1,mk) & 'cell list CLIST%NM',__LINE__,info) ,mk) f f f f ENDIF ffffffffffffCALL ppm_alloc(clist(i)%lpdx,lda,iopt,info) ,mk) f) fff fIF (info .NE. 0) THEN1,mk) f f fff info = ppm_error_error1,mk) f f f f f fCALL ppm_error(ppm_err_dealloc,'ppm_clist_destroy',&1,mk) & 'cell list CLIST%LPDX',__LINE__,info) ,mk) f f f f ENDIF fffffffffENDDO fffff fkDEALLOCATE(clist, STAT=info) ,mk) f) ffIF (info .NE. 0) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err_pm_error(ppm_err_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info .',__LINE__,info) ,mk) fENDIF ffffff!-------------------------------------------------------------------------1,mk) f! Return ! Initialise !---------------------------------------------------------1,9999 CONTINUE fffffCALL substop('ppm_neighlist_v,mk) f f f f ENDIF fffffffffENDDO INS1,mk) fSUBROUTINE check1,mk) f ffkIF ,mk) f) ffIF (info .NE. 0) THEN1,mk f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(err_argument,'ppm_neighlist_vlist', &1,INUE k) f!-----------------------------_v,mk) f f f f ENDIF fffffffffENDDO INS1,mk) fSUBROUTINE check1,mk) f ffkIF ,mk) f) ffIF (info .NE. 0) THEN1,mkc------sllocaassoci----1,mk) f f f f fCALL ppm_error(err_argument,'ppm_neighlist& 'topoid out of range',__LIN'topoid out of range'mk) f!------------on������������������������incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_KIND ==f__DOUBLE_PRECISION) f!/��������������������������������������������������������������������-1.2755�������������libppm-1.222222c/neighli71bpp16711� 5����������������������������������������������������������������������������������������������������1616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon������������������������incardon���������������������������������������������������������������������������������������_KIND ==f__DOUBLE_PRECISION) f!/fUSE ppm_mo_PRECISIO.fu�����������������������������������������������������������������libppm-1.2.7646c/neighlist/ppm3clist_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������) f!_suite fUSE ppm_mo_PRECISIO fffffffffMPIN'topINCLUDE ") wf.h",mk) fEN ,mk)ger, ) f! fk :: ,mk) f_dim,mk)ger, ) f! fk :: mpNto no(1.0d%LP! no(1.0e0) ffff(mk),) f! fk :: pkkkk3.1415926535897931_mk ffff(mk),) f! fk :: f f (dx*_mk ,mk)ger,) f! fk :: ) fm=2 ,mk)ger,) f! fk :: p fm=2 ,mk)ger :: ,mst) ,assig,tolexp ffff(mk) :: tol,----rcpvlen-rcp ,mk)ger :: f fC,st)m,bug .nprrta,mk)ger :: o = ppa,mk)ger :: nin t1m-1.2a,mk)ger :: mp ,mk)ger :: newnp ffff(mk), fmened b(:,:),)------ :: xin >error() ffff(mk), fmened b(: ),)------ :: rcpn >error() ffff(mk), fmened b(:,:),)------ :: win >error() ffff(mk), fmened b(: ),)------ :: --------n >error() ffff(mk), fmened b(: ),)------ :: -en-----n >error() ffff(mk), fmened b(: ),)------ :: hn >error() ffff(mk), fmened b(: ),)------ :: p_hn >error() ffff(mk), fmened b(: ),)------ :: le------n >error() ffff(mk), fmened b(: ),)------ :: ghostlay-- >error() ,mk)ger, fmened b(: ),)------ :: ghost---- >error() ,mk)ger :: f,j,k,sum1,sum2 ,mk)ger :: p_i ,mk)ger, fmened b(6) :: bc----ffff(mk), fmened b(: ),)------ :: cost >error() ,mk)ger, fmened b(: ),)------ :: nm >error() ,mk)ger :: seed---- ,mk)ger, fmened b(:),d_doubltus, :: seed-ffff(mk), fmened b(:),d_doubltus, :: bugdnb ,mk)ger :: f= clf_dimlogiurns :: l= clf_d.false.,ok ffff(mk) ------,t1,t2,t3 ffff(mk) ----epserr_dek) f ent,'ppm_ffffes fffff!---------------m_ffffes fffff!-k) f ------m_ ------m_d_double(---------) fm),-en------) fm),le-------) fm),&LL ppm_error(E. 0) THENghost-----) fm),ghostlay--(2*) fm),&LL ppm_error(E. 0) THENnm-) fm),h-) fm),p_h-) fm),) f! & ---------1:) fm) (dx*dxm-----1,999-en------1:) fm) (d1*dxm-----1,999le-------1:) fm) (d-en------------------1,999ghost-----1:) fm) (d2----1,999ghostlay--(1:2*) fm) (d-en-rcp ---1,999bc---(1:6)ake ,mk) f! bc---_periodic epsakeepsil b(1*dxm- tolexpkkkknt(log10(epsil b(1*dxm- ) nullify(xp,rcpvwp) fffffffffMPIN'topppppst)m (d-pi_st)m_worlf f f f ffo = p-pi_st)m_bug (st)m,bug .& o = p-pi_st)m_------t)m,nprrt.& fkkkkkkkkkkkkkbug m_dim.EQ.3) Tnprrt (d1k fff fkkkkkkkko = ppm_error-) fm,mk,tolexp,0,,mk) .& ,99-------om)%k) f e-----fin subs-------m_ffffes fffff!-fin subs-fkkkkkkkko = ppm_efin subs( !---------- -----------(--------,-en-----,le------,ghost----,nm-------om)%fin subs-f-----setup-fkkkkkkkko = pbugdom_-eed(----=seed----) ------m_d_double(-eed(-eed----)) ------m_d_double(bugdnb((1+) fm)*np),) f! & mory----eed---- -eed(i)=10+i*i*(bugk+-----------om)dofkkkkkkkko = pbugdom_-eed(put=seed)fkkkkkkkko = pbugdom_ (ppm_(bugdnb d_double(xp-) fm,np),rcp(np),wp(p fm,np),) f! & -----om)%setup- - te����wn ----------(xp,rcpvwp,) f! & med_double(-eed,bugdnb -----om)%te����wn - test = cBCo_PRECISIO ! testsffffffffic b modirypst) fenterblic ghost----ent,'ppm_ffffes fffff!---------------m_ffffes fffff!-mko = -------m_ffffes fffff!-mapent,'ppm_ffffes fffff!--tric---------1,999ffffes fffff!-util_dbg-fkkkkkkkk,mk)ger :: nifELSE 4fkkkkkkkk,mk)ger :: newnp k) fff fki,mk)ger :: mp k) fff fki,mk)ger :: oldip,partifffffffffffffff(mk), fmened b(:,:),)------ :: in >error() ffffffffffff(mk), fmened b() fm) :: cp ---1,999ffff(mk), ) f! fk :: gl (dx*1xm-----1,999ffff(mk), ) f! fk :: f f (dx*05xm-----1,999,mk)ger, fmened b(:),)------ :: nCISIOn >error() ffffffff,mk)ger, fmened b(:,:),)------ :: CISIOn >error() d_double(p-) fm,npk) f) ffffffffkkkk1) (dx*05xm-----1,999ffff1) (dx*5xm-----1,999ff1,2) (dx*5xm-----1,999ff2,2) (dx*05xm-----1,999ff1,3) (dx*05xm-----1,999ffff3) (dx*05xm-----1,999ff1,4) (dx*5xm-----1,999ff2,4) (dx*95xm-- ---1,999bc---(1:6)ake ,mk) f! bc---_ffffffff nullify(nCISIO,et list !3ucheck1,mk) f fIF (inf ! makeo = ppm_e !3ucheck1,mk) f fIF (inf ,mst) ake ,mk) f! ofst) _cub ppa !,mst) ake ,mk) f! ofst) _xpenciffffffffffassig memory for Vessign_-----n st o = ppm_dimfkkkkkkkko = ppm_emko = ffGOTO 8p,npk) ,,mst) ,assig,--------,-en-----,bc---,nfo .NE. 0)k) f f fff fkgl+ f f,cost, !---------- -o = ppm_emapy fot_globff(fGOTO 8p,npk) ,& o = ppm_emapy fot_som)(npk) ,newnp k),& o = ppm_emapy fot_pop(p,) fm,npk) ,newnp k),& nlist1,ewnp k) -------- -o = ppm_emapy fot_ghost_---(fGOTO 8p,n fm,npk) ,0,gl+ f f,& o = ppm_emapy fot_som)(npk) ,mp k),& o = ppm_emapy fot_pop(p,) fm,npk) ,mp k),& o = ppm_e-tric-----(fGOTO 8p,npk) ,o .& !o = ppm_edbg_pr---_fffGOTO 8gl+ f f,kk1.& ,p,npk) ,mp k) o = ppm_eSINGLE_PRECISIO(fGOTO 8p,mp k),gl, f f,.TRUE.,fo .NE. 0)k) f f fff fkkkkkkkkkkCISIO,nCISIO, !---------- -!mory---mp k) fff fki-----pr--- *,i,p(:,i) fff fki-----morj=fi fffffff) fff fki---------pr--- *,'----',fffffff,i) fff fki-----om)dofkkkkkkkk!om)dof fff fki--morrticlefff fk!----!9ff1 op-------x*05xm-----1,999op-2) (dx*5xm-----1,999partifffffffffffmory-nf f f -mp k) fff fki,999pf ((abs( fkk)-op---).lt.eps).lic.&LL ppm_error(E. 0(abs( 2kk)-op-2-).lt.eps))rrtiions ,mk) fk) f f partiF ffffff! ibox .EQexi) fff fki,999fff fkkkkkkkkom)dofkkkkkkkk----ot_false(ip.eq.-1 ----ot_true((ist_vlif1).eq.ip).or.(ist_vlifip).eq.--) fk!----!9ff2 op------x*5xm-----1,999op-2) (d-x*05xm-----1,999partifffffffffffmory-nf f f -mp k) fff fki,999pf ((abs( fkk)-op---).lt.eps).lic.&LL ppm_error(E. 0(abs( 2kk)-op-2-).lt.eps))rrtiions ,mk) fk) f f partiF ffffff! ibox .EQexi) fff fki,999fff fkkkkkkkkom)dofkkkkkkkk----ot_false(ip.eq.-1 ----ot_true((ist_vlif2).eq.ip).or.(ist_vlifip).eq.2) !9ff3 op------x*05xm-----1,999op-2) (d-x*05xm-----1,999partifffffffffffmory-nf f f -mp k) fff fki,999pf ((abs( fkk)-op---).lt.eps).lic.&LL ppm_error(E. 0(abs( 2kk)-op-2-).lt.eps))rrtiions ,mk) fk) f f partiF ffffff! ibox .EQexi) fff fki,999fff fkkkkkkkkom)dofkkkkkkkk----ot_false(ip.eq.-1 o m_d(ist_vlif3).eq.ip).or.fo .NE. 0)k) f (ist_vl2f3).eq.ip).or.fo .NE. 0)k) f (ist_vlifip).eq.3).or.fo .NE. 0)k) f (ist_vl2fip).eq.3) ----ot_true(ok op-------x*05xm-----1,999op-2) (dx*05xm-----1,999partifffffffffffmory-nf f f -mp k) fff fki,999pf ((abs( fkk)-op---).lt.eps).lic.&LL ppm_error(E. 0(abs( 2kk)-op-2-).lt.eps))rrtiions ,mk) fk) f f partiF ffffff! ibox .EQexi) fff fki,999fff fkkkkkkkkom)dofkkkkkkkk----ot_false(ip.eq.-1 o m_d(ist_vlif3).eq.ip).or.fo .NE. 0)k) f (ist_vl2f3).eq.ip).or.fo .NE. 0)k) f (ist_vlifip).eq.3).or.fo .NE. 0)k) f (ist_vl2fip).eq.3) ----ot_true(ok op-------x*05xm-----1,999op-2) (d-x*05xm-----1,999partifffffffffffmory-nf f f -mp k) fff fki,999pf ((abs( fkk)-op---).lt.eps).lic.&LL ppm_error(E. 0(abs( 2kk)-op-2-).lt.eps))rrtiions ,mk) fk) f f partiF ffffff! ibox .EQexi) fff fki,999fff fkkkkkkkkom)dofkkkkkkkk----ot_false(ip.eq.-1 o m_d(ist_vlif3).eq.ip).or.fo .NE. 0)k) f (ist_vl2f3).eq.ip).or.fo .NE. 0)k) f (ist_vlifip).eq.3).or.fo .NE. 0)k) f (ist_vl2fip).eq.3) ----ot_true(ok !9ff4 op------x*5xm-----1,999op-2) (d1*05xm-----1,999partifffffffffffmory-nf f f -mp k) fff fki,999pf ((abs( fkk)-op---).lt.eps).lic.&LL ppm_error(E. 0(abs( 2kk)-op-2-).lt.eps))rrtiions ,mk) fk) f f partiF ffffff! ibox .EQexi) fff fki,999fff fkkkkkkkkom)dofkkkkkkkk----ot_false(ip.eq.-1 ----ot_true((ist_vlif4).eq.ip).or.(ist_vlifip).eq.4-) kkkkom)cleff om)cleff_suite-on������������������������incardon��������������������������������������������������������_KIND ==f__DOUBLE_PRECISION1,mkSINGLE_PREMkNINGLIdxTINE ppm_neighlist_vlist_d #endif �����������������������������������libppm-1.222640c/neighlist/ppm3016st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon����������������������������������������������������������������������������������������������������������������������� !o) ,mk) fENDIF ffffff!---------------------------------------------------- !9������������������������������1,mkSINGLE_PREMkNINGLIdx !o) ,mk) fENDIF ffffff!---------------------------------------------------- !9f f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zurich1,mk) f! CH-8092 ZurSINGLE_PREMkNINGLIdxp = cl,ind,jnd,nndk) f!------------Cre--------- f f f ffs f finfoim .EQ.of the center----------- Zue1,mk) f f find occur .EQ.ou shoffffff ----lway,mk)clud PARl list itfiscur ---------ry--------------11,mk) fSUBROUTINE ppm_clI PURPO thisfmorlocavector---, maybno me f f tPOINTER :: cdu f!ENDIFURPmblic pmveIFm=1,topo%..)k) f!e_destroy',t0,: car mod!-------------11,mk) fS laNINGUTINE ppm_cl` f `blic `jf `blre d_doubledmk) f f f f f�������- ZueTINE ppm_clror_eblre d_way,m(3 x nnd) f! neceionno list_vlism_cl) f!e_dester 1,mk)indetp thislre f f f tPOINTER :: cdif! Fuu cthetweion2Dblic 3D,mkset W! ne`nf `bitroy',t0,: c<28nse way-------Y or FIlocabeo =o muchoim a list mroy',t0,: cwastence this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the saI)clud 0 upon success1,mk) f!-------------------------------------------------------------------uccess1,mk) f!-------------------------------------------------------------------sake ,mk) f!!! of portability. 1,mk) f!-------------------------------------------------------------------------1,mk) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm_modultypedef1 useAME !----MK memoryvariables1,--------uccess1,mk) f!-------------------------------------------------------------------saule_alloc fffffIMPLICIT NONE1,mk) f!------------------------------------------------------------LOGICAL clist),fDIN ) :: l= cl---------- Znd ock) f!-ffffffff, Fnd ocenslf! fWithin t :: :,:), !-------:: f pgf90, thisF-----,mk) f f finIC Gdetp(ffff------*,mk) f fs*)--------------11,mk) f1---,m f :d1*..3 (x,y,[z])- f f fshift. +---11,mk) f2m)%k) f :d,mk) f f fin (ppm_d1*..nf .ithin t :: :,:), !-------:: j pgf90, thisSest) -,mk) f f finIC Gdetp(ffff------*,box intera ,mk sh*)----------- ---11,mk) f1---,m f :d1*..3 (x,y,[z])- f f fshift. +---11,mk) f2m)%k) f :d,mk) f f fin (ppm_d1*..nf .ithin t clist),fDIMENSION(:n pgf90, thisN(ppm_dim index of the center-------ee work-------------------1,mk) fTYPE(ppclist),fDIMENSION(:),fPOINTER :: clist ,mk) f!!! Cellist which is to be deallocated. ,mk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Returns status, 0 upon success1,mk) f!------------------------------------------------------------------ :: i1:: f,j,k,l,ffff,nz-------! Lomk) :: i1:: -----------dule_typedef1 :: t01,mk) f! counter fINTEGER :: i1! for ale this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the saI)--------------------------11,mk) f!-------------------------------------------------------------------------1,mk) fSINGLE_PREMkNINGLIdx !-------------------------------------------------------------------------1,mk) fCALL substart('ppm_clist_destroy',t0,info) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check arguments 9 CONTINUE fffffCALL substop('ppm_neighlist_vlist',t0,info) ,mk) fRETURN1,mk) fCONTAINS1,mk) fSUBROUTINE check1,mk) f ffkIF (.NOT. ppMkNINGLIdx alized) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err---------------ighlist_vlis(ppm_err_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info .D fkm����n(ppm_dim index of the center- f f f f f f loc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (infn m_dim.EQ.3)!n2Dbk) f!-ffffffff--------------1,) ,mist'2 .AND. = cl(in m_d5m.EQ.3)!n2DbNUEbk) f!-ffffffff--------------1,) ,mist'2 .AND. TINUE = cl((in m_dffffff!---3Dbk) f!-ffffffff--------------1,) ,mist'3 .AND. = cl(in m_d14fffff!---3DbNUEbk) f!-ffffffff--------------1,) ,mist'3 .AND. TINUE = cl((in m_d27err_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info .A_double list med oc,mk) f f finfffff! lstore ffffff!-----------------------------------------------------------------------he sa memory for Ve_dou_fi) fff fNTE------3 fff fNTE-2) (dn pgf90, ', &1,mk) !& dy',&1,mk) &_vlist', &1, & 'Box interaction index INP',__f,mkffffffffffffopoid(topoid,valid,info)loc(jnp,lda,iopt,infMkNINGLIdx alalized) THEN1,mk) 'Imk) f f finffff D,mk) f f f f fCALL ppm_erro----------------------gf90, ', &1,mk) !& j dy',&1,mk) &_vlist', &1, & 'Box interaction index INP',__f,mkffffffffffffopoid(topoid,valid,info)loc(jnp,lda,iopt,infMkNINGLIdx alalized) THEN1,mk) 'Imk) f f finffff J D,mk) f f f f fCALL ppm_erro----------------------e this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the saI)------z-- f blic jrg/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zurilicens aga=fi cles ,mk) f -------3es ,mk) f ractiod(f,j)m_dim.EQ.3) TTTTTTTjod(f,j)m_dim.EQ.3) TTTerr_dealloc,err_dee this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the saSet z dire f fin, this is act fmened baBut f f f loc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (infnzm_dim.EQ.3)-------1,) ,mist'3 'Box interactnzm_d1-------------e this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox substart('omp! Tha,iopbPubliodic, 0 upon success1,mk) f!-------------------------------------------------------m.EQ.3)---- = cl(i 'Box interacsuccess1,mk) f!----------------------------------------------------ox interacs U) f!-ffffffff-------racsuccess1,mk) f!----------------------------------------------------ox interacccccccccccccccccc!c,mk) f f fin Cel--Cel(as fCALL substo Tjod(1,2) (d1ccccc!c,mk) f f fin Cel--C1 Tiod(ff3) (d1ccccc!c,mk) f f fin Cel--C3 Tjod(1,4) (d1ccccc!c,mk) f f fin Cel--C4 Tjod(2,4) (d1 Tiod(1,5) (d1ccccc!c,mk) f f fin C1l--C3 Tjod(2,5) (d1 T-------1,) ,mist'3 'Box interact Tjod(3,5) (d1ccc!c,mk) f f fin Cel--C9ox interact Tiod(1,5) (d0ccc!cres f actzero (1-33 of the furf! it��wn)ox interact Tjod(2,5) (d0 ox interact Tjod(1,6) (d1ccc!c,mk) f f fin Cel--C10ox interact Tjod(3,6) (d1 ox interact Tjod(2,7) (d1ccc!c,mk) f f fin Cel--C12ox interact Tjod(3,7) (d1 ox interact Tjod(1,8) (d1ccc!c,mk) f f fin Cel--C13ox interact Tjod(2,8) (d1ox interact Tjod(3,8) (d1 ox interact Tiod(1,9) (d1ccc!c,mk) f f fin C1l--C3 Tt Tjod(2,9) (d1 ox interact Tiod(1,1 (d1ccc!c,mk) f f fin C1l--C9ox interact Tjod(3,1 (d1 ox interact Tiod(1,11 (d1ccc!c,mk) f f fin C1l--C12ox interact Tjod(2,11 (d1ox interact Tjod(3,11 (d1 ox interact Tiod(2,12 (d1ccc!c,mk) f f fin C3l--C9ox interact Tjod(3,12 (d1 ox interact Tiod(2,13 (d1ccc!c,mk) f f fin C3l--C10ox interact Tjod(1,13 (d1ox interact Tjod(3,13 (d1 ox interact Tiod(1,14 (d1ccc!c,mk) f f fin C4l--C9ox interact Tiod(2,14 (d1ox interact Tjod(3,14 (d1ox interacighlist_vlis() ,mk) f f f success1,mk) f!----------------------------------------------------ox interacs Fnslf! fWithin t f success1,mk) f!----------------------------------------------------ox interacns _dim.EQ.3) TTfffff_dim.EQ.3) TT---k=-nz,nz-------.3) TT---j=-1,1ox interaccccccc------1,1ox interaccccccc f success1,mk) f!-------------------------------------------ox interaccccccc f s .Admk) ftue1,mk) f f finfffff! lstorraccccccc f success1,mk) f!-------------------------------------------ox interaccccccc f l (dlerlet ,mk) f f f f fff! c------ex of the cesr opt%lpdxfk) ffar mod i) fff fki,999999999jod(1,l)rtiF ffffff! ibox .EQ Tjod(2,l)rtifffffENDDOffffffEQ Tjod(3,l)rtikf fff! of td_way,mhe 0ed oc2d,mkseffffENDDOffffffEffffff fff fk fffffffff fff fk err_dealloc,errm_err_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info .',__LINE__,info) ,mk) fENDIF ffffff!-------------------------------------------------------------------------1,mk) f! Return SINGLE_PREMkNINGLIdx !----------------------1#if) f__KIND ==f__SINGLE_PREMkNINGLIdx ������������������������������������������������������������������������������������������������_KIND ==f__DOUBLEes fffff!-mapy fot_per GalTINE ppm_neighlist_vlist_d #endif ������������������������������������������libppm-1.206036c/neighlist3ppm_cl7st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������E__,info)*- f9el-*DIF ffffff!---------------------------------------------------- (info .ke ,mkff fk ��������������es fffff!-mapy fot_per Galrr_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info f f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriicensrr_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info .Dpolog ----f! lstore ffffff!-----------------------------------------------------------------#opologf f f f fffffGOTO 8---------1-#opologf ffffEND SUBROUTIN---------2err_dealMODULE�es fffff!-mapy fot_per Galrr_deall!H Zuricfffff! provid-------mapp f!-�������slied per Gal per GcleTINE ppm_clmapp f!ithin t f success1,mk) f!---------------------------------------------------------thin t f s WffENfffff! lstorracsuccess1,mk) f!---------------------------------------------------------thin t f :: :ts !----iffff1ccccc >error() ffffffff :: :ts !----iffff2ccccc >error() ffffffff :: :ts !----per 2prrt c >error() ffffffff :: :ts !----iSINGL) f!n >error() PRIVATE----iffff1,iffff2,per 2prrt,iSINGL) f! ithin t f success1,mk) f!---------------------------------------------------------thin t f s Dpolog f thefacer----pm_emapy fot_per Galrr_dealracsuccess1,mk) f!---------------------------------------------------------thin t f RFACE-pm_emapy fot_per Galrr_dealracealMODULE�PROCEDURE-pm_emapy fot_per Gal_drr_dealracealMODULE�PROCEDURE-pm_emapy fot_per Gal_f! lstorrac1#if RFACE ithin t f success1,mk) f!---------------------------------------------------------thin t f s k)clud ccur aPubce ithin t f success1,mk) f!---------------------------------------------------------thin t f ----------#opologf fNTINU f f f fffffGOTO 88#k)clud c"map/pm_emapy fot_per Gal.f" # topof fNTIN--#opologf fNTINU ffffEND SUBROUTINE#k)clud c"map/pm_emapy fot_per Gal.f" # topof fNTIN--torrac1#ifMODULE�es fffff!-mapy fot_per Galr�incardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_KIND ==f__DOUBLEes fin subsTINE ppm_neighlist_vlist_d #endif ���������������������������������������������������������libppm-1.2.5404c/neighlist5pp16575st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������n t f success1,mk) f!---------------------------------------------------------yffor the saS�����������������������������, ppm_efin subsrr_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info f f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuri/licens) f__KIND ==f__fin subs( !---license!H Zuric�������� fkm��---------=f_Nffic Lick)clud f!ithin t:: cded_doubl f!-list melic clo) f!-h), ,mk) f! Ms/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriot, ,mk)aI)clud 0 upon success1,mk) f!-------------------------------------------------------------------uccess1,mk) f!-------------------------------------------------------------------sake ,mk) f!!! of portability. 1,mk) f!-------------------------------------------------------------------------1,mk) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedefmk) fUSE ppm_moml Pefin subsrr_deal1,mk) fUSE ppm_module_substart1,mk) fUSE ppm_module_substop1,mk) fUSE ppm_module_error1,mk) fUSE ppm_module_alloc fffffIMPLICIT NONE1,mk) f!------------------------------------------------------------ ist),fDENSION(:),fPOINTER :: clist ,mkell list which is to be deallocated. ,mk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! Returns status, 0 upon success1,mk) f!------------------------------------------------------------------ :: 1)r fINTEGER ! for allocate ! fo) f!--------- Local variables1,mk:: ---------LOGICAL ! fo)f!mINE__,ind iRACTER(LEN=mk) fharmk:: ml g is to be deallocated. ,mk) fINTEGER ,fINTENT( OUT) :: info ,mk) f!!! R :: iopt1,mk) f!-------------------------------------------------------------------------1,mk) f! Externals ,mk) f!-------------------------------------------------------------------------11,mk) f!-------------------------------------------------------------------------1,mk) ffin subs !---------NTE------0-----------------------------------------------------------------------1,mk) fCALL substart('ppm_clist_destroy',t0,info) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check arguments 9 CONTINUE fffffCALL substop('ppm_neighlist_vlist',t0,info) ,mk) fRETURN1,mk) fCONTAINS1,mk) fSUBROUTINE check1,mk) f ffkIFfin subs alized) THEN1,mk) f f f f finfo = ppm_error_error1,mk) f f f f fCALL ppm_error(ppm_err---------------ighlist_vlis(ppm_err_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info .D d_double globff ) f!y,m(from fUSE ppm_m)rr_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info) f!f_dim.EQ.3)he sake ,mk) f! of portability', &1,mk) !& 1,mksom)bufferdy',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mksom)buffersy',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mk FOvbufferdy',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mk FOvbuffersy',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mkpsom)buffery',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mkp FOvbuffery',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mkbuffer2p k),',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mkisom)ISIO,',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mki FOvISIO,',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mkbuffer1,) ,',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mkbuffer1----y',&1,mk) & o) f!f_do) f!f+:),fPOINTER ', &1,mk) !& 1,mkp oc_speed,',&1,mk) & o) f!f_do) f!f+:),fPO-----------o) f!f& 'Box interactWRITE(ml g,'(A,I3,A)') 'ied ',o) f!,' globff ) f!y,. Possius, list memory.'ox interactst',t0,info) ,mk) fRETURN1,mk) fCffff fkDEALLOCATE(clist, STAT=info)fin subs ml g,k) f f f f fCALL ppm_erro----------------------e this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the saD d_double ml P struct (n,m(from fUSE ppm_moml P)rr_dealloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (infffff fkDml Pefin subs( !---licensell list& 'Box interaction index INP',__ fRETURN1,mk) fCffff fkDEALLOCATE(clist, STAT=info)fin subs alized) THEN1,mk) 'al Puded_doubl finda), d,mk) f f f f fCALL ppm_erro----------------------gf90, might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the saSet ----globff ) f!!!-gf90, might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor thefffffCALL substf_d.FALSEnce this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the sa',__LINE__,info) ,mk) fENDIF ffffff!-------------------------------------------------------------------------1,mk) f! Return fin subs !-------------------------------------------------------------------------1,mk) fCALL substart('loinfoutpmveuCALs9pf f f f f f f loc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (inf-------1std!mve.G 'Box interact!fmorlocacloinfor_pf i---sla system ) fodirdeuCALuments 9 CONT---1std!mve. 6op('ppm_neighlist_vliINQUIRET---1std!mv,f!mIed=o)f!mIALL ppm_error(pp----o)f!mIA CLOSET---1std!mvror1,mk) f f f f fCALL p f f fCALL pCONT---1stdclie.G 'Box interact!fmorlocacloinfor_pf i---sla system ) fodirdeuCALuments 9 CONT---1stdclie.LIST%LPDX',__LINE__,info) INQUIRET---1stdcli,f!mIed=o)f!mIALL ppm_error(pp----o)f!mIA CLOSET---1stdcliror1,mk) f f f f fCALL p f f fCALL pCONT---1logh), M.G 'Box interactINQUIRET---1logh), ,f!mIed=o)f!mIALL ppm_erro----o)f!mIA CLOSET---1logh), pm_error(ppm_err_deal-------m_error(pps) f__KIND ==f__fin subsr�incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_KIND ==f__DOUBLEes fffff!-tree1,)v-----TINE ppm_neighlist_vlist_d #endif ���������������������������������������������libppm-1.204774c/neighlist5pp211list_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������teract!o)*- f9el-*DIF ffffff!---------------------------------------------------- (info .ke ,mkff fk ����������������es fffff!-tree1,)v---------------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuri/licensloc,'ppm_clist_destroy',&1,le_alSE ll lidfIF (i----&1,le_e3ucheck1,mk) f fIF (info .Dpolog ----f! lstore ffffff!-----------------------------------------------------------------#opologf f f f fffffGOTO 8-1-#opologf ffffEND SUBROUTIN-2err_dealMODULE�es fffff!-tree1,)v-------------!H Zuricfffff! provid--------------!H �������� rsio-----s9pf a-ex ofsk) f,)visius,nse1,mk)tore ffffff!-------------------------------------------------------------se1,mk)tore Dpolog f thefacer----Lice�������(s)se1,mk)tore ffffff!-------------------------------------------------------------se1,mk)tor RFACE-pm_etree1,)v------------r_dealMODULE�PROCEDURE-pm_etree1,)v-----_s-------r_dealMODULE�PROCEDURE-pm_etree1,)v-----_drr_dealrac1#if RFACE ithin t f success1,mk) f!---------------------------------------------------------thin t f s k)clud ccur aPubceithin t f success1,mk) f!---------------------------------------------------------thin t f ----------#opologf fNTINU f f f fffffGOTO 88#k)clud c"tree/pm_etree1,)v-----.f" # topof fNTIN--#opologf fNTINU ffffEND SUBROUTINE#k)clud c"tree/pm_etree1,)v-----.f" # topof fNTIN--ealrac1#ifMODULE�es fffff!-tree1,)v------����_KIND ==f__DOUBLEes fffff!-f thep_p2mTINE ppm_neighlist_vlist_d #endif ������������������������������������������������libppm-1.2.3174c/neighlist3ppm042ist_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������n t f suc*- f9el-*DIF ffffff!---------------------------------------------------- (info .ke ,mkff fk �������������es fffff!- Meh_reml P----------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuri/#opologf f f f fffffGOTO 8-1-#opologf ffffEND SUBROUTIN-2e#opologf f2D---------------3e#opologf f3D---------------4e#opologf fVEC--------------5/#opologf f CA--------------6err_dealMODULE�es fffff!-f thep_p2m--------!H Cony on------=er Gener---ml P f thepolbl fin�������s. Curr---ly w---------!H suppo Gr2m)%orl PaB-s f!ogflic MP4 f thepolbl fins---m ,mk) f! -thin t fes/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Z-thin t fe----theface-thin t fes/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Z-thin t f RFACE-pm_ef thep_p2m-------n t fe-2dns-alaTURN1,mk) fCOMODULE�PROCEDURE-p2m_ss_2dURN1,mk) fCOMODULE�PROCEDURE-p2m_ds_2dURN1,mk) fCOe-2dnvectorURN1,mk) fCOMODULE�PROCEDURE-p2m_sv_2dURN1,mk) fCOMODULE�PROCEDURE-p2m_dv_2dURN1,mk) fCO! 3dns-alaTURN1,mk) fCOMODULE�PROCEDURE-p2m_ss_3dURN1,mk) fCOMODULE�PROCEDURE-p2m_ds_3dURN1,mk) fCO! 3dnvectorURN1,mk) fCOMODULE�PROCEDURE-p2m_sv_3dURN1,mk) fCOMODULE�PROCEDURE-p2m_dv_3dURN1,mk) 1#if RFACE ithin t f RFACE-pm_ef thep_p2m_reno-------n t fe-2dns-alaTURN1,mk) fCOMODULE�PROCEDURE-p2m_renorm_ss_3dURN1,mk) fCOMODULE�PROCEDURE-p2m_renorm_ds_3dURN1,mk) fCO! 3dnvectorURN1,mk) fCOMODULE�PROCEDURE-p2m_renorm_sv_3dURN1,mk) fCOMODULE�PROCEDURE-p2m_renorm_dv_3dURN1,mk) 1#if RFACE ithin t f RFACE-p2_ef thep_bsp2ox interact MODULE�PROCEDURE-p2m_f thep_bsp2_ss_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_bsp2_ds_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_bsp2_sv_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_bsp2_dv_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_bsp2_ss_3dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_bsp2_ds_3dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_bsp2_sv_3dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_bsp2_dv_3dURN1,mk) 1#if RFACE ithin t f RFACE-p2_ef thep_mp4URN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_ss_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_ds_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_sv_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_dv_2dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_ss_3dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_ds_3dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_sv_3dURN1,mk) fCO MODULE�PROCEDURE-p2m_f thep_mp4_dv_3dURN1,mk) 1#if RFACE RN1,mk) RN1,mk----------RN1,mk) #opologf fNTINUU f f f fffffGOTO 88#opologf ffIME f f2D8#opologf fMODE f f CA-thin t fe-2D- CA- f f fE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8#opologf fMODE f fVEC-thin t fe-2D-VEC- f f fE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8# topoff ffIME-RN1,mk) #opologf ffIME f f3D8#opologf fMODE f f CA-thin t fe-3D- CA- f f fE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/pm_ef thep_p2m_renormTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8#opologf fMODE f fVEC-thin t fe-3D-VEC- f f fE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/pm_ef thep_p2m_renormTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8# topoff ffIME-# topoff fNTIN-- #opologf fNTINUU ffffEND SUBROUTINE#opologf ffIME f f2D8#opologf fMODE f f CA-thin t fe-2D- CA-fffENDE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8#opologf fMODE f fVEC-thin t fe-2D-VEC-fffENDE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8# topoff ffIME-RN1,mk) #opologf ffIME f f3D8#opologf fMODE f f CA-thin t fe-3D- CA-fffENDE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/pm_ef thep_p2m_renormTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8#opologf fMODE f fVEC-thin t fe-3D-VEC-fffENDE#k)clud c"f thepolble/pm_ef thep_p2mTI"E#k)clud c"f thepolble/pm_ef thep_p2m_renormTI"E#k)clud c"f thepolble/p2m_f thep_bsp2TI"E#k)clud c"f thepolble/p2m_f thep_mp4.f" # topoff fMODE8# topoff ffIME-# topoff fNTINRN1,mk) # topof f f f fffffGOTO 8- # topof ffffEND SUBROUTIN- # topof f2D--------------- # topof f3D--------------- # topof fVEC-------------- # topof f CA-------------- RN1,mk) RN1,mk1#ifMODULE�es fffff!-f thep_p2m-r�incardon�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_KIND ==f__DOUBLEes fffff!-topo_-----TINE ppm_neighlist_vlist_d #endif ������������������������������������������������libppm-1.204775c/neighlist/ppm0467st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������in t feo)*- f9el-*DIF ffffff!---------------------------------------------------- (info .ke ,mkff fk ����������������es fffff!-topo_---------------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriicens----------------------------------------------------------------------1,mk) fCALL substart.Dpolog ----f! lstore ffffff!-----------------------------------------------------------------#opologf f f f fffffGOTO 8-1-#opologf ffffEND SUBROUTIN-2err_dealMODULE�es fffff!-topo_-------------!H Zuricfffff! provid-------�������sltoo----- topologi�sl---------!H o = tus, from ��� f fnse1,mk)tore ffffff!-------------------------------------------------------------se1,mk)tore Dpolog f thefacer----Lopologyo----- f!-�������se1,mk)tore ffffff!-------------------------------------------------------------se1,mk)tor RFACE-pm_etopo_------------r_dealMODULE�PROCEDURE-pm_etopo_-----_s-------r_dealMODULE�PROCEDURE-pm_etopo_-----_drr_dealrac1#if RFACE ithin t f success1,mk) f!---------------------------------------------------------thin t f s k)clud ccur aPubce ithin t f success1,mk) f!---------------------------------------------------------thin t f ----------#opologf fNTINU f f f fffffGOTO 88#k)clud c"topo/pm_etopo_-----.f" # topof fNTIN--#opologf fNTINU ffffEND SUBROUTINE#k)clud c"topo/pm_etopo_-----.f" # topof fNTIN--ealrac1#ifMODULE�es fffff!-topo_------���_KIND ==f__DOUBLEes fffff!-ml Peon-----TINE ppm_neighlist_vlist_d #endif ����������������������������������������������libppm-1.205415c/neighlist/ppm1025st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������n t f suc*- f9el-*DIF ffffff!---------------------------------------------------- (info .ke ,mkff fk ���������������es fffff!-ml Peon---------------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuri----------------------------------------------------------------------1,mk) fCALL substart.Dpolog ----f! lstore ffffff!-----------------------------------------------------------------#opologf f f f fffffGOTO 8---------1-#opologf ffffEND SUBROUTIN---------2err_dealMODULE�es fffff!-ml Peon-------------!H Zuricfffff! cony on------f theface----` fkDml Peon-----`.--------!H--------!H [NOTE]--------!H Zu�� fkm��ologyoatio f!uu ca,mhetweionml P ffaic field---------!H (----1,mk liv f!-oon. ,mml P f)t WIvetailfield-,mk) Lic------------!H sam,mml P.ral P ffarrantologdware:D =f thenailTYPES, w! iea---------!H field-,arraLicr-provid-d ) f!y,.se1,mk)tore ffffff!-------------------------------------------------------------se1,mk)tore Dpolog f theface----pm_eml Peon------------tore ffffff!-------------------------------------------------------------se1,mk)tor RFACE-pm_eml Peon------------tordealMODULE�PROCEDURE-pm_eml Peon-----_--------tordealMODULE�PROCEDURE-pm_eml Peon-----_drr_dealrac1#if RFACE ithin t f success1,mk) f!---------------------------------------------------------thin t f s I)clud ccur aPubceithin t f success1,mk) f!---------------------------------------------------------thin t f ----------#opologf fNTINU f f f fffffGOTO 88#k)clud c"ml P/pm_eml Peon-----.f" # topof fNTIN-thin t f -#opologf fNTINU ffffEND SUBROUTINE#k)clud c"ml P/pm_eml Peon-----.f" # topof fNTIN--ealrac1#ifMODULE�es fffff!-ml Peon------ardon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_KIND ==f__DOUBLEes fffff!-fsffCALL substTINE ppm_neighlist_vlist_d #endif ��������������������������������������������libppm-1.204140c/neighlist3ppm_332st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������n t f suc*- f9el-*DIF ffffff!---------------------------------------------------- (info .ke ,mkff fk ���������������es fffff!-fsffCALL subst----------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriicensrr_dealMODULE�es fffff!-fsffCALL subst--------!H Zuricfffff! provid-------�������s--------!H o = tus, from ----��� f fnse1,mk)tore ffffff!-------------------------------------------------------------se1,mk)tore Dpolog f theface----globff ) f!!! f quiLic�������se1,mk)tore ffffff!-------------------------------------------------------------se1,mk)tor RFACE-pm_efsffCALL subst-------r_dealMODULE�PROCEDURE-pm_efsffCALL subst-------r_d1#if RFACE ithin t f success1,mk) f!---------------------------------------------------------thin t f s k)clud ccur aPubce ithin t f success1,mk) f!---------------------------------------------------------thin t f ----------#k)clud c"���l/pm_efsffCALL subst.f" -ealrac1#ifMODULE�es fffff!-fsffCALL subst-�incardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������_KIND ==f__DOUBLEtree/������������������������������������������������������������������������������1.20755�������������libppm-1.200000c/neighlist3pp14702st5����������������������������������������������������������������������������������������������������1616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������_KIND ==f__DOUBLEtree/pm_etree1d_douTINE ppm_neighlist_vlist_d #endif ��������������������������������������������������libppm-1.224416c/neighlist3ppm2045st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�021650� 0����������������������������������������������������������������������������������������������������ustar �incardon�����������������������������������������������������������������������������������������������������������������������licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriicens saS�����������������������������, ppm_etree1d_dou----------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/licenses/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuri-#kf ff fTYPE ==f fTREE-#kf ff fNTINU==f f f f fffffGOTO 88licens) f__KIND ==f__tree1d_dou_ts(,mk) nbox nbpd,nlrsil,min_box icensized) THEN1,max_box boxcost,per---,nchld,child,blrsil,nbpl !---#eliff fNTINU==f ffffEND SUBROUTINElicens) f__KIND ==f__tree1d_dou_td(,mk) nbox nbpd,nlrsil,min_box icensized) THEN1,max_box boxcost,per---,nchld,child,blrsil,nbpl !---#enart-#eliff fTYPE ==f fDECOMP-#kf ff fNTINU==f f f f fffffGOTO 88licens) f__KIND ==f__tree1d_dou_ds(,mk) nbox nbpd,min_box max_box censized) THEN1,boxcost,nchld,blrsil, !---#eliff fNTINU==f ffffEND SUBROUTINElicens) f__KIND ==f__tree1d_dou_dd(,mk) nbox nbpd,min_box max_box censized) THEN1,boxcost,nchld,blrsil, !---#enart-#enart-license!H Zuric��������(re)d_double------tree-1,mk struct (n,,mk) f! Ms/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriot, ,mk)ake ,mk)s----------------------------------------------------------------------1,mk) fCALL substa---------------1,mk) f! Modules fffff!-1,mk_tree) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm#kf ff fNTINU==f f f f fffffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f ffffEND SUBROUTINElicens useAME !----MKindex Ivariables1,-#enart-license--------------------------------------------------------------1,mk) fCALL substak)aI)clud 0 upon success1,mk) f!-------------------------------------------------------------------uccess1,mk) f!-------------------------------------------------------------------saule_alloc-------------uccess1,mk) f!-------------------------------------------------------------------- LoMK) :: :,:) PO R------k:: min_box-license!H Lowmorcoord��-----R PURPObox.--------!H--------!H 1sionel x: x,y[,z] +--------!H 2nd:-ex oID--------- LoMK) :: :,:) PO R------k:: max_box--------!H Uppmorcoord��-----R PURPObox.--------!H--------!H 1sionel x: x,y[,z] +--------!H 2nd:-ex oID--------- LoMK) :: : ) PO R------k:: boxcost--------!H Cost-R P = pURPOboxn,,mk) f! :: : ) PO R------k:: nchld--------!H NumbmorR Pchildr--rR PeachObox.------- ist),fDIN---) ! for allocate-!H A_doubl fin pp��(par md-oon.o&1,mk) !&)------- ist),fDIN---) ! fnbox--------!H New numbmorR Pboxn,n.o&d_double------- ist),fDIN---) ! fnbpd--------!H NumbmorR Pchildr--rpmorper---------- ist),fD ENSION(:),fPOINTER :: clist , ) f!!!, 0 list which is to :: : ) PO R------k:: blrsil-license!H Zree-lrsilrR PeachObox-#kf ff fTYPE ==f fTREE------- ist),fDIN---) ! fnlrsil-license!H NumbmorR Plrsilser 1,mk)tree) f! M :: : ) PO R------k:: per----------e!H Iel x-R PURPOper----ex oR PeachObox.-` fkD) f! topologd`9pf POINTER :: cper----(i.e.c��o--ex )------- :: : ) PO R------k:: nbpl-license!H Zue numbmorR Pboxn,npmorlrsil-licens :: :,:) PO R------k:: child-------e!H Ielic---R P = pchildr--rR PaObox.-1sionel x: childoID, 2nd:-ex oID.-#enart-license--------------------------------------------------------------1,mk) fCALL substak)aeturns status, ---------uccess1,mk) f!-------------------------------------------------------------------- LoMK) :: --------- :: 2) fINTu----------------------------------------------------------------------1,mk) fCALL substartR ---------uccess1,mk) f!-------------------------------------------------------------------license--------------------------------------------------------------1,mk) fCALL substak)aI)----------license--------------------------------------------------------------1,mk) fCALL substa------------1,mk) ftree1d_dou !-------------------------------------------------------------------------1,mk) fCALL substart('---- inpmvelist_destroy',t0,info) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check arguments -----------------r_ell liste.LIST%LP----------------------e this might be a ,mk) f!!! compiler-dependent feature we do it the orthodox wayffor the saA_double-------,info) 1,mk) f!----------------------------------------------------------------------TNES_=er Genes 'Box interactNTu------2ox interactNTu-2----nbox-------s -----1,mk) !& tree1lhbx,NTu1,mk) & --r_ell list& 'Box interactttttion index INP',__f,mklox interactttttffff fkDEALLOCATE(clis STAT=info)tree1d_dou teractttttized) THEN1,mk) f f fpof then.o&headers TREE_LHBX,mk) f f f f fCALL ppm_error(ppm_err---------------ighli ------ighli ------NTu---- index Idim ------NTu-2-- indnbox------------1,mk) !& min_box NTu1,mk) & ell list& 'Box interaction index INP',__f,mklox interactffff fkDEALLOCATE(clis STAT=info)tree1d_dou teractttttized) THEN1,mk) 'lowmorex ob modiri�slMIN_BOX,mk) f f f f fCALL ppm_erro--------------------- ------------1,mk) !& max_box NTu1,mk) & ell list& 'Box interaction index INP',__f,mklox interactffff fkDEALLOCATE(clis STAT=info)tree1d_dou teractttttized) THEN1,mk) 'uppmorex ob modiri�slMAX_BOX,mk) f f f f fCALL ppm_erro--------------------- -----------TNES_ml P) 'Box interact-----1,mk) !& Nm_box NTu1,mk) & ell list& 'Box interactraction index INP',__f,mklox interactractffff fkDEALLOCATE(clis STAT=info)tree1d_dou teractttttized) THEN1,mk) mk) 'ex ogrid size NM_BOX,mk) f f f f fCALL ppm_erroerro------------------------- -------ighli ------NTu----ndnbox------------1,mk) !& narv NTu1,mk) & ell list& 'Box interaction index INP',__f,mklox interactffff fkDEALLOCATE(clis STAT=info)tree1d_dou teractttttized) THEN1,mk) 'numbmorR P,)visius,P,)recl fis ghlV,mk) f f f f fCALL ppm_erro--------------------- ------------1,mk) !& blrsil,NTu1,mk) & ell list& 'Box interaction index INP',__f,mklox interactffff fkDEALLOCATE(clis STAT=info)tree1d_dou teractttttized) THEN1,mk) 'tree-lrsilsrR Pboxn,nBLEVELR P,)visius,P,)recl fis ghlV,mk) f f f f fCALL ppm_erro-----------------n----Tu1,mk) & ��n t o----------pXCOST interaction index INP',__f,mklox interactffff fkDEALLOCATE(clis STAT=hld,ble1d_dou teractttttized) THEN1,mk) 'tree-lrsilsrR Pboxn,nBLEVELR P,)visius,P,)recl fis ghlV,mk) f f f f fCALL ppm_erro-----------------n----Tu1,mk) & ��n t n ist),NCHLD interaction index INP',__f,mklox interactffff fk ENSION(:),fPOINTER :: clisto)tree1d_do- -----,info) 1,mk) f!CATE(clis STAT=ff fNTe1d_dou teractttttized) THEN1,mk) 'tree-lrsilsrR Pboxn,nBLEVELR P,)visius,P,)recl fis ghlV,mk) f f f f fCALL ppm_erro-----------------n----Tu1,mk) & ��n t ) & ist),CHILD interaction index INP',__f,mklox interactffff fk clisto)tree1d_do 1,mk) f!CATE(clis STAT=pl !-e1d_dou teractttttized) THEN1,mk) 'tree-lrsilsrR Pboxn,nBLEVELR P,)visius,P,)recl fis ghlV,mk) f f f f fCALL ppm_erro-----------------n----Tu1,mk) & ��n t ) f! Mst& PARENT interaction index INP',__f,mklox interactffff fkDEALLOo)tree1d_df! topologCATE(clis STAT=hfffEe1d_dou teractttttized) THEN1,mk) 'tree-lrsilsrR Pboxn,nBLEVELR P,)visius,P,)recl fis ghlV,mk) f f f f fCALL ppm_erro-----------------n----Tu1,mk) & ��n t R PeachObox.-` fkD) f! NBPx interaction index INP',__f,mklox interactffff fkmorlrsi--------------------------------------------------------1,mk) f! Check arguments ------- --------------------------------------------------------1,mk) f! Check arguments ependent feature we do it the orthodox---1,mk) fCALL substare we fCALL re we d--------re we f__KIND ==fcer----Lopologyed) do 1 .L) fCALL substart('-rR Pboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro----------------- ell'N PeachObox.-` fmu& be >= 0ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) dopd .L) fCALL substart('-rR Pboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro----------------- ell'N PeachObox.-` fkD) stepfmu& be >= 0ractraction index INP',__f,mk,mklo8888x INP',__fCONT-- ENSION(:),fPOINTER :: clistogyed) df! .L) fCALL substart('-rR Pboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro----------------- ell'N PeachObo ell limu& be >= 0ractraction index INP',__f,mk,mklo8888x INP',__fCONT-- orlrsil8888ll fint feature we -1logh), M.G cer---nse along with PPM.fIf not, ,mk) f! see <http://www.gnu.org/lice-1logh), M.G ,mk) f! Para ppm_module_data1,mk) fUSE ppm_module_type-1logh), M.G ,mk) f! PardBROUTINElicens) f__KIND ==f__tree1d_dou_td(,mk) nbox nbpd,nlrsil,min_box i-1logh), M.G ,mk) f! Pada ppm_module_data1,mk) fUSE ppm_module_type-1logh), M.G ,mk) f! Paddeliff fNTINU==f16003524�021650� 0���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ustar �incardon��������cutpoND SUBROUTINE#k)clud c"topo/pm_etopo_-----.f" # topof fNTIN--���������������������������������313���������_KIND =20256OUBLEtree/pm_etree1d_douTINE ppm_neighlist_vlist_d #endif ��������������������������������������������������libppm-1.224416c/neighlist3ppm2045st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�022222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incardon�������������������������������������������������������������������������������������������������n��������cutpoND --------------------------------------------------------1,mk) f! Check arguments ------s saS�����������������������������, ppm_etree1d_dou----------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free software: you can redistribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) f! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License alu_td(,mk) nbox nbpd,nlrsil,min_box iogh), M.G ,mk)cutpoN_s(xp,Ndest,weS���sin_box max_box censi cutx nbpcutin_bx n 'B,icuticpoNn ind,p----#kf ff fNTINU==f f f f fffffGOTO 88licens) ogh), M.G ,mk)cutpoN_d(xp,Ndest,weS���sin_box max_box censi cutx nbpcutin_bx n 'B,icuticpoNn ind,p----#kf NU==f ffffEND SUBROUTINElicefind==f__tbe& cNElig poNiox intmk) f__tgthenf ffffEND ScNE 'Box in-#opologf ffffEND SUBROUTIN---------2err_dec ologf f3D-ROUcf! tf!uu cac (==f ffffEND Sgthen)atio1.) frDml Peo, f__tc ROU1fkD) ��������n t D Sst& .) frDf__tgeometfordest, f__tc ����n t D S8-1-#opgthenics its vol---. UarrweS���s(3)! fordju& tBROUsilseededox nbpd,min_box max_box censized) THEN1,boxcost,nchld,blrsil, !---#enart-#enart------------uric���x nbpd,min_box max_box censized) THEN1,boxcost,nchld,blrsil, !---#enart-#enart--------e Mesh Library (PPM) ,mk) f!kETH Zuriot, ,mk)ake ,mk)s----------------------------------------------------------------------1,mk) fCALL substa---------------1wricate-!H A_les fffff!-1,mk_tree) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm#kf ff fNTINU==f f f f fffffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart--------icens useAME !----MKindex Ivariables1,-#enart-license-----------------------------1,mkffffGOMPIle_typedeCLUDE 'mpif.h'fffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart--------icA----------1,mk) ftree1d_dou !-----------------------------------------------------are we frd��-----R PURPObox.---- to xp����n t D SPoNiox i we do itare we frd��-----R PURPObox.---- to _alloc------------Minimum itare we frd��-----R PURPObox.---- to _sionel x: x,y[,z]Maximum itare we frd��-----R PURPObo3per-- to _alx n 'B-----------Minimum 8-1- 'Bore----itfand ) spa---- 'Box inare we frd��-----R PURPObo3per-- to weS���s-----------WeS���stmk) f__t c ----bute x in: we do it, ����,f ffffEND Sgeometformk) findlig f__tcutare we frd��-----R PURPOboxper--OPTPObAL-- to ponel x: x,y[,z]A-------hObo eng,mkNdest, specb (lig f__f ffffEND Scomputmk) f-- c ! fnl we do i--k:: boxcost--------!H Cost-R P = pURPOboxn,,mk) fNdestf ffffEND SN PeachObo we do itare we , ) f!!!, 0 list which is to cutare we NE 'Box inare we , ) f!!!, 0 list which is to cutx nare we IDhObox.-! fob_tcutare we ) PO R------k:: per-- pURPOboxn,,mk) f!cutare we CNE 'Box inare we oord��-----R PURPObox.--------!H--------!H cpoN����n t D SPoNiox ilist& e& cNEs.license!1.. cut--k:: boxcost--------!H Cost-R P = pURPObd_double------- ist),fDIN---) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart--------icrR PaObox.-1sio--1,mk) ftree1d_dou !-----------------------------------------------------are we frd��-----R PURPObotttttiz) f!-------------elloc-------- frd��-----R PURPObo cut+1) f!---------- po,p-sumare we ) PO R------k::k) f!---------------------------------------------1,mk) fCALL substak)aeturns ,dm,����total,geomtotal------------------------1,mk) fCALL substak)aeturnpmassinmassigmassitmass------------------------1,mk) fCALL substak)aeturnpwe poNnmidpoN����n txcost--------!H Cost-R PCALL substak)aeturni,j,ip,cut bpcp1_dou 1,mkffffGOMPIle_typedeost--------!H Cost-R PCALL substak)aeturnMPf__KfffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart--------ic----- 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-- 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart--------ic---------- 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart------------------------------1,cutpoNCALL substare we ns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart--------icCALL substa------------1,mk) ftree1d_dou !-----------------------------------------------------le_typed-----------1,mk) fCALL substart('---- inpmvelist_destroy',t0,info) 1,mk) f!-------------------------------------------------------------------------1,mk) f! Check argument-------ic-f weibutedsio==f_anU1f 'Box i-----ut, weiogyoaon- 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart--------ed) d NE .L) f1ALL substart('-rRd-----------1,mk) fCALL substart('-art('---- i----wrica-----rank,--------1,cutpoNCA si 'No NE 'Box in prese .)ExiElig. 'n index INP',__f,CONT---1stdcogymk) f!-------------------------------------------------------------------------1,mk) f! Check argument-------icComputpm_efse---nsx i --1,mk) ftree1d_dou !-----------------------------------------------------le_typed--------im,mk) f2 the orthodox wayfelloc-ree1d__sionel(1,cutx n)-_alloc-(1,cutx n)rthodox wayfelloc-r2e1d__sionel(2,cutx n)-_alloc-(2,cutx n)rthodox wayfelloc-r3e1d__sionel(3,cutx n)-_alloc-(3,cutx n)rthodoxELSErthodox wayfelloc-ree1d__sionel(1,cutx n)-_alloc-(1,cutx n)rthodox wayfelloc-r2e1d__sionel(2,cutx n)-_alloc-(2,cutx n)rthodox-------,mkffffGOMPIle_type-------------------------------------------------1,mk) f! Check argument-------icDealMODUenMPId_dou_Part useAME !----MKindex Ivariables1,-#enart-license-----------------------------1,mk tree) f! Modules fffff!----------MPf__K1d_MPI_---- ppm_module_data1,mk) fUSE ppm_module_typeMPf__K1d_MPI_-------------thin iff fNTINU==f--------------------------------------------------------1,mk) f! Check argument-------icComputpmlogf f3D-c ------- gravityfand ) 'Box inare we -------------------------------------------------1,mk) f! Check argument-------pc1d_0.0_MK-------pcp11d_dcut+1le_typed---ature we do it .AND.rweS���s(ee1nfo) 1,mhe or,mkffffGOVECTORrthodox wayDO i=1, cutare we cut 1d_!cut(iex INP',__f,mklDO j=---------(1,cutx n),---------(2,cutx n)rthodox wayyyyyyyyip1d_------pdx(j)rthodox wayyyyyyyydm1d_1.0_MK------------------d------SRPObp----#)ydm1d_p----(ip)rthodox wayyyyyyyypc(ie1d_p-(ie1+ (xp(cut bip)*dm)rthodox wayyyyyyyypc(pcp1e1d_p-(pcp1e1+ydmrthodox wayyyy---DO dox wayyyy---DO dox wayyyy! repl-----BROUby somethlig f!mvec ellrfand/or fuk) n. TryUcf! tlig dox wayyyy! and wayfy fffavoid==f__tlist& i fie dox wayyyypc(pcp1e1d_p-(pcp1e/-----pcuti--- ppms�����rthodox wayDO j=---------(1,cutx n),---------(2,cutx n)rthodox wayyyyyip1d_------pdx(j)rthodox wayyyyydm1d_1.0_MK---------------d------SRPObp----#)ydm1d_p----(ip)rthodox wayyyyyDO i=1, cutare we cut 1d_!cut(iex INP',__f,mklayyyypc(ie1d_p-(ie1+ (xp(cut bip)*dm)rthodox wayyyyy---DO dox wayyyyyyyypc(pcp1e1d_p-(pcp1e1+ydmrthodox way---DO TINU==���rthodox wa-,mkffffGOMPIle_typeeeee-------------------------------------------------1,mk) f! Check argum dox wayyyy! AllreducehObo we do it---msle_typeeeee-------------------------------------------------1,mk) f! Check argum dox wayyyy--- iMPI_Allreduce(po,p-sumbpcp1_MPf__K,MPI_SUM,----commpmorex ob modiri�slMAX_BO1nfo) 1,mhe ordox wayyyyyyyyro--------------------- -----------TNES_ml P) 'Box interacmpi---il,--------1,cutpoNCA si 'MPI_AllreducehObo roj'Boedo we do itractraction index INP',__f,mklox interactractffff fkDEA dox wayyyypc1d_p-sumaffGOTO 88licefff f!ature we do itf--------------------------------------------------------1,mk) f! Check argument-------icTotalrweS���hObo����ANY Wgeometfo-------icConllrt-------- first----avoid����sg--- llrflowox nbpd,min_box max_box censized) THEN1,boxcost,nchld,blrsil, !---#enart-#enart--------����total1d_0.0_MK-------d--------im,mEQ f2 the orthodox waATE(clis STAT .AND.rweS���s(2)1nfo) 1,mhe ordox wayyyyyyy����total1d_-----) THEN(1,cutx n),---*-----) THEN(2,cutx n),---�rthodox wafkDEA dox wayyygeomtotal1d_felloc-ree*felloc-r2erthodoxELSErthodox waATE(clis STAT .AND.rweS���s(2)1nfo) 1,mhe ordox wayyyyyyy����total1d_-----) THEN(1,cutx n),---* & ell -----) THEN(2,cutx n),---*-----) THEN(3,cutx n),---rthodox wafkDEA dox wayyygeomtotal1d_felloc-ree*felloc-r2e*felloc-r3e---------------------------------------------------------------------1,mk) f! Check argument-------icComputpmweS���edomass :: : we do it, ����ANY Wgeometfo-------i------------------------------------------------1,mk) f! Check argument-------pmass1d_p-(pcp1e*weS���s(ee-------�mass1d_����total*weS���s(2)-------gmass1d_geomtotal*weS���s(3)-------tmass1d_pmass+�mass+gmass-------ATE(tmass1mEQ f) 'tree-lrsilsrR Pboxn,nBLEVELR P,)visius,P,)recl fis ghlV,mk) f f f f fCAL-------m_erro-----cutpoNCA si 'Totalrc ROU0z]A-ed ) weS���s 0? interaction index INP',__f,mklox interactffff f--------------------------------------------------------1,mk) f! Check argument-------icTbrarptimalrcut poNiox i ROUand/or weS���edo------- mass--------------------------------------------------------1,mk) f! Check argument-------DO i=1, cutare we cut 1d_!cut(iee we ob modiri�slMAature we do it .AND.rweS���s(ee1nfo) 1.0_MK,mhe ordox wayyyyyyypwe poN1d_p-(ie/p-(pcp1etractffff fLSErthodox wayyyypwe poN1d_0.0_MK-----------fkDEA dox wayyyymidpoNf f _alloc-(cut bcutx n)1+ (0.5_MK*felloc-rcut )etractffff cpoN(ie1d_pwe poN*pmass1+ymidpoN*(�mass+gmassetractffff cpoN(ie1d_cpoN(ie/tmass-le_typeeeee-------------------------------------------------1,mk) f! Check argu dox wayyyy! E inrcify fff_alx n 'B ROUrespectedox nbpd,eeee-------------------------------------------------1,mk) f! Check argu dox wayyyyslMAcpoN(ie-_alloc-(cut bcutx n)1.L) f_alx n 'Brcut )emhe ordox wayyyyyyyycpoN(ie1d__alloc-(cut bcutx n)+_alx n 'Brcut )-----------fkDEA dox wayyyyslMA_sionel(cut bcutx n)-cpoN(ie1.L) f_alx n 'Brcut )emhe ordox wayyyyyyyycpoN(ie1d__sionel(cut bcutx n)-_alx n 'Brcut )-----------fkDEA dox wa---DO dox wayyy--------------------------------------------------------1,mk) f! Check argument-------ic --------------------------------------------------------1,mk) f! Check argument--ependent feature we do it the orthodox---1,cutpoNCALL substare we fCALL re we d--------re we f__KIND ==fcer----Lopologyed) cutx n1.Lo) 1,mhe ordox wayyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro-----cutpoNCA si si 'cutx n1mu& be > 0 !ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) SIZELHBX,mk) 2e1.L) fcutx n)1he ordox wayyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro-----cutpoNCA si si ' 'B mBX,mk)1mu& be ffflea& cNEmk)1!ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) SIZELH_box ce2e1.L) fcutx n)1he ordox wayyyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll ffis ghlV,mk) f f f f fCAL-------m_erro-----cutpoNCA si s ' 'B m_box c1mu& be ffflea& cNEmk)1!ractraction index INP',__f,mkk,mklo8888x INP',__fCONT---1stdcogyDO i=1,tttttized) THEtdcogyed) _alloc-(ibcutx n)1.k) f_sionel(ibcutx n)emhe ordox wayyyyyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll ff fis ghlV,mk) f f f f fCAL-------m_erro-----cutpoNCA si 'mBX,mk)1mu& be <d__sionel1!ractraction index INP',__f,mkkkk,mklo8888x INP',__f__fCONT---1stdcogy---DO d8888ll fint feature we -1logh), M.G cer---nse alond(,mk) nbox nbpd,nlrsil,min_box i-1logh), M.G ,mk)cutpoN_s ppm_module_data1,mk) fUSE ppm_module_type-1logh), M.G ,mk)cutpoN_d TINU==� f16003524�021650� 0���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ustar �incardon��������cut D SUBROUTINE#k)clud c"topo/pm_etopo_-----.f" # topof fNTIN--���������������������������������4550��������_KIND ==f250OUBLEtree/pm_etree1d_douTINE ppm_neighlist_vlist_d #endif ��������������������������������������������������libppm-1.224416c/neighlist3ppm2045st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�022222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incardon���������������������������������������������������������������������������������������������������n��������cut --------------------------------------------------------1,mk) f! Check arguments ------s saS�����������������������������, ppm_etree1d_dou----------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free s---------------------stribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) ! You should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License al_td(,mk) nbox nbpd,nlrsil,min_box icensized) THEN1,max_cut _s(xp,Ndest,weS���sin_box max_box censi cutx nbpcutifixedin_bx n 'B,icuti ind,p----#kf ff fNTINU==f f f f fffffGOTO 88licens) censized) THEN1,max_cut _d(xp,Ndest,weS���sin_box max_box censi cutx nbpcutifixedin_bx n 'B,icuti ind,p----#kf NU==f ffffEND SUBROUTINElicefind==f__tbe& cNEElig 'Box in copy of th!! poNiox intmk) f__tgthenScNE 'Box in-#opologf ffffEND SUBROUTIN---------2err_dec ologf f3D-ROUcf! tf!uu cac (==f ffffEND Sgthen)atio1.) frDml Peo, f__tc ROU1fkD) ��������n t D Sst& .) frDf__tgeometfordest, f__tc ����n t D S8-1-#opgthenics its vol---. UarrweS���s(3)! f����n t D Srdju& tBROUsilseededox nbpd,m ffffEND SUBROUTIN---------2err_debe& 'Box i-cNE #opgthenics n_btc f ffffEND Sgeometfo&����ANY Wx_btc mo----hObolicgf ����n t D S( we do it ----#ky of the GNU General Public License1,mk) f!mand the GNU Lesser General Public Lick) ! YoZuric��������(re)d_double------tree-1,mk struct (n,,mk) f! Ms/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriot, ,mk)ake ,mk)s----------------------------------------------------------------------1,mk) fCALL substa---------------1wricate-!H A_les fffff!-1,mk_tree) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm#kf ff fNTINU==f f f f fffffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliffk) f! ,mk) f! Parallel Particlicens useAME !----MKindex Ivariables1,-#enart-license-------------------------------,mkffffGOMPIle_typedeCLUDE 'mpif.h'fffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart- f!-------------------------------------------------------------------uccess1,mk) f!------------------------------------------------------- to xp����n t D SPogf f3D-poNiox in--------------------------------- to _alloc------------Minimum itare we frd��-----R PURPObox.---- to _sionel x: x,y[,z]Maximum itare we frd��-----R PURPObo3per-- to _alx n 'B-----------Minimum 'B aS8-1-#nd ) 'Box in.are we frd��-----R PURPObo3per-- to weS���s-----------WeS���stmk) f__t h c ----bute x in: we do it, ����,f ffffEND Sgeometformk) findlig f__tcut 'Box in.are we frd��-----R PURPOboxper--OPTPObAL-- to ponel x: x,y[,z]A-------hObo eng,mkNdest, specb (lig f__f ffffEND Scomputmk) f-- c ! fnl we do i--k:: boxcost--------!H Cost-R P = pURPOboxn,,mk) fNdestf ffffEND SN PeachObo we do itare we , ) f!!!, 0 list which is to cutare we NE 'Box inare we , ) f!!!, 0 list which is to cutx nare we IDhObox.-! fob_tcutare we LOGICAL R------k:: per-- pURPOboxn,,mk) ffixedare we Set----`TRUE`rmk) dim-nsx is whve 1mu& notob_tcutare we ) PO R------k:: per------!H--------!H !cutare we D 'Box in st& e& cNE. !cut=i ��ain: cNEElig pa cD-ROUorc Lg f--are we ---i-,mk axis.license!1.. cut-rr_de 'Box in r----rtedare we f ,mkf__tm favorcle Meirst--k:: boxcost--------!H Cost-R P = pURPObd_double------- ist),fDIN---) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr--rR PaObox.-1sionel x: childoID, 2nd:-ex oID.-#enart-license--------------------------------------------------------R PURPObotttttiz) f!-------------elloc-------- frd��-----R PURPObotttttiz) f!------------cgeom,c����,cdest,ctotal------------------R PURPObotttttiz) f!------------cdest_tot,shiftare we LOGICAL R------k::tttttiz) f!------------cutm fffre we ) PO R------k::tttttiz) f!------------i--rt------------------R PURPObo cut+1) f!---------- po,p-sumare we -----------------1,mk) fCALL substak)aeturns ,dmare we -----------------1,mk) fCALL substak)aeturn-sumb-suminv,lmyeps------------------------1,mk) fCALL substak)aeturnx,y,z,x2,y2,z2-k:: boxcost--------!H Cost-R PCALL substak)aeturni,j,k,ip,cut bpcp11,mkffffGOMPIle_typedeost--------!H Cost-R PCALL substak)aeturnMPf__KfffGOTO -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr------- :: 2) fINTu----------------------------------------------------------------------1,mk) fCALL substartR ---------uccess1,mk) f!-------------------------------------------------------------------license--------------uccess1,mk) f!----------------------------------1,cut CALL substa,mk_tree) f! Modules fffff!------------lmyepsfNTINU=myepss ppm_module_data1,mk) fUSE ppm_module_typelmyepsfNTINU=myepsdfffGOTO -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr--CALL substa------------1,mk) ftree1d_dou !-------------------------------------------------------------------------1,mk) fCALL substart('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,mk) fCALL substartR ---------uccess1,mk) f!----------------f weibutedsio==f_anU1f 'Box i-----ut, weiogyoaon- 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart---------ed) d NE .L) f1ALL substart('-rRd-----------1,mk) fCALL substart('-art('---- i----wrica-----rank,--------1,cut CA & ell liNo NE 'Box in prese .)ExiElig.'n index INP',__f,CONT---1stdcogymk) f!-------------------------------------------------------------------------1,mk) f! Check argument= pchildr--Computpm_efse---nsx i --1,mk) ftree1d_dou !------------------------------------------------------le_typed--------im,mk) f2 the orthodox wayfelloc-ree1d__sionel(1,cutx n)-_alloc-(1,cutx n)rthodox wayfelloc-r2e1d__sionel(2,cutx n)-_alloc-(2,cutx n)rthodox wayfelloc-r3e1d__sionel(3,cutx n)-_alloc-(3,cutx n)rthodoxELSErthodox wayfelloc-ree1d__sionel(1,cutx n)-_alloc-(1,cutx n)rthodox wayfelloc-r2e1d__sionel(2,cutx n)-_alloc-(2,cutx n)rthodox--------------------------------------------------------------1,mk) f! Check argument= pchildr--DealMODUencNEEa 'Box int ROUb --1,mk) ftree1d_dou !------------------------------------------------------le_typecutm ff1d_.FALSE--k:: boip1d_ status,DO i=1,tttttized) THEtdcod---(.NOT.fixed(i)) .AND.r(felloc-ri)-(2.0_MK*_alx n 'Bri)) & emk) lmyeps*felloc-ri))emhe ordox wayyyyyyyyip1d_ip1+ 1rdox wayyyyyyyycutm ff(ie1d_.TRUE.yyyyyyx INP',__f,CONT---1stdc---DO -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr----itUsilx.-!has notoenoughncNEEa 'Box in--1,mk) ftree1d_dou !------------------------------------------------------le_typed---ip1.L) fd NEALL substart('-rRd-----------1,mk) fCALL substart('-art('---- i----wrica-----rank,--------1,cut CA & ell liNotoenoughncNEa 'Box in!)ExiElig.'n index INP',__f,CONT---1stdcogymk) f!-------------------------------------------------------------------------1,mk) f! Check argument= pchildr--I ROUin c oct in 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk) f! Check argument= pchilded) d NE .EQ f3 .AND.r-----im,mEQ f3 'tree-lrsilsrR Pbcut(ee1d_1-lrsilsrR Pbcut(2the saA_double--bcut(3e1d_3--1stdcogymk) f!------------LSEed) d NE .EQ f2 .AND.r-----im,mEQ f2 the orthodox waybcut(ee1d_1-lrsilsrR Pbcut(2the saA_double--k) f!------------------------------,mkffffGOMPIle_type-------------------------------------------------1,mk) f! Check argument= pchildr--DealMODUenMPId_dou_Part useAME !----MKindex Ivariables1,-#enart-license------------------------------1,mk tree) f! Modules fffff!------------MPf__K1d_MPI_---- ppm_module_data1,mk) fUSE ppm_modu -------MPf__K1d_MPI_-------------thin iff fNTINU==f-------- useAME !----MKindex Ivariables1,-#enart-license----------------------------- pchildr--Computpm_efsgeometforc : pchildr---rmk) 3D f__tcgeom(ee1d_felloc-r2e*felloc-r3e-----------------------cgeom(2e1d_felloc-r1e*felloc-r3e-----------------------cgeom(3e1d_felloc-r1e*felloc-r2e----------Ic ord obtaand/or sum geometforc sist) ) a-` f1------------f__tc n ! fnlaxisfin norm---zs pu ,mkf__tsum ) P s.--- useAME !----MKindex Ivariables1,-#enart-license----------------------------- pchildctotal1d_0.0_MK-------cgeom 1d_0.0_MK-------d---weS���s(3)!nfo) 1.0_MK,mhe ordox wayyyyd--------im,mk) f2 the orthodox way----cgeom(ee1d_felloc-r2e*felloc-r3e---------------cgeom(2e1d_felloc-r1e*felloc-r3e---------------cgeom(3e1d_felloc-r1e*felloc-r2e---------------! norm---zmk) f: totalrc ----bute x i ! fnl we lseeds! f����n t--------! sum up 1 in ord ge --r 'Bo weS���lig.---------------csum =-cgeom(ee+cgeom(2e+cgeom(3e---------------csuminv 1d_1.0_MK/-sumare we way----cgeom(ee1d_cgeom(ee*csuminv---------------cgeom(2e1d_cgeom(2e*csuminv---------------cgeom(3e1d_cgeom(3e*csuminv---------------ctotal(ee=rweS���s(3)*cgeom(ee---------------ctotal(2e=rweS���s(3)*cgeom(2e---------------ctotal(3e=rweS���s(3)*cgeom(3etractffff fLSErthodox wayyyy-cgeom(ee1d_felloc-r2e---------------cgeom(2e1d_felloc-r1e---------------! norm---zmk) f: totalrc ----bute x i ! fnl we lseeds! f����n t--------! sum up 1 in ord ge --r 'Bo weS���lig.---------------csum =-cgeom(ee+cgeom(2e---------------csuminv 1d_1.0_MK/-sumare we way----cgeom(ee1d_cgeom(ee*csuminv---------------cgeom(2e1d_cgeom(2e*csuminv---------------ctotal(ee=rweS���s(3)*cgeom(ee---------------ctotal(2e=rweS���s(3)*cgeom(2e-----------CONT---1stdc--- f--------------------------------------------------------1,mk) f! Check argument-------ic-Computpm_efs����Ac :------------rmk) 2D f__tc����(ie1) THEN(i,cutx n)rthodoxr---rmk) 3D f__tc����(ee1d_) THEN(2,cutx n)*) THEN(3,cutx n)-----------------------c����(2e1d_) THEN(1,cutx n)*) THEN(3,cutx n)-----------------------c����(3e1d_) THEN(1,cutx n)*) THEN(2,cutx n)rthodoxME !----MKindex Ivariables1,-#enart-license----------------------------- pchildc����Ad_0.0_MK-------d---clis STAT .AND.rweS���s(2)1nfo) 1.0_MK,mhe ordox wayyyyd--------im,mk) f2 the orthodox way----c����(ee1d_) THEN(2,cutx n)*) THEN(3,cutx n)---------------c����(2e1d_) THEN(1,cutx n)*) THEN(3,cutx n)---------------c����(3e1d_) THEN(1,cutx n)*) THEN(2,cutx n) ---------------! norm---zmk) f: totalrc ----bute x i ! fnl we lseeds! f����n t--------! sum up 1 in ord ge --r 'Bo weS���lig.---------------csum =------c����(ee,---+-----c����(2e,---+-----c����(3),---rthodox wa-----csuminv 1d_1.0_MK/-sumare we way----c����(ee1d_c����(ee*csuminv---------------c����(2e1d_c����(2e*csuminv---------------c����(3e1d_c����(3e*csuminv---------------ctotal(ee=rctotal(ee1+ (weS���s(2)*c����(eee---------------ctotal(2e=rctotal(2e1+ (weS���s(2)*c����(2ee---------------ctotal(3e=rctotal(3e1+ (weS���s(2)*c����(3)etractffff fLSErthodox wayyyy-c����(ee1d_) THEN(2,cutx n)---------------c����(2e1d_) THEN(1,cutx n)---------------! norm---zmk) f: totalrc ----bute x i ! fnl we lseeds! f����n t--------! sum up 1 in ord ge --r 'Bo weS���lig.---------------csum =------c����(ee,---+-----c����(2e,---rthodox wa-----csuminv 1d_1.0_MK/-sumare we way----c����(ee1d_c����(ee*csuminv---------------c����(2e1d_c����(2e*csuminv---------------ctotal(ee=rctotal(ee1+ (weS���s(2)*c����(eee---------------ctotal(2e=rctotal(2e1+ (weS���s(2)*c����(2ee-----------CONT---1stdc--- f-1stdc--------------------------------------------------------1,mk) f! Check argument-------ic-Computpm_efs we do it ----:kf__tm ------Obolicgf ����n t ------------------------------------------------1,mk) f! Check argument-------cdestAd_0.0_MK-------d---clis we do it .AND.rweS���s(ee1nfo) 1.0_MK,mhe o-1stdc-------�n t ------------------------------------------------1,mk) f! Check argum-------�n t c-Computpm_efsc lR PaO we do itare we �n t ------------------------------------------------1,mk) f! Check argum-------�n tshift(ee1d_0.5_MK*(_alloc-(1,cutx n)+_sionel(1,cutx n))-------�n tshift(2e1d_0.5_MK*(_alloc-(2,cutx n)+_sionel(2,cutx n))-------�n td--------im,mEQ f2 the orthodox waaaaaaDO k=---------(1,cutx n),---------(2,cutx n)rthodox wayyyyyyyyyip1d_------pdx(k)rthodox wayyyyyyyyyx1d_xp(1,ip)-shift(eerthodox wayyyyyyyyyy1d_xp(2,ip)-shift(2e---------------yyyyx21d_x*xrthodox wayyyyyyyyyy21d_y*yrthodox wayyyyyyyyydm1d_1.0_MK-------------------d------SRPObp----#)ydm1d_p----(ip)rthodox wayyyyyyyy-cdest(ee1d_cdest(ee1+ (y2*dm)rthodox wayyyyyyyy_cdest(2e1d_cdest(2e1+ (x2*dm)rthodox wayyyyy---DO dox wayyyy-LSErthodox wayyyy-shift(3e1d_0.5_MK*(_alloc-(3,cutx n)+_sionel(3,cutx n)) ---------------DO k=---------(1,cutx n),---------(2,cutx n)rthodox wayyyyyyyyyip1d_------pdx(k)rthodox wayyyyyyyyyx1d_xp(1,ip)-shift(eerthodox wayyyyyyyyyy1d_xp(2,ip)-shift(2e---------------yyyyz1d_xp(3,ip)-shift(3e---------------yyyyx21d_y*y+z*zrthodox wayyyyyyyyyy21d_x*x+z*zrthodox wayyyyyyyyyz21d_x*x+y*yrthodox wayyyyyyyyydm1d_1.0_MK-------------------d------SRPObp----#)ydm1d_p----(ip)rthodox wayyyyyyyy-cdest(ee1d_cdest(ee1+ (x2*dm) ---------------yyy-cdest(2e1d_cdest(2e1+ (y2*dm)rthodox wayyyyyyyy_cdest(3e1d_cdest(3e1+ (z2*dm)rthodox wayyyyy---DO dox wayyyy-ONT-- EffffGOMPIle_typeeeee-------------------------------------------------1,mk) f! Check argum dox wayyyy! AllreducehObo we do irc sile_typeeeee-------------------------------------------------1,mk) f! Check argum dox wayyyy--- iMPI_Allreduce(cdest,cdest_tot,-----im_MPf__K,MPI_SUM,yyyy e----commpmorex ob modiri�slMAX_BO1,mk) 'tree-lrsilsrR PPPPPro--------------------- -----------TNES_ml P) 'Box interacmpi---il,--------1,cut CA & ell liMPI_AllreducehObolicgf --nsk) f-iled!ractraction index INP',__f,mkkkx interactractffff fkDEAile_typeeeeecdestAd_cdest_totNTINU==f-------dc-------�n t ------------------------------------------------1,mk) f! Check argum-------�n t c-Norm---zsm_efs we do i onel x: x,y�n t ------------------------------------------------1,mk) f! Check argum-------�n td--------im,mk) f2 the orthodox way----csum 1d_cdest(ee+cdest(2e+cdest(3erthodox wa-----csuminv 11d_1.0_MK/-sumare we way----cdest(ee11d_cdest(ee*csuminv---------------cdest(2e11d_cdest(2e*csuminv---------------cdest(3e11d_cdest(3e*csuminv---------------ctotal(ee =rctotal(ee+(weS���s(ee*cdest(ee----------1,---------------ctotal(2e =rctotal(2e+(weS���s(ee*cdest(2e----------1,---------------ctotal(3e =rctotal(3e+(weS���s(ee*cdest(3e----------1,-----------fLSErthodox wayyyy-csum 1d_cdest(ee+cdest(2erthodox wa-----csuminv 11d_1.0_MK/-sumare we way----cdest(ee11d_cdest(ee*csuminv---------------cdest(2e11d_cdest(2e*csuminv---------------ctotal(ee =rctotal(ee+(weS���s(ee*cdest(ee----------1,---------------ctotal(2e =rctotal(2e+(weS���s(ee*cdest(2e----------1,-----------CONT---1stdc--- t cature we do itf -------------------------1,mk) fCALL substartR ---------uccess1,mk) f!---------------SorE 'Box in in decrea) fU ord cs (otalrc . Wyoao notoseed ----------norm---zsdctotal1cs SUM(weS���s), ) fce weiogyoonly����sres itfand/or ----------ORDERhObo 'Box in co noto/or actualrc valuen-#opologf---------------1,mk) fCALL substartR ---------uccess1,mk) f!------------d--------im,mEQ f2 the orthodox waai--rt(1:2e =r(/1,2/x ob modiri�slMActotal(2e .L) fctotal(ee)ai--rt(1:2e =r(/2,1/x ob modfLSErthodox wayi--rt(1:3e =r(/1,2,3/x ob modiri�slMActotal(2e .L) fctotal(ee)ai--rt(1:3e =r(/2,1,3/x ob modiri�slMActotal(3).L) ctotal(ee.AND.ctotal(3).L) ctotal(2)emhe o,---------------i--rt(3e =ri--rt(2erthodox wa-----i--rt(2e =ri--rt(eerthodox wayyyyyi--rt(ee1d_3--1stdcogym-LSEed) ctotal(3).L) ctotal(i--rt(2e)emhe ordox wayyyyyyyyi--rt(3e =ri--rt(2erthodox wa-----i--rt(2e =r3-----------CONT---1stdc--- ---------------------------------------------------------1,mk) f! Check argument= pchildr--Assignfd NE& e& non-fixed 'Box in in ascendlig ord !cutare we ------------------------------------------------1,mk) f! Check argument= pchildip1d_ status,i 1d_1-lrsilsDO WHILE (-ip1.L) fd NEAL.AND.r(i1.Lo) tttttiz)erthodox wa-k =ri--rt(ix ob modiri�slMAcutm ff(k)emhe ordox wayyyyyyyyip1d_ip1+ 1rdox wayyyyyyyy!cut(ipe =rk-----------CONT---1stdctus,i d_i1+ 1rdox wa---DO -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr-- -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pependent feature we do it the orthodox---1,cut CALL substare we fCALL re we d--------re we f__KIND ==fcer----Lopologyed) cutx n1.Lo) 1,mhe ordox wayyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro-----cut CA & & ell'cutx n1mu& be > 0 !ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) SIZELHBX,mk) 2e1.L) fcutx n)1he ordox wayyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro-----cut CA & & ell' 'B mBX,mk)1mu& be ffflea& cNEmk)1!ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) SIZELH_box ce2e1.L) fcutx n)1he ordox wayyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro-----cut CA & & ell' 'B m_box c1mu& be ffflea& cNEmk)1!ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyDO i=1,tttttized) THEtdcogyed) _alloc-(ibcutx n)1.k) f_sionel(ibcutx n)emhe ordox wayyyyyyyyyboxn,nBLEVELR P,)y',&1,le_alSE ll ff fis ghlV,mk) f f f f fCAL-------m_erro-----cut CA & & ell 'mBX,mk)1mu& be <d__sionel1!ractraction index INP',__f,mkkkk,mklo8888x INP',__f__fCONT---1stdcogy---DO d8888ll fint feature we -1logh), M.G cer---nse alond(,mk) nbox nbpd,nlrsil,min_box i-1logh), M.G ,mk)cut _s ppm_module_data1,mk) fUSE ppm_module_type-1logh), M.G ,mk)cut _dNTINU==f-f16003524�021650� 0�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ustar �incardon��������nelc . SUBROUTINE#k)clud c"topo/pm_etopo_-----.f" # topof fNTIN--��������������������������������27412�������_KIND ==f433OUBLEtree/pm_etree1d_douTINE ppm_neighlist_vlist_d #endif ��������������������������������������������������libppm-1.224416c/neighlist3ppm2045st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�022222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incardon��������������������������������������������������������������������������������������������������n��������nelc -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr-s saS�����������������������������, ppm_etree1d_dou----------------------------------------------------------------------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free s---------------------stribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) ildr-s should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License al_td(,mk) nbox nbpd,nlrsil,min_box icensized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,----,-pdx,nelc i ind,p----#kf ff fNTINU==f f f f fffffGOTO 88licens) censized) THEN1,max_nelc _d(Nm,weS���sin_box max_box censi lx n,----,-pdx,nelc i ind,p----#kf NU==f ffffEND SUBROUTINElicecomputes f__tc orthObox.-en-#opologf ffffEND SUBROUTIN---------2err_dec ologf f3D-ROUcf! tf!uu cac (==f ffffEND Sgthen)atio1.) frDml Peo, f__tc ROU1fkD) ��������n t D Sst& .) frDf__tgeometfordest, f__tc ����n t D S8-1-#opgthenics its vol---. UarrweS���s(3)! f����n t D Srdju& tBROUsilseededox nbpd,me GNU General Public License1,mk) f!mand the GNU Lesser General Public Lick) ildr-Zuric��������(re)d_double------tree-1,mk struct (n,,mk) f! Ms/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriot, ,mk)ake ,mk)s----------------------------------------------------------------------1,mk) fCALL substa---------------1wricate-!H A_les fffff!-1,mk_tree) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm#kf ff fNTINU==f f f f fffffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliffk) f! ,mk) f! Parallel Particlicens useAME !----MKindex Ivariables1,-#enart-license-------------------------------,mkffffGOMPIle_typedeCLUDE 'mpif.h'fffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart- f!----------------------------------------useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart- f!------------------------------- to _alloc------------r_deminimum x.-en-#opologf ffffEND SUBR1 Rcense!x,y[,z] +fffEND SUBR2nd:S8-1-IDf!------------------------------- to _sionel x: x,y[,z]r_demaximum x.-en-#opologf ffffEND SUBR1 Rcense!x,y[,z] +fffEND SUBR2nd:S8-1-IDf!-------------------------3per-- to weS���s-----------WeS���stmk) f__t h c ----bute x in: we do it, ����,f ffffEND Sgeometformk) fffiniig f__ttotalrc aS8-1.are we frd��-----R PURPOboxper--OPTPObAL-- to ponel x: x,y[,z]A-------hObo eng,mkNdest, specb (lig f__f ffffEND Scomputmk) f-- c ! fnl we do i--k:: boxcost--------!H Cost-R P = pURPOboxn,,mk) fnnel x: x,y[,z] x.-en-----omputpmc mk)--k:: boxcost--- R------k:: per-- pURPOboxn,,mk) f---- x: x,y[,z]Po���sr----first-logf f3D-Rn ! fnlb.-! fodealMODUenc mk)--k:: boND SUBROUonly�seeds! ffundprese Usilis feiogyo ,mk we do it--k:: boxcost--- R------k:: per-- pURPOboxn,,mk) f-pdx-k:: boND SIcens Dy st& s-Rn ! fnlb.-! fodealMODUenc mk)--k:: boND SUBROUonly�seeds! ffundprese Usilis feiogyo ,mk we do it--k:: boxcost--- R------k:: ----- to Nm x: x,y[,z] gr---st& s-Rn ! fnlb.-.are we frd��-----R PURPOboxper------!H--------!H nelc -) ! fnn!r-s stoIvaria) f!le-#eliffk) f! ,mk) f! DUenc mk)--k:22222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incardon���������������������sr-----ncardon��ortoc-r1e*felloc���(ee1elc -) ! fnn!r-s stoIvaria) f!le-#eliffk) f! ,mk) f! DUenc mk)--k:22222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incardon�������������---putpm_efsgeometforc : pchildr---rmk) 3D f__tcgeom(ee1d_felloc-r2e*felloo d-------w 3D f__tcgeom(ee1d_felloc-r2e*felloo d-------w 3D f__tcgeom(ee1d_felloc-r2e*felloo d-------w 3Dox max_box censi lx n,-�����������t--------t1.0_MK/-x: x,y[,z].f" # top ip,iopt,jk:2222222222222222222222222222222222222222222umb-sumnca=> NULL()rt- f!--------------22222222222222222222222222222222222222umb-sumnfEN=> NULL()r,-�����������t--------t1.0_MK/-x: x,y[,z].f" # to :: 2) ].f" # fINTu----------------------------------------------------------------------1,mk) fCALL substartR ---------uccess1,mk) f!-------------------------------------------------------------------license--------------uccess1,mk) f!----------------------------------1,cut CALL substa,mk_tree) f! Modules fffff!------------lmyepsfNTINU=myepss ppm_module_data1,mk) fUSE ppm_module_typel2222e_t P,)y',&1,l-----------------------license--------------uccess1,mk) f!----------------------------------1,mk) fCALL substart('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,mk) fCALL substartR ---------uccess1,mk) f!----------------f weibutedsio==f_anU1f-----------------------license--------------uccess1,mk) f!---------------------------------ox ip do it--k:workponmo---�mass1d_����total*weS���s(2)-------gmass1d_geomtotal*weS���s(3)-------tmass1d_p---------thin iff fNTINU==f-------- useAMEumnca=> umnc������.fSee theumnca=> umnc����������t- f!-- --------------thin iff fNTINU==f-------- useAMEumnfEN=> umnfE������.fSee theumnfEN=> umnfE�d_efsgeometforc -----------------------license--------------uccess1,mk) f!----------------------------------fft-#enart---------ed): ----- fodeal, exi������, ppm_etree1d_dou----------------------------------------------------------------------- ell liNo NE 'Box in prese .)ExiElig.'n index INP',__f,CONT---1stdcogymk) f!--------------2222e_t P --------------------------! fnlb.-!b==f ffffEd--1,mk) f! Check argument= pchildr--Computpm_efse---nsx i u_Part useAME !----MKindex Ivariables1,-#enart-license------------------------------1,mk tree) f! Modules fffff!------------MPf__K1d_MPI_---- ppm_module_data1,mk) fUSE ppm_modu -------MPf__K1d_MPI_-------------thin iff fNTINU==f-------- useAME !----MKindex Ivariables1,-#enart-license----------------------------- pchildr--Computpm_efsgeometforc -----------------------license--------------uccess1,mk) f!----------------------------------omputpmc Allreduce(cdestPTPObAL-- tb.-!boneral t('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,poN1d_0.0_MK-----------fkDEA dox wayyyymidpoNf f _alloc-(cutyyyyypwe----w 3D fffffffffumncfff --------- we do irc sile_typeeffffumnum#enart------- _efs we do i on-(cutyyyj=)-shii),)-shii+1)-ia) f!le-#eliff indexhift(j----------------------------yyy-cdest(2e1d_cdest(2e1+ (y2*dm)rthodox wayyyyyyyy_cdest(3e1d_cdest(3e1+ (umncfff =(umncfff + d(ee+(weS���s(ee*wayyyy! AllreducehseAM we do irc sile_typeeeee-------------------------------------------------1,mk) f! Check argum dox wayyyy--- iMPI_Allr-cgeeduce(cdenum1,cutx n)+_sionel(1,cutx n))-------�n tshift(2e1d_0.5_MK*(_alloc-(2,cutx n)+_sionel(2,cutx n)ee-lrsilsrR PPPPProumncinv,lmwe-------------TNES_mpi---il,--------1,cut CA & ell liMPI_AllreducehObolicgf --nsk) f-iled!ractraction index INP',__f,mkkkx interactractffff2222e_t P -----------------------_totNTINU==f-----educe(cdest,cd------------------------------------------1,mk) f! Check argum-----yyyyypwe----w 3D fffffffffumncfff =fumnum#eny! AllreducehseA _efs we do i Check 'Box in in decrea)---useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart- f!------------------------ddsumi-cgeom 1estPTPObAL-- tb.-!ORDERhObo ('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,mk) fhodox wayi--rt(1:3e =r(/1,yyyyypwe----w 3D fffffffffinpmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffi nd themk) -------hObase al t('---- ffffffffinpmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffx censi ---------------111111111-----------------------i------------i----------------k) f! Check argument= ir--DealMODUei----------------tx n)*) THEN(3,cutx n)--------------- ell 'mBX,mfffx censi ---22222Nm---i-umin*22222Nm-2-i-uminee+(weS���s(ee*wayildr--Computppppp m up 1 in ord ge --r 'Bo weS���npmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffi n---�n tsn)----e K------st,cdemk) stout it --r 'Bo weS���npmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffIF,poN1d_0.0_MK-- ell 'mBX,mff2222e_type�=(umncfff*--fkDEA dox+fx censi *n)---------+,mff--DO d8888ll fint feaaaaaaaaaaaaaaaa *blic Lick)ee+(weS���s(ee*w*csuminv----------mff2222e_type�=(x censi *n)---------+, *blic Lick)ee+(weS���s(ee*w#enildr--Computpwayyyy! Allw*csuminv------yyyyypwe----w 3D fffffffffinpmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffi nd themk) -------hObase al t('---- ffffffffinpmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffx censi -----------------------------------------------i------------i----------------k) f! Check argument= ir--DealMODUei----------------hodox wayfelloc-r2e1d__i(2,cutx n)-_i----------------tx n)*) THEN(3,cutx n)--------------- ell 'mBX,mfffx censi ---22222Nm---i-umin*22222Nm-2-i-umin*22222Nm-3-i-uminee+(weS���s(ee*wayildr--Computppppp m up 1 in ord genl we lseeds! f����n t----�npmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffi n---�n tsn)----e K------st,cdemk) stout it --r 'Bo weS���npmvelist_destroy',t0,info) 1,mk) f!------------------------------w 3D fffffffffIF,poN1d_0.0_MK-- ell 'mBBBBBB2222e_type�=(umncfff*--fkDEA dox+fx censi *n)---------+,mff--DO d8888ll fint feaaaaaaaaaaaaaaaa *blic Lick)ee+(weS���s(ee*w*csuminv----------mff2222e_type�=(x censi *n)---------+, *blic Lick)ee+(weS���s(ee*w#enildr--Computpwayyyy! AllwanU1f-----------------------license--------------uccess1,mk) f!--------------------------------------5_MK*(onmo---�mass1d_����total*weS���s(2)-------gmass1d_geomtotal*weS���s(3)-------tmass1d_p--yed) cutx n1.Lo) 1,mhNULLIFYoumnc)�t- f!-- -------) 1,mhNULLIFYoumnumlogf f3D-ROUcf! _����total*weS���s(2)-------gmass1d_geomtotal*weS���s(3)-------tmass1d_p--y--------orthodox---1,cut CALL substare we fCALL re we d--------re we f__KIND ==fcer----Lopologyyyyyye ordox wayyyyyyboxn,nB2222e_t P,)y',&1,lyyyyyy ll fis ghlV,mk) f f f f fCAL-------m_erro-----cut Cyyyypypwe----w 3D ffffffflSE ll ff fis ghlV,mk) f f f f f fCAL------U==f----cut CA &U== ell 'mBX,mfffk)1mu& be <d__sionel1!ractraction ind ndex INP',__f,mkkkk,mklo8888x INP',__f__fCON2222e_t P --ff--DO d8888ll fint feaaaature we -1logh), M.G cer---nse alond(,mk) nbox nbpd,nlrsil, l,min_box i-1logh), M.G e*wayildr--Computpppwayyyy! Allred _s ppm_module_data1,mk) fUSE ppm_module_type-1logh), M.G ,mk)cut _dNTINU==f-f16003524�021650� 0����������licens) c������������������������������������������������������������������putes f__ogf f3D-incardon��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������27412�������_KIND ==f'-rREtree/pm_etree1d_douTINE ppm_neighlist_vlist_d #endif ������������������������������������������4743�������libppm-17704416c/neighlist3ppm2045st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�022222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa����������nelc -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr-s saS�������� _KIND ==f'-rR-ROUcf! _����total*weS���s(2)-------gmass1d_geomtotal*weS���s(3)-------tmass1d_p--y---------1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free s---------------------stribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) ildr-s should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License al_td(,mk) nbox nbpd,nlrsil,min_box icensized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,----,-pdx,nelc i ind,p----#kf ff fNTINU==f f f f fffffGOTO 88'-rR_s(.yyyyyes,nox w--2err_dec-2e: bowe---: bow ogf ffffEND SUBl anl.-en22222nce.-en-2err_de-enl anls,lstPTinueU=myepsd-,-pdx,nelc i ind,p----#kf NU==f ffffEND SUBROUTINElicecom'-rR_d(.yyyyyes,nox w--2err_dec-2e: bowe---: bow ogf ffffEND SUBl anl.-en22222nce.-en-2err_de-enl anls,lstPTinueU=myepsd- f3D-ROUcf! tf!uu cac (==decide_douba=decom��-----Rby th-rR l1!ractra tf!-rR l1thout ! fnlbo notfuritfanrg,mke INP f__tc ROU1fkD) ��������n t D Sst& Decom��-----Rby tstPsider= pc-rR ifthout ! fnlb---- t D Sst& .yyyyyeswe fRn ! fnlmk) f! G22222nceFITNESS ral t('---- itf!-fx in: visi----(i.e.pe-ild-----------n-empty)('---- itf!yyyesw1d_ elow -en22222nce. Al,mk) tABIly,License1,mk) decom��-----Rby talway th-rR whny nothout e visi---('---- itf!yyyeswex boxc part ,y[,z]mk) +fffENneliffk) fl anls('---- itf!ped-beemicsae-1---tree-1,mk struct (n,,mk) f! Ms/>. ,mk) f! ,mk) f! Parallel Particle Mesh Library (PPM) ,mk) f!kETH Zuriot, ,mk)ake ,mk)s----------------------------------------------------------------------1,mk) fCALL substa---------------1wri) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm#kf ff fNTINU==f f f f fffffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliffk) f! ,mk) f! Parallel Particlicens useAME !----MKindex Ivariables1,-#enart-license-------------------------------,mkffffGOMPIle_typedeCLUDE 'mpif.h'fffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enarx Ivariables1,-#enart-license-------------------------------,mkffffGOMPIle_typedeCLUDE 'mp-------- to _alloc------------r_deminimum x.-en-#opologf ffffEND SUBR1 Rcense!x,y[,z] ) f---- x: x,y[,z]Po��22222222222222222222mputpmc mk)--kassociatotal1d_0 mk)-,mk) f! Parall ---- x: x,y[,z]Po���sr-: bo22222222222gf f3D-Rn ! fnlbin: cNck) f!bt e vidnotfuritfan(i.e.pmk) fnnoD-ROUcf! tf!c-2e: bo����������sr-----ncardon��ortoc-r1e*felloc ! fnl-ROUcf! tf!M +fffENneliffk) fe-ild-----! fnlbof---n-l,momk)--k--- csatR------k:: per-- pURPOboxn,,mk) f---- x: x,y[,z]Po���----22222222222gf f3D-Rn e-ild-----! fnlbl1d_0--n-l,momk)--.!uu cais-----im,22222222222samek) fneliffk) f visi----yyyeswestar gr--g pa cD-largs par-- t D Sst& 2E.yyyyyyx Itware y tsasR------k:: per-- pURPOboxn,,mk) f---- x: x,y[,z]Po���l anl22222222222gf f3D-b.-.----5 anls (.----depth)er fa mk)--k:: boND ncardon��ortoc-r1e*felloc enl anls-ROUcf! tf!M +fffENneliffk) fl anlsb.-!b==fcsatRd.!uenter---swestsoles1s-ROUcf! tf! f! Checsae-1--f! , ,fl anlsbe funlimit1---tree-1r------!H--------!H n) f---- x: x,y[,z]Po��isr-: bo22222222222L boxcos visi----yyyes-k:2222222222222ncardon��ortoc-r1e*felloc en22222nce-ROUcf! tf!M +fffEN22222nceFITNk)--kallow--g !b=tweemiyyyes--ox i.-! ildr-Zuric���he ----- f! -k:2222222222222ncardon��ortoc-r1e*felloc en222222222222222222M +fffENallow--glig f__f ffffE!uenteher 1r---doubar 1,yyeswe ('---- itf!yelow e y ts)--.!! , ,f�s(3)! funlimit1---tree-1---R PURncardon��ortoc-r1e*felloc���(ee1elclstPTinue('---- itf!` `doublotfuritfan--- visi-Rby tle----, `= pc` oitfawisR------k:: per-- pURPOboxn,,mk) f---- x: x���(ee1elc -) ! fnn!r-s stoIvaria) f!le-#eliffk) f! ,mk) f! DUenc mk)--k:22222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incardon�������������---putpm_efsgeometforc : pchildr---rmk) 3 pURPOboxn,,mk) ffffffffffffffffmax_box 2ncr_deindfcr_de22222222222222--rmk) 3 pURPOboxn,,mk) ffffffffffffffffmax encr_dei n,-�����������t--------t1.0_MK/-x: x,y[,z].f" # top j! ,mk) f! DUenc mk)--k:22222222222222222222222222222222222222222222222222222222222222222-1,mk) fCALL substartR ---------uccess1,mk) f!-------------------------------------------------------------------license--------------uccess1,mk) f!----------------------------------1,cut CALL substa,mk_tree) f! Modules fffff!------------lmyepsfN------------------------------k) fUSE ppm_module_typelh-rR P,)y',&1,lyyyyyylstPTinue rt-= pchl-----------------------license--------------uccess1,mk) f!----------------------------------1,mk) fCALL substart('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,mk) fCALL substartR ---------uccess1,mk) f!----------------f weibutedsio==f_anU1 tioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk) fre we fn--! fnlsubstqui������, ppm_etree1d_dou-----------------------------------------------------------------------SE p ell liNo NE 'BolstPTinue rt- ��lig1,yyesw=g pah on--- videral Publi ---------1stdcogymk) f!--------------h-rR P ff--DO d8888ll fin------n-empty1,yyesw---------D-rRE Check argument= Uin c oct in 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk) fre we fn--hout ! fnlb---tNck) f!pot---ut ly!bt e vidnosubs--------1, MERC on---- ('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,�sr-: bo ell liNo NE 'BolstPTinue rt- NE 'Boeee-------------------------------------------------1,mk) f! Check argum dox wayyyymk) fre we f-----! fnlb----eprok) forlsubst MERCaepro222mgum dox wayyyyTHIS SHOULD Ui n liN DECOMP SUBROUTIAND NOT���� liN GENERICgum dox wayyyyTREE ROU1fkD) 'Boeee-------------------------------------------------1,mk) f! Check argum dox way-----SE p e ! fnl ell liMPI_AllreducehObolicgf -onel1!ractraction inex INP',__f,mkkkk,mklo8few----------------h-rR P ff-----------------------Ck) f! pa fcsatR0_MK-- +fffENneliffk) f--n-empty1,yyes! P --------------------e alond(,mk) nbox nbpd,nlpchildr--I ROUin c oct in 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk) f + .----depth!ped-beemicsae-1-subst-----------inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1, enl anls)ExiElig.'n index INP',_-----l anl)ExE. enl anls ell liMPI_AllrelstPTinue rt- NE 'BoP',_----mk) fCALL substll liNo NE 'Boction inex INP',_dcogymk) f!--------------h-rR P ffff--DO d8888ll fint feaaaatM +Nneliffk) fl anlsbcsae-1--fD-rRE Check argument= d,nlpchildr--I RO ROUin c oct id,nlpchildr--I n 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk) fre we f-----! fnlb----eprok) forlsudecom��-----Rby t pa OK('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,�SE p e ! fnl Uin c oct-----------------------license--------------uccess1,mk) f!------------------------------------�n tshift22222nceFITN visi----yyyeral t('---- inpmvelist_destroy',t0,info) 1,mk) f!--------------------------------------------2222222*felloc-r3e------x 2ncr_dfelloc-r3e------xencr_d*fel-HUGcut olo------yyyyypwe---: bo22222222222j) ! ---: bo#eny! Allreduayyyy2222e_tyj------------x 2ncr_dfelx 2ncr_df+ d(ee+(weS���s--1,dmf----cut ol liNo NE 'Boctioxencr_d*= d(ee+(weS���spchildr--I n 3yyy! All--1,�sr-: bo ubstll liNo NE 'Box 2ncr_dfelx 2ncr_d/--rmke---: bowminee+(weS���syyyyypwe---: bo222222222222222j) ! ---: bo#eny! Allredureduandfcr_dyyy2222e_tyj- -lx 2ncr_dy! Allreduredu2222222*fel2222222*+1,dndfcr_d*dndfcr_dny! AllreducehseAllreduredu2222222*fel2222222/--rmke---: bo-1wminee+(weSpchildr--I ROioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk)22222nceFITNk)--sw1d_ elow URPOsholdsudecom��-----Rby tOK('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,2222222* e en22222nce)elstPTinue rt- ioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk)ar 1,yyeswe _ elow UReoxencr_d*fCALL s'-rRE-------inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1, en2222* e en2222e_t)elstPTinue rt- tioa quad- in 2dffffin trivi--are we ------------------------------------------------1,orthodox---1,cut CALL substare we fCALL re we d--------re we f__KIND ==fcer----Lopologyed) cutx n1.Lo) 1,mhe ordox wayyyyyyboxn,nBh-rR P,)y',&1,lyyyyyy ll fis ghlV,mk) f f f f fCAL-------m_erro-----cut CA &�SE p e ell'cutx n1mu& be > 0 !ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) Sh-rR P ffff--DO d8888ll fint 'Neliffk) f--n-empty1,yyesayyyyyyboxellLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro---l anl)E e ell'cutx n1mu& be > 0 !ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) Sh-rR P ffff--DO d8888ll fint 'Neliffk) fl anlsbyyyyyyboxellLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erro---sr-: bo e ell'cutx n1mu& be > 0 !ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) Sh-rR P ffff--DO d8888ll fint 'Neliffk) fyyyesw1n:: boxyyyyyyboxellLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL---m_module_data1,mk) fUSE ppm_module_type-1logh), M.G ,mk)cut _dNTINU==f-f16003524�021650� 0����������'-rR_s������������������������������������������������������������������'-rR_dogf f3D-incardon�������������������������������27412�������_KIND ==f'ive-1loEtree/pm_etree1d_douTINE ppm_neighlist_vlist_d #endif �������������������������������������16423�������libppm-1.532416c/neighlist3ppm2045st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�022222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa����������nelc -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr-s saS�����������������'ive-1loioa quad- in 2dffffin trivi--are we ------------------------------------------------1--1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free s---------------------stribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) ildr-s should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License al_td(,mk) nbox nbpd,nlrsil,min_box icensized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,----,-pdx,nelc i ind,p----#kf ff fNTINU==f f f f fffffGOTO 88'ive-1lo_s(.yyObox.-en-#opoe----.yyyyyyx IP ff--DO d8888llent= --2err_de f3vU=myepsd-,-pdx,nelc i ind,p----#kf NU==f ffffEND SUBROUTINElicecom'ive-1lo_d(.yyObox.-en-#opoe----.yyyyyyx IP ff--DO d8888llent= --2err_de f3vU=myepsd- f3D-ROUcf! tf!uu cac (==f-1losounw -e Gedi--1s-- tb__f ffffALL s' visi--- f__tc ROU1fkD) �������:thefffAls. ,2222*0t, f__tc --n-' visi--- f__tc ized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,-e al_td(k) f!kETH Zuriot, ,mk)ake ,mk)s----------------------------------------------------------------------1,mk) fCALL substa---------------1wri) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_module_data1,mk) fUSE ppm_module_typedef1,mk) fUSE ppm#kf ff fNTINU==f f f f fffffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliffk) f! ,mk) f! Parallel Particlicens useAME !----MKindex Ivariables1,-#enart-license-------------------------------,mkffffGOMPIle_typedeCLUDE 'mpif.h'fffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enarx Ivariables1,-#enart-license-------------------------------,mkffffGOMPIle_typedeCLUDE 'mp-------- to _alloc------------r_deminimum x.-en-fffGOMPIle_typedeCLUDE Rcense!x,y[,z] Lowal D SUBR2nd:22222222222222---------------------3per-- to weS���s-----------WeS���stmk) f__t h c ----bute x in: we do it, ����,f ffffEND Sgeometform Uppal D SUBR2nd:22222222222222---------------------3per-- to weS���s-----------WeS���stmk) f__t h c ----bute x in: we do it, ����,f: per-- pURPOboxn,,mk) f---- x: x,y[,z]Po���sr----first-logf f3D-Rn ! fnlb.-! -1loioa qua22222222222222222222222222*felloc ! fyx I---first-loM +fffENdo iyx Itwar in: --1s-- t-k:2222222222222222222222222222222-- x: x,y[,z]Po��22222222222222222222,cdemssociatotal1d_0! fnl-ROUcf!---R PUR222222222222222222-- x: x,y[,z]Po��ent= 22222222222Flaglb.ell in: cNdi--1s-- tbLL sent= p(i.e.pyyyyy pa cD-e vidno����������sr-----22222222222222222222222222222222222 f3v---first-logf f3D-Rn visi----childip1d_ :: boxcodo i(2222222����������sr-----ncardon��ortoc-r1e*felloc���(ee1elc -) ! fnn!r-s stoIvaria) f!le-#eliffk) f! ,mk) f! DUenc mk)--k:22222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incardon�������������---p2222222222222222222222222222222--rmk) 3 pURPOboxn,,mk) ffffffffffffffffmax_bolmyepw--2elenk:2222222222222222222222222ee1d_felloc-r2e*felloo ms2��������sr-----ncardon��ortoc-rffffffffffffffffmaxiopt,p j! ,mk) Parallele1d_felloc-r2e*felloo d--------w 3D f__tcgeof! DUenc mk)--k:22222222222222222222222222222222222222222222222222222222222222222-1,mk) fCALL substartR ---------uccess1,mk) f!-------------------------------------------------------------------license--------------uccess1,mk) f!----------------------------------1,cut CALL substa,mk_tree) f! Modules fffff!------------lmyepsfN------------------------------k) fUSE ppm_module_typelhive-1lo P,)y',&1,l_typedef1,mk) fUSE ppm#kf ff fNTINU==f f lmyepw myepws������������������������������������������lmyepw myepwdmetforc -----------------------license--------------uccess1,mk) f!----------------------------------1,mk) fCALL substart('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,mk) fCALL substartR ---------uccess1,mk) f!----------------f weibutedsio==f_anU1 tioa quad- in 2dffffin trivi--are we ------------------------------------------------1,mk) fre we fn--! fnlb.-! -1losubstqui������, ppm_etree1d_dou----------------------------------------------------------------------- ell liNo NE 'Boex INP',_dcogymk) f!--------------hive-1lo P ff--DO d8888ll fin----! fnlb.-!b==f-1loEd--1,mk) f! Check argument= Uin c oct in 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,C_tc ,mk) to visi----ch--1s-- tioa quad- in 2dffffin trivi--are we -----------------------------------------------lSE ll ff fis ghlV,mk) f ms2ype�=(2oc-r3E.yyyyyyx I#eny! All useAME !--yyyyypwe----w 3D fffff f3v#enart--w 3D fffff----2222e_type�substlmyepwl liNo NE 'Boctioyyyj=l ff fis ghlV,mk) f f f ff222lenelloc-r2e1dj_i(2,cutx n)j_i----------------ffff----((222len-ms2yj))subslmyepw*222len),cutx(.NOT.ent= yj))l liNo NE 'Boction inffff f3v#enart f3v#enaaria) f!le-#eliff in 3datle-#eliff in 3yyy! Allreducehildr--I n 3yyyioa quad- in 2dffffin trivi--are we ------------------------------------------------1,orthodox---1,cut CALL substare we fCALL re we d--------re we f__KIND ==fcer----Lopologyed) cutx n1.Lo) 1,mhe ordox wayyyyyyboxn,nBhive-1lo P,)y',&1,l) 1,mh ll fis ghlV,mk) f f f f fCAL-------m_erro-----cut CA &� e ell'cutx n1mu& be > 0 !ractraction index INP',__f,mk,mklo8888x INP',__fCONT---1stdcogyed) Shive-1lo P ffff--DO d8888ll fint 'Neliffk) fyyyeswyyyyyyboxellLEVELR P,)y',&1,le_alSE ll fis ghlV,mk) f f f f fCAL-------m_erlSE ll ff fis ghlV,mk) f f f f fCAyyyyx I#en e ymidpoNf f _alloc-(cut1mu& be > 0 !ractraction index INP',__f__f,mk,mklo8888x INP',__fCONT---1stdcogyed) Shive-1lo P ffff--DO d8888ll fint nt '_MK-- +fffENdo iyx Ityyyyyyboxle--nse alond(,mk) nbox nbpd,nlrsil,min_box i-1logh), M.G ,mk)cut ioyyyj=l e----w 3D fffffffff f f fCAL------j=f----cut CA &j= ell 'mBX,mfffk)1mu& be <d__sionel1!ractraction ind ndex INP',__f,mkkkk,mklo8888x INP',__f__fCONhive-1lo P ff--DO d8888ll finfint nt 'ure we -1logh), M.G cer---nse alond(,mk) nbox nbpd,nlrsil, l,min_box i-1logh), M.G e*wayildr--Computpppwayyyy! Allred _s ppm_module_data1,mk) fUSE ppm_module_type-1logh), M.G ,mk)cut _dNTINU==f-f16003524�021650� 0����������'ive-1lo_s������������������������������������������������������������������'ive-1lo_dogf f3D-incardon�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������27412�������_KIND ==Etree/pm_etree1d_douTINE ppm_neighlist_vlist_d #endif ���������������������������������������������152713�������libppm-16675416c/neighlist3ppm2045st_destroy.f������������������������������������������������������0000644�0001752�0001753�00000014252�11616003524�022222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222e_type�ustar �incaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa����������nelc -) ! fnns useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enart-= pchildr-s saS�������� ����������ioa quad- in 2dffffin trivi--are we ------------------------------------------------1--1,mk) fCALL substartf f f f fffffppm_clist_destroy ffffff!-------------------------------------------------------------------------1,mk) f! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1,mk) f!mk) f) f f f f f f fCenter for Fluid Dynamics (DTU) ,mk) f! ,mk) f! ,mk) f! This file is part of the Parallel Particle Mesh Library (PPM). ,mk) f! ,mk) f! PPM is free s---------------------stribute itfand/or modify ffffff! itfunder the terms of the GNU Lesser General Public License 1,mk) f!mas published by the Free Software Foundation, either 1,mk) f!mversion 3 of the License, or (at your option) any later 1,mk) f!mversion. ,mk) f! ,mk) f! PPM is distributed in the hope that itfwill be useful, ,mk) f! but WITHOUT ANY WARRANTY; without even the implied warranty of ,mk) f! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.fSee the ,mk) f! GNU General Public License for more details. ,mk) f! ,mk) ildr-s should have received a copy of the GNU General Public License1,mk) f!mand the GNU Lesser General Public License al_td(,mk) nbox nbpd,nlrsil,min_box icensized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,----,-pdx,------�����ECOMP---,-pdx,nelc i ind,p----#kf ff fNTINU==f f f f fffffGOTO 88's(xp,Np,NmorthOdom.-en-dom.TO 8----P ffff--DO d8888l.yyyyyes,pruneyyyes,.yyyyyyx IP-en22222nce.-en-2err_de ffff--DO d8888lent= - orthObox.-en-#opoe----nchld lx n,----,-pdx,nelc i ind,p----#kf NU==f ffffEND SUBROUTINElicecomdd(xp,Np,NmorthOdom.-en-dom.TO 8----P ffff--DO d8888l.yyyyyes,pruneyyyes,.yyyyyyx IP-en22222nce.-en-2err_de ffff--DO d8888lent= - orthObox.-en-#opoe----nchld lx n,----sgeomet,-pdx,------����TREE---,-pdx,nelc i ind,p----#kf ff fNTINU==f f f f fffffGOTO 88ts(xp,Np,NmorthOdom.-en-dom.TO 8----P fffffffffff--DO d8888l.yyyyyes,pruneyyyes,.yyyyyyx IP-en22222nce.-en-2err_de-enl anls,ff--DO d8888lent= - orthObox.-en-#opo)-sh,hift,-2err_de fffffff--DO d8888lLabINP'nchld e-ild,bl anl.e----nbpl.el anl. lx n,----,-pdx,nelc i ind,p----#kf NU==f ffffEND SUBROUTINElicecomtd(xp,Np,NmorthOdom.-en-dom.TO 8----P fffffffffff--DO d8888l.yyyyyes,pruneyyyes,.yyyyyyx IP-en22222nce.-en-2err_de-enl anls,ff--DO d8888lent= - orthObox.-en-#opo)-sh,hift,-2err_de fffffff--DO d8888lLabINP'nchld e-ild,bl anl.e----nbpl.el anl. lx n,----sgeometforc x icens!f!uu cac (==per withea gublise .----decom��-----R x icens!f!uE !CHANunsevR l1ptig mmultisldip1d (ROM)Uenc itfa x icens!f!2, 4terms8dox unit---bin Les.---, quad.---, x icens!f!oct.---). .----nami,mkbase #elicatter= pcsubsta----s!f!) f! DU(-pdNpoxle---omicsgul017HEN(3) f! DU(-psta----s!f!Nmoxle-ermspurely-omif! G-------hOITNESS domaiR x icens!f!(-pdbofnnel,mk) Nmo----0mk)#-pdx,------����TREE-x icens!f x icens!f!Iare y tfy fffffESS !mvl .---- rmpmc A(connldipvity, x icens!f!l anls,fetc.)t, f__ffffEd,mk) rrthod1---tree-1,!f!Ifdx,------�����ECOMP, art ,yaceudecom��-----Rby -tree-1,!f!'-rR,of thno .---- rmpmc Arrthod1---etforc x icens!f-tree-1,!f!�����n t D Sst& .Remark -tree-1,!f!==============================================================-tree-1,!f!IfdNpoxle, art _0.0_MK--cause al =perdox by -tree-1,!f!giany reeneliff(_0.0_MK-- [ordoxmrthodox]tware n, ox --tree-1,!f!IfdNm--:ee1d_fell> 1, art HEN(-cause al =y -tree-1,!f!giany reeart neliffk) fHEN(3) f! DUenc mox --tree-1,!f!T! G-------h-base al by talway tgiany reeart-tree-1,!f!volume :: boxcoox --tree-1,!f-tree-1,!f!T! sS ral t-nami,mkCent com��-e uE !Cart-tree-1,!f! L substar--tree-1,!f-tree-1,!f!mk) fCcom�_222tes22nby t pa made :bsolemk)reeary -tree-1,!f!c (==E ctshiftlatter-namigrace!mvlyepro==f--e, x icens!f!( any prime) neliffk) fequiyx Idn--- omaiRs, x icens!f!wfre estar cac (==Checs FrecfEd,to3) wy fnoD-ROUcf! tf!2, 4terms8d( witequiyx Idn---s!)--tree-1,!f-tree-1,!f!childi com�,mk)yyyeral ttwareecomcut��- x icens!f!(E ctswS doshiftaTINU==f-- fre wenyway),mk) rrthod x icens!f! frm. recom�,mk)(ls. ,�����putes f)lb.-.ar cut-tree-1,!f!min_nlblre wshift1---tree-1,!f!==============================================================-ioa quad- in 2dffffin trivi--are we ------------------------------------------------1,) f!kETH Zuriot, ,mk)ake ,mk)s----------------------------------------------------------------------1,mk) fCALL substa---------------1wri sub�����ioa qua-----------1wri) f! Modules fffff!--------------------------------------------1,mk) fUSE ppm_modulealloc-1,mk) fUSE ppm_module_data1,mk) ffUSE ppm_module�����alloc-1,mk) fUSE ppm_module�����'ive-1loioa quafUSE ppm_module�����cutchiioa quafUSE ppm_module�����cut��- x icenfUSE ppm_module�����puteuodules fffff!---------�����putes f-1,mk) fUSE ppm_module�����'-rR-ROUcf!fUSE ppm_module lf!---sta---------------1wri ecom�sta----USE ppm_module_typedef1,mk) fUSE ppm#kf ff fNTINU==f f f f fffffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliffk) f! ,mk) f! Parallel Particlicens useAME !----MKindex Ivariables1,-#enart-license-------------------------------,mkffffGO------------------'mpif.h'fffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enar we do irc sile_tINCLUDE 'mpif.h'--MKindex Ivariables1,-#enart-license-------------------------------,mkffffGO------------------'mp-------- to _alloc------------r_deminimum x.-en-fffGOMPIle_typedeCLUDE Rcense!x,y[,z] xp-tree-1,!f!T! G-----) f! DeCLUDE Rcense!x,y[,z] 22222*felloc -dom-tree-1,!f!M +fffEND SUBR2nd:OITNESS domaiR x icen Rcense!x,y[,z] 22222*felloc en-dom-tree-1,!f!M +fffEND SUBR2nd:OITNESS domaiR x icen Rcense!x,y[,z] 22222*felloc ! fyx I---first-loM fENdo iyx Itwar in: ildip1d_ x icen Rcense!x,y[,z] 3,2222*felloc ---first-loW Lfc part URPOeeom 1estPTPObAL-- tb(_0.0_MK--,fHEN(sta----s!f!) f! D,!volume) (per-- to )Lfc pyyyeral )(llic Lic:,1)),mk) f! -tree-1,!f!cto pmc Allr.ar cut!min_nlb(llic Lic:,2))--tree-1 Rcense!x,y[,z] 22222OPT AL22*felloc p222222222222222--------k) fl ) fnnNp, ,y[,z]y !Cart-tree-1,!f!lig f__fboxco-----) f! --tree-1---R PUR222222222222222222-- x: x,y[,z]Po��ent= 22222222222Flag in: cN.ell Lfc pboxcoopacut -ch--1s-- i(222ee1d_fellindi =y -tree-1,!f!ent= p(i.e.pno cuts=perpMKincul017to3 f! reNallow--). ent= =(F,F,T)('---- itf!her 1e.g. e rf--z-pMKciludecom��-----Rs--tree-1---R PURRRRRRRRRRRRRRRRR22-- x: x,y[,z]Po��pruneyyyes('---- itf!`= pc` to3)runepart UPOeeto3 stPTaiR-! fnlbof---n-l,momk)----tree-1,!f!` `dto3gef! UPOeels. ,ar 1,yyesw(alsoshiftempty1-rRs)--tree-1 Rcense!x,y[,z] 22222222222222222 M +. ext--- t222222222222-tree-1 Rcense!x,y[,z] 22222222222222222 M +. ext--- t222222222222-tree-1�sr-----222222222222222222-- x: x,y[,z]Po��Nm-tree-1,!f!Neliffk) fgrid3) f! DUencf! G-lobK*(onsh. (0,0,0)lb.-.arut is('---- itf!n--hnsh. mk)afHEN(3isw-------,22222222222---srinlbl1r 1,mkalign= 22222222222ls. ,HEN(3)in_nl mk)--k:: boND ncardon��ortoc-r1e*felloc Np-tree-1,!f!Neliffk) f-----) f! D--tree-1,!f!Ifd<=le, decom��-----Rby tbase #el-------hOmk) HEN(3 mk)--k:: boND ncardon��ortoc-r1e*felloc TO 8-----tree-1,!f!T---k) fHultisldip1d D ==E OrR lf:-tree-1,!f-tree-1,!f!*������_0.a�������piR x icens!f!*������_0.a�������quad x icens!f!*������_0.a�������oc )(3D3 )-tree-1,!f-tree-1,!f!Fc pyin Le, quad-ermsoc -D ==E mk)--k:: boND ncardon��ortoc-r1e*felloc ! fnl-ROUcf! tf!M +fffENneliffk) fe-ild-----! fnlb(leav-- of---n-l,momk)--k---bt-tree-1,!f!lcsatRd.!ox i.r ca----1lb.-.arut is!n--h +fffENrequire INP f__tc 22222222ncardon��ortoc-r1e*felloc en22222nce-ROUcf! tf!M +fffEN22222nceFITNk)--kallow--gb=tweemiyyyes-- .----r---swes-ROUcf! tf!soles1sshift22222nceFITNral ttok)ar 1,yyesw1d_ elow UR1d_ en--tree-1,!f!ox i.r ca----1l---he ----- f! !lcatare 1,mk) f!m22222222ncardon��ortoc-r1e*felloc en222222222222222222M +fffEN al =perdfffE!S-- visi-Rbher 1r---22222222222estsoles1s)ar 1,yyesw MERCral tt elow UR1d_value.!ox i.r ca----1 x icens!f! ot pa im��-eer Genimit���������sr-----ncardon��ortoc-r1e*felloc���(ee1elc�sr----first-lo . mneliffk) fyyyes��������sr-----ncardon��ortoc-r1e*felloc���(ee1elc -) ! fnn!r-s stoIvaria) f!le-up#eliffk) f! ,mk) �sr-----22222222222222222222222222222222222 chld-tree-1,!f!Neliffk) fe-ildren :: boxcodo .---,-pdx,------����TREE-x icen:: boND ncardon��ortoc-r1e*felloc enl anls-ROUcf! tf!M +fffENneliffk) fl anlsb.-! csatR-!uenter---swestsoles1s-ROUcf! tf! f! Checsae-1--f ropa c222, f__tc l anl)1--ox i.-!<rt--w 3D f,!f!ermsunlimit1-fl anls.!uu caifCALL ca Rn ! fnlencf! -w 3D f,!f!��TREEtfy ffff,t pa incf! G���ECOMPicense 1,mk) f!m Rcense!x,y[,z] 222222222222222222222222222222222222222222,cdeok)ar 1,yyesw2222222���������sr-----22222222222222222222222222222222222LabINP x icens!f!Iato t2222222LabINP c222:: boxcodo .�����_0.a��e is,mkeddoublosta----s!f!)abINP (i.e.propa c22)! ,mk) �sr-----22222222222222222222222222222222222 bpl-ROUcf! tf! femneliffk) fyyyes=perdl anl. L anl)1L cat ropa c22���������sr-----22222222222222222222222222222222222bl anl22222222222.----5 anl2:: boxcodo .�2222222� L anl)1L cat ropa c22���������sr-----2222222222222 22222222222222222)-shsta----s!f!) f! e17to3firl )(1 Omk) lal )(2 O-----) f! ----sta----s!f!hift)Uenc m.----222� uu cais- Rn ! fnlepsta----s!f!NpoxleE Or R f! DUfffESS 5_MK*(prok) for! reNstPsider= --tree-1,!f!EPTPOe Lfc p--n-lea fyyyes= reN aruR ift`pruneyyyes= `��������sr-----22222222222222222222222222222222222hift-tree-1,!f!P f! e1sb.-!t! G-----) f! D---- xp)Uenc m.----222� B222,b-tree-1,!f!li pmc tb) f! D-hift()-sh---ib):()-sh-2-ib)))---first-lo cais- Rn ! fnlep!NpoxleE Or R f! DUfffESS 5_MK*sta----s!f!)rok) for! reNstPsider= -!EPTPOe Lfc p--n-lea fyyyes= resta----s!f! aruR ift`pruneyyyes= `��������sr-----2222222222222 22222222222222222e-ild x icens!f!Iaticedeok)ar 1e-ildren :: ffffE!-tree-1,!f-tree-1,!f!per-- to e-ild ID --bute x in: we do it,���������sr-----ncardon��ortoc-r1e*felloc���(ee1elc�l anl22222222222Tfemneliffk) fl anls.!L anl)1L cat ropa c22��-MKindex Ivariables1,-#enart-license-------------------------------,mkffffGO------------------'mp222222222222222222222222222222222e_type�ustar �incardon�������������---p2222222222222222222222222222222--rmk) 3222222222222ee1d_felloc-r2e*felloo miRs, ens, EN(dx, EN(dxinv��������sr-----222222222222ee1d_felloc-r2e*felloo f! Nm-tree-1�sr-----2222222222222*ee1d_felloc-r2e*feoo gh2,cNm-tree-1�sr-----2222222222222r2e*felloo d-------w 3D f__tcgeo Rcense!x,y[,z] 2222222222222222222222c��- =>hNULL()__tcgeo Rcense!x,y[,z] 2222222222222222222222c2,cc =>hNULL()__tcgeo�sr-----22222222222222222222222222222222222icut! =>hNULL()__tcgeo Rcense!x,y[,z] 22222222222222222 c! =>hNULL()__tcgeo Rcense!x,y[,z] 22222222222222222 axc! =>hNULL()_--,-pdx,------�����ECOMP-_tcgeo Rcense!x,y[,z] 22222222222222222222222222222 =>hNULL()__tcgeo�sr-----22222222222222222222222222222222222bl anl! =>hNULL()__tcgeo�sr-----ncardon��ortoc-rffffffffffffffffmax�l anl2-MKindex Ivar�sr-----ncardon��ortoc-rffffffffffffffffmax�b2e: boweadd,k2-i-----tree-1�sr-----ncardon��ortoc-rffffffffffffffffmax�b2ealloc.el anlalloc-1,mk) --rmk) 3 pURPOboxn,,mk) ffffffffffffffffmax_bolmyepw-r0,r1, en2222-tree-1---R PURRRRRRRRRRRRRRRRRffffffffffffffffmaxup,noent= -sr 1,e ---firs---R PURRRRRRRRRRRRRRRRRffffffffffffffffmaxlstPTinue('---- �������t--------t1.0_MK/-x: x,y[,z].f" # top j,k,l,iopt,pnexP'ncuowe-pd('---- �������t--------t1.0_MK/-x: x,y[,z].f" # top----n----2222222�������t--------t1.0_MK/-x: x,y[,z].f" # topnexPb2e: bowlctrex Ivar�sr-----ncardon��ortoc-rffffffffffffffffmax�b2e: boalloc-1,mk) �������t--------t1.0_MK/-x: x,y[,z].f" # topnfo2,mnl a,bpc,i! Mo,ie_box icenCHARAC222(LEN=ee1dchar3 pURPOboxn,,mk) f222 esgex Ivariables1,-#enart-license-------------------------------,mkffffGO------------------'mp-1,mk) fCALL substartR ---------uccess1,mk) f!-------------------------------------------------------------------license--------------uccess1,mk) f!----------------------------------1,cut CALL substa,mk_tree) f! Modules fffff!------------lmyepsfN------------------------------k) fUSE ppm_module_type P,)y',&1,l_typedef1,mk) fUSE ppm#kf ff fNTINU==f f lmyepw myepws������������������������������������������lmyepw myepwdmetforc ������lstPTinue rt-= pchl������i---- rtTO 8-------,-pdx,------����TREE-x icenmnl aelloc-l anls-���.fSee themnl aell-1metforc -----------------------license--------------uccess1,mk) f!----------------------------------1,mk) fCALL substart('---- inpmvelist_destroy',t0,info) 1,mk) f!----------------------------------------------1,mk) fCALL substartR ---------uccess1,m------1,-------------f weibutedsio==f_anU1 tioa quad- in 2dffffin trivi--are we ------------------------------------------------1,-1,mk)w n, useAk) f fCALL-----i tgianyioa quad- in 2dffffin trivi--are we ----------------------------------------------- MER__0.0_MK-- rt- NE MER_HEN(333333rt- NE --1,Nposubstart MER__0.0_MK-- rt-= pchl������--1,SIZE(Nm,1))ExE. ee1d_fell'n index INP',_----ee1d_feosubst2 ell 'mBX,----(Nm--)subs1),cutx(Nm-2)subs1),cutx(Nm-3)subs1)3 pURPO--DO d8888ll finfint MER_HEN(3rt-= pchl������o==f_ ell 'mBX,----(Nm--)subs1),cutx(Nm-2)subs1))t MER_HEN(3rt-= pchl������o==f_childr--I n 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,R anrtb.-!t! Ghout efficiINP (,y[,zt zed) decom��-----RbTO 8s!wfre -----------��-si---('---- i PC: De ----d�i-:t pa !mvlyecom�pmc----ye---tree-1, NeEd,to3gublind:O- to :: bosfetc.. f__tc ized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,-e al_tnoent= 3rt-= pchl������lSE ll ff fis ghlV,mk) f ----ent= yi))tnoent= 3rt- NE wayyyy! Allsr 1,e rt-= pchl������--1,llic Lic1,1))E----1ymidpoNsr 1,e rt- NE --1,llic Lic2,1))E----0ymidpoNsr 1,e rt- NE --1,llic Lic3,1))E----0ymidpoNsr 1,e rt- NE --1,llic Lic1,2))E----0ymidpoNsr 1,e rt- NE --1,llic Lic2,2))E----0ymidpoNsr 1,e rt- NE --1,llic Lic3,2))E----1ymidpoNsr 1,e rt- ree-1, ----(i---- .EQ.�����_0.a�������quad))Ecutx (.NOT. MER_HEN())Ecutx O--DO d8!888ll( MER__0.0_MK--))Ecutx (.NOT.pruneyyyes))Ecutx (noent= ))Ecutx --DO d8!888ll(sr 1,e ))Ecutx (ee1d_feosEQ.�2= el! --1,���Sllocthodox el! ex INP',_fCcom�_����(xp,Np,rthOdom.-en-dom.MAX fCAyyyyx I#1), --DO d8!888lllllllllfCAyyyyx I#2= P-en22222nce.-thObox.-en-#opoe---- lx n,-- el! _ el! ex INP',_fCcom�_����(xp,Np,rthOdom.-en-dom.MAX fCAyyyyx I#1), --DO d8!888lllllllllfCAyyyyx I#2= P-en22222nce.-thObox.-en-#opoe---- -- el! _childr--I ! min_bo000dr--I ! _childr--I ! ----(i---- .EQ.�����_0.a�������oct))Ecutx (.NOT. MER_HEN())Ecutx OO--DO d8!888ll( MER__0.0_MK--))Ecutx (.NOT.pruneyyyes))Ecutx (noent= ))Ecutx --DO d8!888ll(sr 1,e ))Ecutx (ee1d_feosEQ.�3= el! --1,���Sllocthodox el! ex INP',_fCcom�_����(xp,Np,rthOdom.-en-dom.MAX fCAyyyyx I#1), --DO d8!888lllllllllfCAyyyyx I#2=,.yyyyyyx I-3) P-en22222nce.-thObox.-en-#opo OO--DO d8!888llllllllle---- lx n,-- el! _ el! ex INP',_fCcom�_����(xp,Np,rthOdom.-en-dom.MAX fCAyyyyx I#1), --DO d8!888lllllllllfCAyyyyx I#2=,.yyyyyyx I-3) P-en22222nce.-thObox.-en-#opo OO--DO d8!888llllllllle---- -- el! _childr--I ! min_bo000dr--I ! _childioa quad- in 2dffffin trivi--are we ------------------------------------------------1,Stout art HEN( ,yacingDU(-pdle----)ioa quad- in 2dffffin trivi--are we -------------------------------------------------1, MER_HEN())liNo NE 'Box N(dx#1) rt(-en-dom#1) - -dom#1))/--rmkNm--)-1wminee+(weS 'Box N(dxinv#1) rt1ymidp/x N(dx#1) NE 'Box N(dx#2) rt(-en-dom#2) - -dom#2))/--rmkNm-2)-1wminee+(weS 'Box N(dxinv#2) rt1ymidp/x N(dx#2nee+(weS 'Bo----ee1d_feosubst2 ell 'mBX,x N(dx#3) rt(-en-dom#3) - -dom#3))/--rmkNm-3)-1wminee+(weS 'Bo 'Box N(dxinv#3) rt1ymidp/x N(dx#3nbox nbpd,nlpchildr--I _childioa quad- in 2dffffin trivi--are we ------------------------------------------------1,Stout art neliffk) fyyyes=mk) cuts=pern--- visi-Rioa quad- in 2dffffin trivi--are we -------------------------------------------------1,i---- .EQ.�����_0.a�������bin ell 'e-pd�=(2 ell 'ecut!=ria) f!le-#el--1,mk) fCALL substartR ---------ex INP',_dcogymk) f!-------------','Ccsat !Cbin Les.---! Check argument= pchildr--I _ --1,i---- .EQ.�����_0.a�������quad)) ell 'e-pd�=(4 ell 'ecut!=r2a) f!le-#el--1,mk) fCALL substartR ---------ex INP',_dcogymk) f!-------------','Ccsat !Cquad-.---! Check argument= pchildr--I _ --1,i---- .EQ.�����_0.a�������oct)) ell 'e-pd�=(8 ell 'ecut!=r3a) f!le-#el--1,mk) fCALL substartR ---------ex INP',_dcogymk) f!-------------','Ccsat !Coc -D ==E Check argument= pchildr--I _ argument= k)1mu& be <d__sionel1!ractractioex INP',__f,mkkkk,mklo8888x INP',__f__fCO P ffff--DO d8888ll fin'unknown UPOeet--- ,y[,z]mk) -nse alond(,mk) nbox nbpd,nlUin c oct in 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,Clea f! ,u---) f! e1t('---- inpmvelist_destroy',t0,info) 1,mk) f!--------------------------------------------NULLIFY(�����)-sh)-------NULLIFY(�����)ift)tioa quad- in 2dffffin trivi--are we ------------------------------------------------1,AllocatR0_----d----structurffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enarx Ivariopt u& be _0.a��alloc_fi������, ppm_etree1d_dou-------------------------------------------------------------------1,Gu----.----rx Itbase #elassx Id uni rmthe Free Si-Rioa quad- in 2dffffin trivi--are we -----------------------------------------------� =ria) f!le-l anl) =ria) f!le--1,Nposubstart'n index INP',_---- en2222222osubstaymidpoNf f _alloc-(cut1mu&f! femneliffk) fl anlsble----le is puni rmt_0.0_MK-_alloc-(cut1mu&f!he Free Si-Rioa quaaaaaaaaael anlalloc =rCEIaloG(LOG(--rmkNpwmin/ en2222e_t)/ PO--DO d8888ll finfintLOG(--rmke-pdwmin)))#-pdx,------�����TREE-x icennnnn_ --1, enl anls)ExiElig.'n index INP',_1mu&f!assx Iubst it enl anls-ROUcf!aaaaaaaael anlalloc =roc-l anls-��forc ������nnnn_ _alloc-(cut1mu&f!hefault!assx pSi-Rioa quaaaaaaaaael anlalloc =r3_alloc-(cut1mu&f!el anlalloc =rMAX NIlocLOG(--rmkNpwmin)/LOG(2oc-r3) P3nee+(weS 'Bo 'Bo! JHW 20061108 ell 'pchildr--I _ argument= ! Assx Iu3fl anlsboublo _0.0_MK-- reNRn ! fn ell 'el anlalloc =r3_alloc-(cutf!el anlalloc =rMAX NIlocLOG(--rmkNpwmin)/LOG(2oc-r3) P3nee+(weS 'Bo! JHW 20061108 ellpchildr--I f! femneliffk) fyyyes=( pa lea s)L cat -------ic sePOe Lsx ll 'el anlalloc =rel anlalloc + 1I f!bst--ab (__tc !Cl anlsbatria) f!le--1,el anlalloc ell el anlalloc =r1-------� alloc =r(1-ke-pd**el anlallocn)/(1-e-pd)a) f!le--1,e alloc ell e alloc =ria) f!le--1,mk) fCALL substartR --,-pdx,------����TREE-x icennnnnWRITE( esg,'(A,I3,A,I6,A)') 'Allocat !C'.el anlallocP ff--DO d8888ll fin-Cl anlsbak) ',�b2ealloc.'iyyyes-'-���.fSee thennnnWRITE( esg,'(A,I3,A)') 'Allocat !C'.eb2ealloc.'iyyyes-'-��forc ������nnnnex INP',_dcogymk) f!-------------', esg,mk) nbox nbppchild--,-pdx,------����TREE-x icenex INP',_�����alloc(iopt,�b2ealloc.e-pdwel anlallocP-thObox.-en-#opo OO--DO d8888ll-2err_deLabINP'nchld e-ild,bl anl.e-plU=myepsd-,-pdx,------�����ECOMP-_tcgeoex INP',_�����alloc(iopt,�b2ealloc.e-pdw-thObox.-en-#opo OO--DO d8888ll-2err_denchld bl anl. psd- f3D-ROUcf!--1,---------- be _0.a��iffk) f Uin c oct-----------------------license--------------uccess1,mk) f!---------------------------------AllocatR0memoLesfc pyyyeru������, ppm_etree1d_dou------------------------------------------------------------------ldc#1) rtff fis ghlV,mkldc#2) rt2**eru������, ex INP',_alloc( c,ldc,iopt,pn) nbox nbp--1,--------ig.'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffffDO d88-DO d8888ll fin-lowal D SUBR2nd:22222newfyyyes=MINCnse alond(,mk) nbox nbpd,nlUin c oct in 3da �����, ex INP',_alloc( axc,ldc,iopt,pn) nbox nbp--1,--------ig.'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffffDO d88-DO d8888ll fin-uppal D SUBR2nd:22222newfyyyes=MAXCnse alond(,mk) nbox nbpd,nlUin c oct in 3da �-----------------------license--------------uccess1,mk) f!---------------------------------AllocatR05_MK*(d----structurffGOTO 88licens useAME !----MKindex Ivaria) f!le-#eliff fNTINU==f fft-#enarx Ivar-sr-: bo =r1-------� : boalloc =r10*e-pd**,el anlalloc-1)-----: bo ) fl av--. gu---.. f__tc e decatR010 timeswyout ,yaceufc pl av--... JHW 20061108 ellldc#1) rt�b2e: boalloc-1,mk) ex INP',_alloc(b2e: bowldc,iopt,pn) nbox nbp--1,--------ig.'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffffDO d88-DO d8888ll fin-: bo ) f visi----yyyes=BOXLISTnse alond(,mk) nbox nbpd,nlUin c oct in 3da �����, b2e: bo#1) rt1---------1, MER_HEN())liNo NE 'Boldc#1) rtff fis ghlV,mk 'Boldc#2) rt�bpd('---- mk) ex INP',_alloc(Nmc,ldc,iopt,pn) nbox nbp nbp--1,--------ig.'n index INP',_P',_k)1mu& be <d__sif---l ������nnnnnnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffffDO d88-DO d8888ll fin fin-: bo ) f visi----yyyes=BOXLISTnse alond(,mk) nbox nbpd,nld,nlUin c oct i in 3da �����, n 3da �����, --1, MER__0.0_MK--))liNo NE 'Boldc#1) rt2**eru������, mk) ex INP',_alloc(c#opo)dc,iopt,pn) nbox nbp nbp--1,-------------'n index INP',_P',_k)1mu& be <d__sif---l ������nnnnnnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ff8-DO d8888ll fin fin-tempoU Lesyyye) f! e1t CBOXnse alond(,mk) nbox nbpd,nld,nlUin c oct i in 3da�����, mk) ex INP',_alloc(npbpo)dc,iopt,pn) nbox nbp nbp--1,-------------'n index INP',_P',_k)1mu& be <d__sif---l ������nnnnnnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ff8-DO d8888ll fin fin-neliffk) f_0.0_MK-- perdfff NPBXnse alond(,mk) nbox nbpd,nld,nlUin c oct i in 3da�����, n 3da �-----------------------license--------------uccess1,mk) f!---------------------------------TSS domaiR itselfL cat ropa c22� Gx i.r .----r-22ted!-----------------------license--------------uccess1,mk) f!----------------------------------ee1d_feosubst2 ell 'fCAL----1,1))= -dom#1) ell 'fCAL----2,1))= -dom#2) ell 'fCAL----3,1))= -dom#3nee+(weS 'Bout CA 1,1))= en-dom#1)ee+(weS 'Bout CA 2,1))= en-dom#2)ee+(weS 'Bout CA 3,1))= en-dom#3nbox nbp nbp--1, MER_HEN())liNo NE 'BoooooNm CA 1,1))= Nm#1)ee+(weS 'BoooooNm CA 2,1))= Nm#2)ee+(weS 'BoooooNm CA 3,1))= Nm#3nbox nbpd,nlpchildr--I _ argument= fCAL----1,1))= -dom#1) ell 'fCAL----2,1))= -dom#2) ell 'ft CA 1,1))= en-dom#1)ee+(weS 'Bout CA 2,1))= en-dom#2)ee+(weS 'Bo--1, MER_HEN())liNo NE 'BoooooNm CA 1,1))= Nm#1)ee+(weS 'BoooooNm CA 2,1))= Nm#2)ee+(weS 'Bopchildr--I _childr--I n------I =r1-------�chld--I =r--w 3D fbl anl#1) rt1---,-pdx,------����TREE-x icenLabINP#1) rtff f_0.a��e is,mked-x icene-ild -I =rff f_0.a��e is,mked-x icene-pl(1)---rt1--tforc -----------------------license--------------uccess1,mk) f!---------------------------------R--- art _0.0_MK-DUencf! Gropa c22-----------------------license--------------uccess1,mk) f!---------------------------------- MER__0.0_MK--))liNo NE 'Bo----ee1d_feosEQ.�2=)liNo NE 'Booooo f! Nm(1)---!=ria) f!le-#eloooo f! Nm(2)---!=ria) f!le-#eloooogh2,cNm(1:4nart--w 3D fffffffffex INP',_ lf!---2d(xp,Np,rthOdom.-en-dom. f! Nm,gh2,cNmP ffff--DO d8888ll fint nt�����)ifto)-sh�cut Check argument= p _alloc-(cut1mu& f! Nm(1)---!=ria) f!le-#eloooo f! Nm(2)---!=ria) f!le-#eloooo f! Nm(3)---!=ria) f!le-#eloooogh2,cNm(1:6nart--w 3D fffffffffex INP',_ lf!---3d(xp,Np,rthOdom.-en-dom. f! Nm,gh2,cNmP ffff--DO d8888ll fint nt�����)ifto)-sh�cut Check argument= p 3da�����, mk) --1,---------- be _0.a��iffk) f Uin c octll fint nt�����)-sh---1) rt)-sh�cut#1)ee+(weS 'Bo�����)-sh-2-1) rt)-sh�cut#2) - 1dr--I _child-----------------------license--------------uccess1,mk) f!---------------------------------AllocatR0f! Gwork0memoLesfc pP',_�����-2err_d. Do! f! onceFIutside----------2222222loop� uu caassx Isre n, art newlyeccsatRdfyyyes= resta----sBo�estRd,222ucat rx It222nbpd f__tc ized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,-e al_tiopt u& be _0.a��alloc_fi������, ldc#1) rt�bpd('---- ex INP',_alloc(c2,ccwldc,iopt,pn) nbox nbp--1,-------------'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffff8-DO d8888ll fin-byyeral ttCOSTCnse alond(,mk) nbox nbpd,nlUin c oct in 3dal_typedef1,mk) fUSE ppm#kf ff fNTINU==f f ex INP',_alloc(pcst_swldc,iopt,pn) nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-------------'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffff8-DO d8888ll fin-_0.0_MK-N al =pab (PCOSTnse alond(,mk) nbox nbpd,nlUin c oct in 3dal_ty do irc _typedef1,mk) fUSE ppm#kf ff fNTINU==f f ex INP',_alloc(pcsum_swldc,iopt,pn) nb���.fSee theex INP',_alloc(pcsum_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-------------'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffff8-DO d8888ll fin-_0.0_MK-N al =sums(PCSUMnse alond(,mk) nbox nbpd,nlUin c oct in 3dal_tforc -----------------------license--------------uccess1,mk) f!----------------------------------om�,mk)lig f__fropa c22-----------------------license--------------uccess1,mk) f!----------------------------------���Sllocthodox el�nnnnex INP',_�����-2err_d(Nm CA,llic Lic:,1)w-thObox.-en-#opo O8-DO d8888ll fin1o)-sh�cut �����)ifto-2err_de lx n,-- el p _alloc-(cutex INP',_�����-2err_d(Nm CA,llic Lic:,1)w-thObox.-en-#opo O8-DO d8888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.a��iffk) f Uin c octll fin-----------------------license--------------uccess1,mk) f!---------------------------------Grow URe-: bo .-!t! Gpropern-x Itas lf!--- has- allocatRd----------io .-!l ) fnn2-----------------------license--------------uccess1,mk) f!---------------------------------- MER__0.0_MK--))liNo NE 'Boiopt & be _0.a��alloc_grow NE 'Boldc#1) rt2**eru�aaria) f!le-#elex INP',_alloc()-sh�cut ldc,iopt,pn) nbox nbp nbp--1,--------ig.'n index INP',_P',_k)1mu& be <d__sif---l ������nnnnnnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffffDO d88-DO d8888ll fin fin-_0.0_MK-N: bo heais p) f! e1t LHBX_CUTnse alond(,mk) nbox nbpd,nld,nlUin c oct i in 3da �����, n 3da �-----------------------license--------------uccess1,mk) f!----------------------------------1,mk) .-.arut is!any f! !Ca-!b=='-rRbatr8ll-----------------------license--------------uccess1,mk) f!------------------------------ex INP',_�����'-rR(.yyyyyes,n----o-2err_deb2e: boweb2e: bow d88-DO d8888llel anl.-en22222nce.-en-2err_de-nl a,lstPTinue,pn) nbox nbp--1,---------- be _0.a��iffk) f Uin c octll fin----(.NOT.lstPTinue))Ecutx (ee1d_CALL substarl liNo NE 'Boex INP',_dcogymk) f!------------- P ffff8-DO d8888ll fin-No f! !Ca-!b=='-rR--1,mk) f! Check argumen 3datioa quad- in 2dffffin trivi--are we ------------------------------------------------1,C1,mk)e n, ropa c222, f visi--------------------------license--------------uccess1,mk) f!------------------------------ex INP',_�����'ive-1lo(-thObox.-en-#opo1,.yyyyyyx IPent= - ffff8-DO d8888ll-2err_den'iv,pn) nbox nbp--1,-------------Uin c octll fin---- f3v#1n eeru�))liNo NE 'BolstPTinue rt- NE fin----mk) fCALL substartR ---------ex INP',_dcogymk) f!-------------', ffff8-DO d8888ll fin fin--1,cut domaiR i t pa visi---. Don=E Check argument= pchildr--I _child-----------------------license--------------uccess1,mk) f!---------------------------------AllocatR0memoLesfc pru�a ildip1d_bak) ��-----Rsf__tc ized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx n,-e al_tiopt & be _0.a��alloc_fi������, ldc#1) rt�ru������, ex INP',_alloc(icut ldc,iopt,pn) nbox nbp--1,-------------'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffff8-DO d8888ll fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcut!=rff f_0.a��e is,mked-x icenex INP',_alloc(c��- ldc,iopt,pn) nbox nbp--1,-------------'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffff8-DO d8888ll fin-: bo ) fru�a��-----Rs CPOSnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_c��- = -HUGE(c��-#1))dioa quad- in 2dffffin trivi--are we ------------------------------------------------1,S-- vide tc l '-rR-ROUcf!ppm_etree1d_dou------------------------------------------------------------------lctrart--w 3D fDO WHILE (n, ropa c2oaaaariI--------------ex INP'un trivi_----io .-!l ) fnn2----MK-- +fffEn int2 s1,ooooNm CA 2,1))=----'n ind---------h----exi,.e-plU-----------ex INP',_�����'ive-1lo(-thObox.-en-#opo1,.yyyyyyx IPent= - ffff8-DO d8888ll-2err_den'iv,pn) nbox nbp--1,-------------Uin c octll fin---- f3v#1n edse alond(,m f! D,!volume) (per-- to )Lfc pyyyeral )(llic Lic:,1)),mk) f! -tree-1,!f!cto pmc Allr.ar cut!'ftCO _MKto )Lfc proc w-----------------1,i---- .EQ.�����_0.a�������nnnex Ipm_etree1dnn2----MK-ex INP',___ bo heais p) f!������nnn Nm-tree-1�sr-----2222222222222*ee1d_felloc-r2e*feoo gh2,cNm-tree-1�sr-----2222222222222r2e*felloo d-------w _CUTnse alond(,mk) nbox nbpd,nld,nlUin c oct P-----) nbox nbpx]tware n, ox --tree-1,!f!IfdNm--:ee1d_fell> 1, art HEN(-cause al =y -tree-1,!f!giany reeart neliffk) fHEN(3) f! DUenc mox --tree-1,!f!T! G-------h-base al by talway tgiany reeart-tree-1o OO--DO d8888ll-2err_denchld bl anl. psd- f3Ee2n 2dffffin trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oaaaariI-------------k NE r-----sider= -!Eree-1,!ll fdatimk)-edse----ea c2om-----����TR.[ordoxd1--se---3,1))= ,ee-1,!f-t'fCAL----edse----ea c2oe.pno cuts=lc eshes FrecfEd,to3) wy fnoD-ROUcf',_af-------------c2o) 'Allocat: x,y[,z]Po��N_allocubeNallow.n 2dffffin trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea x,y[,z]x IPent= x,y[,z])oaaaariI-----ccess1,mk)d- aaaariI-----cced- aaaariI---222*ee1d_fe,mk)c(icut ldc,ioptjd- eru�����i Uin c octll fir0d- eruK--))j Uin c octll fifDO r0d��������--1,mk��������������'ive-1lo_x,y[,z]x Irde----------2222I-----ccess1,mk)d- ie----------2222I-----cced- je----------2222,max_nelc _s(N���������������l 'e-pd�=(2 ell 'ecut!=ria) f!le-#ins Nm,gh2,--h-base -ccedcogymk) f!------ins 2m,gh2,--h-base2 -ccedcogymk) f!------ins 3m,gh2,--h-base3 -ccedcogymk) f!------axs Nm,gh2,--:ee1d_fel-ccedcogymk) f!------axs 2m,gh2,--:ee1d_2 -ccedcogymk) f!------axs 3m,gh2,--:ee1d_3 -ccedcogymk) f!------------license--------------uccessssssss1,mk) f!=s1,mk) f!- -ccedcogymk) f!-----ssssss1,mk)2f!=s1,mk) f2 -ccedcogymk) f!-----ssssss1,mk)3f!=s1,mk) f3 -ccedcogymk) f!-----,max_nelc _s(N�--------------ucce#ins Nm,gh2,--h-base -ccedcogymk) f!------ins 2m,gh2,--h-base2 -ccedcogymk) f!------axs Nm,gh2,--:ee1d_fel-ccedcogymk) f!------axs 2m,gh2,--:ee1d_2 -ccedcogymk) f!------------license--------------uccessssssss1,mk) f!=s1,mk) f!- -ccedcogymk) f!-----ssssss1,mk)2f!=s1,mk) f2 -ccedcogymk) f!-----,max_nelc _s(N���8ll fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oD��-----e ree-------------(s) fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row URe-: bo .-!t! Gprop cogymk) f!-------------------------sre n, E 'Boiopt & be _0.a��allocNP',_k)1mu& be <d___________________startR ldip1dfc pru�a ii f__tc !-------------_s(N�--- cogymk) f!-------------------------sre n, E 'Boiopt & be _0.a��allocNP',_k)1mu& be <d___________________startR ldip1dfc pru�a ii f__tc ized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oD��-----e ree----[,z]Po��(s) fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row URe-: bo .-!t! Gprop cogymk) f!---------------------- fffre n, E 'Boio2t & be _0.a��allocNP',_k)1mu& be <d___________________startR fc pru�a ii f__-----tc !-------------_s(N�--- cogymk) f!---------------------- fffre n, E 'Boio2t & be _0.a��allocNP',_k)1mu& be <d___________________startR fc pru�a ii f__-----tc ized) THEN1,max_nelc _s(Nm,weS���sin_box max_box censi lx fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oAad-eh----exi,.emk)--k:: boND nc 'Bo 'Box fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row ---license--------------uccess222*ee1dfCO P ff8-DO dddddddddjgh2,i f_�i Uin c octll fiiiiir0d- - fffi)--ins j))*--------',j Uin c octll fiiiiikgh2,A,I6,r0 Uin c octll fiiiiir1h2, 'Allkat *------,j Uin c octll fiiiii- fffi)h2,--hs j)���r����-2err_d. Do!!!!!upmk) f ----ent= yi))te----ea row (r1-r0 l_alloc-(upmk) fi������, ldc#1) trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) t-!b=='-rR--fc pru�a fCALL re utx fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) row ( - fffi)--ins j)) l1) rt1ymidpj)) ORyyx I#1), -1mu& be <d______((-axs j)-- fffi)) l1) rt1ymidpj))e--------------uccessssss row upe--------------uccessssss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss t f---wE vn)/Lp, ox id88lin-.arut is!anycessssss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss kmk)koc(c2,ccwlddddddddddddddddddddd- fffi)h2,--hs j)���( 'Allkat *------,j Uin c octll fiiiiiiiii�--------------uccessss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss t f---wE vn)/d88l, ox iuparut is!anycessssss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss kmk)ko+(c2,ccwlddddddddddddddddddddd- fffi)h2,--hs j)���( 'Allkat *------,j Uin c octll fiiiiiiiii�max_nelc _s(Nssss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivirivi---------uccessssss t-!b=='-rR--fc pru�a fCALL re utx in-.arut is!anycessssss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivirivi---------uccessssss row ( - fffi)--ins j)) l1) rt1ymidpj)) ORyyx I#1), -1mu& be <d__________((-axs j)-- fffi)) l1) rt1ymidpj))e--------------uccessssss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss t fCanx INsd(,m f! Dyyera=E along.a����li ncardon��o--uccessssss t fRe vnnd(,from d88-DO d8 INP',_alloc(npbpo)an fin-: t fnbpd,---------uccessssss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss 222l=-uccess1,mk) d_fe,mk)-c2,ccwlddddddddddddddddddddddddderu�����l)d- eru�����l+-----------------------------���������������lllllllllllllllll���, b2e: b���, b2e:c(c2,ccwlddddddddddddddddddddd 10de----------2222I-------���x_nelc _s(Nssss ���x_nelc _s(Nssss���������������l���8ll fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oSd(,m f! Dyyera=E fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea ------ MER__0.0_MKf_�re startR=>hNULL()_ i f__-----yyyesrx Ivx I#1), -1mu& be license---pdpd f__tc ized) THEN1m,weS���sin_box max_box censi lx fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oUpdmklo88llNmk) nbox sd(-b mnelifikNpwmisrgumen 3dati,mk) f-------------c2o2222sd(-b mn========__0.0_MK--)Npwmisrit. fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row ---license--------------uccess222*ee1dP',_P',_k)1mu&&&&&&&&&Nmce ah2,A,I6, x,y[e a--in[e a)*--------',1))+c2,ccwldddddddddddddNmce2 ah2,A,I6, x,y[e2 a--in[e2 a)*--------',2))+c2,ccwlddddddddddddd 'e-pd�=(2 ell 'ecut!=ria) f!le-ddddddddNmce3 ah2,A,I6, x,y[e3 a--in[e3 a)*--------',3))+c2,ccwlddddddddddddd���x_nelc _s(Nssss���������������l���8ll fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oUpdmklo88ll���(ee1el_typede------ledse----ea c2olUin boN .-.s eruK--).n 2dffffin trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row URe-: bo .-!t! Gprop cogymk) f!-------------------0_MK--))lic E 'Boiopt & esrx Ivx I#1), -1mu& be <d__)1mu&license---pdpd f__lo88lltc !-------------_s(N�---cogymk) f!-------------------0_MK--))lic E 'Boiopt & esrx Ivx I#1), -1mu& be <d__)1mu&license---pdpd f__lo88lltc !-------------_s(N���8ll fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oAddl_typede------8888ll f---- fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row ---liss1,mk) f!--k) fU =tiopt u& be -ccedcogymk) f!-----tside----------222*ee1dP',_P',_k)1mu&&&&&trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p�_P',_k)1mu&&&&&t f---yyyyyx I-3!f-tset,) f! e1dSE ppm#k222222---srinlbl1r 1,mka1mu&&&&&trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p�_P',_k)1mu&&&&&row (yyyyyx I-3!v,pn) ABS(0_MK--))i)) e1 tioa) ORyyx I#1), -1mu& be <d__8888ll-yyyyyx I-3)e--------------uccessssss-l an b���,o+(c2,ccwldddddddddddddkdddd=ia) f!le -ccedo+(c2,ccwldddddddddddddrow k ecess1,l 'ecut!=ria) f!le-ddddddddnnn_ k)kcut!=ria) f!le-ddddddddupmk) f ----ent= yi))te----ea �--------------uccessss upmk) fi������, ldc#1) ���8ll fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) t-!ffDO d88-DO dc 'Bo 'Box fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) ------------------1,mk) .-._substrv-------------------1,-1,mk)w n,,,,,,,,,,,,,box.-en- ecbn-#opo OOORyynnn_ ecess1,c.e-pd--------------uccessssss ro.-en- cbn-#opo d8888ll-2er=888ll-2er+ x I#1), -1mu& be <d__________(())liNo NE -1 Uin c octll fiiiiiiiiiro.- aru cess1,c.e-pd-cess1,c.e-p=cess1,c.e-p+c2,ccwlddddddddddddd,,,,box.u������, ex INP',_alloc(icut ldc,ioptttttttttttttoex INP',_�����alloc(iopt,�b2Rea c oct----888,1))= -dom#2) ell ------------2err_denchld bl anl. psd- f3D-RO(icut ldc,iopttttttttttttt-uccess1,mk) f!---------------------------------Allooooooooooooooooo�max_nelc _s(Nssss tree1d_dou------------------------------------------)= -dom#2) ell & be _0.a��allobtff fis ghlV,mkldc#2) rt2* -dom#2) ell *eru������, ex INPlooooooooooooooooo�max_n',_alloc( c,ldc,iopt,pn) nboxxxxxxxxxxxxxbox.-en- ecbn-#opo l 'ecut!=ria) f!le-ddddddddnb8ll-2err_dnb8ll-2err+_(())liNo NE -1 Uin c octll fiiiiiiiiirox.u������, ex INP',_alloc(icut ldc,ioptttttttttttttoex INP',_�����allot,�b2Rea c oct----888,1))= -dom#2) ell -anl. psd- f3D-RO(icut ldc,iopttttttttttttt-uccess1,mk) f!---------------------------------Allooooooooooooooooo�max_nelc _s(Nssss tree1d_dou------------------------------& be _0.a��allo -dom#2) ell *P',__f,mkkkk,mklo88lloc.'_looooooooooooooooo�max_nense---------------------m,weS���sin_box max_box censi lx fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) t-!-#el--1,mk)de------ fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) row e-pd�=(2 ell 'ecut!=ria) f!le-dddddddd--h-base ----m,gh2,--h[e acut!=ria) f!le-dddddddd--h-base2 ----m,gh2,--h[e2 acut!=ria) f!le-dddddddd--h-base3 ----m,gh2,--h[e3 acut!=ria) f!le-dddddddd--:ee1d_fe----m,gh2,-,y[e acut!=ria) f!le-dddddddd--:ee1d_2e----m,gh2,-,y[e2 acut!=ria) f!le-dddddddd--:ee1d_3 ----m,gh2,-,y[e3 acut!=ria) f!le-dddddddd-------license--------------uccessssssssssssss1,mk) f!-----m=&Nmce a---------uccessssssssssssss1,mk) f2-----m=&Nmce2 acut!=ria) f!le-ddddddddssss1,mk) f3-----m=&Nmce3 acut!=ria) f!le-dddddddd���x_nelc _s(Nssss �--------------uccessss --h-base ----m,gh2,--h[e acut!=ria) f!le-dddddddd--h-base2 ----m,gh2,--h[e2 acut!=ria) f!le-dddddddd--:ee1d_fe----m,gh2,-,y[e acut!=ria) f!le-dddddddd--:ee1d_2e----m,gh2,-,y[e2 acut!=ria) f!le-dddddddd-------license--------------uccessssssssssssss1,mk) f!-----m=&Nmce a---------uccessssssssssssss1,mk) f2-----m=&Nmce2 acut!=ria) f!le-dddddddd���x_nelc _s(Nssss ���x_nelc _s(Nssssssss0_MK--))----m,ghhhhhhhhhhh=-----n�i Uin c octll fiiiiimkkkk)----m,ghhhhhhhhhhh side----------2222iiiimkkkk) -ccedohhhhhhhhhhh simkkkk) -ccedo+(c2,ccwlddddddddddddda) f!le----m,ghhhhhhhhhhh k)kc-----------------1,-1,mk)w n,,,,,,,,,,,,,) rt2(1:---------m,ghhhhhh----------------------------,,,,,,,,,,,,) rt2(mkkkk) -ccede -ccedr_dnb8l-------,,,,,,,,,,,,ooogh2,----m,ghhhhhhhhhhh k) -cce��, ldc#1) row upe-. f! k)hhhhhhhhhh k)de----------2222iiiim f! k)hhhhhhhhhh hhhhhhh k)m f! k)h+,cNmP ffffhhhhhhhhh hhhhhhh trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) t-!Updmklo88llstPTinue,sr 1,e fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lf��, ldc#1) row -uccess1,mk) f!----------------------------bpchhhhhhhhhh hhhhhhh k)x INP',_ai+1)-x INP',_aiacut!=ria) f!le-ddddddddE pphhhhhhhhh hhhhhhh k)-k) fU+bpc-c2,ccwlddddddddddddddddderu�aaria(-k) fU:E ppm=&-pdpd f_(x INP',_aia: )= -dom#2) ell (x INP',_ai+1)-1 Uin c octll fiiiiiiiiiiopt u& be----m,ghhhk)-k) fUUin c octll fiiiiiiiiiiopt u& 2e----m,ghhhk)-en fin-: -k) fU k)-en +c2,ccwlddddddddddddd���x_nelc _s(Nssssssss----tttttttttttttttttttttt=s----t+(c2,ccwlddddddddd,max_nelc _s(N������ fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oUpdmklo88llDO d8 INP',_alloc(npbpo fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row ----t(2oc-r3) P3nee+(weS 'Bo! JHW--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea -ea c2oOf! ed-byyerai--wE ---x inde------8888ll f---- fin-: ! JHW--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea -ea il an b���,o-s----t+(c2,ccwlddddddddd-------------------------Alloc(1:e-pd�=(,il a:----mooNm -dom#2) ell --:ee1d_f:e-pd�=(,il a:----mo-----& bru�a ildip1d_ -dom#2) ell 0_MK--))il a:----mo-d) THEN1,max_nele----ea row _s(Nm,weS���sin_box max_box ccccccccckgh2,0-ea c2fEd,to3) w---x i----- fin-: k2h2,0-ea c2fEd,to3) w ppm#k222222---srinlbl fin-: 222*ee1d---��, ldc#1) row 0_MK--))il a+i-1) e1 tioa) k2h2,k2h+(c2,ccwldddddddddddddrow i----��-x n,-e al_tiopt & beeeeeeeeeeeeetrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivirivi---------uccessssss t-!If yuts=addl_tym8888ll fDO d8 INP',_alloc(npbpo fin-: eeeeeeeeeeeetrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivirivi---------uccessssss row k --DO',_alloc(icut ldc,iopttttttttttttttrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss t fFirson=E 888addlreplac-3!f oogh2c(icut ldc,iopttttttttttttttrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss j k) -ccebfe,mk)c(icut ldc,iopttttttttt�--------------uccessss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss t fFollow����)n fCALL appen x ia2)ee+(e),cutxll fDO d-----------uccessss trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi---------uccessssss ���, b2e: b���, b2e:+(c2,ccwldddddddddddddddddddddj: b���, b2e---Allooooooooooooooooo�max_nelc _s(Nssss box.-en- b2e: ecbn-dex INP',,_alloc(icut ldc,iopttttttttttttt--'n index INP',_k)1mu& .-._substrv----------uccessssss ���, b2el-2err_dnb8l b2el-2err+_(())liNo NE -1 Uin c octll fiiiiiiiiiiiii-----ig.'n index INP',_P',_k)))))))))))))))))))))1mu& be <d__sif---l ������nnnnnnnnex INP',_c _s(Nssss box.---------------------------ex iopttttttttttttt-NP',_�����'-rR(.yyyyyes,n----o-2err_))))))))))))))))1mu& be nn2----MK-- +fffEn int2 s1,ooooN -dom#2) ell mk) ex INP',_alloc(npbpo)dc,iopt,p -dom -dom#2) ell 0.a��iffk) f Uin c octll fiiiiiiiiiiiiiiiiiin_box max_box ccccccccccccccccccccc))Ecutx (ee1dcccccccccccccccc))Ecutx (ee1dcccccccccccccccceru�����jig.'il a+i-1x (ee1dcccccccccccccccckmk)ko+(c2,ccwlddddddddddddd���x_nelc _s(Nssss������ee+(weS 'Bo! JHW--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea -ea c2o f rmin)k) ex) f!lereplac--------3,1)----couldmen mad- fin-: ! JHW--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea -ea row k --DO',_alloc(icut ldc,iopttttt222*e-uccess1,mk) d_fe,mk)-c2,ccwldddddddddddddddddbru�����i d- eru�����i+---------------------���������������lllllllll���, b2e: b���, b2e:c(c2,ccwlddddddddd���8ll fin-: W--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea -ea c2oUpdmklo88llfEd,to3) w) rt2lmin) ppm#k222222-emptyinlbl fin-: W--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea -ea .�2=)l= .�2=)lc(co+(kO P ffff--DO))Ecut---ea -ea c2d--- 0x fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oD��-----e R--1eS 'erafinishx fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N ed100: k)e n, ropa c222, f visi--------------------------license--------------uc-ea .ess1,mk) f!------------------------------ex INP',_�����'iiiiim,weS���sin_box max_box censi lx fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oD��, eoutpCO P ff8-DO dtrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea row u������, ex INP1,_alloc(icut ldc,ioptoex INP',_�����a8t,�b2 f letr 1,emidp ais p) (icut ldc,iopt-uccess1,mk) f!---------------------------------Allooooooooooex INP',_�����a8t,�b2Toyyy2fEd,to3) w ppm#: bl anl (icut ldc,iopt-uccess1,mk) f!---------------------------------Allooooooooooex INP',_�����a8t,�b2NEd,to3) wfur1,mkNP',_alloc(npbpo: bl I#1), -1mu& be <d__)1�, b2e---Allooooooooo-uccess1,mk) f!---------------------------------AlloooooP ffff8-DO d888222222222222222! w rtee _0.a��al c-----------------1,-1,mk)w n,888ll fint nt�����)ifto)-sh�cut Check argument= p _alloc-(cut1mu& f! Nm(1)---!=ria)eturn stPTinue,pn) ---------------1,Gu----.----rx Itbase #elassx Id uni rmthe Free Si-Rioa quad- in 2dffffin t-are we -----------------e ---�����nnnnnnnnex INP',__f,mkkkk,mklo8are =>iiopt u& ,mkkkk,mklo8--- =>iiopt ---f8-DO d888o O8-DO d8888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.a��iffk)FeS '.a��e 888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0. l CONTINU,mk)w n,-----------------deINP',_P',_k)1mu& be <d__sif---l ������nnnnnnnne2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n ind------P',_alloc(npbpo)dc,iopt,pn) nbox nbp nbp--1,--P ffff8-DO d-----------licend) T����nnnnnnnne2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n ifEd,to3) wP',_alloc(di---sxi,.e ffV,pn) nbox nbp nbp--1,--P ffff8-DO d-----------licefru�a��-----Rs CPO2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n i------------------------1,S-- vide tc l P ffff8-DO d-----------lice------------lctrar2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n i--------exi,.e-plU-----------ex INP',_���P ffff8-DO d-----------liceyyyes=MAXCnse alon2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n iyyy---��----exi,.e�b2e: f1,mutfGOTO 88licens useAME !--P ffff8-DO d-----------liceyx Ivar-sr-: bo =r2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n iy-----��----exi,.e�b2e: f1,mutfGOTO 881,mk) ex INP',_alloc(b2e: P ffff8-DO d-----------lice-o88lloc.'__f__fCO 2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n i���(ee1elnde------8=f f ex INP',_alloc(pcsum_swloc()-sh�cut ldc---license--------------uc be <d__sif---l �allooc.'__f__fCO 2--e --- ---����nnne2E (n, ropa c2oaaaariI---I--------------ex INP ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n ifEd,to3) wy fnoD-ROUcfdom#3nee+M_--TSS domaiR itselfL cat ropted!-----------------------licel ������nnnnnnnne2--e --- ---����nnne2E (n, ropa c2oaaaariI---I--------------ex INP ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n ifEd,to3) wy fnoD-ROUcf�b2e: f1,mutfGOTO 8NM ex INP',_alloc(pcsum_swldc,P ffff8-DO d8888lleex INP',_alloc(pcsum_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-------------'n index INP',_k)1mu& be <d__sif---l ������nnnnex INP',__f,mkkkk,mklo88lloc.'__f__fCO P ffff8-DO d8888ll fin-_0.0_MK-N --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n i---------------license--------------uccess1,mk)-----------------om�,mk)lig f__fropa c22-----------------------license--------------uccess1,mk) f!----------------------------------���Sllocthodox el�nnnnex INP',_�����-2err_d(Nm CA,llic Lic:,1)w-thOb --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n i--------------x INP',_�����-2err_d(Nm CA,llic �max_nense---------�����nnnnnnnnex INP',__f,mkkkk,mklo---------------lpdpd f__����nnnnnnnne2--e --- ---����nnne2E (n, ropa c2oaaaariI---I--------------ex INP ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n istPTinue,sr 1,e--1,------PD-- be _0.a��iffk) f Uin c octlted!-----------------------licelicense--------------u2--e --- ---����nnne2E (n, ropa c2oaaaariI---I--------------ex INP ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n is-1,-----to firsonstPTinue,sr#3nee----- be _0.a��iffk) f Uin c octlP ffff8-DO d8888lleex INP'( c,ldc,iopt,pn) nbox nbp--1,-<d__sif-------oc.'__f__fCO 2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n i���(ee1el2222npbpo)dc,se--------------uccess1,mk)------) nbox nbp--1,-<d__sifess1,moc.'__f__fCO 2--e ---����nnne2E (n, ropa c2oaaaariI--------------ex INP --------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n i1eS 'rr_denc) w ppm#kBLEVELex INP',_alloc(pcsum_swloc()-sh�cut ldc---linnnnex INP',__f,mkkkk,mklo---------------nse--------------uccess1,mk) f!----------------------------------ee1d_feosubst2 ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n ifEd,to3) w,1))= -dom#3nee+(weS 'Bout CA 1,1))= en-domted!-----------------------liceneliffk) f_0.0_MK-- perdfff NPBXnse alond(,mk) nbox nbpd,nld,nlUin c oct i i ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n i--------------------------TSS domaiR itselfL cat ropted!-----------------------liceiopt u& -------------u2--e --- ---����nnne2E (n, ropa c2oaaaariI---I--------------ex INP ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n ik) ex INP',_alloc(npbpo)dc,iopt,pn) nbox nbp nbp--1,------ted!-----------------------liceiopt It222-----------u2--e --- ---����nnne2E (n, ropa c2oaaaariI---I--------------ex INP ------------------------------------------deINP',int2 s1,ooooNm CA 2,1))=----'n -'n ik) ex INP',_alloc(npbpo)dc,iopt,pn) nbox nbp nbp--1,------ted!--------888o O8-DO d8888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.a��iffk))eturn 888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.8000----------top(nt2 s1,ooot0nbp nbp--1,--RETUR---------ONTAINS-------SUBROUTnbo -----p--1,-----����E 'Bobe _ --D_allocv,pn)E 'Bo2e _ --D_allocv,pn)m CA 2,1))=----'E 'Bo3e _ --D_allocopa c2oaaaariI---I------------ex INP -----------------1mu& be nn2----MK-- +ffrgu----int2 s1,ooooNm CA 2,1))=----'n -''Atc,io ex atim 'Boiopt muson=e2222---sr! _0.a��iffk) f Uin c octll 8888Uin c octted!-----------����E 'Bobe2_ --D_allocv,pn)E 'Bo2e2_ --D_allocv,pn)m CA 2,1))=----'E 'Bo3e2_ --D_allocopa c2oaaaariI---I------------ex INP -----------------1mu& be nn2----MK-- +ffrgu----int2 s1,ooooNm CA 2,1))=----'n -''Atc,io ex atim 'Boio2t muson=e2222---sr! _0.a��iffk) f Uin c octll 8888Uin c octted!-----------����s1,otype --D----------iopt octv,pn)e-pd�=( --Dll 'ecut!=ria) f!l-----------ex INPwarning-------------1mu& be nn2----MK-- +ffrgu----int2 s1,ooooNm CA 2,1))=----'n -''Oct1eS 'erax INposalloc(sr#2d.))evert----888quad1eS .oooN -dom#2) ell0.a��iffk) f Uin c octll itype-------------iopt quadUin c octted!-----------222*ee1e-pd�=(Uin c octll ����1) rt1ymidpi l_alloc-(alloc(icut ldc,ioptt-----------ex INP --------------------1mu& be nn2----MK-- +ffrgu----int2 s1,ooooNm om -dom#2) ell '88llyyy---��----_0.0_muson=e2> 0 ! _0.a��iffk) f Uin c octll l 8888Uin c octoctted!-----------ll ����1) 22---i)d��������22---i)-(alloc(icut ldc,ioptt-----------ex INP --------------------1mu& be nn2----MK-- +ffrgu----int2 s1,ooooNmm -dom#2) ell '1) 22--_muson=e2<opa c22-- ! _0.a��iffk) f Uin c octll l 8888Uin c octoctted!-----------�������8888----1ONTINU,mk)w n,���-SUBROUTnbo -----peex INP'( c,ldc,iopt,pn�,mk)lig f__fropa c22--------------------���-SUBROUTnbo t2 s1,o_dsn',_alloc f__fropa DOUB-------------------���-SUBROUTnbo t2 s1,o_ddO8-DO d8',_alloc( c,ldc,,-1,m�,mk)lig f__fropa c22--------------------���-SUBROUTnbo t2 s1,o_tsn',_alloc f__fropa DOUB-------------------���-SUBROUTnbo t2 s1,o_tdO8-DO d8',DO d8�����������������������������������������������������libt2 -1.2.1/src/s1,o/t2 s1,o_b_MKf_.f�������������������������������������������������������������0000644�0001752�0001753�00000043201�11616003523�020250� 0����������������������������������������������������������������������������������������������������uk) f �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������------ll-2err_den'iv,pn) nbox nbp--1,-------------Uin c octll fin---- f3v#1n edse alond(rout--e : t2 s1,o_b_MKf_888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.a��iffkCopyr ' (c) 2010--SE Lab (ETH Zurich), MOSAIC!ffDup (ETH Zurich), edse aloooooooooooooooooooCe----=lc Fluid Dynamics (DTU Uin c !Uin c !Uin c !olUin frteeis--liceutxll fP---llelfP--Tinue,M fnoLib-----(PPM).Uin c !Uin c !oPPM'erafeS 'software: you can red) eribUin itchld/c oO d 888ll fi itc----r8ll f-ermee1el_typGNU Less-r8Gene--l PublicoLicense edse alas--ublishx bal_typFeS 'Software Fo---dp , ei1,mkN edse alversxi, 3e1el_typLicense, c (at your ---xi,) Ch latmkN edse alversxi,.Uin c !Uin c !oPPM'erad) eribUindNm(2)---hopeisi---itcwi222ne useful,Uin c !obUi WITHOUT ANY WARRANTY;emk)-out eve(2)---implindNwarranty---edse---! MERCHANTABILITY c FITNESS FOR A PARTICULAR PURPOSn, Selo88ledse---! GNU Gene--l PublicoLicense lc el--details.Uin c !Uin c !oYou shouldm---l receivn)/a copye1el_typGNU Gene--l PublicoLicense edse alandl_typGNU Less-r8Gene--l PublicoLicense along.mk)--PPM.!If x I,Uin c !oselo<http://www.gnu.org/licenses/>.Uin c !Uin c !oP---llelfP--Tinue,M fnoLib-----(PPM)Uin c !oETH Zurich0.a��iffkCH-8092 Zurich, Smk)--slan fin-: in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0m�,mk)lig f__fropa c22--------------------SUBROUTnbo t2 s1,o_b_MKf__ffre Kf_e _0. be _0.a��allo ------ooN -dom#2) --- ff & e faxse---u& --It22mk) f!---alloc f__fropa DOUB-------------------SUBROUTnbo t2 s1,o_b_MKf__dfre Kf_e _0. be _0.a��allo ------ooN -dom#2) --- ff & e faxse---u& --It22mk) f!--se---------!!!olUin rout--e se-s/a ----in8882, 4 c 8 piec-3!using-------!!!o_typgive(2ed-x icenex INP',_a--------exi,..-------!!!-------!!!o[NOTE]-------!!!olUe rout--e f! eoc.'s lc e ee182, c 3,iopt,pn) nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-----------aloModu -iopt,pn) nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-----------USo t2 modu _-dpa-------USo t2 modu _-dpa_---- fin-: USo t2 modu _----t fUUin c USo t2 modu _----topUin c USo t2 modu _ -----------USo t2 modu _INP',_P',_k)USo t2 modu _mk) f-sh�cut MPLICIT NON,m�,mk)lig f__fropa c22--------------------INTEGER, PARAMETER :: MK-------kind_single!---alloc f__fropa DOUB-------------------INTEGER, PARAMETER :: MK-------kind_double!--se---------! nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-----------t-!Include---------------1,Gu----.----rx Itbase #elassx Id uni rmthe Free Si-Rioa quad- in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcut!rgu----sP',_k in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_k 'AllMK), DIMEN----(:,:), INTENT(IN,_k) :: xp-------!!!oP---exi,.e�b288lls-ROUc.INP',_k 'AllMK), DIMEN----(:_k), INTENT(IN,_k) :: . be _-------!!!oMyy---��coordinatm.e�b288ll=E 888be se-.INP',_k 'AllMK), DIMEN----(:_k), INTENT(IN,_k) :: .a��all-------!!!oM-----����ordinatm.e�b288ll=E 888be se-.INP',_k 'AllMK), DIMEN----(:_k), INTENT(IN,_k) :: --- ff-------!!!oP---exi,.e�b288llse-s/along._typgive(2a---ledse---INTEGER , INTENT(IN,_k) :: dfCO P ff8-!!!oNEd,to3) wse-s/888applyedse---INTEGER , INTENT(IN,_k) :: Kf_e _ P ff8-!!!oIDe�b288ll=E 888be se-.INP',_kINTEGER , DIMEN----(:_k), INTENT(IN,_k) :: --- ic P ff8-!!!oDicenex INP�b288llse-s. --- ic(1)=2 mea�N_ala2)ee+(firso P ff8-!!!o----i -dompen icul f 888ll fseco,_a-�ordinatm2a-i -(y2a-i ).INP',_k 'AllMK), DIMEN----(:,:), POINTER :: . fCO P ff8-!!!oMyy---��coordinatm.e�b288llmutfGOTO .-------!!!-------!!!o1st: x,y[,z] +-------!!!o2nd:'il a.INP',_k 'AllMK), DIMEN----(:,:), POINTER :: .axfCO P ff8-!!!oM-----����ordinatm.e�b288llmutfGOTO .-------!!!-------!!!o1st: x,y[,z] +-------!!!o2nd:'il a.INP',_kINTEGER , DIMEN----(:_k), POINTER :: u& ,mkkkk,!!!oP------ 888ll ffirsons----��nno8---)Nm(2each2sd(-b sider= -!,mkkkk,!!!o f! e1=rff f_dP',_areturnndNm--1,mk) are ,1))= -oa qua.INP',_kINTEGER , DIMEN----(:_k), POINTER :: ---f8-DO d!!!oIr 1,e) w,1))= -m(2sd(-b mnelifikNikN f! e1=rff f_dP',_areturnndf8-DO d!!!om--1,mk) are ,1))= -oa qua.INP',_kINTEGER , INTENT( OUT) :: mk) f8-DO d!!!o)eturn -t tus, 0N f censi in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutLff l f!---b -iopt,pn) nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,----------- 'AllMK) :: t0INP',_kINTEGER :: n rt1,cd,i,j------Np,ipINP',_kINTEGER , DIMEN----(2) :: dcINP',_kINTEGER , DIMEN----(:), POINTER :: pl an >-----() in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutEx---nal -iopt,pn) nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,------------------! nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-----------t-!In---l ise edse a nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,--------------------t1))(nt2 s1,o_b_MKf_oot0nbp nbp-------! nb���.fSee theex INP',_alloc(pcst_dwldc,iopt,pn) nb�� f3D-ROUcf!--1,-----------t-!b=='-rRnputffrgu---- in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_krox.u������, ex INP',_alloc(icut ld----------p--1,----row _s(Nm,weS���sin_box max_box c���8ll fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutExitom--1,mk) erax Ih----888be se- in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_krox. fCO l1,_alloc(icut ldc,rox.u������, ex INP',_alloc(icut ldc,iopt-uccess1,mk) f!------------------_b_MKf_ooioptCA 2,1))=----'n -'n iN Ih----888se-.tExit---.'nbp nbp--1,------ted!------------in_box max_box c���8ll fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutNEd,to3) wnde------8888be sreatx fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kn-l an b2** fCO P ff8---'n idex INP',_k)1mu& .-.INP',_krox.---linnnnex INP',__f,mkkkk,mkloNpmk)-iiopt u& beKf_e _)h+,iopt u& 2eKf_e _)h+,c2,ccwlddddd-----ig.'Nparut is!any---------------lpdpffk) f_0.0_MK-- perdfff NPBXnse al-----------------------ex -NP',_�����'-rR(.yyyyyes,n----o-2err_1mu& be nn2----MK-- +fffEn int2 s1,o_b_MKf_ooioptttttttCA 2,1))=----'n -'n istPTinue,k) ex--1,------PD- _0.a��iffk) f Uin c octll lin_box max_box ccccc))Ecutx (ee1d))Ecutx fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutSplit ----in8882 piec-3 in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_krox. fCO --DO1,_alloc(icut ldc,rox.u����=(2 ell 'ecut!=ria) f!le-222*ee1dnb8l-------,,,,,,,,,,,,. fCOe ah2,--Alloc(1--------------------. fCOe2 ah2,--Alloc(2--------------------. fCOe3 ah2,--Alloc(3--------------------.axfCOe ah2,--:ee1d_f--------------------.axfCOe2 ah2,--:ee1d_2--------------------.axfCOe3 ah2,--:ee1d_3----------------���������������l�--------------ucce222*ee1dnb8l-------,,,,,,,,,,,,. fCOe ah2,--Alloc(1--------------------. fCOe2 ah2,--Alloc(2--------------------.axfCOe ah2,--:ee1d_f--------------------.axfCOe2 ah2,--:ee1d_2----------------���������������l���8ll fin-: cdhh=---- ic(1) fin-: . fCOecd,1ah2,--Alloc(cd) fin-: . fCOecd,2f!=s--- fff1)l fin-: .axfCOecd,1ah2,--- fff1)lfin-: .axfCOecd,2ah2,--:ee1d_cd) fin-: fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutSplit ----in8884 piec-3 in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_k�---rox. fCO --DOll 'ecut!=ria) frox.u����=(2 ell 'ecut!=ria) f!le-222*ee1dnb8l-------,,,,,,,,,,,,. fCOe ah2,--Alloc(1--------------------. fCOe2 ah2,--Alloc(2--------------------. fCOe3 ah2,--Alloc(3--------------------.axfCOe ah2,--:ee1d_f--------------------.axfCOe2 ah2,--:ee1d_2--------------------.axfCOe3 ah2,--:ee1d_3----------------���������������l�--------------ucce222*ee1dnb8l-------,,,,,,,,,,,,. fCOe ah2,--Alloc(1--------------------. fCOe2 ah2,--Alloc(2--------------------.axfCOe ah2,--:ee1d_f--------------------.axfCOe2 ah2,--:ee1d_2----------------���������������l���8ll fin-: cdh=---- ic(1) fin-: . fCOecd,1ah2,--Alloc(cd) fin-: . fCOecd,2f!=s--Alloc(cd) fin-: . fCOecd,3ah2,--- fff1)lfin-: . fCOecd,4f!=s--- fff1)l fin-: .axfCOecd,1ah2,--- fff1)lfin-: .axfCOecd,2ah2,--- fff1)lfin-: .axfCOecd,3ah2,--:ee1d_cd) fin-: .axfCOecd,4ah2,--:ee1d_cd) fin-: cdh=---- ic(2) fin-: . fCOecd,1ah2,--Alloc(cd) fin-: . fCOecd,2f!=s--- fff2) fin-: . fCOecd,3ah2,--Alloc(cd) fin-: . fCOecd,4f!=s--- fff2) fin-: .axfCOecd,1ah2,--- fff2)lfin-: .axfCOecd,2ah2,--:ee1d_cd) fin-: .axfCOecd,3ah2,--- fff2)lfin-: .axfCOecd,4ah2,--:ee1d_cd) : fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutSplit ----in8888 piec-3 in 2dbo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_k�---rox. fCO --DO3l 'ecut!=ria) frox.u����=(2 ell 'ecut!=ria) f!le-222*ee1dnb8l-------,,,,,,,,,,,,. fCOe ah2,--Alloc(1--------------------. fCOe2 ah2,--Alloc(2--------------------. fCOe3 ah2,--Alloc(3--------------------.axfCOe ah2,--:ee1d_f--------------------.axfCOe2 ah2,--:ee1d_2--------------------.axfCOe3 ah2,--:ee1d_3----------------���������������l�--------------ucce222*ee1dnb8l-------,,,,,,,,,,,,. fCOe ah2,--Alloc(1--------------------. fCOe2 ah2,--Alloc(2--------------------.axfCOe ah2,--:ee1d_f--------------------.axfCOe2 ah2,--:ee1d_2----------------���������������l���8ll fin-: cdh=---- ic(1) fin-: . fCOecd,1ah2,--Alloc(cd) fin-: . fCOecd,2f!=s--Alloc(cd) fin-: . fCOecd,3ah2,--- fff1)lfin-: . fCOecd,4f!=s--- fff1)l fin-: ----.axfCOecd,1ah2,--- fff1)lfin-: .axfCOecd,2ah2,--- fff1)lfin-: .axfCOecd,3ah2,--:ee1d_cd) fin-: .axfCOecd,4ah2,--:ee1d_cd) fin-: . fCOecd,5f!=s--Alloc(cd) fin-: . fCOecd,6f!=s--Alloc(cd) fin-: . fCOecd,7ah2,--- fff1)lfin-: . fCOecd,8f!=s--- fff1)l fin-: ----.axfCOecd,5ah2,--- fff1)lfin-: .axfCOecd,6ah2,--- fff1)lfin-: .axfCOecd,7ah2,--:ee1d_cd) fin-: .axfCOecd,8ah2,--:ee1d_cd) fin-: cdh=---- ic(2) fin-: . fCOecd,1ah2,--Alloc(cd) fin-: . fCOecd,2f!=s--- fff2) fin-: . fCOecd,3ah2,--Alloc(cd) fin-: . fCOecd,4f!=s--- fff2) fin-: .axfCOecd,1ah2,--- fff2)lfin-: .axfCOecd,2ah2,--:ee1d_cd) fin-: .axfCOecd,3ah2,--- fff2)lfin-: .axfCOecd,4ah2,--:ee1d_cd) fin-: . fCOecd,5f!=s--Alloc(cd) fin-: . fCOecd,6f!=s--- fff2) fin-: . fCOecd,7f!=s--Alloc(cd) fin-: . fCOecd,8f!=s--- fff2) fin-: .axfCOecd,5ah2,--- fff2)lfin-: .axfCOecd,6ah2,--:ee1d_cd) fin-: .axfCOecd,7ah2,--- fff2)lfin-: .axfCOecd,8ah2,--:ee1d_cd) fin-: cdh=---- ic(3) fin-: . fCOecd,1ah2,--Alloc(cd) fin-: . fCOecd,2f!=s--Alloc(cd) fin-: . fCOecd,3ah2,--Alloc(cd) fin-: . fCOecd,4f!=s--Alloc(cd) fin-: .axfCOecd,1ah2,--- fff3)lfin-: .axfCOecd,2ah2,--- fff3)lfin-: .axfCOecd,3ah2,--- fff3)lfin-: .axfCOecd,4ah2,--- fff3)l fin-: . fCOecd,5f!=s--- fff3)lfin-: . fCOecd,6f!=s--- fff3)lfin-: . fCOecd,7f!=s--- fff3)lfin-: . fCOecd,8ah2,--- fff3)l fin-: .axfCOecd,5ah2,--:ee1d_cd) fin-: .axfCOecd,6ah2,--:ee1d_cd) fin-: .axfCOecd,7ah2,--:ee1d_cd) fin-: .axfCOecd,8ah2,--:ee1d_cd) : fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutUnknow(2ed-t----mod- fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_k�--- fin-: -----------ex INP --------------------------------------frgu----int2 s1,o_b_MKf_ooiopttCA 2,1))=----'n iffCO muson=e2< 4. _0.a��iffk) f Uin c octlin_box max_box c���8ll fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_kcutRankw,1))= -m(888ede------l We canx INuse-----util-----INP',_kcut,mk),========8llm rt2------8 'Boax INbel2222) nbox same-_0.0! fin-: bo ) fru�a ildip1d_bICUTnse alond(,mk) nbox nbpd,nlUin c oct in 3dalINP',_krox.---linnnnex INP',__f,mkkkk,mklotrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oA=rff f_nstPTinue,----IDfDO d-----------trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea ------------------1,mk)fid----------------ig.'Nparut is!any---------------peliffk) f_0.0_MK-- perdfff NPBXnse alond(,mk) nbox nbpd,nld,nlUin c oct i iyyyyyes,n----o-2err_1mu& be nn2----MK-- +fffEn int2 s1,o_b_MKf_ooiopCA 2,1))=----'n -'n ik) ex INstPTinue,----IDs P--TSS domaiR itselfL cat ropppppin_box max_box ccccc))Ecux_box cccccpl an -c2,ccwldddddnse- k)de,mkkkk,mklotrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oD��-----e sd(-b lc each2stPTinue. TODO:Nuse-box snip letedse----ea c2o,mk)...obUi avoide1=rff!,mkkkk,mklotrivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea rox.u����=(2 --DO3l 'ecut!=ria) fffff222*ee1dnb8l-------,,,,,,,,,,,,222jee1Nparut is!anyyyyyyyyyyyyyipmk)eru�aaria(iopt u& beKf_e _)+j-f---------------------ea rox.888ll(xpe p l. fCOe a) v,pn)m I#1), -1mu& be <d__________(xpe p l.axfCOe a) v,pn)m I#1), -1mu& be <d__________888ll(xpe2 p l. fCOe2 a) v,pn)m I#1), -1mu& be <d__________(xpe2 p l.axfCOe2 a) v,pn)m I#1), -1mu& be <d__________888ll(xpe3 p l. fCOe3 a) v,pn)m I#1), -1mu& be <d__________(xpe3 p l.axfCOe3 a)------------------ex ioptttttttttpl a�jig.'i------------ex iopttttt���x_nelc _s(Nssss ���������������lllll���������������l�--------------ucce222*ee1dnb8l-------,,,,,,,,,,,,222jee1Nparut is!anyyyyyyyyyyyyyipmk)eru�aaria(iopt u& beKf_e _)+j-f---------------------ea rox.888ll(xpe p l. fCOe a) v,pn)m I#1), -1mu& be <d__________(xpe p l.axfCOe a) v,pn)m I#1), -1mu& be <d__________888ll(xpe2 p l. fCOe2 a) v,pn)m I#1), -1mu& be <d__________(xpe2 p l.axfCOe2 a)------------------ex ioptttttttttpl a�jig.'i------------ex iopttttt���x_nelc _s(Nssss ���������������lllll���������������l���8ll fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oD��-----e fEd,to3) w,1))= -m(2each2sd(-b fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea 222jee1Nparut is!anyyyyyioct l a�jiarut is!anyyyyyBXnseex INP',_nse-�i d- nse-�i d+,c2,ccwlddddd������ fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oBurt2-88ll=E stPTinue,--1,---- fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea ce1d_f-d- c2,ccwlddddd-u& b-d- c2,ccwlddddd222*e21dnb8l-------,,,,,,,,ce1d_i d- ce1d_i-1) + nse-�i-f-----------------u& i d- ce1d_i)2,ccwlddddd������-----------u& dnb8l+b-d- -u& dnb8l) + nse-�dnb8l)� fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oRankw88llstPTinuesNm(2)---sd(-b mn fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea 222jee1Nparut is!anyyyyyipmk)eru�aaria(iopt u& beKf_e _)+j-f----------------ioct l a�jiarut is!anyyyyyBXnseex INP',_----------------ex ioptaria(ce1d_i)ig.'iparut is!anyyyyyyyyyce1d_i ddddddd- ce1d_i)t+(c2,ccwlddddddddd,max_nelc _s(N������ fin-: trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea c2oDea c oct '.a��e 888ll f trivi--are we ----x_boi psd- f3Ee2n 2dffffin trivi--arO_Lfc p���N edse----ea -----------------deINP',_P',_k)))))---------------peliffk) f_0.0_MK-- perdfff NPBXnse alond(,mk) nbox nbpd,nld,nlUin c oct i i ------------------------------------------deINP',int2 s1,o_b_MKf_ooiopttCA 2,1))=----'n ik) ex INstPTinue,----IDs P--TSS domaiR itselfL cat ropted!--------888o ----'n ! ---linnnnex IN8888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.a��iffk))eturn 888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0. l CONTINU,mk)w n,---------top(nt2 s1,o_b_MKf_oot0nbp nbpk)w n,RETUR---------ONTAINS-------SUBROUTnbo -----p--1,-----����Kf_e _ l1,_alloc(icut ldc,I------------ex INP -----------------1mu& be nn2----MK-- +ffrgu----int2 s1,o_b_MKf_ooiopttCA 2,1))=----'n 'Kf_e _ muson=e2>0 ! _0.a��iffk) f Uin c octll 8888Uin c octted!-----------����.u����=(2 l3) v,pn)m. fCO ell,_alloc(icut ldc,I------------ex INP -----------------1mu& be nn2----MK-- +ffrgu----int2 s1,o_b_MKf_ooiopttCA 2,1))=----'n 'Canx INfCO mel--than 2 timesNm(22D! _0.a��iffk) f Uin c octll 8888Uin c octted!-----------222*ee1e-pd�=(Uin c octll ����1) _e1d_i)t��������2e1d_i)igalloc(icut ldc,ioptt-----------ex INP --------------------1mu& be nn2----MK-- +ffrgu----int2 s1,o_b_MKf_ooiopttCA 2,1))=----'n '1) 2e _ muson=e2<2,--:ee1d ! _0.a��iffk) f Uin c octll l 8888Uin c octoctted!-----------�������--------222*ee1 fCO-c2,ccwlddddddd222jei+e1 fCOUin c octll l ����Kf_ ic(i)t�--DOKf_ ic(j)------------------ex iopt-----------ex INP -----------------------1mu& be nn2----MK-- +ffrgu----int2 s1,o_b_MKf_ooiopttCA 2,1))=----'n n i---------------muson=e2d) e ft ! _0.a��iffk) f Uin c octll l l 8888Uin c octoctoctted!--------------�������--------�������8888----1ONTINU,mk)w n,���-SUBROUTnbo -----peex INP' f__fropa c22--------------------���-SUBROUTnbo t2 s1,o_b_MKf__fn',_alloc f__fropa DOUB-------------------���-SUBROUTnbo t2 s1,o_b_MKf__d8',DO d8�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libt2 -1.2.1/src/t2 modu _map_field_global.f������������������������������������������������������0000644�0001752�0001753�00000010037�11616003524�021575� 0����������������������������������������������������������������������������������������������������uk) f �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������------in1*- f90 1*-�����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.-----iloModu -------: t2 modu _map_field_global888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.a��iffkCopyr ' (c) 2010--SE Lab (ETH Zurich), MOSAIC!ffDup (ETH Zurich), edse aloooooooooooooooooooCe----=lc Fluid Dynamics (DTU Uin c !Uin c !Uin c !olUin frteeis--liceutxll fP---llelfP--Tinue,M fnoLib-----(PPM).Uin c !Uin c !oPPM'erafeS 'software: you can red) eribUin itchld/c oO d 888ll fi itc----r8ll f-ermee1el_typGNU Less-r8Gene--l PublicoLicense edse alas--ublishx bal_typFeS 'Software Fo---dp , ei1,mkN edse alversxi, 3e1el_typLicense, c (at your ---xi,) Ch latmkN edse alversxi,.Uin c !Uin c !oPPM'erad) eribUindNm(2)---hopeisi---itcwi222ne useful,Uin c !obUi WITHOUT ANY WARRANTY;emk)-out eve(2)---implindNwarranty---edse---! MERCHANTABILITY c FITNESS FOR A PARTICULAR PURPOSn, Selo88ledse---! GNU Gene--l PublicoLicense lc el--details.Uin c !Uin c !oYou shouldm---l receivn)/a copye1el_typGNU Gene--l PublicoLicense edse alandl_typGNU Less-r8Gene--l PublicoLicense along.mk)--PPM.!If x I,Uin c !oselo<http://www.gnu.org/licenses/>.Uin c !Uin c !oP---llelfP--Tinue,M fnoLib-----(PPM)Uin c !oETH Zurich0.a��iffkCH-8092 Zurich, Smk)--slan fin-: in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0mfin-: MODULE t2 modu _map_field_global888ll fi!!olUin modu _0.aai�N_alc(srtmkfacelandl_typ 'BondNwork arrays lc 88ledse---!!!ofield global,--pping..-------!!!-------!!!o[NOTE]-------!!!olUe �-----ology2d) e guishxs2netwee(2y fneNP',_afield!,mkkkk,!!!o(_typ-dpa liv����)nl_typy fneN), Seve--l field! can use-box,mkkkk,!!!osame-y fn.,M fn fCALL definndNas--2 -srtmkn-l ( S, w,mk)asedse---!!!ofieldfCALL user-provi x iarrays.--------: in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: i Work .a��e 888ll f in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: INTEGER, DIMEN----(:_k), POINTER :: ms,DOfromsubn >-----() in 2d-: INTEGER, DIMEN----(:_k), POINTER :: ms,DOtosubn n >-----() in 2d-: INTEGER, DIMEN----(:,:), POINTER :: ms,DOblk-t1))n >-----() in 2d-: INTEGER, DIMEN----(:,:), POINTER :: ms,DOblk-0.0_n >-----() in 2d-: INTEGER, DIMEN----(:,:), POINTER :: moffsetn 2d-: >-----() in 2d-: INTEGER, DIMEN----(:_k), POINTER :: mrecvfromsubn >-----() in 2d-: INTEGER, DIMEN----(:_k), POINTER :: mrecvtosubn nn >-----() in 2d-: INTEGER, DIMEN----(:,:), POINTER :: mrecvblk-t1))n >-----() in 2d-: INTEGER, DIMEN----(:,:), POINTER :: mrecvblk-0.0_n >-----() in 2d-: PRIVATE :: ms,DOfromsub,ms,DOtosub,ms,DOblk-t1)),ms,DOblk-0.0 in 2d-: PRIVATE :: moffset,mrecvfromsub,mrecvtosub,mrecvblk-t1)),mrecvblk-0.0 --------: in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: i Definn(srtmkfacelto t2 map_field_global888ll f in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: INTERFACE t2 map_field_global888ll f MODULE PROCEDURE t2 map_field_global888ll f ���-INTERFACE --------: INTERFACE t2 map_field_global_sym(Uin c octll MODULE PROCEDURE t2 map_field_global_sym(Uin c oct���-INTERFACE --------: INTERFACE t2 map_field_global_useperiodUin c octll MODULE PROCEDURE t2 map_field_global_useperiodUin c oct���-INTERFACE --------: INTERFACE t2 map_field_global_useperiod_stel-Uin c octll MODULE PROCEDURE t2 map_field_global_useperiod_stel-Uin c oct���-INTERFACE --------: INTERFACE t2 map_field_globalstel-dUin c octll MODULE PROCEDURE t2 map_field_globalstel-dUin c oct���-INTERFACE 88ll f in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: t-!Include2)---source 88ll f in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: -ONTAINS- #include2"map/t2 map_field_global.f"- #include2"map/t2 map_field_global_sym(.f"- #include2"map/t2 map_field_global_useperiod.f"- #include2"map/t2 map_field_global_useperiod_stel-.f"- #include2"map/t2 map_field_globalstel-d.f"- c oct���-MODULE t2 modu _map_field_global8�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������libt2 -1.2.1/src/t2 modu _cel-.f������������������������������������������������������������������0000644�0001752�0001753�00000003753�11616003523�017273� 0����������������������������������������������������������������������������������������������������uk) f �incardon������������������������incardon���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������l f in1*- f90 1*-�����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.-----iloModu -------: t2 modu _cel-888ll fin1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0.a��iffkCopyr ' (c) 2010--SE Lab (ETH Zurich), MOSAIC!ffDup (ETH Zurich), edse aloooooooooooooooooooCe----=lc Fluid Dynamics (DTU Uin c !Uin c !Uin c !olUin frteeis--liceutxll fP---llelfP--Tinue,M fnoLib-----(PPM).Uin c !Uin c !oPPM'erafeS 'software: you can red) eribUin itchld/c oO d 888ll fi itc----r8ll f-ermee1el_typGNU Less-r8Gene--l PublicoLicense edse alas--ublishx bal_typFeS 'Software Fo---dp , ei1,mkN edse alversxi, 3e1el_typLicense, c (at your ---xi,) Ch latmkN edse alversxi,.Uin c !Uin c !oPPM'erad) eribUindNm(2)---hopeisi---itcwi222ne useful,Uin c !obUi WITHOUT ANY WARRANTY;emk)-out eve(2)---implindNwarranty---edse---! MERCHANTABILITY c FITNESS FOR A PARTICULAR PURPOSn, Selo88ledse---! GNU Gene--l PublicoLicense lc el--details.Uin c !Uin c !oYou shouldm---l receivn)/a copye1el_typGNU Gene--l PublicoLicense edse alandl_typGNU Less-r8Gene--l PublicoLicense along.mk)--PPM.!If x I,Uin c !oselo<http://www.gnu.org/licenses/>.Uin c !Uin c !oP---llelfP--Tinue,M fnoLib-----(PPM)Uin c !oETH Zurich0.a��iffkCH-8092 Zurich, Smk)--slan fin-: in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- be _0mfin-: MODULE t2 modu _cel-888ll fi!!lifikNikN_typglobal,user modu .!It _0.aai�N_-ll888ll fi!!luser-c-ll-b rout--eee1el_type--ire---- cel- lib----.--------: in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: i PPM'modu s--------: in1o)-sh�cut �����)ifto-2err_de nbox nbppchildROUcf!--1,---------- b--------: USo t2 modu _map--------: USo t2 modu _cel--util--------: USo t2 modu _loadbal888ll f USo t2 modu _topo888ll f USo t2 modu _io888ll f USo t2 modu _n DO d----------USo t2 modu _t--- fin-: -: USo t2 modu _m fn fin-: -: USo t2 modu _rmeh- c oct���-MODULE t2 modu _cel-8��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������