diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml new file mode 100644 index 0000000000..e22b10eb35 --- /dev/null +++ b/.github/workflows/CI.yml @@ -0,0 +1,46 @@ +name: CI + +on: [push, pull_request] + +env: + CI: "ON" # We can detect this in the build system and other vendors implement it + +jobs: + build: + strategy: + fail-fast: false + matrix: + os: [ ubuntu-20.04 ] + # gcc_v: [8, 9] # Version of GFortran we want to use. + build: [ Release, Debug ] + runs-on: ${{ matrix.os }} + env: + # FC: gfortran-${{ matrix.gcc_v }} + # OMPI_FC: gfortran-${{ matrix.gcc_v }} + # GCC_V: ${{ matrix.gcc_v }} + FC: gfortran + OMPI_FC: gfortran + + steps: + + - name: Checkout code + uses: actions/checkout@v2 + + - name: Install dependencies + run: | + sudo apt-get update + sudo apt-get -yqq install csh cmake gfortran libgomp1 openmpi-bin libopenmpi-dev libnetcdf-dev libnetcdff-dev netcdf-bin + + - name: Determing OS version + uses: kenchan0130/actions-system-info@master + id: system-info + + - name: Set OS version + run: | + echo "Release: ${{ steps.system-info.outputs.release }}" + echo "os_version=${{ steps.system-info.outputs.release }}" >> $GITHUB_ENV + + - name: Compile + run: | + cmake -S . -B build/Debug -D CMAKE_BUILD_TYPE=Debug + cd build/Debug && make -j diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml deleted file mode 100644 index 9f54b8dd6e..0000000000 --- a/.gitlab-ci.yml +++ /dev/null @@ -1,592 +0,0 @@ -before_script: - - hostname - - -# ********************************************************************** -# GFDL Workstation -# -# GNU Compilers -# ********************************************************************** -.build:gfdl-ws:gnu:repro: - stage: build - tags: - - gfdl-ws - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML -D_F2000" - myBuild: gfdl-ws_gnu_repro - script: - - source /usr/local/Modules/default/init/bash - - module use /home/fms/local/modulefiles - - module load fre/bronx-11 - - module rm netcdf - - module use /home/sdu/privatemodules - - module load netcdf_private/4.3.2 - - module load netcdf-fortran/4.4.1 - - module load mpich/3.1.3 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_gnu.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/gnu.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_gnu.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -# ********************************************************************** -# GFDL Workstation -# -# Intel 15 Compilers -# ********************************************************************** -build:gfdl-ws:intel15:debug: - stage: build - tags: - - gfdl-ws - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: gfdl-ws_intel15_debug - script: - - source /usr/local/Modules/default/init/bash - - module use /home/fms/local/modulefiles - - module load fre/bronx-11 - - module rm netcdf - - module use /home/sdu/privatemodules - - module load intel_compilers/15.0.0 - - module load netcdf_private/4.3.2 - - module load netcdf-fortran/4.4.1 - - module load mpich/3.1.3 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y DEBUG=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:gfdl-ws:intel15:repro: - stage: build - tags: - - gfdl-ws - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: gfdl-ws_intel15_repro - script: - - source /usr/local/Modules/default/init/bash - - module use /home/fms/local/modulefiles - - module load fre/bronx-11 - - module rm netcdf - - module use /home/sdu/privatemodules - - module load intel_compilers/15.0.0 - - module load netcdf_private/4.3.2 - - module load netcdf-fortran/4.4.1 - - module load mpich/3.1.3 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:gfdl-ws:intel15:prod: - stage: build - tags: - - gfdl-ws - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: gfdl-ws_intel15_prod - script: - - source /usr/local/Modules/default/init/bash - - module use /home/fms/local/modulefiles - - module load fre/bronx-11 - - module rm netcdf - - module use /home/sdu/privatemodules - - module load intel_compilers/15.0.0 - - module load netcdf_private/4.3.2 - - module load netcdf-fortran/4.4.1 - - module load mpich/3.1.3 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -# ********************************************************************** -# NCRC3 -# -# Intel 16 Compilers -# ********************************************************************** -build:ncrc3:intel16:debug: - stage: build - tags: - - ncrc3 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc3_intel16_debug - script: - - source /opt/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-intel - - module swap intel intel/16.0.3.210 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y DEBUG=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc3:intel16:repro: - stage: build - tags: - - ncrc3 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc3_intel16_repro - script: - - source /opt/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-intel - - module swap intel intel/16.0.3.210 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc3:intel16:prod: - stage: build - tags: - - ncrc3 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc3_intel16_prod - script: - - source /opt/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-intel - - module swap intel intel/16.0.3.210 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -# ********************************************************************** -# NCRC4 -# -# Intel 16 Compilers -# ********************************************************************** -build:ncrc4:intel16:debug: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc4_intel16_debug - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-intel - - module swap intel intel/16.0.3.210 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y DEBUG=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:intel16:repro: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc4_intel16_repro - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-intel - - module swap intel intel/16.0.3.210 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:intel16:prod: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc4_intel16_prod - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-intel - - module swap intel intel/16.0.3.210 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -# ********************************************************************** -# NCRC4 -# -# GNU Compilers -# ********************************************************************** -build:ncrc4:gnu:debug: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML -D_F2000" - myBuild: ncrc4_gnu_debug - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-gnu - - module swap gcc gcc/5.3.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/gnu.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make DEBUG=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:gnu:repro: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML -D_F2000" - myBuild: ncrc4_gnu_repro - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-gnu - - module swap gcc gcc/5.3.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/gnu.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:gnu:prod: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML -D_F2000" - myBuild: ncrc4_gnu_prod - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-gnu - - module swap gcc gcc/5.3.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/gnu.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -# ********************************************************************** -# NCRC4 -# -# PGI Compilers -# ********************************************************************** -build:ncrc4:pgi:debug: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc4_pgi_debug - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-pgi - - module swap pgi pgi/16.5.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/pgi.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y DEBUG=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:pgi:repro: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc4_pgi_repro - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-pgi - - module swap pgi pgi/16.5.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/pgi.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:pgi:prod: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: ncrc4_pgi_prod - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-pgi - - module swap pgi pgi/16.5.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/pgi.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -# ********************************************************************** -# NCRC4 -# -# Cray Compilers -# ********************************************************************** -build:ncrc4:cce:debug: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML -D_F2000" - myBuild: ncrc4_cce_debug - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-cray - - module swap cce cce/8.5.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/cray.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y DEBUG=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:cce:repro: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML -D_F2000" - myBuild: ncrc4_cce_repro - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-cray - - module swap cce cce/8.5.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/cray.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -build:ncrc4:cce:prod: - stage: build - tags: - - ncrc4 - variables: - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML -D_F2000" - myBuild: ncrc4_cce_prod - script: - - source /opt/cray/pe/modules/default/init/bash - - module use /ncrc/home2/fms/local/modulefiles - - module load fre/bronx-11 - - module rm cray-netcdf cray-hdf5 - - module rm PrgEnv-intel PrgEnv-pgi PrgEnv-gnu PrgEnv-cray - - module load PrgEnv-cray - - module swap cce cce/8.5.0 - - module load cray-netcdf - - module load cray-hdf5 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/cray.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -# ********************************************************************** -# theia -# -# Intel 16 Compilers -# ********************************************************************** -.build:theia:intel16:debug: - stage: build - tags: - - theia - variables: - PROJECT_DIR: /scratch4/GFDL/gfdlscr - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: theia_intel16_debug - script: - - source /apps/lmod/lmod/init/bash - - module use -a /home/fms/local/modulefiles - - module use -a /contrib/gfdl/modulefiles - - module load fre/bronx-11 - - module load intel/16.1.150 - - module load netcdf/4.3.0 - - module load hdf5/1.8.14 - - module load impi/5.0.1.035 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y DEBUG=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -.build:theia:intel16:repro: - stage: build - tags: - - theia - variables: - PROJECT_DIR: /scratch4/GFDL/gfdlscr - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: theia_intel16_repro - script: - - source /apps/lmod/lmod/init/bash - - module use -a /home/fms/local/modulefiles - - module use -a /contrib/gfdl/modulefiles - - module load fre/bronx-11 - - module load intel/16.1.150 - - module load netcdf/4.3.0 - - module load hdf5/1.8.14 - - module load impi/5.0.1.035 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y REPRO=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod - -.build:theia:intel16:prod: - stage: build - tags: - - theia - variables: - PROJECT_DIR: /scratch4/GFDL/gfdlscr - CPPFLAGS: "-Duse_netCDF -Duse_libMPI -DINTERNAL_FILE_NML" - myBuild: theia_intel16_prod - script: - - source /apps/lmod/lmod/init/bash - - module use -a /home/fms/local/modulefiles - - module use -a /contrib/gfdl/modulefiles - - module load fre/bronx-11 - - module load intel/16.1.150 - - module load netcdf/4.3.0 - - module load hdf5/1.8.14 - - module load impi/5.0.1.035 - - list_paths -o pathnames_fms . - - mkmf -m Makefile -p libfms_${myBuild}.a -t $FRE_COMMANDS_HOME/site/$FRE_SYSTEM_SITE/intel.mk -c "$CPPFLAGS" -Iinclude -Impp/include pathnames_fms - - make OPENMP=Y libfms_${myBuild}.a - artifacts: - paths: - - libfms_${myBuild}.a - - ./*.mod diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000000..ab0bf5ae08 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,81 @@ +cmake_minimum_required(VERSION 3.6) +project(FMS C Fortran) + +# make sure that the default is a RELWITHDEBINFO +if (NOT CMAKE_BUILD_TYPE) + set (CMAKE_BUILD_TYPE RELWITHDEBINFO CACHE STRING + "Choose the type of build, options are: Debug Release Relwithdebinfo." + FORCE) +endif() +message("Build type: " ${CMAKE_BUILD_TYPE}) + +find_package(MPI) +if(NOT MPI_FOUND) + # On NCI systems the MPI compiler is a wrapper script that adds compiler specific + # paths based on the loaded modules. Set MPIFORT_EXE and MPICC_EXE to the paths + # to these scripts and all should be well + if (DEFINED ENV{MPIFORT_EXE}) + message("mpifort executable found: " $ENV{MPIFORT_EXE}) + message("Will assume system MPI implementation is sound. Remove MPIFORT_EXE from environment to automatically configure MPI") + set(MPI_FORTRAN_COMPILER $ENV{MPIFORT_EXE}) + set(CMAKE_Fortran_COMPILER $ENV{MPIFORT_EXE}) + else () + message("Could not find Fortran MPI. Will continue and hope for the best") + endif() + if (DEFINED ENV{MPICC_EXE}) + message("mpicc executable found: " $ENV{MPICC_EXE}) + message("Will assume system MPI implementation is sound. Remove MPICC_EXE from environment to automatically configure MPI") + set(MPI_C_COMPILER $ENV{MPICC_EXE}) + set(CMAKE_C_COMPILER $ENV{MPICC_EXE}) + else () + message("Could not find C MPI. Will continue and hope for the best") + endif() +endif() + +include_directories(${MPI_Fortran_INCLUDE_PATH}) +add_compile_options(${MPI_Fortran_COMPILE_FLAGS}) + +message("Using Fortran: ${CMAKE_Fortran_COMPILER_ID} ${CMAKE_Fortran_COMPILER} and C: ${CMAKE_C_COMPILER_ID} ${CMAKE_C_COMPILER}") + +if(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fno-alias -stack-temps -safe-cray-ptr -ftz -assume byterecl -i4 -r8 -nowarn -sox -traceback") + set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -O2 -fp-model source") + set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -g") + set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g -O0 -check -check noarg_temp_created -check nopointer -warn -warn noerrors -fpe0 -ftrapuv") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -no-pie -fcray-pointer -fdefault-real-8 -ffree-line-length-none -fno-range-check") + set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -O2") + set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -g") + set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -O0 -g -Wuninitialized -fcheck=bounds -Werror -ffpe-trap=invalid,zero,overflow") +else () + message ("Unknown FORTRAN compiler default flags only...") +endif() + +if(CMAKE_C_COMPILER_ID STREQUAL "Intel") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -sox -traceback") + set(CMAKE_C_FLAGS_DEBUG "${CMAKE_C_FLAGS_DEBUG} -O0 -debug") + set(CMAKE_C_FLAGS_RELEASE "${CMAKE_C_FLAGS_RELEASE} -O2 -debug minimal") +elseif(CMAKE_C_COMPILER_ID STREQUAL "GNU") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -frecord-gcc-switches") + set(CMAKE_C_FLAGS_DEBUG "${CMAKE_C_FLAGS_DEBUG} -O0 -Werror -Wuninitialized -Wno-stringop-overflow") + set(CMAKE_C_FLAGS_RELEASE "${CMAKE_C_FLAGS_RELEASE} -O2") +else () + message ("Unknown C compiler default flags only...") +endif() + +string(TOUPPER ${CMAKE_BUILD_TYPE} BUILD_TYPE) +message("Using Fortran flags: ${CMAKE_Fortran_FLAGS} ${CMAKE_Fortran_FLAGS_${BUILD_TYPE}}") +message("Using C flags: ${CMAKE_C_FLAGS} ${CMAKE_C_FLAGS_${BUILD_TYPE}}") + +add_definitions(-Duse_libMPI -Duse_netCDF -Duse_LARGEFILE -DSPMD -D__IFC) + +set(FMS_DIR "${CMAKE_CURRENT_SOURCE_DIR}") + +# FMS static library +file(GLOB_RECURSE FMS_SOURCE LIST_DIRECTORIES false + ${FMS_DIR}/*.[fF]90 ${FMS_DIR}/*.c) + +add_library(FMS ${FMS_SOURCE}) + +target_include_directories(FMS PRIVATE + /usr/include ${FMS_DIR}/include ${FMS_DIR}/mosaic ${FMS_DIR}/drifters ${FMS_DIR}/fms ${FMS_DIR}/mpp/include) diff --git a/README.md b/README.md index 5d4b8aa8b3..d1e0710467 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,5 @@ +[![CI](https://github.com/mom-ocean/FMS/actions/workflows/CI.yml/badge.svg)](https://github.com/mom-ocean/FMS/actions/workflows/CI.yml) + # Flexible Modeling System (FMS) The Flexible Modeling System (FMS) is a software framework for supporting the @@ -6,6 +8,22 @@ of atmospheric, oceanic, and climate system models. More information is available on the [GFDL FMS page](http://www.gfdl.noaa.gov/fms). +# MOM5 Version + +This is a [GitHub fork](https://docs.github.com/en/get-started/quickstart/fork-a-repo) of +the [Official FMS repository](https://github.com/NOAA-GFDL/FMS) for the purpose of maintaining +a version of FMS that is compatible with the MOM5 ocean model. + +The GFDL `master` branch is tracked in the `https://github.com/mom-ocean/FMS/tree/gfdl/master` branch +on this repository. + +The `master` branch in this repository is included as a [subtree](https://www.atlassian.com/git/tutorials/git-subtree) +within the MOM5 repository. The forked occurred from the commit for the +[Warsaw 201803 Release](https://github.com/mom-ocean/FMS/commit/e8940fe90d68c3dc7c0d6bf1b8f552a577251754). After +this point the codebases started to diverge and it was decided it would be too difficult to udpate +driver code for all the supported model configurations. + +Note that this is not the version of FMS that is used for [MOM6](https://github.com/mom-ocean/MOM6). # Disclaimer The United States Department of Commerce (DOC) GitHub project code is provided diff --git a/astronomy/astronomy.tech.ps b/astronomy/astronomy.tech.ps deleted file mode 100644 index 23629b217b..0000000000 Binary files a/astronomy/astronomy.tech.ps and /dev/null differ diff --git a/axis_utils/axis_utils.F90 b/axis_utils/axis_utils.F90 index 0a2fade440..f0ffaae3e1 100644 --- a/axis_utils/axis_utils.F90 +++ b/axis_utils/axis_utils.F90 @@ -876,7 +876,7 @@ program test end program test -#endif /* test_axis_utils */ +#endif diff --git a/block_control/block_control.F90 b/block_control/block_control.F90 index a03af97137..cd366c77e2 100644 --- a/block_control/block_control.F90 +++ b/block_control/block_control.F90 @@ -74,7 +74,7 @@ subroutine define_blocks (component, Block, isc, iec, jsc, jec, kpts, & integer, dimension(nx_block) :: i1, i2 integer, dimension(ny_block) :: j1, j2 character(len=256) :: text - integer :: i, j, nblks, ii, jj + integer :: i, j, nblks, ii, jj, ix if (message) then if ((mod(iec-isc+1,nx_block) .ne. 0) .or. (mod(jec-jsc+1,ny_block) .ne. 0)) then diff --git a/exchange/test_xgrid.F90 b/exchange/test_xgrid.F90 index 91025f3bc6..439fed7b3f 100644 --- a/exchange/test_xgrid.F90 +++ b/exchange/test_xgrid.F90 @@ -980,4 +980,4 @@ end program xgrid_test module null_test_xgrid end module -#endif /* test_mpp */ +#endif diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index b8f0f6bb2a..9d086ba71a 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -477,9 +477,15 @@ module xgrid_mod integer :: id_get_2_from_xgrid = 0 integer :: id_put_2_to_xgrid = 0 integer :: id_setup_xmap = 0 - integer :: id_load_xgrid1, id_load_xgrid2, id_load_xgrid3 - integer :: id_load_xgrid4, id_load_xgrid5 - integer :: id_load_xgrid, id_set_comm, id_regen, id_conservation_check + integer :: id_load_xgrid1 = 0 + integer :: id_load_xgrid2 = 0 + integer :: id_load_xgrid3 = 0 + integer :: id_load_xgrid4 = 0 + integer :: id_load_xgrid5 = 0 + integer :: id_load_xgrid = 0 + integer :: id_set_comm = 0 + integer :: id_regen = 0 + integer :: id_conservation_check = 0 ! The following is for nested model @@ -866,7 +872,9 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u !--- first find out number of points need to send to other pe and fill the send buffer. nsend1(:) = 0; nrecv1(:) = 0 nsend2(:) = 0; nrecv2(:) = 0 - ibuf1(:)= 0; ibuf2(:)= 0 + + ibuf1(:) = 0; ibuf2(:) = 0 + call mpp_clock_begin(id_load_xgrid2) if(nxgrid_local>0) then @@ -918,6 +926,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u if (do_alltoall) then do p = 0, npes-1 + ibuf1(2*p+1) = nsend1(p) ibuf1(2*p+2) = nsend2(p) enddo @@ -943,7 +952,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u nrecv1(p) = ibuf2(2*p+1) nrecv2(p) = ibuf2(2*p+2) enddo - + if(.not. do_alltoall) call mpp_sync_self() call mpp_clock_end(id_load_xgrid3) call mpp_clock_begin(id_load_xgrid4) diff --git a/fft/fft.F90 b/fft/fft.F90 index b0ef732c7e..cfdd62b51b 100644 --- a/fft/fft.F90 +++ b/fft/fft.F90 @@ -62,11 +62,9 @@ module fft_mod use platform_mod, only: R8_KIND, R4_KIND use fms_mod, only: write_version_number, & error_mesg, FATAL -#ifndef SGICRAY -#ifndef NAGFFT +#if !defined(SGICRAY) || !defined(NAGFFT) use fft99_mod, only: fft991, set99 #endif -#endif implicit none private diff --git a/field_manager/field_manager.F90 b/field_manager/field_manager.F90 index 5d2670bf2c..7560846d43 100644 --- a/field_manager/field_manager.F90 +++ b/field_manager/field_manager.F90 @@ -19,11 +19,11 @@ module field_manager_mod #ifndef MAXFIELDS_ -#define MAXFIELDS_ 150 +#define MAXFIELDS_ 250 #endif #ifndef MAXFIELDMETHODS_ -#define MAXFIELDMETHODS_ 150 +#define MAXFIELDMETHODS_ 250 #endif ! @@ -1181,7 +1181,9 @@ subroutine new_name ( list_name, method_name_in , val_name_in) if (val_name(1:1) .eq. squote) then !{ if (val_name(length:length) .eq. squote) then - val_name = val_name(2:length-1) + ! gfortran complains reading about 128 bytes from a region of size 127. Concatenating + ! an empty string prevents flagging an error + val_name = val_name(2:length-1) // '' val_type = string_type elseif (val_name(length:length) .eq. dquote) then call mpp_error(FATAL, trim(error_header) // ' Quotes do not match in ' // trim(val_name) // & diff --git a/fms/fms.F90 b/fms/fms.F90 index a85cdd9f01..378f772112 100644 --- a/fms/fms.F90 +++ b/fms/fms.F90 @@ -300,7 +300,6 @@ module fms_mod ! ---- private data for check_nml_error ---- - integer, private :: num_nml_error_codes, nml_error_codes(20) logical, private :: do_nml_error_init = .true. private nml_error_init @@ -441,7 +440,6 @@ subroutine fms_init (localcomm ) if (mpp_pe() == mpp_root_pe()) then unit = stdlog() write (unit, nml=fms_nml) - write (unit,*) 'nml_error_codes=', nml_error_codes(1:num_nml_error_codes) endif call memutils_init( print_memory_usage ) diff --git a/fms/fms_io.F90 b/fms/fms_io.F90 index 4b62dbc32b..acff993d7c 100644 --- a/fms/fms_io.F90 +++ b/fms/fms_io.F90 @@ -145,7 +145,7 @@ module fms_io_mod integer, parameter, private :: max_split_file = 50 -integer, parameter, private :: max_fields=400 +integer, parameter, private :: max_fields=200 integer, parameter, private :: max_axes=40 integer, parameter, private :: max_atts=20 integer, parameter, private :: max_domains = 10 @@ -544,10 +544,16 @@ module fms_io_mod logical :: show_open_namelist_file_warning = .false. logical :: debug_mask_list = .false. logical :: checksum_required = .true. +! Deprecated namelist variables +character(len=32) :: threading_write = 'multi' +character(len=32) :: fileset_write = 'multi' + namelist /fms_io_nml/ fms_netcdf_override, fms_netcdf_restart, & threading_read, format, read_all_pe, iospec_ieee32,max_files_w,max_files_r, & read_data_bug, time_stamp_restart, print_chksum, show_open_namelist_file_warning, & - debug_mask_list, checksum_required, dr_set_size + debug_mask_list, checksum_required, dr_set_size, & + threading_write, & ! Deprecated + fileset_write ! Deprecated integer :: pack_size ! = 1 for double = 2 for float diff --git a/fms/fms_io_unstructured_read.inc b/fms/fms_io_unstructured_read.inc index 8750ffda14..5962a91791 100644 --- a/fms/fms_io_unstructured_read.inc +++ b/fms/fms_io_unstructured_read.inc @@ -47,7 +47,7 @@ subroutine fms_io_unstructured_read_r_scalar(filename, & !Use the 1D case. if (present(timelevel)) then - if (tlevel .le. 0) then + if (timelevel .le. 0) then call mpp_error(FATAL, & "fms_io_unstructured_read_r_scalar:" & //" the inputted time level must be at" & @@ -359,7 +359,7 @@ subroutine fms_io_unstructured_read_i_scalar(filename, & !Read in the data. if (present(timelevel)) then - if (tlevel .le. 0) then + if (timelevel .le. 0) then call mpp_error(FATAL, & "fms_io_unstructured_read_i_scalar:" & //" the inputted time level must be at" & diff --git a/memutils/memutils.F90 b/memutils/memutils.F90 index f858f9955d..139f066236 100644 --- a/memutils/memutils.F90 +++ b/memutils/memutils.F90 @@ -241,7 +241,7 @@ integer function hplen( hpalloc, hplargest, hpshrink, hpgrow, hpfirs if( present(hplast ) )hplast = IHPSTAT(14) !Last word address return end function hplen -#endif /* _CRAY */ +#endif #ifdef _CRAYT90 integer function stklen( stkhiwm, stknumber, stktotal, stkmost, stkgrew, stkgtimes ) @@ -259,7 +259,7 @@ integer function stklen( stkhiwm, stknumber, stktotal, stkmost, stkgr if( present(stkgtimes) )stkgtimes = istat(7) !#times stack grew return end function stklen -#endif /* _CRAYT90 */ +#endif !cache utilities: need to write version for other argument types function get_l1_cache_line(a) diff --git a/mosaic/read_mosaic.c b/mosaic/read_mosaic.c index f40365eacd..bd0ffc11d4 100644 --- a/mosaic/read_mosaic.c +++ b/mosaic/read_mosaic.c @@ -827,7 +827,7 @@ float get_global_area(void) void read_mosaic_grid_data(const char *mosaic_file, const char *name, int nx, int ny, double *data, unsigned int level, int ioff, int joff) { - char tilefile[STRING], gridfile[STRING], dir[STRING]; + char tilefile[STRING*2+1], gridfile[STRING], dir[STRING]; double *tmp; int ni, nj, nxp, nyp, i, j; diff --git a/mpp/affinity.c b/mpp/affinity.c index f7417be470..47f6c82beb 100644 --- a/mpp/affinity.c +++ b/mpp/affinity.c @@ -27,10 +27,12 @@ #include #include +#if !defined(__GLIBC__) || __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 30) static pid_t gettid(void) { return syscall(__NR_gettid); } +#endif /* * Returns this thread's CPU affinity, if bound to a single core, diff --git a/mpp/include/mpp_alltoall_mpi.h b/mpp/include/mpp_alltoall_mpi.h index eaf0bf7da6..e5d9c11d50 100644 --- a/mpp/include/mpp_alltoall_mpi.h +++ b/mpp/include/mpp_alltoall_mpi.h @@ -18,12 +18,10 @@ !*********************************************************************** subroutine MPP_ALLTOALL_(sbuf, scount, rbuf, rcount, pelist) - MPP_TYPE_, intent(in) :: sbuf(:) MPP_TYPE_, intent(inout) :: rbuf(:) integer, intent(in) :: scount, rcount - integer, intent(in), optional :: pelist(0:) integer :: n @@ -31,7 +29,6 @@ subroutine MPP_ALLTOALL_(sbuf, scount, rbuf, rcount, pelist) call mpp_error(FATAL, 'MPP_ALLTOALL: You must first call mpp_init.') n = get_peset(pelist) -! if (peset(n)%count .eq. 1) return if (current_clock .NE. 0) call SYSTEM_CLOCK(start_tick) @@ -48,7 +45,6 @@ end subroutine MPP_ALLTOALL_ subroutine MPP_ALLTOALLV_(sbuf, ssize, sdispl, rbuf, rsize, rdispl, pelist) - MPP_TYPE_, intent(in) :: sbuf(:) MPP_TYPE_, intent(inout) :: rbuf(:) @@ -60,14 +56,13 @@ subroutine MPP_ALLTOALLV_(sbuf, ssize, sdispl, rbuf, rsize, rdispl, pelist) integer :: n if (.NOT. module_is_initialized) & - call mpp_error(FATAL, 'MPP_ALLTOALL: You must first call mpp_init.') + call mpp_error(FATAL, 'MPP_ALLTOALLV_: You must first call mpp_init.') n = get_peset(pelist) -! if (peset(n)%count .eq. 1) return if (current_clock .NE. 0) call SYSTEM_CLOCK(start_tick) - if (verbose) call mpp_error(NOTE, 'MPP_ALLTOALL_: using MPI_Alltoallv...') + if (verbose) call mpp_error(NOTE, 'MPP_ALLTOALLV_: using MPI_Alltoallv...') call MPI_Alltoallv(sbuf, ssize, sdispl, MPI_TYPE_, & rbuf, rsize, rdispl, MPI_TYPE_, & @@ -77,3 +72,46 @@ subroutine MPP_ALLTOALLV_(sbuf, ssize, sdispl, rbuf, rsize, rdispl, pelist) call increment_current_clock(EVENT_ALLTOALL, MPP_TYPE_BYTELEN_) end subroutine MPP_ALLTOALLV_ + + +subroutine MPP_ALLTOALLW_(sbuf, ssize, sdispl, stype, & + rbuf, rsize, rdispl, rtype, pelist) + MPP_TYPE_, intent(in) :: sbuf(:) + MPP_TYPE_, intent(inout) :: rbuf(:) + + integer, intent(in) :: ssize(:), rsize(:) + integer, intent(in) :: sdispl(:), rdispl(:) + type(mpp_type), intent(in) :: stype(:), rtype(:) + integer, intent(in), optional :: pelist(0:) + integer :: i, n + + integer, allocatable :: sendtypes(:), recvtypes(:) + + if (.NOT. module_is_initialized) & + call mpp_error(FATAL, 'MPP_ALLTOALLW_: You must first call mpp_init.') + + n = get_peset(pelist) + + if (current_clock .NE. 0) call SYSTEM_CLOCK(start_tick) + + if (verbose) call mpp_error(NOTE, 'MPP_ALLTOALLW_: using MPI_Alltoallw...') + + ! Convert mpp_types to MPI datatype IDs + ! NOTE: sendtypes and recvtypes must be the same size + allocate(sendtypes(size(stype))) + allocate(recvtypes(size(rtype))) + do i = 1, size(stype) + sendtypes(i) = stype(i)%id + recvtypes(i) = rtype(i)%id + end do + + call MPI_Alltoallw(sbuf, ssize, sdispl, sendtypes, & + rbuf, rsize, rdispl, recvtypes, & + peset(n)%id, error) + + deallocate(sendtypes, recvtypes) + + if (current_clock .NE. 0) & + call increment_current_clock(EVENT_ALLTOALL, MPP_TYPE_BYTELEN_) + +end subroutine MPP_ALLTOALLW_ diff --git a/mpp/include/mpp_alltoall_nocomm.h b/mpp/include/mpp_alltoall_nocomm.h index d72eb2458d..1805a4283e 100644 --- a/mpp/include/mpp_alltoall_nocomm.h +++ b/mpp/include/mpp_alltoall_nocomm.h @@ -18,7 +18,6 @@ !*********************************************************************** subroutine MPP_ALLTOALL_(sbuf, scount, rbuf, rcount, pelist) - MPP_TYPE_, dimension(:), intent(in) :: sbuf MPP_TYPE_, dimension(:), intent(inout) :: rbuf integer, intent(in) :: scount, rcount @@ -39,7 +38,6 @@ end subroutine MPP_ALLTOALL_ subroutine MPP_ALLTOALLV_(sbuf, ssize, sdispl, rbuf, rsize, rdispl, pelist) - MPP_TYPE_, intent(in) :: sbuf(:) MPP_TYPE_, intent(inout) :: rbuf(:) @@ -59,3 +57,27 @@ subroutine MPP_ALLTOALLV_(sbuf, ssize, sdispl, rbuf, rsize, rdispl, pelist) call increment_current_clock(EVENT_ALLTOALL, MPP_TYPE_BYTELEN_) end subroutine MPP_ALLTOALLV_ + + +subroutine MPP_ALLTOALLW_(sbuf, ssize, sdispl, stype, & + rbuf, rsize, rdispl, rtype, pelist) + MPP_TYPE_, intent(in) :: sbuf(:) + MPP_TYPE_, intent(inout) :: rbuf(:) + + integer, intent(in) :: ssize(:), rsize(:) + integer, intent(in) :: sdispl(:), rdispl(:) + type(mpp_type), intent(in) :: stype(:), rtype(:) + + integer, intent(in), optional :: pelist(0:) + + if (.NOT. module_is_initialized) & + call mpp_error(FATAL, 'MPP_ALLTOALL: You must first call mpp_init.') + + if (current_clock .NE. 0) call SYSTEM_CLOCK(start_tick) + + rbuf(:) = sbuf(:) + + if (current_clock .NE. 0) & + call increment_current_clock(EVENT_ALLTOALL, MPP_TYPE_BYTELEN_) + +end subroutine MPP_ALLTOALLW_ diff --git a/mpp/include/mpp_alltoall_sma.h b/mpp/include/mpp_alltoall_sma.h index 8a19296ba0..28ab518f0b 100644 --- a/mpp/include/mpp_alltoall_sma.h +++ b/mpp/include/mpp_alltoall_sma.h @@ -18,7 +18,6 @@ !*********************************************************************** subroutine MPP_ALLTOALL_(sbuf, scount, rbuf, rcount, pelist) - MPP_TYPE_, dimension(:), intent(in) :: sbuf MPP_TYPE_, dimension(:), intent(inout) :: rbuf integer, intent(in) :: scount, rcount @@ -31,7 +30,6 @@ end subroutine MPP_ALLTOALL_ subroutine MPP_ALLTOALLV_(sbuf, ssize, sdispl, rbuf, rsize, rdispl, pelist) - MPP_TYPE_, intent(in) :: sbuf(:) MPP_TYPE_, intent(inout) :: rbuf(:) @@ -43,3 +41,19 @@ subroutine MPP_ALLTOALLV_(sbuf, ssize, sdispl, rbuf, rsize, rdispl, pelist) call mpp_error(FATAL, 'MPP_ALLTOALLV: No SHMEM implementation.') end subroutine MPP_ALLTOALLV_ + + +subroutine MPP_ALLTOALLW_(sbuf, ssize, sdispl, stype, & + rbuf, rsize, rdispl, rtype, pelist) + MPP_TYPE_, intent(in) :: sbuf(:) + MPP_TYPE_, intent(inout) :: rbuf(:) + + integer, intent(in) :: ssize(:), rsize(:) + integer, intent(in) :: sdispl(:), rdispl(:) + type(mpp_type), intent(in) :: stype(:), rtype(:) + + integer, intent(in), optional :: pelist(0:) + + call mpp_error(FATAL, 'MPP_ALLTOALLW: No SHMEM implementation.') + +end subroutine MPP_ALLTOALLW_ diff --git a/mpp/include/mpp_comm_mpi.inc b/mpp/include/mpp_comm_mpi.inc index aee87d117c..cb411600fb 100644 --- a/mpp/include/mpp_comm_mpi.inc +++ b/mpp/include/mpp_comm_mpi.inc @@ -34,6 +34,7 @@ logical :: opened, existed integer :: unit_begin, unit_end, unit_nml, io_status character(len=5) :: this_pe + type(mpp_type), pointer :: dtype if( module_is_initialized )return @@ -79,6 +80,23 @@ tick_rate = 1./ticks_per_sec clock0 = mpp_clock_id( 'Total runtime', flags=MPP_CLOCK_SYNC ) + ! Create the bytestream (default) mpp_datatype + mpp_byte%counter = 1 + mpp_byte%ndims = 0 + allocate(mpp_byte%sizes(0)) + allocate(mpp_byte%subsizes(0)) + allocate(mpp_byte%starts(0)) + mpp_byte%etype = MPI_BYTE + mpp_byte%id = MPI_BYTE + + mpp_byte%prev => null() + mpp_byte%next => null() + + ! Initialize datatype list with mpp_byte + datatypes%head => mpp_byte + datatypes%tail => mpp_byte + datatypes%length = 0 + if( PRESENT(flags) )then debug = flags.EQ.MPP_DEBUG verbose = flags.EQ.MPP_VERBOSE .OR. debug @@ -204,6 +222,7 @@ subroutine mpp_exit() real :: t, tmin, tmax, tavg, tstd real :: m, mmin, mmax, mavg, mstd, t_total logical :: opened + type(mpp_type), pointer :: dtype if( .NOT.module_is_initialized )return call mpp_set_current_pelist() @@ -291,14 +310,20 @@ subroutine mpp_exit() close(etc_unit) endif + ! Clear derived data types (skipping list head, mpp_byte) + dtype => datatypes%head + do while (.not. associated(dtype)) + dtype => dtype%next + dtype%counter = 1 ! Force deallocation + call mpp_type_free(dtype) + end do + call mpp_set_current_pelist() call mpp_sync() call mpp_max(mpp_stack_hwm) if( pe.EQ.root_pe )write( out_unit,* )'MPP_STACK high water mark=', mpp_stack_hwm if(mpp_comm_private == MPI_COMM_WORLD ) call MPI_FINALIZE(error) - - return end subroutine mpp_exit @@ -1141,11 +1166,13 @@ end subroutine mpp_gsm_free #undef MPP_ALLTOALL_ #undef MPP_ALLTOALLV_ +#undef MPP_ALLTOALLW_ #undef MPP_TYPE_ #undef MPP_TYPE_BYTELEN_ #undef MPI_TYPE_ #define MPP_ALLTOALL_ mpp_alltoall_int4 #define MPP_ALLTOALLV_ mpp_alltoall_int4_v +#define MPP_ALLTOALLW_ mpp_alltoall_int4_w #define MPP_TYPE_ integer(INT_KIND) #define MPP_TYPE_BYTELEN_ 4 #define MPI_TYPE_ MPI_INTEGER4 @@ -1153,11 +1180,13 @@ end subroutine mpp_gsm_free #undef MPP_ALLTOALL_ #undef MPP_ALLTOALLV_ +#undef MPP_ALLTOALLW_ #undef MPP_TYPE_ #undef MPP_TYPE_BYTELEN_ #undef MPI_TYPE_ #define MPP_ALLTOALL_ mpp_alltoall_int8 #define MPP_ALLTOALLV_ mpp_alltoall_int8_v +#define MPP_ALLTOALLW_ mpp_alltoall_int8_w #define MPP_TYPE_ integer(LONG_KIND) #define MPP_TYPE_BYTELEN_ 8 #define MPI_TYPE_ MPI_INTEGER8 @@ -1165,11 +1194,13 @@ end subroutine mpp_gsm_free #undef MPP_ALLTOALL_ #undef MPP_ALLTOALLV_ +#undef MPP_ALLTOALLW_ #undef MPP_TYPE_ #undef MPP_TYPE_BYTELEN_ #undef MPI_TYPE_ #define MPP_ALLTOALL_ mpp_alltoall_real4 #define MPP_ALLTOALLV_ mpp_alltoall_real4_v +#define MPP_ALLTOALLW_ mpp_alltoall_real4_w #define MPP_TYPE_ real(FLOAT_KIND) #define MPP_TYPE_BYTELEN_ 4 #define MPI_TYPE_ MPI_REAL4 @@ -1177,12 +1208,138 @@ end subroutine mpp_gsm_free #undef MPP_ALLTOALL_ #undef MPP_ALLTOALLV_ +#undef MPP_ALLTOALLW_ #undef MPP_TYPE_ #undef MPP_TYPE_BYTELEN_ #undef MPI_TYPE_ #define MPP_ALLTOALL_ mpp_alltoall_real8 #define MPP_ALLTOALLV_ mpp_alltoall_real8_v +#define MPP_ALLTOALLW_ mpp_alltoall_real8_w #define MPP_TYPE_ real(DOUBLE_KIND) #define MPP_TYPE_BYTELEN_ 8 #define MPI_TYPE_ MPI_REAL8 #include + +#undef MPP_ALLTOALL_ +#undef MPP_ALLTOALLV_ +#undef MPP_ALLTOALLW_ +#undef MPP_TYPE_ +#undef MPP_TYPE_BYTELEN_ +#undef MPI_TYPE_ +#define MPP_ALLTOALL_ mpp_alltoall_logical4 +#define MPP_ALLTOALLV_ mpp_alltoall_logical4_v +#define MPP_ALLTOALLW_ mpp_alltoall_logical4_w +#define MPP_TYPE_ logical(INT_KIND) +#define MPP_TYPE_BYTELEN_ 4 +#define MPI_TYPE_ MPI_INTEGER4 +#include + +#undef MPP_ALLTOALL_ +#undef MPP_ALLTOALLV_ +#undef MPP_ALLTOALLW_ +#undef MPP_TYPE_ +#undef MPP_TYPE_BYTELEN_ +#undef MPI_TYPE_ +#define MPP_ALLTOALL_ mpp_alltoall_logical8 +#define MPP_ALLTOALLV_ mpp_alltoall_logical8_v +#define MPP_ALLTOALLW_ mpp_alltoall_logical8_w +#define MPP_TYPE_ logical(LONG_KIND) +#define MPP_TYPE_BYTELEN_ 8 +#define MPI_TYPE_ MPI_INTEGER8 +#include +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! DATA TRANSFER TYPES: mpp_type_create, mpp_type_free ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +#define MPP_TYPE_CREATE_ mpp_type_create_int4 +#define MPP_TYPE_ integer(INT_KIND) +#define MPI_TYPE_ MPI_INTEGER4 +#include +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +#define MPP_TYPE_CREATE_ mpp_type_create_int8 +#define MPP_TYPE_ integer(LONG_KIND) +#define MPI_TYPE_ MPI_INTEGER8 +#include +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +#define MPP_TYPE_CREATE_ mpp_type_create_real4 +#define MPP_TYPE_ real(FLOAT_KIND) +#define MPI_TYPE_ MPI_REAL4 +#include +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +#define MPP_TYPE_CREATE_ mpp_type_create_real8 +#define MPP_TYPE_ real(DOUBLE_KIND) +#define MPI_TYPE_ MPI_REAL8 +#include +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +#define MPP_TYPE_CREATE_ mpp_type_create_logical4 +#define MPP_TYPE_ logical(INT_KIND) +#define MPI_TYPE_ MPI_INTEGER4 +#include +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +#define MPP_TYPE_CREATE_ mpp_type_create_logical8 +#define MPP_TYPE_ logical(LONG_KIND) +#define MPI_TYPE_ MPI_INTEGER8 +#include + +! Clear preprocessor flags +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +! NOTE: This should probably not take a pointer, but for now we do this. +subroutine mpp_type_free(dtype) + type(mpp_type), pointer, intent(inout) :: dtype + + if (.NOT. module_is_initialized) & + call mpp_error(FATAL, 'MPP_TYPE_FREE: You must first call mpp_init.') + + if (current_clock .NE. 0) & + call SYSTEM_CLOCK(start_tick) + + if (verbose) & + call mpp_error(NOTE, 'MPP_TYPE_FREE: using MPI_Type_free...') + + ! Decrement the reference counter + dtype%counter = dtype%counter - 1 + + if (dtype%counter < 1) then + ! De-register the datatype in MPI runtime + call MPI_Type_free(dtype%id, error) + + ! Remove from list + dtype%prev => dtype%next + + ! Remove from memory + if (allocated(dtype%sizes)) deallocate(dtype%sizes) + if (allocated(dtype%subsizes)) deallocate(dtype%subsizes) + if (allocated(dtype%starts)) deallocate(dtype%starts) + deallocate(dtype) + + datatypes%length = datatypes%length - 1 + end if + + if (current_clock .NE. 0) & + call increment_current_clock(EVENT_TYPE_FREE, MPP_TYPE_BYTELEN_) + +end subroutine mpp_type_free diff --git a/mpp/include/mpp_comm_nocomm.inc b/mpp/include/mpp_comm_nocomm.inc index 430dd6ef75..2588e4f947 100644 --- a/mpp/include/mpp_comm_nocomm.inc +++ b/mpp/include/mpp_comm_nocomm.inc @@ -56,6 +56,25 @@ subroutine mpp_init( flags,localcomm ) tick_rate = 1./ticks_per_sec clock0 = mpp_clock_id( 'Total runtime', flags=MPP_CLOCK_SYNC ) + ! Initialize mpp_datatypes + ! NOTE: mpp_datatypes is unused in serial mode; this is an empty list + datatypes%head => null() + datatypes%tail => null() + datatypes%length = 0 + + ! Create the bytestream (default) mpp_datatype + ! NOTE: mpp_byte is unused in serial mode + mpp_byte%counter = -1 + mpp_byte%ndims = -1 + allocate(mpp_byte%sizes(0)) + allocate(mpp_byte%subsizes(0)) + allocate(mpp_byte%starts(0)) + mpp_byte%etype = -1 + mpp_byte%id = -1 + + mpp_byte%prev => null() + mpp_byte%next => null() + if( PRESENT(flags) )then debug = flags.EQ.MPP_DEBUG verbose = flags.EQ.MPP_VERBOSE .OR. debug @@ -1046,3 +1065,55 @@ end subroutine mpp_exit #define MPP_TYPE_BYTELEN_ 8 #define MPI_TYPE_ MPI_REAL8 #include + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! DATA TRANSFER TYPES: mpp_type_create, mpp_type_free ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +#define MPP_TYPE_CREATE_ mpp_type_create_int4 +#define MPP_TYPE_ integer(INT_KIND) +#define MPI_TYPE_ MPI_INTEGER4 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_int8 +#define MPP_TYPE_ integer(LONG_KIND) +#define MPI_TYPE_ MPI_INTEGER8 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_real4 +#define MPP_TYPE_ real(FLOAT_KIND) +#define MPI_TYPE_ MPI_REAL4 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_real8 +#define MPP_TYPE_ real(DOUBLE_KIND) +#define MPI_TYPE_ MPI_REAL8 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_logical4 +#define MPP_TYPE_ logical(INT_KIND) +#define MPI_TYPE_ MPI_INTEGER4 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_logical8 +#define MPP_TYPE_ logical(LONG_KIND) +#define MPI_TYPE_ MPI_INTEGER8 +#include + +! Clear preprocessor flags +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +subroutine mpp_type_free(dtype) + type(mpp_type), pointer, intent(inout) :: dtype + + call mpp_error(NOTE, 'MPP_TYPE_FREE: ' & + 'This function should not be used in serial mode.') + + ! For consistency with MPI, we deallocate the pointer + deallocate(dtype) + +end subroutine mpp_type_free diff --git a/mpp/include/mpp_comm_sma.inc b/mpp/include/mpp_comm_sma.inc index c1fb2cb798..3774416edb 100644 --- a/mpp/include/mpp_comm_sma.inc +++ b/mpp/include/mpp_comm_sma.inc @@ -68,6 +68,25 @@ subroutine mpp_init( flags,localcomm ) tick_rate = 1./ticks_per_sec clock0 = mpp_clock_id( 'Total runtime', flags=MPP_CLOCK_SYNC ) + ! Initialize mpp_datatypes + ! NOTE: mpp_datatypes are not implemented in SHMEM; this is an empty list + datatypes%head => null() + datatypes%tail => null() + datatypes%length = 0 + + ! Create the bytestream (default) mpp_datatype + ! NOTE: mpp_byte is unused in SHMEM + mpp_byte%counter = -1 + mpp_byte%ndims = -1 + allocate(mpp_byte%sizes(0)) + allocate(mpp_byte%subsizes(0)) + allocate(mpp_byte%starts(0)) + mpp_byte%etype = -1 + mpp_byte%id = -1 + + mpp_byte%prev => null() + mpp_byte%next => null() + if( PRESENT(flags) )then debug = flags.EQ.MPP_DEBUG verbose = flags.EQ.MPP_VERBOSE .OR. debug @@ -1155,6 +1174,53 @@ end subroutine mpp_malloc #define MPI_TYPE_ MPI_REAL8 #include +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! DATA TRANSFER TYPES: mpp_type_create, mpp_type_free ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +#define MPP_TYPE_CREATE_ mpp_type_create_int4 +#define MPP_TYPE_ integer(INT_KIND) +#define MPI_TYPE_ MPI_INTEGER4 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_int8 +#define MPP_TYPE_ integer(LONG_KIND) +#define MPI_TYPE_ MPI_INTEGER8 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_real4 +#define MPP_TYPE_ real(FLOAT_KIND) +#define MPI_TYPE_ MPI_REAL4 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_real8 +#define MPP_TYPE_ real(DOUBLE_KIND) +#define MPI_TYPE_ MPI_REAL8 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_logical4 +#define MPP_TYPE_ logical(INT_KIND) +#define MPI_TYPE_ MPI_INTEGER4 +#include + +#define MPP_TYPE_CREATE_ mpp_type_create_logical8 +#define MPP_TYPE_ logical(LONG_KIND) +#define MPI_TYPE_ MPI_INTEGER8 +#include + +! Clear preprocessor flags +#undef MPI_TYPE_ +#undef MPP_TYPE_ +#undef MPP_TYPE_CREATE_ + +subroutine mpp_type_free(dtype) + type(mpp_type), pointer, intent(inout) :: dtype + + call mpp_error(FATAL, 'MPP_TYPE_FREE: Unsupported for SHMEM.') +end subroutine mpp_type_free + !####################################################################### !these local versions are written for grouping into shmem_integer_wait subroutine shmem_int4_wait_local( ivar, cmp_value ) diff --git a/mpp/include/mpp_do_global_field.h b/mpp/include/mpp_do_global_field.h index 8e62140ff4..8b94631199 100644 --- a/mpp/include/mpp_do_global_field.h +++ b/mpp/include/mpp_do_global_field.h @@ -1,21 +1,3 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Flexible Modeling System (FMS). -!* -!* FMS 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. -!* -!* FMS 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 Lesser General Public -!* License along with FMS. If not, see . -!*********************************************************************** subroutine MPP_DO_GLOBAL_FIELD_3D_( domain, local, global, tile, ishift, jshift, flags, default_data) !get a global field from a local field !local field may be on compute OR data domain @@ -161,20 +143,27 @@ rpos = mod(domain%x(1)%pos +n,nd) from_pe = domain%x(1)%list(rpos)%pe rpos = from_pe - root_pe ! for concurrent run, root_pe may not be 0. - nwords = (domain%list(rpos)%x(1)%compute%size+ishift) * (domain%list(rpos)%y(1)%compute%size+jshift) * ke + if (from_pe == NULL_PE) then + nwords = 0 + else + nwords = (domain%list(rpos)%x(1)%compute%size+ishift) & + * (domain%list(rpos)%y(1)%compute%size+jshift) * ke + endif ! Force use of scalar, integer ptr interface call mpp_transmit( put_data=clocal(1), plen=nword_me, to_pe=domain%x(1)%list(lpos)%pe, & get_data=cremote(1), glen=nwords, from_pe=from_pe ) m = 0 - is = domain%list(rpos)%x(1)%compute%begin; ie = domain%list(rpos)%x(1)%compute%end+ishift - do k = 1, ke - do j = jsc, jec - do i = is, ie - m = m + 1 - global(i,j+jpos,k) = cremote(m) + if (from_pe /= NULL_PE) then + is = domain%list(rpos)%x(1)%compute%begin; ie = domain%list(rpos)%x(1)%compute%end+ishift + do k = 1, ke + do j = jsc, jec + do i = is, ie + m = m + 1 + global(i,j+jpos,k) = cremote(m) + end do end do end do - end do + endif call mpp_sync_self() !-ensure MPI_ISEND is done. end do else if( yonly )then @@ -184,21 +173,27 @@ rpos = mod(domain%y(1)%pos +n,nd) from_pe = domain%y(1)%list(rpos)%pe rpos = from_pe - root_pe - nwords = (domain%list(rpos)%x(1)%compute%size+ishift) & - * (domain%list(rpos)%y(1)%compute%size+jshift) * ke + if (from_pe == NULL_PE) then + nwords = 0 + else + nwords = (domain%list(rpos)%x(1)%compute%size+ishift) & + * (domain%list(rpos)%y(1)%compute%size+jshift) * ke + endif ! Force use of scalar, integer pointer interface call mpp_transmit( put_data=clocal(1), plen=nword_me, to_pe=domain%y(1)%list(lpos)%pe, & get_data=cremote(1), glen=nwords, from_pe=from_pe ) m = 0 - js = domain%list(rpos)%y(1)%compute%begin; je = domain%list(rpos)%y(1)%compute%end+jshift - do k = 1,ke - do j = js, je - do i = isc, iec - m = m + 1 - global(i+ipos,j,k) = cremote(m) - end do - end do - end do + if (from_pe /= NULL_PE) then + js = domain%list(rpos)%y(1)%compute%begin; je = domain%list(rpos)%y(1)%compute%end+jshift + do k = 1,ke + do j = js, je + do i = isc, iec + m = m + 1 + global(i+ipos,j,k) = cremote(m) + end do + end do + end do + endif call mpp_sync_self() !-ensure MPI_ISEND is done. end do else @@ -258,3 +253,235 @@ return end subroutine MPP_DO_GLOBAL_FIELD_3D_ + + + subroutine MPP_DO_GLOBAL_FIELD_A2A_3D_( domain, local, global, tile, ishift, jshift, flags, default_data) +!get a global field from a local field +!local field may be on compute OR data domain + type(domain2D), intent(in) :: domain + integer, intent(in) :: tile, ishift, jshift + MPP_TYPE_, intent(in), contiguous, target :: local(:,:,:) + MPP_TYPE_, intent(out), contiguous, target :: global(domain%x(tile)%global%begin:,domain%y(tile)%global%begin:,:) + integer, intent(in), optional :: flags + MPP_TYPE_, intent(in), optional :: default_data + + integer :: i, j, k, m, n, nd, nwords, lpos, rpos, ioff, joff, from_pe, root_pe, tile_id + integer :: ke, isc, iec, jsc, jec, is, ie, js, je + integer :: ipos, jpos + logical :: xonly, yonly, root_only, global_on_this_pe + + ! Alltoallw vectors + MPP_TYPE_, dimension(:), pointer :: plocal, pglobal + + integer, dimension(:), allocatable :: sendcounts(:), recvcounts(:) + integer, dimension(:), allocatable :: sdispls(:), rdispls(:) + type(mpp_type), allocatable :: sendtypes(:), recvtypes(:) + integer, dimension(3) :: array_of_subsizes, array_of_starts + integer :: n_sends, n_ax, pe + integer :: isg, jsg + integer, allocatable :: pelist(:), axis_pelist(:), pelist_idx(:) + + if (.NOT.module_is_initialized) & + call mpp_error( FATAL, 'MPP_GLOBAL_FIELD: must first call mpp_domains_init.' ) + + ! Validate flag consistency and configure the function + xonly = .FALSE. + yonly = .FALSE. + root_only = .FALSE. + if( PRESENT(flags) ) then + xonly = BTEST(flags,EAST) + yonly = BTEST(flags,SOUTH) + if( .NOT.xonly .AND. .NOT.yonly )call mpp_error( WARNING, & + 'MPP_GLOBAL_FIELD: you must have flags=XUPDATE, YUPDATE or XUPDATE+YUPDATE' ) + if(xonly .AND. yonly) then + xonly = .false.; yonly = .false. + endif + root_only = BTEST(flags, ROOT_GLOBAL) + if( (xonly .or. yonly) .AND. root_only ) then + call mpp_error( WARNING, 'MPP_GLOBAL_FIELD: flags = XUPDATE+GLOBAL_ROOT_ONLY or ' // & + 'flags = YUPDATE+GLOBAL_ROOT_ONLY is not supported, will ignore GLOBAL_ROOT_ONLY' ) + root_only = .FALSE. + endif + endif + + global_on_this_pe = .NOT. root_only .OR. domain%pe == domain%tile_root_pe + + ! Calculate offset for truncated global fields + ! NOTE: We do not check contiguity of global subarrays, and assume that + ! they have been copied to a contigous array. + ipos = 0; jpos = 0 + if(global_on_this_pe ) then + if(size(local,3).NE.size(global,3) ) call mpp_error( FATAL, & + 'MPP_GLOBAL_FIELD: mismatch of third dimension size of global and local') + if( size(global,1).NE.(domain%x(tile)%global%size+ishift) .OR. size(global,2).NE.(domain%y(tile)%global%size+jshift))then + if(xonly) then + if(size(global,1).NE.(domain%x(tile)%global%size+ishift) .OR. & + size(global,2).NE.(domain%y(tile)%compute%size+jshift)) & + call mpp_error( FATAL, 'MPP_GLOBAL_FIELD: incoming arrays do not match domain for xonly global field.' ) + jpos = -domain%y(tile)%compute%begin + 1 + else if(yonly) then + if(size(global,1).NE.(domain%x(tile)%compute%size+ishift) .OR. & + size(global,2).NE.(domain%y(tile)%global%size+jshift)) & + call mpp_error( FATAL, 'MPP_GLOBAL_FIELD: incoming arrays do not match domain for yonly global field.' ) + ipos = -domain%x(tile)%compute%begin + 1 + else + call mpp_error( FATAL, 'MPP_GLOBAL_FIELD: incoming arrays do not match domain.' ) + endif + endif + endif + + ! NOTE: Since local is assumed to contiguously match the data domain, this + ! is not a useful check. But maybe someday we can support compute + ! domains. + if( size(local,1).EQ.(domain%x(tile)%compute%size+ishift) .AND. size(local,2).EQ.(domain%y(tile)%compute%size+jshift) )then + !local is on compute domain + ioff = -domain%x(tile)%compute%begin + joff = -domain%y(tile)%compute%begin + else if( size(local,1).EQ.(domain%x(tile)%memory%size+ishift) .AND. size(local,2).EQ.(domain%y(tile)%memory%size+jshift) )then + !local is on data domain + ioff = -domain%x(tile)%data%begin + joff = -domain%y(tile)%data%begin + else + call mpp_error( FATAL, 'MPP_GLOBAL_FIELD_: incoming field array must match either compute domain or memory domain.' ) + end if + + ke = size(local,3) + isc = domain%x(tile)%compute%begin; iec = domain%x(tile)%compute%end+ishift + jsc = domain%y(tile)%compute%begin; jec = domain%y(tile)%compute%end+jshift + isg = domain%x(1)%global%begin; jsg = domain%y(1)%global%begin + + if(global_on_this_pe) then + !z1l: initialize global = 0 to support mask domain + if(PRESENT(default_data)) then + global = default_data + else +#ifdef LOGICAL_VARIABLE + global = .false. +#else + global = 0 +#endif + endif + endif + + ! if there is more than one tile on this pe, then no decomposition for + ! all tiles on this pe, so we can just return + if(size(domain%x(:))>1) then + !--- the following is needed to avoid deadlock. + if( tile == size(domain%x(:)) ) call mpp_sync_self( ) + return + end if + + root_pe = mpp_root_pe() + + ! Generate the pelist + ! TODO: Add these to the domain API + if (xonly) then + n_ax = size(domain%x(1)%list(:)) + allocate(axis_pelist(n_ax)) + axis_pelist = [ (domain%x(1)%list(i)%pe, i = 0, n_ax-1) ] + + nd = count(axis_pelist >= 0) + allocate(pelist(nd), pelist_idx(0:nd-1)) + pelist = pack(axis_pelist, mask=(axis_pelist >= 0)) + pelist_idx = pack([(i, i=0, n_ax-1)], mask=(axis_pelist >= 0)) + + deallocate(axis_pelist) + else if (yonly) then + n_ax = size(domain%y(1)%list(:)) + allocate(axis_pelist(n_ax)) + axis_pelist = [ (domain%y(1)%list(i)%pe, i = 0, n_ax-1) ] + + nd = count(axis_pelist >= 0) + allocate(pelist(nd), pelist_idx(0:nd-1)) + pelist = pack(axis_pelist, mask=(axis_pelist >= 0)) + pelist_idx = pack([(i, i=0, n_ax-1)], mask=(axis_pelist >= 0)) + + deallocate(axis_pelist) + else + nd = size(domain%list(:)) + allocate(pelist(nd), pelist_idx(0:nd-1)) + call mpp_get_pelist(domain, pelist) + pelist_idx = [ (i, i=0, nd-1) ] + end if + + ! Allocate message data buffers + allocate(sendcounts(0:nd-1)) + allocate(sdispls(0:nd-1)) + allocate(sendtypes(0:nd-1)) + sendcounts(:) = 0 + sdispls(:) = 0 + sendtypes(:) = mpp_byte + + allocate(recvcounts(0:nd-1)) + allocate(rdispls(0:nd-1)) + allocate(recvtypes(0:nd-1)) + recvcounts(:) = 0 + rdispls(:) = 0 + recvtypes(:) = mpp_byte + + array_of_subsizes = [iec - isc + 1, jec - jsc + 1, size(local, 3)] + array_of_starts = [isc + ioff, jsc + joff, 0] + + n_sends = merge(1, nd, root_only) ! 1 if root_only else nd + do n = 0, n_sends - 1 + sendcounts(n) = 1 + + call mpp_type_create( & + local, & + array_of_subsizes, & + array_of_starts, & + sendtypes(n) & + ) + end do + + ! Receive configuration + if (global_on_this_pe) then + do n = 0, nd - 1 + recvcounts(n) = 1 + pe = pelist_idx(n) + + if (xonly) then + is = domain%x(1)%list(pe)%compute%begin + ie = domain%x(1)%list(pe)%compute%end + ishift + js = jsc; je = jec + else if (yonly) then + is = isc; ie = iec + js = domain%y(1)%list(pe)%compute%begin + je = domain%y(1)%list(pe)%compute%end + jshift + else + is = domain%list(pe)%x(1)%compute%begin + ie = domain%list(pe)%x(1)%compute%end + ishift + js = domain%list(pe)%y(1)%compute%begin + je = domain%list(pe)%y(1)%compute%end + jshift + end if + + array_of_subsizes = [ie - is + 1, je - js + 1, ke] + array_of_starts = [is - isg + ipos, js - jsg + jpos, 0] + + call mpp_type_create( & + global, & + array_of_subsizes, & + array_of_starts, & + recvtypes(n) & + ) + end do + end if + + plocal(1:size(local)) => local + pglobal(1:size(global)) => global + + call mpp_alltoall(plocal, sendcounts, sdispls, sendtypes, & + pglobal, recvcounts, rdispls, recvtypes, & + pelist) + + plocal => null() + pglobal => null() + + ! Cleanup + deallocate(pelist) + deallocate(sendcounts, sdispls, sendtypes) + deallocate(recvcounts, rdispls, recvtypes) + + call mpp_sync_self() + + end subroutine MPP_DO_GLOBAL_FIELD_A2A_3D_ diff --git a/mpp/include/mpp_domains_reduce.inc b/mpp/include/mpp_domains_reduce.inc index fc8f58ac9f..5dc655dbb1 100644 --- a/mpp/include/mpp_domains_reduce.inc +++ b/mpp/include/mpp_domains_reduce.inc @@ -499,6 +499,7 @@ !**************************************************** #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_r8_3d +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_r8_3d #undef MPP_TYPE_ #define MPP_TYPE_ real(DOUBLE_KIND) #include @@ -506,6 +507,8 @@ #ifdef OVERLOAD_C8 #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_c8_3d +#undef MPP_DO_GLOBAL_FIELD_A2A_3D_ +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_c8_3d #undef MPP_TYPE_ #define MPP_TYPE_ complex(DOUBLE_KIND) #include @@ -514,12 +517,16 @@ #ifndef no_8byte_integers #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_i8_3d +#undef MPP_DO_GLOBAL_FIELD_A2A_3D_ +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_i8_3d #undef MPP_TYPE_ #define MPP_TYPE_ integer(LONG_KIND) #include #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_l8_3d +#undef MPP_DO_GLOBAL_FIELD_A2A_3D_ +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_l8_3d #define LOGICAL_VARIABLE #undef MPP_TYPE_ #define MPP_TYPE_ logical(LONG_KIND) @@ -530,6 +537,8 @@ #ifdef OVERLOAD_R4 #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_r4_3d +#undef MPP_DO_GLOBAL_FIELD_A2A_3D_ +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_r4_3d #undef MPP_TYPE_ #define MPP_TYPE_ real(FLOAT_KIND) #include @@ -538,6 +547,8 @@ #ifdef OVERLOAD_C4 #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_c4_3d +#undef MPP_DO_GLOBAL_FIELD_A2A_3D_ +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_c4_3d #undef MPP_TYPE_ #define MPP_TYPE_ complex(FLOAT_KIND) #include @@ -545,15 +556,18 @@ #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_i4_3d +#undef MPP_DO_GLOBAL_FIELD_A2A_3D_ +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_i4_3d #undef MPP_TYPE_ #define MPP_TYPE_ integer(INT_KIND) #include #undef MPP_DO_GLOBAL_FIELD_3D_ #define MPP_DO_GLOBAL_FIELD_3D_ mpp_do_global_field2D_l4_3d +#undef MPP_DO_GLOBAL_FIELD_A2A_3D_ +#define MPP_DO_GLOBAL_FIELD_A2A_3D_ mpp_do_global_field2D_a2a_l4_3d #define LOGICAL_VARIABLE #undef MPP_TYPE_ #define MPP_TYPE_ logical(INT_KIND) #include #undef LOGICAL_VARIABLE - diff --git a/mpp/include/mpp_global_field.h b/mpp/include/mpp_global_field.h index d9ad7da91c..890452cbc5 100644 --- a/mpp/include/mpp_global_field.h +++ b/mpp/include/mpp_global_field.h @@ -48,12 +48,31 @@ integer :: ishift, jshift integer :: tile + integer :: isize, jsize tile = 1; if(PRESENT(tile_count)) tile = tile_count call mpp_get_domain_shift(domain, ishift, jshift, position) - call mpp_do_global_field( domain, local, global, tile, ishift, jshift, flags, default_data) + ! The alltoallw method requires that local and global be contiguous. + ! We presume that `local` is contiguous if it matches the data domain; + ! `global` is presumed to always be contiguous. + ! Ideally we would use the F2015 function IS_CONTIGUOUS() to validate + ! contiguity, but it is not yet suppored in many compilers. + + ! Also worth noting that many of the nD->3D conversion also assumes + ! contiguity, so there many be other issues here. + + isize = domain%x(tile)%data%size + ishift + jsize = domain%y(tile)%data%size + jshift + if ((size(local, 1) .eq. isize) .and. (size(local, 2) .eq. jsize) & + .and. use_alltoallw) then + call mpp_do_global_field_a2a(domain, local, global, tile, & + ishift, jshift, flags, default_data) + else + call mpp_do_global_field(domain, local, global, tile, & + ishift, jshift, flags, default_data) + end if end subroutine MPP_GLOBAL_FIELD_3D_ subroutine MPP_GLOBAL_FIELD_4D_( domain, local, global, flags, position,tile_count, default_data ) diff --git a/mpp/include/mpp_io_write.inc b/mpp/include/mpp_io_write.inc index 1596f4fc9f..3564e8579b 100644 --- a/mpp/include/mpp_io_write.inc +++ b/mpp/include/mpp_io_write.inc @@ -1032,7 +1032,7 @@ else call mpp_error( FATAL, 'WRITE_ATTRIBUTE_NETCDF: one of rval, ival, cval must be present.' ) end if -#endif /* use_netCDF */ +#endif return end subroutine write_attribute_netcdf diff --git a/mpp/include/mpp_transmit_mpi.h b/mpp/include/mpp_transmit_mpi.h index bc7dfbde4e..2405e559c5 100644 --- a/mpp/include/mpp_transmit_mpi.h +++ b/mpp/include/mpp_transmit_mpi.h @@ -175,6 +175,7 @@ if( debug )then call SYSTEM_CLOCK(tick) + stdout_unit = stdout() write( stdout_unit,'(a,i18,a,i6,a,2i6,2i8)' )& 'T=',tick, ' PE=',pe, ' MPP_BROADCAST begin: from_pe, length=', from_pe, length end if diff --git a/mpp/include/mpp_type_mpi.h b/mpp/include/mpp_type_mpi.h new file mode 100644 index 0000000000..545c45b45e --- /dev/null +++ b/mpp/include/mpp_type_mpi.h @@ -0,0 +1,82 @@ +subroutine MPP_TYPE_CREATE_(field, array_of_subsizes, array_of_starts, & + dtype_out) + MPP_TYPE_, intent(in) :: field(:,:,:) + integer, intent(in) :: array_of_subsizes(:) + integer, intent(in) :: array_of_starts(:) + type(mpp_type), target, intent(out) :: dtype_out + + type(mpp_type), pointer :: dtype + integer :: newtype ! MPI datatype ID + + if (.NOT. module_is_initialized) & + call mpp_error(FATAL, 'MPP_TYPE_CREATE_: You must first call mpp_init.') + + if (current_clock .NE. 0) & + call SYSTEM_CLOCK(start_tick) + + if (verbose) & + call mpp_error(NOTE, 'MPP_TYPE_CREATE_: & + &using MPI_Type_create_subarray...') + + dtype => datatypes%head + ! TODO: Check mpp_byte + + ! Check if mpp_type already exists + do while (.not. associated(dtype)) + dtype => dtype%next + + if (dtype%ndims /= rank(field)) cycle + if (any(dtype%sizes /= shape(field))) cycle + if (any(dtype%subsizes /= array_of_subsizes)) cycle + if (any(dtype%starts /= array_of_starts)) cycle + if (dtype%etype /= MPI_TYPE_) cycle + + ! If all parameters match, then the datatype exists and return dtype + dtype%counter = dtype%counter + 1 + dtype_out = dtype + return + end do + + ! The type does not exist; create a new internal type + call MPI_Type_create_subarray( & + rank(field), & + shape(field), & + array_of_subsizes, & + array_of_starts, & + MPI_ORDER_FORTRAN, & + MPI_TYPE_, & + newtype, & + error & + ) + + ! Register on the MPI runtime + call MPI_Type_commit(newtype, error) + + ! Create new entry + allocate(dtype) + allocate(dtype%sizes(rank(field))) + allocate(dtype%subsizes(rank(field))) + allocate(dtype%starts(rank(field))) + + ! Populate values + dtype%counter = 1 + dtype%ndims = rank(field) + dtype%sizes = shape(field) + dtype%subsizes = array_of_subsizes + dtype%starts = array_of_starts + dtype%etype = MPI_TYPE_ + dtype%id = newtype + + ! Add dtype to the list + dtype%prev => datatypes%tail + dtype%prev%next => dtype + datatypes%tail => dtype + datatypes%length = datatypes%length + 1 + + ! Copy dtype to output + dtype_out = dtype + + if (current_clock .NE. 0) & + call increment_current_clock(EVENT_TYPE_CREATE, MPP_TYPE_BYTELEN_) + +end subroutine MPP_TYPE_CREATE_ diff --git a/mpp/include/mpp_type_nocomm.h b/mpp/include/mpp_type_nocomm.h new file mode 100644 index 0000000000..f3c98c3f1b --- /dev/null +++ b/mpp/include/mpp_type_nocomm.h @@ -0,0 +1,22 @@ +subroutine MPP_TYPE_CREATE_(field, array_of_subsizes, array_of_starts, dtype) + MPP_TYPE_, intent(in) :: field(:,:,:) + integer, intent(in) :: array_of_subsizes(:) + integer, intent(in) :: array_of_starts(:) + type(mpp_type), target, intent(out) :: dtype + + if (.NOT. module_is_initialized) & + call mpp_error(FATAL, 'MPP_TYPE_CREATE: You must first call mpp_init.') + + if (current_clock .NE. 0) & + call SYSTEM_CLOCK(start_tick) + + call mpp_error(NOTE, 'MPP_TYPE_CREATE: & + &This function is not used in serial mode.') + + ! For consistency with the MPI version, we return a valid mpp_type + dtype = mpp_byte + + if (current_clock .NE. 0) & + call increment_current_clock(EVENT_TYPE_CREATE, MPP_TYPE_BYTELEN_) + +end subroutine MPP_TYPE_CREATE_ diff --git a/mpp/include/mpp_type_sma.h b/mpp/include/mpp_type_sma.h new file mode 100644 index 0000000000..a8c7a23f62 --- /dev/null +++ b/mpp/include/mpp_type_sma.h @@ -0,0 +1,8 @@ +subroutine MPP_TYPE_CREATE_(field, array_of_subsizes, array_of_starts, dtype) + MPP_TYPE_, intent(in) :: field(:,:,:) + integer, intent(in) :: array_of_subsizes(:) + integer, intent(in) :: array_of_starts(:) + type(mpp_type), target, intent(out) :: dtype + + call mpp_error(FATAL, 'MPP_TYPE_CREATE_: Unsupported in SHMEM.') +end subroutine MPP_TYPE_CREATE_ diff --git a/mpp/include/mpp_update_domains2D.h b/mpp/include/mpp_update_domains2D.h index 4df50b37aa..c9d4bf8f70 100644 --- a/mpp/include/mpp_update_domains2D.h +++ b/mpp/include/mpp_update_domains2D.h @@ -620,4 +620,4 @@ return end subroutine MPP_UPDATE_DOMAINS_5D_V_ -#endif /* VECTOR_FIELD_ */ +#endif diff --git a/mpp/include/mpp_update_domains2D_ad.h b/mpp/include/mpp_update_domains2D_ad.h index 84968e5723..45d416efcb 100644 --- a/mpp/include/mpp_update_domains2D_ad.h +++ b/mpp/include/mpp_update_domains2D_ad.h @@ -417,4 +417,4 @@ whalo, ehalo, shalo, nhalo, name, tile_count ) return end subroutine MPP_UPDATE_DOMAINS_AD_5D_V_ -#endif /* VECTOR_FIELD_ */ +#endif diff --git a/mpp/include/mpp_util.inc b/mpp/include/mpp_util.inc index 4538d3e0ef..ee2cfe3ad9 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -97,7 +97,7 @@ ! ! function stdlog() - integer :: stdlog,istat + integer :: stdlog, istat logical :: opened character(len=11) :: this_pe !$ logical :: omp_in_parallel @@ -125,7 +125,7 @@ if( pe.EQ.root_pe )then write(this_pe,'(a,i6.6,a)') '.',pe,'.out' - inquire( file=trim(configfile)//this_pe, opened=opened ) + inquire( file=trim(configfile)//this_pe, opened=opened, number=log_unit ) if( opened )then call FLUSH(log_unit) else diff --git a/mpp/include/mpp_util_mpi.inc b/mpp/include/mpp_util_mpi.inc index 33ca875a90..62a8ca94ad 100644 --- a/mpp/include/mpp_util_mpi.inc +++ b/mpp/include/mpp_util_mpi.inc @@ -27,6 +27,10 @@ subroutine mpp_error_basic( errortype, errormsg ) !a very basic error handler +#ifdef __INTEL_COMPILER + ! Needs special traceback module for intel compile RASF + use ifcore +#endif !uses ABORT and FLUSH calls, may need to use cpp to rename integer, intent(in) :: errortype character(len=*), intent(in), optional :: errormsg @@ -65,6 +69,10 @@ subroutine mpp_error_basic( errortype, errormsg ) call FLUSH(out_unit) #ifdef sgi_mipspro call TRACE_BACK_STACK_AND_PRINT() +#endif +#ifdef __INTEL_COMPILER + ! Get traceback and return quietly for correct abort + call TRACEBACKQQ(user_exit_code=-1) #endif call MPI_ABORT( MPI_COMM_WORLD, 1, error ) end if @@ -125,7 +133,8 @@ function get_peset(pelist) peset(i)%count = size(sorted(:)) call MPI_GROUP_INCL( peset(current_peset_num)%group, size(sorted(:)), sorted-mpp_root_pe(), peset(i)%group, error ) - call MPI_COMM_CREATE( peset(current_peset_num)%id, peset(i)%group, peset(i)%id, error ) + call MPI_COMM_CREATE_GROUP(peset(current_peset_num)%id, peset(i)%group, & + DEFAULT_TAG, peset(i)%id, error ) #ifdef use_MPI_SMA n = size(sorted(:)) write( text, '(20i6)' )( sorted(l), l=1,min(n,20) ) @@ -251,4 +260,3 @@ subroutine mpp_sync_self( pelist, check, request, msg_size, msg_type) if( debug .and. (current_clock.NE.0) )call increment_current_clock(EVENT_WAIT) return end subroutine mpp_sync_self - diff --git a/mpp/include/mpp_util_nocomm.inc b/mpp/include/mpp_util_nocomm.inc index 9a6bda006d..a3934d4d73 100644 --- a/mpp/include/mpp_util_nocomm.inc +++ b/mpp/include/mpp_util_nocomm.inc @@ -28,6 +28,10 @@ subroutine mpp_error_basic( errortype, errormsg ) !a very basic error handler !uses ABORT and FLUSH calls, may need to use cpp to rename +#ifdef __INTEL_COMPILER + ! Needs special traceback module for intel compile RASF + use ifcore +#endif integer, intent(in) :: errortype character(len=*), intent(in), optional :: errormsg character(len=512) :: text @@ -63,6 +67,10 @@ subroutine mpp_error_basic( errortype, errormsg ) call FLUSH(outunit) #ifdef sgi_mipspro call TRACE_BACK_STACK_AND_PRINT() +#endif +#ifdef __INTEL_COMPILER + ! Get traceback and return quietly for correct abort + call TRACEBACKQQ(user_exit_code=-1) #endif call ABORT() !automatically calls traceback on Cray systems end if diff --git a/mpp/mpp.F90 b/mpp/mpp.F90 index 3f934a547b..f625142fce 100644 --- a/mpp/mpp.F90 +++ b/mpp/mpp.F90 @@ -173,8 +173,9 @@ module mpp_mod use shmem_interface #endif -#if defined(use_libMPI) && defined(sgi_mipspro) +#if defined(use_libMPI) && (defined(sgi_mipspro) || (__GNUC__ >= 11)) use mpi +#define MPI_IMPORTED 1 #endif use mpp_parameter_mod, only : MPP_VERBOSE, MPP_DEBUG, ALL_PES, ANY_PE, NULL_PE @@ -184,6 +185,7 @@ module mpp_mod use mpp_parameter_mod, only : MAX_EVENTS, MAX_BINS, MAX_EVENT_TYPES, MAX_CLOCKS use mpp_parameter_mod, only : MAXPES, EVENT_WAIT, EVENT_ALLREDUCE, EVENT_BROADCAST use mpp_parameter_mod, only : EVENT_ALLTOALL + use mpp_parameter_mod, only : EVENT_TYPE_CREATE, EVENT_TYPE_FREE use mpp_parameter_mod, only : EVENT_RECV, EVENT_SEND, MPP_READY, MPP_WAIT use mpp_parameter_mod, only : mpp_parameter_version=>version use mpp_parameter_mod, only : DEFAULT_TAG @@ -204,9 +206,9 @@ module mpp_mod #include #endif -#if defined(use_libMPI) && !defined(sgi_mipspro) +#if defined(use_libMPI) && !defined(MPI_IMPORTED) #include -!sgi_mipspro gets this from 'use mpi' +! !sgi_mipspro gets this from 'use mpi' #endif !--- public paramters ----------------------------------------------- @@ -238,6 +240,7 @@ module mpp_mod public :: mpp_chksum, mpp_max, mpp_min, mpp_sum, mpp_transmit, mpp_send, mpp_recv public :: mpp_broadcast, mpp_malloc, mpp_init, mpp_exit public :: mpp_gather, mpp_scatter, mpp_alltoall + public :: mpp_type, mpp_byte, mpp_type_create, mpp_type_free #ifdef use_MPI_GSM public :: mpp_gsm_malloc, mpp_gsm_free #endif @@ -296,6 +299,29 @@ module mpp_mod type (Clock_Data_Summary) :: event(MAX_EVENT_TYPES) end type Summary_Struct + ! Data types for generalized data transfer (e.g. MPI_Type) + type :: mpp_type + private + integer :: counter ! Number of instances of this type + integer :: ndims + integer, allocatable :: sizes(:) + integer, allocatable :: subsizes(:) + integer, allocatable :: starts(:) + integer :: etype ! Elementary data type (e.g. MPI_BYTE) + integer :: id ! Identifier within message passing library (e.g. MPI) + + type(mpp_type), pointer :: prev => null() + type(mpp_type), pointer :: next => null() + end type mpp_type + + ! Persisent elements for linked list interaction + type :: mpp_type_list + private + type(mpp_type), pointer :: head => null() + type(mpp_type), pointer :: tail => null() + integer :: length + end type mpp_type_list + !*********************************************************************** ! ! public interface from mpp_util.h @@ -540,6 +566,21 @@ module mpp_mod ! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! DATA TRANSFER TYPES: mpp_type_create ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + interface mpp_type_create + module procedure mpp_type_create_int4 + module procedure mpp_type_create_int8 + module procedure mpp_type_create_real4 + module procedure mpp_type_create_real8 + module procedure mpp_type_create_logical4 + module procedure mpp_type_create_logical8 + end interface mpp_type_create + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! ! GLOBAL REDUCTION ROUTINES: mpp_max, mpp_sum, mpp_min ! @@ -730,10 +771,20 @@ module mpp_mod module procedure mpp_alltoall_int8 module procedure mpp_alltoall_real4 module procedure mpp_alltoall_real8 + module procedure mpp_alltoall_logical4 + module procedure mpp_alltoall_logical8 module procedure mpp_alltoall_int4_v module procedure mpp_alltoall_int8_v module procedure mpp_alltoall_real4_v module procedure mpp_alltoall_real8_v + module procedure mpp_alltoall_logical4_v + module procedure mpp_alltoall_logical8_v + module procedure mpp_alltoall_int4_w + module procedure mpp_alltoall_int8_w + module procedure mpp_alltoall_real4_w + module procedure mpp_alltoall_real8_w + module procedure mpp_alltoall_logical4_w + module procedure mpp_alltoall_logical8_w end interface @@ -1208,6 +1259,9 @@ module mpp_mod integer :: clock_num=0, num_clock_ids=0,current_clock=0, previous_clock(MAX_CLOCKS)=0 real :: tick_rate + type(mpp_type_list) :: datatypes + type(mpp_type), target :: mpp_byte + integer :: cur_send_request = 0 integer :: cur_recv_request = 0 integer, allocatable :: request_send(:) @@ -1244,7 +1298,7 @@ module mpp_mod !(t3e: fixed on 3.3 I believe) integer, parameter :: MPI_INTEGER8=MPI_INTEGER #endif -#endif /* use_libMPI */ +#endif #ifdef use_MPI_SMA #include integer :: pSync(SHMEM_BARRIER_SYNC_SIZE) diff --git a/mpp/mpp_domains.F90 b/mpp/mpp_domains.F90 index 7aa208c024..48d347a384 100644 --- a/mpp/mpp_domains.F90 +++ b/mpp/mpp_domains.F90 @@ -156,6 +156,8 @@ module mpp_domains_mod use mpp_mod, only : mpp_max, mpp_min, mpp_sum, mpp_get_current_pelist, mpp_broadcast use mpp_mod, only : mpp_sync, mpp_init, mpp_malloc, lowercase use mpp_mod, only : input_nml_file, mpp_alltoall + use mpp_mod, only : mpp_type, mpp_byte + use mpp_mod, only : mpp_type_create, mpp_type_free use mpp_mod, only : COMM_TAG_1, COMM_TAG_2, COMM_TAG_3, COMM_TAG_4 use mpp_memutils_mod, only : mpp_memuse_begin, mpp_memuse_end use mpp_pset_mod, only : mpp_pset_init @@ -697,8 +699,9 @@ module mpp_domains_mod logical :: debug_message_passing = .false. integer :: nthread_control_loop = 8 logical :: efp_sum_overflow_check = .false. + logical :: use_alltoallw = .false. namelist /mpp_domains_nml/ debug_update_domain, domain_clocks_on, debug_message_passing, nthread_control_loop, & - efp_sum_overflow_check + efp_sum_overflow_check, use_alltoallw !*********************************************************************** @@ -2109,6 +2112,25 @@ module mpp_domains_mod module procedure mpp_do_global_field2D_l4_3d end interface + interface mpp_do_global_field_a2a + module procedure mpp_do_global_field2D_a2a_r8_3d +#ifdef OVERLOAD_C8 + module procedure mpp_do_global_field2D_a2a_c8_3d +#endif +#ifndef no_8byte_integers + module procedure mpp_do_global_field2D_a2a_i8_3d + module procedure mpp_do_global_field2D_a2a_l8_3d +#endif +#ifdef OVERLOAD_R4 + module procedure mpp_do_global_field2D_a2a_r4_3d +#endif +#ifdef OVERLOAD_C4 + module procedure mpp_do_global_field2D_a2a_c4_3d +#endif + module procedure mpp_do_global_field2D_a2a_i4_3d + module procedure mpp_do_global_field2D_a2a_l4_3d + end interface + interface mpp_global_field_ug module procedure mpp_global_field2D_ug_r8_2d module procedure mpp_global_field2D_ug_r8_3d diff --git a/mpp/mpp_parameter.F90 b/mpp/mpp_parameter.F90 index cde11f240d..43d8dd642a 100644 --- a/mpp/mpp_parameter.F90 +++ b/mpp/mpp_parameter.F90 @@ -33,7 +33,7 @@ module mpp_parameter_mod public :: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, CLOCK_SUBCOMPONENT, CLOCK_MODULE_DRIVER public :: CLOCK_MODULE, CLOCK_ROUTINE, CLOCK_LOOP, CLOCK_INFRA, MAX_BINS public :: EVENT_ALLREDUCE, EVENT_BROADCAST, EVENT_RECV, EVENT_SEND, EVENT_WAIT - public :: EVENT_ALLTOALL + public :: EVENT_ALLTOALL, EVENT_TYPE_CREATE, EVENT_TYPE_FREE public :: DEFAULT_TAG public :: COMM_TAG_1, COMM_TAG_2, COMM_TAG_3, COMM_TAG_4 public :: COMM_TAG_5, COMM_TAG_6, COMM_TAG_7, COMM_TAG_8 @@ -69,6 +69,7 @@ module mpp_parameter_mod integer, parameter :: MAX_CLOCKS=400, MAX_EVENT_TYPES=5, MAX_EVENTS=40000 integer, parameter :: EVENT_ALLREDUCE=1, EVENT_BROADCAST=2, EVENT_RECV=3, EVENT_SEND=4, EVENT_WAIT=5 integer, parameter :: EVENT_ALLTOALL=6 + integer, parameter :: EVENT_TYPE_CREATE=7, EVENT_TYPE_FREE=8 integer, parameter :: MPP_CLOCK_SYNC=1, MPP_CLOCK_DETAILED=2 integer :: DEFAULT_TAG = 1 !--- implimented to centralize _FILL_ values for land_model.F90 into mpp_mod @@ -116,7 +117,7 @@ module mpp_parameter_mod ! combination with the flag parameter defined above to create a unique identifier for ! each Domain+flags combination. Therefore, the value of any flag must not exceed DOMAIN_ID_BASE. ! integer(LONG_KIND), parameter :: DOMAIN_ID_BASE=INT( 2**(4*LONG_KIND),KIND=LONG_KIND ) - integer(LONG_KIND), parameter :: DOMAIN_ID_BASE=Z'0000000100000000' ! Workaround for 64bit init problem + integer(LONG_KIND), parameter :: DOMAIN_ID_BASE=INT(Z'0000000100000000', kind=LONG_KIND) ! Workaround for 64bit init problem integer, parameter :: NON_BITWISE_EXACT_SUM=0 integer, parameter :: BITWISE_EXACT_SUM=1 integer, parameter :: BITWISE_EFP_SUM=2 diff --git a/mpp/test_mpp.F90 b/mpp/test_mpp.F90 index 195b1c3676..5e7ec9e5f4 100644 --- a/mpp/test_mpp.F90 +++ b/mpp/test_mpp.F90 @@ -543,4 +543,4 @@ end program test module null_mpp_test end module -#endif /* test_mpp */ +#endif diff --git a/mpp/threadloc.c b/mpp/threadloc.c index 173b52cb39..26caa6d9bb 100644 --- a/mpp/threadloc.c +++ b/mpp/threadloc.c @@ -68,7 +68,7 @@ int find_nodenum(int mynodedev) { int mld_id_() { /* dummy routine for portability */ return 0; } -#endif /* sgi */ +#endif #ifdef test_threadloc void main(int argc, char **argv) {