├── .gitignore ├── Makefile ├── README.md ├── _mkf ├── MakefileC.mk ├── MakefileCUDA.mk ├── MakefileDefaultCompile.mk ├── MakefileDll.mk ├── MakefileFortran.mk ├── MakefileOS.mk ├── MakefileSimpleRules.mk └── MakefileSupport.mk ├── _support ├── SupportArchitecture_amd64.f90 ├── SupportArchitecture_ia32.f90 ├── SupportCompiler_compaq.f90 ├── SupportCompiler_gfortran.f90 ├── SupportCompiler_intel.f90 ├── SupportISO_compaq.f90 ├── SupportISO_gfortran.f90 ├── SupportISO_intel.f90 ├── SupportPrecision.f90 ├── SupportSystem_linux.f90 └── SupportSystem_windows.f90 ├── _support_dll ├── Makefile ├── README.md └── include_me_in_C_programs.c ├── _support_lib ├── SupportMKL_0.f90 ├── SupportMKL_1.f90 ├── SupportMPI_0.TEMPLATE.F90 ├── SupportMPI_0.f90 ├── SupportMPI_1.f90 ├── SupportOMP_0.f90 └── SupportOMP_1.f90 ├── _tools ├── CStrings.f90 ├── FileSystem.f90 ├── MainIO.f90 ├── MemoryManager.f90 └── PackFunctions.f90 ├── _unit_tests ├── Makefile ├── character_arrays │ ├── Makefile │ └── test_char_array.f90 ├── fortran-c │ ├── Makefile │ └── test_c_precision.c ├── precision_iso │ ├── Makefile │ └── test_precision_iso.f90 ├── preproc │ ├── Makefile │ ├── _macros-linux-amd64-gfortran │ ├── _macros-linux-amd64-ifort │ ├── _macros-windows-ia32-compaq │ ├── _macros-windows-ia32-ifort │ ├── empty.f90 │ └── test_preproc.f90 └── small_tests │ ├── Makefile │ └── test_save.f90 ├── fortran-guidelines.pdf ├── opencmd.bat ├── setenv.bat └── tex ├── .gitignore ├── Makefile ├── _preamble.tex ├── fortran-guidelines.tex └── make_version.sh /.gitignore: -------------------------------------------------------------------------------- 1 | *.pdf 2 | *.log 3 | *.aux 4 | *.toc 5 | *.out 6 | *.gz 7 | _unit_tests/character_arrays/test_char_array 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include _mkf/MakefileOS.mk 2 | 3 | all: pdf test_batch 4 | 5 | clean: 6 | @make --no-print-directory -C tex clean 7 | @make --no-print-directory -C _unit_tests clean 8 | # -------------------------------------------------------------------------------- 9 | # --- Pdf 10 | # -------------------------------------------------------------------------------- 11 | pdf: 12 | @make -C tex 13 | @cp tex/fortran-guidelines.pdf . 14 | 15 | 16 | # -------------------------------------------------------------------------------- 17 | # --- 18 | # -------------------------------------------------------------------------------- 19 | test: 20 | @make -C _unit_tests 21 | 22 | test_batch: 23 | ifeq ($(OSNAME),windows) 24 | @echo "# --------------------------------------------------------------------------------" 25 | @echo "# --- GFORTRAN " 26 | @echo "# --------------------------------------------------------------------------------" 27 | @vcvarsall.bat x86& @make --no-print-directory -C _unit_tests FCOMPILER=0 28 | @echo "# --------------------------------------------------------------------------------" 29 | @echo "# --- INTEL 32 " 30 | @echo "# --------------------------------------------------------------------------------" 31 | @vcvarsall.bat x86 & ifortvars.bat ia32 vs2010 & make --no-print-directory -C _unit_tests FCOMPILER=1 32 | ifeq ($(ARCHI),amd64) 33 | @echo "# --------------------------------------------------------------------------------" 34 | @echo "# --- INTEL 64 " 35 | @echo "# --------------------------------------------------------------------------------" 36 | @vcvarsall.bat amd64 & ifortvars.bat amd64 vs2010 & make --no-print-directory -C _unit_tests FCOMPILER=1 37 | endif 38 | @echo "# --------------------------------------------------------------------------------" 39 | @echo "# --- COMPAQ " 40 | @echo "# --------------------------------------------------------------------------------" 41 | @vcvarsall.bat x86 & dfvars.bat & make --no-print-directory -C _unit_tests FCOMPILER=2 42 | else 43 | @echo "# --------------------------------------------------------------------------------" 44 | @echo "# --- GFORTRAN " 45 | @echo "# --------------------------------------------------------------------------------" 46 | @make --no-print-directory -C _unit_tests FCOMPILER=0 47 | @echo "# --------------------------------------------------------------------------------" 48 | @echo "# --- INTEL " 49 | @echo "# --------------------------------------------------------------------------------" 50 | @make --no-print-directory -C _unit_tests FCOMPILER=1 51 | endif 52 | 53 | include _mkf/MakefileSimpleRules.mk 54 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # fortran-guidelines 2 | 3 | This document provides guidelines and pitfalls related to Fortran code. 4 | 5 | Portability is addressed in this document and it is achieved using wrapped module containing the non-portable code. The source code of some wrapped modules is provided in this repository. 6 | 7 | ## Pdf file 8 | The pdf is available [here](https://github.com/elmanuelito/fortran-guidelines/raw/master/fortran-guidelines.pdf) 9 | -------------------------------------------------------------------------------- /_mkf/MakefileC.mk: -------------------------------------------------------------------------------- 1 | c=c 2 | # 0: Gnu compiler GCC 3 | # 1: intel C Compiler icc 4 | # 2: visual studio compiler cl.exe 5 | 6 | # INTEL C COMPILER 7 | ifeq ($(CCOMPILER),1) 8 | CC = icc 9 | COUT = -o 10 | CFFREE = 11 | CFOPT = -O3 12 | CFOPTO5 = -O3 13 | CFACC = #-offload-build #-no-offload 14 | CFOPENMP = -openmp 15 | CFWARN = -Wall 16 | CFDEBUGINFO= -g 17 | CFDEBUG = 18 | CFMODINC = 19 | CFAUTOPAR = -parallel -par-report1 20 | CFFPP = -fpp 21 | CFC99 = -std=c99 22 | CFDLL = -fPIC 23 | CFTRACE = -traceback 24 | ifeq ($(OSNAME),windows) 25 | CC = icc 26 | CFMODINC = -module= 27 | CFFREE = /free 28 | CFOPENMP = -Qopenmp 29 | CFWARN = -warn:all 30 | CFWARNERROR= -warn:error 31 | # CFDEBUG = -check:bounds -check:format -check:output_conversion -check:pointers -check:uninit -debug:full -fpe0 -gen-interface -traceback 32 | CFDEBUG = -check:bounds -check:format -check:output_conversion -check:pointers -check:uninit -debug:full -gen-interface 33 | CFF95 = -assume:norealloc_lhs 34 | CFDLL = /libs:dll 35 | endif 36 | endif 37 | # Gcc COMPILER 38 | ifeq ($(CCOMPILER),0) 39 | CC = gcc 40 | COUT = -o 41 | CFFREE = 42 | CFOPT = -O3 43 | CFOPTO5 = -O5 44 | CFACC = #-offload-build #-no-offload 45 | CFOPENMP = -fopenmp 46 | CFWARN = -Wall 47 | CFDEBUGINFO= -g 48 | CFDEBUG = 49 | CFMODINC = 50 | CFAUTOPAR = -parallel -par-report1 51 | CFFPP = -fpp 52 | CFC99 = -std=c99 53 | CFDLL = -fPIC 54 | CFTRACE = -traceback 55 | ifeq ($(OSNAME),windows) 56 | CC = icc 57 | CFMODINC = -module= 58 | CFFREE = /free 59 | CFWARN = -warn:all 60 | CFWARNERROR= -warn:error 61 | # CFDEBUG = -check:bounds -check:format -check:output_conversion -check:pointers -check:uninit -debug:full -fpe0 -gen-interface -traceback 62 | CFDEBUG = -check:bounds -check:format -check:output_conversion -check:pointers -check:uninit -debug:full -gen-interface 63 | CFDLL = /libs:dll 64 | CC = gcc 65 | CFMODINC = 66 | CFFREE = 67 | CFWARN = -Wall 68 | CFWARNERROR= 69 | CFDEBUG = 70 | CFDLL = -fPIC 71 | endif 72 | endif 73 | 74 | # INTEL C COMPILER 75 | ifeq ($(CCOMPILER),2) 76 | CC = cl /nologo 77 | COUT = /Fe 78 | endif 79 | -------------------------------------------------------------------------------- /_mkf/MakefileCUDA.mk: -------------------------------------------------------------------------------- 1 | # NVIDIA CUDA COMPILER 2 | CUDA_PATH = /usr/local/cuda 3 | NVCC = nvcc 4 | ifeq ($(shell echo $$HOSTNAME),work) 5 | CUDA_ARCH = sm_21 6 | else 7 | CUDA_ARCH = sm_35 8 | endif 9 | NVCFLAGS = -m64 -I$(CUDA_PATH)/include -I$(CUDA_PATH)/samples/common/inc -arch $(CUDA_ARCH) --compiler-options "-fPIC -fopenmp" 10 | 11 | NVCFFREE = 12 | NVCFOPT = -O3 13 | NVCFACC = 14 | NVCFOPENMP = 15 | NVCFWARN = 16 | NVCFDEBUGINFO= -g -Xptxas=-v 17 | NVCFDEBUG = 18 | NVCFMODINC = 19 | NVCFAUTOPAR = 20 | NVCFFPP = 21 | NVCFC99 = -std=c99 22 | NVCFDLL = -fPIC 23 | NVCFTRACE = 24 | -------------------------------------------------------------------------------- /_mkf/MakefileDefaultCompile.mk: -------------------------------------------------------------------------------- 1 | $(OBJ_DIR)/%.$(o): %.for 2 | @echo "($(SUPPORT)) :" $< 3 | @$(FC) $(DEFS) $(INCS) $(FFLAGS) -c $< $(LIBS) $(FOUT_OBJ)$(OBJ_DIR)$(SLASH)$*.$(o) 4 | 5 | $(OBJ_DIR)/%.$(o): %.F90 6 | @echo "($(SUPPORT)) :" $< 7 | @$(FC) $(DEFS) $(INCS) $(FFFREE) $(FFLAGS) -c $< $(LIBS) $(FOUT_OBJ)$(OBJ_DIR)$(SLASH)$*.$(o) 8 | 9 | $(OBJ_DIR)/%.$(o): %.$(f) 10 | @echo "($(SUPPORT)) :" $< 11 | @$(FC) $(DEFS) $(INCS) $(FFFREE) $(FFLAGS) -c $< $(LIBS) $(FOUT_OBJ)$(OBJ_DIR)$(SLASH)$*.$(o) 12 | -------------------------------------------------------------------------------- /_mkf/MakefileDll.mk: -------------------------------------------------------------------------------- 1 | # Note: This is a default makefile to compile a library 2 | # 3 | # -------------------------------------------------------------------------------- 4 | # --- Defining variables based on OS and fortran 5 | # -------------------------------------------------------------------------------- 6 | include ../_mkf/MakefileSupport.mk 7 | 8 | LIB_DIR=$(LIB_DIR_BASE)-$(SUPPORT) 9 | OBJ_DIR=$(OBJ_DIR_BASE)-$(SUPPORT) 10 | LIB_NAME= $(LIB_NAME_BASE) 11 | ifeq ($(OSNAME),linux) 12 | LIB_NAME=lib$(LIB_NAME_BASE) 13 | endif 14 | 15 | ifeq ($(MAKE_STATIC),1) 16 | RULES+= $(LIB_DIR)$(SLASH)$(LIB_NAME).$(lib) 17 | endif 18 | ifeq ($(MAKE_DLL),1) 19 | RULES+= $(LIB_DIR)$(SLASH)$(LIB_NAME).$(dll) 20 | endif 21 | # -------------------------------------------------------------------------------- 22 | # --- INCLUDES 23 | # -------------------------------------------------------------------------------- 24 | INCS=-I$(LIB_DIR_BASE)-$(SUPPORT) 25 | # -------------------------------------------------------------------------------- 26 | # --- DEFINITIONS 27 | # -------------------------------------------------------------------------------- 28 | DEFS=$(OSDEF) 29 | # -------------------------------------------------------------------------------- 30 | # --- Compiler Flags 31 | # -------------------------------------------------------------------------------- 32 | FFLAGS = $(FFNOLOGO) $(FFMODINC)$(OBJ_DIR) 33 | FFLAGS += $(FFDLL) 34 | ifeq ($(RELEASE),0) 35 | FFLAGS += $(FFDEBUGINFO) $(FFDEBUG) $(FFPE) $(FFWARN) $(FFWARNEXTRA) $(FFWARNERROR) $(FFOPT0) 36 | FFLAGS += $(FFTRACE) 37 | BUILD=debug 38 | else 39 | FFLAGS += $(FFOPTO5) 40 | BUILD=release 41 | endif 42 | FFLAGS += $(FFLAGS_EXTRA) 43 | # 44 | # -------------------------------------------------------------------------------- 45 | # --- ARCHIVER flags 46 | # -------------------------------------------------------------------------------- 47 | ifeq ($(OSNAME),windows) 48 | AFLAGS=$(FFNOLOGO) 49 | else 50 | # v: verbose 51 | # r: insert with replacement 52 | # c: create 53 | # q: quickly append without checking for replacements 54 | #AFLAGS=-cq 55 | AFLAGS=-cr 56 | endif 57 | AFLAGS+= $(AFLAGS_EXTRA) 58 | 59 | # -------------------------------------------------------------------------------- 60 | # --- Defining Objects based on SRC 61 | # -------------------------------------------------------------------------------- 62 | # Setting up objects 63 | OBJ:= $(patsubst %.f90,%.$(o),$(SRC)) 64 | OBJ:= $(patsubst %.F90,%.$(o),$(OBJ)) 65 | OBJ:= $(patsubst %.for,%.$(o),$(OBJ)) 66 | OBJ:= $(patsubst %,$(OBJ_DIR)/%,$(OBJ)) 67 | 68 | 69 | vpath %.f90 70 | vpath %.F90 71 | vpath %.for 72 | 73 | # -------------------------------------------------------------------------------- 74 | # --- Main rules 75 | # -------------------------------------------------------------------------------- 76 | .PHONY: lib all clean flags 77 | 78 | all: $(RULES) 79 | 80 | clean: 81 | @$(RM) $(OBJ_DIR)$(SLASH)*.$(o) $(OBJ_DIR)$(SLASH)*.mod 82 | @$(RM) $(OBJ_DIR) 83 | @echo "- $(LIB_NAME_BASE) lib cleaned" 84 | 85 | purge: clean 86 | @$(RM) $(LIB_DIR)$(SLASH)$(LIB_NAME)* 87 | @$(RM) $(OBJ_DIR_BASE)* 88 | @echo "- $(LIB_NAME_BASE) lib purged" 89 | 90 | 91 | # -------------------------------------------------------------------------------- 92 | # --- Static library 93 | # -------------------------------------------------------------------------------- 94 | $(LIB_DIR)$(SLASH)$(LIB_NAME).$(lib): $(LIB_DIR) $(OBJ_DIR) $(OBJ) 95 | @echo "- Compiling static library: " $(LIB_DIR)$(SLASH)$(LIB_NAME).$(lib) 96 | @$(ARCHIVER) $(AFLAGS) $(LIBS) -o $(LIB_DIR)$(SLASH)$(LIB_NAME).$(lib) $(OBJ_DIR)$(SLASH)*.$(o) 97 | @$(TOUCH) $(OBJ_DIR)$(SLASH)dummy.mod 98 | @$(CP) $(OBJ_DIR)$(SLASH)*.mod $(LIB_DIR) 99 | @$(RM) $(OBJ_DIR)$(SLASH)dummy.mod 100 | @$(RM) $(LIB_DIR)$(SLASH)dummy.mod 101 | 102 | # -------------------------------------------------------------------------------- 103 | # --- DLL library 104 | # -------------------------------------------------------------------------------- 105 | $(LIB_DIR)$(SLASH)$(LIB_NAME).$(dll): $(LIB_DIR) $(OBJ_DIR) $(OBJ) 106 | @echo "- Compiling dynamic library: " $(LIB_DIR)$(SLASH)$(LIB_NAME).$(dll) 107 | ifeq ($(OSNAME),windows) 108 | @$(FC) $(DEFS) $(INCS) $(LDFLAGS) -shared -Wl,-soname,$(LIB_NAME).$(dll).1 $(OBJ_DIR)$(SLASH)*.$(o) $(LIBS) -o $(LIB_DIR)$(SLASH)$(LIB_NAME).$(dll) 109 | else 110 | @$(FC) $(DEFS) $(INCS) $(LDFLAGS) -shared -Wl,-soname,$(LIB_NAME).$(dll).1 $(OBJ_DIR)$(SLASH)*.$(o) $(LIBS) -o $(LIB_DIR)$(SLASH)$(LIB_NAME).$(dll) 111 | endif 112 | 113 | 114 | # -------------------------------------------------------------------------------- 115 | # --- Low-level Compilation rules 116 | # -------------------------------------------------------------------------------- 117 | include ../_mkf/MakefileDefaultCompile.mk 118 | 119 | 120 | # -------------------------------------------------------------------------------- 121 | # --- DEPENDENCIES 122 | # -------------------------------------------------------------------------------- 123 | # Creating build directory 124 | $(OBJ_DIR): 125 | @echo "# --------------------------------------------------------------------------------" 126 | @echo "# --- Compilation of $(LIB_NAME) " 127 | @echo "# --------------------------------------------------------------------------------" 128 | @make --no-print-directory flags 129 | @$(MKDIR) $(OBJ_DIR) 130 | 131 | $(LIB_DIR): 132 | @$(MKDIR) $(LIB_DIR) 133 | 134 | # -------------------------------------------------------------------------------- 135 | # --- SIMPLE RULES 136 | # -------------------------------------------------------------------------------- 137 | include ../_mkf/MakefileSimpleRules.mk 138 | -------------------------------------------------------------------------------- /_mkf/MakefileFortran.mk: -------------------------------------------------------------------------------- 1 | f=f90 2 | 3 | FCOMPILERDEF= 4 | # INTEL FORTRAN COMPILER 5 | ifeq ($(FCOMPILER),1) 6 | FC =ifort 7 | FCNAME =intel 8 | FCOMPILERDEF=-D__INTEL_COMPILER 9 | FOUT_EXE = -o 10 | FOUT_OBJ = -o 11 | FOUT_DLL = -o 12 | FFNOLOGO = -nologo 13 | FFFREE = -free 14 | FFOPT0 = -O0 15 | FFOPT = -O3 16 | FFOPTO3 = -O3 17 | FFOPTO5 = -O5 18 | FFACC = #-offload-build #-no-offload 19 | FFOPENMP = -openmp 20 | FFWARN = -warn all 21 | FFWARNERROR= -warn error 22 | FFWARNEXTRA= 23 | FFDEBUGINFO= -g 24 | FFDEBUG = -check bounds -check format -check output_conversion -check pointers -check uninit -debug full -gen-interface 25 | FFPE = -fpe0 26 | FFDEBUGARG = -check arg_temp_created 27 | FFMODINC = -module 28 | FFAUTOPAR = -parallel -par-report1 29 | FFFPP = -fpp 30 | FFF90 = -stand f90 31 | FFF95 = -stand f95 32 | # FFF95 = -assume norealloc_lhs 33 | FFF03 = -assume realloc_lhs -stand f03 34 | FFDLL = -fPIC 35 | FFTRACE = -traceback 36 | FFBYTERECL = -assume byterecl 37 | FFSAVE = -save 38 | ifeq ($(OSNAME),windows) 39 | FOUT_EXE = /exe: 40 | FOUT_OBJ = /obj: 41 | FOUT_DLL = /out: 42 | FFOPT0 = -O0 43 | FFOPTO5 = -O3 44 | FFOPENMP = -Qopenmp 45 | FFMODINC = -module= 46 | FFWARN = -warn:all 47 | FFWARNERROR= -warn:error 48 | FFDEBUGINFO= 49 | # FFDEBUG = -check:bounds -check:format -check:output_conversion -check:pointers -check:uninit -debug:full -fpe0 -gen-interface -traceback 50 | FFDEBUG = -check:bounds -check:format -check:output_conversion -check:pointers -check:uninit -debug:full -gen-interface 51 | FFF95 = -assume:norealloc_lhs 52 | FFDLL = /libs:dll 53 | FFSAVE = /Qsave 54 | # FFDLL = /iface:stdcall 55 | endif 56 | endif 57 | 58 | # GFORTRAN COMPILER 59 | ifeq ($(FCOMPILER),0) 60 | # Wall contains: -Waliasing, -Wampersand, -Wconversion, -Wsurprising, -Wc-binding-type, -Wintrinsics-std, -Wno-tabs, 61 | # -Wintrinsic-shadow, -Wline-truncation, -Wtarget-lifetime, -Wreal-q-constant -Wunused 62 | # Other Flags: 63 | # -Warray-temporaries -Wcharacter-truncation: 64 | # FC = gfortran-4.8 65 | FC = gfortran 66 | FCNAME =gfortran 67 | FCOMPILERDEF=-D__GFORTRAN__ 68 | FOUT_EXE = -o 69 | FOUT_OBJ = -o 70 | FOUT_DLL = -o 71 | FFNOLOGO = 72 | FFFREE = -free 73 | FFOPT = -O3 74 | FFOPTO3 = -O3 75 | FFOPTO5 = -O5 76 | FFOPENMP = -fopenmp 77 | FFWARN = -Wall -Wno-intrinsic-shadow -Wtabs -Wuninitialized -O -Wunused 78 | # -Wno-c-binding-type -Wno-unused-function 79 | FFWARNEXTRA= -Wcharacter-truncation -Wextra -Wno-implicit-interface -Wno-implicit-procedure -Wunderflow -Wunused-dummy-argument -Wunused-parameter -Wmaybe-uninitialized 80 | FFDEBUGINFO= -g 81 | FFDEBUG = -fbounds-check -finit-real=nan 82 | FFPE = -ffpe-trap=invalid,zero,overflow 83 | FFMODINC = -J 84 | FFAUTOPAR = 85 | FFFPP = -cpp 86 | FFF95 = -std=f95 -fno-realloc-lhs 87 | FFF03 = -ffree-line-length-none 88 | FFDLL = -fPIC 89 | FFTRACE = -fbacktrace -fdump-core 90 | FFBYTERECL = 91 | ifeq ($(OSNAME),windows) 92 | FFDLL = 93 | endif 94 | endif 95 | 96 | 97 | # SUN COMPILER 98 | ifeq ($(FCOMPILER),2) 99 | FC = f95 100 | FCNAME =sun 101 | FCOMPILERDEF=-DSUN_NOT_DEF 102 | FOUT_EXE = -o 103 | FOUT_OBJ = -o 104 | FOUT_DLL = -o 105 | FFFREE = -free 106 | FFNOLOGO = 107 | FFOPT = -O3 108 | FFOPTO5 = -O3 109 | FFOPENMP = -openmp 110 | FFWARN = 111 | FFDEBUGINFO= -g 112 | FFDEBUG = -C 113 | FFMODINC = -M 114 | FFAUTOPAR = -xloopinfo -xautopar 115 | FFFPP = -xpp 116 | # FFLAGS = -xopenmp=noopt 117 | endif 118 | 119 | 120 | # COMPAQ COMPILER 121 | ifeq ($(FCOMPILER),2) 122 | FC =f90 123 | FCNAME =compaq 124 | FCOMPILERDEF=-D_DF_VERSION_ -DCOMPAQ 125 | FOUT_EXE = /exe: 126 | FOUT_OBJ = /obj: 127 | FOUT_DLL = /out: 128 | FFNOLOGO = -nologo 129 | FFFREE = -free 130 | FFOPT0 = /Optimize=0 131 | FFOPT = /Optimize=3 132 | FFOPTO3 = /Optimize=3 133 | FFOPTO5 = /Optimize=3 134 | FFACC = #-offload-build #-no-offload 135 | FFOPENMP = -openmp 136 | FFWARN = -warn:all 137 | FFWARNEXTRA= 138 | FFDEBUG = -check:bounds -check:format -check:output_conversion -check:pointers -check:uninit -debug:full -gen-interface 139 | FFDEBUGINFO= 140 | FFPE = -fpe0 141 | FFDEBUGARG = -check arg_temp_created 142 | FFMODINC = /module= 143 | FFAUTOPAR = -parallel -par-report1 144 | FFFPP = -fpp 145 | FFF90 = -assume:realloc_lhs -stand f90 146 | FFF95 = -assume:realloc_lhs -stand f95 147 | FFF03 = -assume:realloc_lhs -stand f03 148 | FFTRACE = -traceback 149 | FFBYTERECL = -assume byterecl 150 | FFDLL = -fPIC 151 | FFDLL = /libs:dll 152 | FFSAVE = /Qsave 153 | # FFDLL = /iface:stdcall 154 | endif 155 | 156 | 157 | 158 | 159 | # -------------------------------------------------------------------------------- 160 | # --- MKL LIBRARY 161 | # -------------------------------------------------------------------------------- 162 | ## DEFAULT VARIABLES (May be overriden upstream) 163 | ifeq ($(MKL_VERSION),) 164 | MKL_VERSION=12 165 | endif 166 | ifeq ($(MKL_DIR),) 167 | MKL_DIR= 168 | endif 169 | 170 | 171 | # !!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 172 | # Python and MKL have some conflicts (see e.g.https://github.com/GalSim-developers/GalSim/issues/261) 173 | # 174 | # mkl_intel_lp64: resolves the lapack symbols at compilation but creates a bug when loading from python 175 | # It seems the solution is to link with -lmkl_rt instead of -lmkl_sequential -lmkl_intel_lp64 -lmkl_core 176 | # In newer version where mkl_rt is available, then it's fine. 177 | # For older versions, I had to add mkl_lapack AND mkl_mc3 178 | # I added a switch depending on MKL_VERSION. 179 | # 180 | 181 | 182 | ## INFERFACE LAYER 183 | # This layer provides matching between the compiled code of an application and the threading/computational 184 | # components of the library 185 | # CHOICES: lmkl_intel_ilp64 lmkl_intel_lp64 lmkl_gf_lp64 lmkl_gf_ilp64 lmkl_intel_sp2dp 186 | # 187 | MKL_INTERF= 188 | ifeq ($(ARCHI),amd64) 189 | MKL_INTERF=-lmkl_intel_lp64 190 | endif 191 | ifeq ($(MKL_VERSION),12) 192 | # cf IMPORTANT NOTE above 193 | MKL_INTERF=-lmkl_rt 194 | endif 195 | 196 | ## COMPUTATIONAL LAYER 197 | # This is the heart of MKL and has only one variant for any processor/operating system family, The 198 | # computational layer accommodates multiple architectures through identification of the architecture or 199 | # architectural feature and chooses the appropriate binary code at execution. Intel MKL may be thought of as 200 | # the large computational layer that is unaffected by different computational environments. Then, as it has no 201 | # RTL requirements, RTLs refer not to the computational layer but to one of the layers above it: the Interface 202 | # layer or Threading layer. The most likely case is matching the threading layer with the RTL layer. 203 | # CHOICES: lmkl_lapack lmkl_core lmkl_scalapack_lp64/ilp64 204 | MKL_COMPUT=-lmkl_core 205 | ifeq ($(ARCHI),ia32) 206 | MKL_COMPUT=-lmkl_intel -lmkl_core 207 | endif 208 | ifeq ($(MKL_VERSION),11) 209 | # cf IMPORTANT NOTE above 210 | MKL_COMPUT=-lmkl_lapack -lmkl_core -lmkl_mc3 211 | endif 212 | 213 | ## THREADING LAYER 214 | # This layer helps the threaded MKL to co-operate with compiler level threading. This also provides the 215 | # sequential version lay 216 | # CHOICES: lmkl_intel_thread lmkl_gnu_thread lmkl_pgi_thread lmkl_sequential 217 | ifeq ($(OSNAME),linux) 218 | ifeq ($(LIB_ACCELERATOR),0) 219 | MKL_THREAD=-lmkl_sequential 220 | else 221 | ifeq ($(OPENMP),0) 222 | MKL_THREAD=-lmkl_sequential 223 | else 224 | ifeq ($(FCOMPILER),0) 225 | MKL_THREAD=-lmkl_gnu_thread 226 | else 227 | MKL_THREAD=-lmkl_intel_thread 228 | endif 229 | endif 230 | endif 231 | endif 232 | 233 | ifeq ($(OSNAME),windows) 234 | ifeq ($(LIB_ACCELERATOR),0) 235 | MKL_THREAD=-Qmkl:sequential 236 | else 237 | ifeq ($(OPENMP),0) 238 | MKL_THREAD=-Qmkl:sequential 239 | else 240 | # if threaded, IO might fail, but seem ok with dbglibs. Otherwise het rid of IO, or threads. 241 | MKL_THREAD=-threads -dbglibs -Qmkl:sequential 242 | endif 243 | endif 244 | endif 245 | # To force the use of specified number of threads: export MKL_DYNAMIC=FALSE (but a bad idea) 246 | 247 | ## RUN-TIME LIBRARY LAYER 248 | # This layer has run-time library support functions. For example, libiomp and libguide are run-time libraries 249 | # providing threading support for the OpenMP threading in Intel MKL. Note that when using the legacy 250 | # libguide you should also link against the POSIX threads library by appending -lpthread. 251 | # In addition to the libraries provided through the layered model you have the solver libraries, Fortran 90/95 252 | # interfaces and cluster components. Each of them fits in the computational or RTL layer. 253 | # CHOICES: Solver Libraries mkl_solver_ilp64_sequential mkl_solver_lp64_sequential lmkl_solver_lp64 lmkl_solver_ilp64 254 | # CHOICES Fortran 90/95 Interfaces: lmkl_lapack95 lmkl_blas95 255 | # CHOICES Cluster Components: lmkl_blacs_intelmpi_ilp64 libmkl_blacs_intelmpi_lp64 lmkl_blacs_openmpi_ilp64 libmkl_blacs_openmpi_lp64 lmkl_blacs_sgimpt_ilp64 lmkl_blacs_sgimpt_lp64 lmkl_cdft_core lmkl_scalapack_ilp64 lmkl_scalapack_lp64 256 | # CHOICES FFT Interfaces: lfftw2x_cdft_DOUBLE/SINGLE lfftw2xc_intel/_sp lfftw2xf_intel/_sp lfftw3xc_intel/_sp lfftw3xf_intel/_sp 257 | MKL_RUNTIME= 258 | ifeq ($(LIB_ACCELERATOR),1) 259 | # MKL_RUNTIME=-liomp5 -lpthread # Introduced some bugs 260 | # MKL_RUNTIME=-lgomp -lpthread 261 | # MKL_RUNTIME=-lguide -lpthread 262 | MKL_RUNTIME= -lpthread 263 | # 264 | endif 265 | 266 | 267 | ifeq ($(OSNAME),linux) 268 | ifeq ($(ARCHI),ia32) 269 | MKL_DIR := $(MKL_DIR)$(MKL_32) 270 | endif 271 | ifeq ($(ARCHI),amd64) 272 | MKL_DIR := $(MKL_DIR)$(MKL_64) 273 | endif 274 | endif 275 | 276 | 277 | 278 | ## DUMP of WINDOWS DLL FLAGS 279 | #### FROM MIN TEST 280 | # DEBUG 281 | # FFLAGS=/nologo /debug:full /Od /warn:interfaces /module:".\\" /object:".\\" /Fd"vc100.pdb" /traceback /check:bounds /libs:dll /threads /dbglibs /Qmkl:sequential 282 | # RELEASE 283 | # LDFLAGS_DLL=/NOLOGO /SUBSYSTEM:WINDOWS /DLL /OUT:"test.dll" 284 | # LDFLAGS_DLL=/INCREMENTAL:NO /NOLOGO /MANIFEST /MANIFESTFILE:"raccoon.dll.intermediate.manifest" /MANIFESTUAC:"level='asInvoker' uiAccess='false'" /DEBUG /PDB:"test.pdb" /SUBSYSTEM:WINDOWS /IMPLIB:"test.lib" /DLL /OUT:"test.dll" 285 | # FFLAGS=/nologo /O3 /module:".\\" /object:".\\" /traceback /libs:dll /threads /dbglibs /Qmkl:sequential 286 | # FFLAGS=/nologo /O3 /module:".\\" /object:".\\" /traceback /libs:dll /Qmkl:sequential 287 | 288 | #### ADAPTED FOR OMNIVOR 289 | # DEBUG 290 | # LDFLAGS_DLL=/OUT:"_lib\windows-ia32\libraccoon.dll" /INCREMENTAL:NO /NOLOGO /LIBPATH:$(LIB_DIR) /MANIFEST /MANIFESTFILE:"_lib\windows-ia32\raccoon.dll.intermediate.manifest" /MANIFESTUAC:"level='asInvoker' uiAccess='false'" /DEBUG /PDB:"_lib\windows-ia32\raccoon.pdb" /SUBSYSTEM:WINDOWS /IMPLIB:"_lib\windows-ia32\raccoon.lib" /DLL 291 | # RELEASE 292 | # LDFLAGS=/OUT:"raccoon.dll" /NOLOGO /MANIFEST /MANIFESTFILE:"raccoon.dll.intermediate.manifest" /MANIFESTUAC:"level='asInvoker' uiAccess='false'" /SUBSYSTEM:WINDOWS /IMPLIB:"raccoon.lib" /DLL 293 | # /OUT:"hawc2mb.exe" /INCREMENTAL:NO /NOLOGO /MANIFEST /MANIFESTFILE:"F:\Exchange\hawc2mb\hawc2mb\Release\hawc2mb.exe.intermediate.manifest" /MANIFESTUAC:"level='asInvoker' uiAccess='false'" /SUBSYSTEM:CONSOLE /IMPLIB:"hawc2mb.lib" 294 | #### ORIGINALS 295 | # ORIGINALS 296 | #/I"_includes" 297 | # DEBUG 298 | # FFLAGS=/nologo /debug:full /Od /warn:interfaces /module:"_build\windows-ia32\\" /object:"_build\windows-ia32\\" /Fd"_build\windows-ia32\vc100.pdb" /traceback /check:bounds /libs:dll /threads /dbglibs /Qmkl:sequential /c 299 | # RELEASE 300 | # FFLAGS=/nologo /module:"Release\\" /object:"Release\\" /Fd"Release\vc100.pdb" /libs:dll /threads /c 301 | # FFLAGS=/nologo /module:"Release\\" /object:"Release\\" /Fd"Release\vc100.pdb" /libs:statuc /threads /c 302 | #/LIBPATH:"_includes" 303 | 304 | 305 | ifeq ($(OSNAME),linux) 306 | ifeq ($(LIB_ACCELERATOR),2) 307 | LDFLAGS_MKL += 308 | LIBS_MKL += -llapack 309 | else 310 | LDFLAGS_MKL += -Wl,-R/$(MKL_DIR) 311 | LIBS_MKL += -L$(MKL_DIR) $(MKL_INTERF) $(MKL_THREAD) $(MKL_COMPUT) $(MKL_RUNTIME) 312 | endif 313 | 314 | LDFLAGS_DLL= $(LDFLAGS_MKL) 315 | endif 316 | ifeq ($(OSNAME),windows) 317 | ifeq ($(FCOMPILER),1) 318 | # DEBUG: 319 | #LDFLAGS =/nologo /SUBSYSTEM:WINDOWS /INCREMENTAL:NO 320 | # RELEASE: 321 | LDFLAGS_MKL =/nologo /SUBSYSTEM:CONSOLE -threads -dbglibs 322 | LIBS_MKL =/Qmkl:sequential 323 | LDFLAGS_DLL =/DLL /OUT: 324 | # if threaded, IO might fail, but seem ok with dbglibs. Otherwise het rid of IO, or threads. 325 | #FFLAGS+=/threads /dbglibs 326 | else 327 | LDFLAGS_MKL += NOT_SET_WINDOWS_NOT_IFORT 328 | LDFLAGS_DLL += NOT_SET_WINDOWS_NOT_IFORT 329 | LIBS_MKL += NOT_SET_WINDOWS_NOT_IFORT 330 | endif 331 | endif 332 | 333 | 334 | 335 | 336 | # MPI 337 | MPIFC = mpif90 338 | MPIRUN = mpirun -n $(PPN) 339 | RUN = mpirun 340 | ifeq ($(strip $(HOSTNAME)),jess.dtu.dk) 341 | MPIFC = mpiifort 342 | MPIRUN = mpirun -n $(PPN) 343 | RUN = mpirun 344 | endif 345 | ifeq ($(strip $(PBS_O_HOST)),jess.dtu.dk) 346 | MPIFC = mpiifort 347 | MPIRUN = mpirun -n $(PPN) 348 | RUN = mpirun 349 | endif 350 | ifeq ($(strip $(HOSTNAME)),g-000.risoe.dk) 351 | MPIFC = mpiifort 352 | MPIRUN = mpirun -n $(PPN) 353 | RUN = mpirun 354 | endif 355 | ifeq ($(strip $(HOSTNAME)),work) 356 | ifeq ($(FCOMPILER),0) 357 | MPIFC = mpif90.openmpi 358 | MPIRUN = mpirun.openmpi -n $(PPN) 359 | RUN = mpirun.openmpi 360 | endif 361 | endif 362 | ifeq ($(strip $(HOSTNAME)),olympe) 363 | ifeq ($(FCOMPILER),0) 364 | MPIFC = mpif90.openmpi 365 | MPIRUN = mpirun.openmpi -n $(PPN) 366 | RUN = mpirun.openmpi 367 | endif 368 | endif 369 | 370 | -------------------------------------------------------------------------------- /_mkf/MakefileOS.mk: -------------------------------------------------------------------------------- 1 | # This make file should maybe be updated according to: http://mad-scientist.net/make/multi-arch.html 2 | #-------------------------------------------------------------------------------- 3 | # --- Architecture, system name, objects 4 | # -------------------------------------------------------------------------------- 5 | ifeq ($(OS),Windows_NT) 6 | OSNAME=windows 7 | #REG=$(shell reg query "HKLM\System\CurrentControlSet\Control\Session Manager\Environment" /v PROCESSOR_ARCHITECTURE) 8 | 9 | ifeq ($(PROCESSOR_ARCHITEW6432),AMD64) 10 | ARCHI = amd64 11 | endif 12 | 13 | ifeq ($(PROCESSOR_ARCHITECTURE),AMD64) 14 | ARCHI ?= amd64 15 | else 16 | ARCHI ?= ia32 17 | endif 18 | 19 | OSDEF=-DWINDOWS -D_WIN32 20 | # Forcing the usual preprocessor flags 21 | ifeq ($(ARCHI),amd64) 22 | OSDEF := $(OSDEF) -D_WIN64 23 | endif 24 | 25 | 26 | # File Extensions 27 | o=obj 28 | lib=lib 29 | dll=dll 30 | EXE=.exe 31 | 32 | else 33 | UNAME_S := $(shell uname -s) 34 | ifeq ($(UNAME_S),Linux) 35 | OSNAME=linux 36 | else ifeq ($(UNAME_S),Darwin) 37 | OSNAME=mac 38 | endif 39 | UNAME_P := $(shell uname -p) 40 | UNAME_M := $(shell uname -m) 41 | ifeq ($(UNAME_M),x86_64) 42 | ARCHI=amd64 43 | # STUFF BELOW NEED TO BE re-tested.. 44 | else ifneq ($(filter %86,$(UNAME_P)),) 45 | ARCHI=ia32 46 | else ifneq ($(filter arm%,$(UNAME_P)),) 47 | ARCHI=arm 48 | else ifneq ($(filter unknown%,$(UNAME_P)),) 49 | ARCHI=ia32 50 | endif 51 | 52 | OSDEF=-D__linux__ -D__unix__ -D__LINUX__ -D__UNIX__ 53 | # Forcing the usual preprocessor flags 54 | ifeq ($(ARCHI),amd64) 55 | OSDEF := $(OSDEF) 56 | endif 57 | 58 | # File Extensions 59 | o=o 60 | lib=a 61 | dll=so 62 | EXE= 63 | 64 | endif 65 | 66 | #-------------------------------------------------------------------------------- 67 | # --- System Commands 68 | # -------------------------------------------------------------------------------- 69 | ifeq ($(OS),Windows_NT) 70 | # System 71 | RM=del /q 72 | LN=copy /y 73 | CP=copy /y 74 | MKDIR=mkdir 75 | SLASH=/ 76 | SLASH := $(subst /,\,$(SLASH)) 77 | TOUCH=echo.> 78 | MKDEPF=makedepf90.exe 79 | SHELL=cmd.exe 80 | LD=link.exe 81 | LD_OUT=/out: 82 | LD_DLL=/nologo /dll 83 | AR=Lib 84 | CAT=type 85 | ECHOSAFE=echo( 86 | else 87 | # System 88 | RM=rm -rf 89 | LN=ln -sf 90 | CP=cp 91 | MKDIR=mkdir -p 92 | SLASH=/ 93 | TOUCH=touch 94 | MKDEPF=makedepf90 95 | SHELL=/bin/bash 96 | LD=LD 97 | LD_OUT=-o 98 | LD_DLL= 99 | AR=ar 100 | CAT=cat 101 | ECHOSAFE=echo 102 | endif 103 | 104 | 105 | 106 | HOSTNAME=$(shell hostname) 107 | -------------------------------------------------------------------------------- /_mkf/MakefileSimpleRules.mk: -------------------------------------------------------------------------------- 1 | # -------------------------------------------------------------------------------- 2 | # --- Simple rules 3 | # -------------------------------------------------------------------------------- 4 | # Convenient rule to print any variable 5 | echo-%: 6 | @echo '$*=$($*)' 7 | 8 | flags: 9 | @echo "" 10 | @echo "OS-Archi-Build: " $(OSNAME)-$(ARCHI)-$(BUILD) 11 | @echo "" 12 | @echo "SUPPORT: " $(SUPPORT) 13 | @echo "" 14 | @echo "Compilers: " $(FC) $(CC) 15 | @echo "" 16 | @echo "C FLAGS: " $(CFLAGS) 17 | @echo "" 18 | @echo "Fortran FLAGS: " $(FFLAGS) 19 | @echo "" 20 | @echo "Linker FLAGS: " $(LDFLAGS) 21 | @echo "" 22 | @echo "Archiver FLAGS: " $(AFLAGS) 23 | @echo "" 24 | @echo "INCLUDES: " $(INCS) 25 | @echo "" 26 | @echo "DEFS: " $(DEFS) 27 | @echo "" 28 | @echo "LIBS: " $(LIBS) 29 | @echo "" 30 | -------------------------------------------------------------------------------- /_mkf/MakefileSupport.mk: -------------------------------------------------------------------------------- 1 | # -------------------------------------------------------------------------------- 2 | # --- Defining variables based on config 3 | # -------------------------------------------------------------------------------- 4 | SUPPORT=$(strip $(OSNAME))-$(strip $(ARCHI))-$(strip $(FC)) 5 | ifeq ($(RELEASE),0) 6 | SUPPORT:=$(SUPPORT)-debug 7 | endif 8 | LIB_DIR=$(LIB_DIR_BASE)-$(SUPPORT) 9 | OBJ_DIR=$(OBJ_DIR_BASE)-$(SUPPORT) 10 | -------------------------------------------------------------------------------- /_support/SupportArchitecture_amd64.f90: -------------------------------------------------------------------------------- 1 | module SupportArchitecture 2 | integer, parameter :: ISTRING_LEN=64 3 | character(len=ISTRING_LEN), parameter :: ARCHITECTURE = 'amd64' 4 | end module SupportArchitecture 5 | -------------------------------------------------------------------------------- /_support/SupportArchitecture_ia32.f90: -------------------------------------------------------------------------------- 1 | module SupportArchitecture 2 | integer, parameter :: ISTRING_LEN=64 3 | character(len=ISTRING_LEN), parameter :: ARCHITECTURE = 'ia32' 4 | end module SupportArchitecture 5 | -------------------------------------------------------------------------------- /_support/SupportCompiler_compaq.f90: -------------------------------------------------------------------------------- 1 | module SupportCompiler 2 | implicit none 3 | ! 4 | integer, parameter :: IPTRK=int_ptr_kind() !< for pointers 5 | integer, parameter :: RECORD_LENGTH=1 !< for direct access binaries 6 | ! 7 | integer, parameter :: ISTR_LEN = 64 !< parameter for ease of comparison of parameter-strings 8 | character(len=ISTR_LEN), parameter :: FORTRAN_COMPILER='compaq' 9 | 10 | 11 | contains 12 | ! 13 | integer function command_argument_count() result(n) 14 | use DFLIB 15 | n=NARGS() 16 | end function 17 | 18 | subroutine get_command_argument(i,arg) 19 | use DFLIB 20 | integer, intent(in) :: i 21 | character(len=*), intent(inout) :: arg 22 | call getarg(i,arg) 23 | end subroutine 24 | end module 25 | -------------------------------------------------------------------------------- /_support/SupportCompiler_gfortran.f90: -------------------------------------------------------------------------------- 1 | module SupportCompiler 2 | use iso_c_binding, only: C_INTPTR_T 3 | implicit none 4 | ! 5 | integer, parameter :: IPTRK=C_INTPTR_T !< for pointers 6 | integer, parameter :: RECORD_LENGTH=1 !< for direct access binaries 7 | ! 8 | integer, parameter :: ISTR_LEN = 64 !< parameter for ease of comparison of parameter-strings 9 | character(len=ISTR_LEN), parameter :: FORTRAN_COMPILER='gfortran' 10 | 11 | 12 | 13 | end module 14 | -------------------------------------------------------------------------------- /_support/SupportCompiler_intel.f90: -------------------------------------------------------------------------------- 1 | module SupportCompiler 2 | implicit none 3 | ! 4 | integer, parameter :: IPTRK=int_ptr_kind() !< for pointers 5 | integer, parameter :: RECORD_LENGTH=1 !< for direct access binaries 6 | ! 7 | integer, parameter :: ISTR_LEN = 64 !< parameter for ease of comparison of parameter-strings 8 | character(len=ISTR_LEN), parameter :: FORTRAN_COMPILER='ifort' 9 | 10 | end module 11 | -------------------------------------------------------------------------------- /_support/SupportISO_compaq.f90: -------------------------------------------------------------------------------- 1 | module SupportISO 2 | implicit none 3 | ! -------------------------------------------------------------------------------- 4 | ! --- ISO_C_BINDING 5 | ! -------------------------------------------------------------------------------- 6 | ! Builtin types kind 7 | integer, parameter :: C_INT = 4 8 | integer, parameter :: C_FLOAT = 4 9 | integer, parameter :: C_DOUBLE = 8 10 | integer, parameter :: C_CHAR = 1 11 | integer, parameter :: C_BOOL = 1 12 | 13 | ! 14 | integer, parameter :: C_INTPTR_T = int_ptr_kind() ! 32/64-bits: 4/8 15 | integer(C_INTPTR_T), parameter :: C_NULL_FUNPTR = 0 16 | character(kind=C_CHAR, len=1), parameter :: C_NULL_CHAR=CHAR(0) 17 | 18 | ! type(TODO): 19 | type C_FUNPTR 20 | PRIVATE 21 | integer :: i 22 | end type 23 | type C_PTR 24 | PRIVATE 25 | integer :: i 26 | end type 27 | 28 | ! -------------------------------------------------------------------------------- 29 | ! --- ISO_FORTRAN_ENV 30 | ! -------------------------------------------------------------------------------- 31 | integer, parameter :: INT32 = 4 32 | integer, parameter :: INT64 = 8 33 | integer, parameter :: REAL32 = 4 34 | integer, parameter :: REAL64 = 8 35 | 36 | 37 | contains 38 | 39 | subroutine print_iso() 40 | print*,'C_INTPTR_T', C_INTPTR_T 41 | print*,'C_INT', C_INT 42 | end subroutine 43 | 44 | end module SupportISO 45 | -------------------------------------------------------------------------------- /_support/SupportISO_gfortran.f90: -------------------------------------------------------------------------------- 1 | module SupportISO 2 | use iso_c_binding 3 | use iso_fortran_env 4 | 5 | implicit none 6 | 7 | contains 8 | 9 | subroutine print_iso() 10 | print*,'C_INTPTR_T', C_INTPTR_T 11 | print*,'C_INT', C_INT 12 | end subroutine 13 | 14 | end module SupportISO 15 | -------------------------------------------------------------------------------- /_support/SupportISO_intel.f90: -------------------------------------------------------------------------------- 1 | module SupportISO 2 | use iso_c_binding 3 | use iso_fortran_env 4 | implicit none 5 | 6 | contains 7 | 8 | subroutine print_iso() 9 | print*,'C_INTPTR_T', C_INTPTR_T 10 | print*,'C_INT', C_INT 11 | end subroutine 12 | 13 | end module SupportISO 14 | -------------------------------------------------------------------------------- /_support/SupportPrecision.f90: -------------------------------------------------------------------------------- 1 | module SupportPrecision 2 | ! Compiler interface to iso_c_binding 3 | use SupportISO, only: C_FLOAT, C_DOUBLE, C_CHAR, C_INT, C_BOOL 4 | use SupportISO, only: C_INTPTR_T, C_NULL_FUNPTR 5 | ! Compiler interface to iso_fortran_env 6 | use SupportISO, only: REAL32, REAL64, INT32, INT64 7 | ! Compiler interface to int_ptr_kind 8 | use SupportCompiler, only: IPTRK 9 | ! 10 | integer, parameter :: R4 = REAL32 ! 32 bits 11 | integer, parameter :: R8 = REAL64 ! 64 bits 12 | integer, parameter :: SP = kind(1e0)! "Single precision" 13 | integer, parameter :: DP = kind(1d0)! "Double precision" 14 | integer, parameter :: MK = C_DOUBLE ! MK stands for My Kind 15 | 16 | contains 17 | ! -------------------------------------------------------------------------------- 18 | ! --- 19 | ! -------------------------------------------------------------------------------- 20 | subroutine print_precision_kinds() 21 | print*,'C_INT ',C_INT 22 | print*,'C_FLOAT ',C_FLOAT 23 | print*,'C_DOUBLE ',C_DOUBLE 24 | print*,'C_CHAR ',C_CHAR 25 | print*,'C_BOOL ',C_BOOL 26 | print*,'INT32 ',INT32 27 | print*,'INT64 ',INT64 28 | print*,'REAL32 ',REAL32 29 | print*,'REAL64 ',REAL64 30 | print*,'SP ',kind(1e0) 31 | print*,'DP ',kind(1d0) 32 | print*,'C_INTPTR_T ',C_INTPTR_T 33 | print*,'C_NULL_FPTR ',C_NULL_FUNPTR 34 | print*,'IPTRK ',IPTRK 35 | end subroutine 36 | 37 | 38 | ! Below we have functions for MK, DP, SP (no interface is used because redundancy is possible) 39 | ! -------------------------------------------------------------------------------- 40 | ! --- MK, default 41 | ! -------------------------------------------------------------------------------- 42 | logical function precision_equal(x,y) result(b) 43 | real(MK), intent(in) :: x,y 44 | b=.not.precision_different(x,y) 45 | end function 46 | 47 | logical function precision_different(x,y) result(b) 48 | real(MK), intent(in) :: x,y 49 | b= abs(x -y) >0.0_MK 50 | end function 51 | 52 | ! -------------------------------------------------------------------------------- 53 | ! --- Double precision 54 | ! -------------------------------------------------------------------------------- 55 | logical function precision_equal_dp(x,y) result(b) 56 | real(DP), intent(in) :: x,y 57 | b=.not.precision_different_dp(x,y) 58 | end function 59 | 60 | logical function precision_different_dp(x,y) result(b) 61 | real(DP), intent(in) :: x,y 62 | b= abs(x -y) >0.0_MK 63 | end function 64 | 65 | ! -------------------------------------------------------------------------------- 66 | ! --- Single precision 67 | ! -------------------------------------------------------------------------------- 68 | logical function precision_equal_sp(x,y) result(b) 69 | real(SP), intent(in) :: x,y 70 | b=.not.precision_different_sp(x,y) 71 | end function 72 | 73 | logical function precision_different_sp(x,y) result(b) 74 | real(SP), intent(in) :: x,y 75 | b= abs(x -y) >0.0_MK 76 | end function 77 | 78 | end module 79 | -------------------------------------------------------------------------------- /_support/SupportSystem_linux.f90: -------------------------------------------------------------------------------- 1 | !> Contains Parameters/Data that are system/architecture specific, autogenerated by Makefile 2 | module SupportSystem 3 | implicit none 4 | !LINUX 5 | character(len=10), parameter :: OSNAME = "linux" 6 | character(len=1), parameter :: SLASH = '/' !< Path separator. 7 | character(len=1), parameter :: BADSLASH = '\' !< Bad slash 8 | character(len=1), parameter :: SWITCH = '-' !< switch for command-line options. 9 | character(len=20), parameter :: COPY = "cp " 10 | character(len=20), parameter :: RENAME = "mv " 11 | character(len=20), parameter :: REMOVE = "rm -f " 12 | character(len=10), parameter :: MKDIR = "mkdir -p " 13 | character(len=20), parameter :: RMDIR = "rmdir " 14 | character(len=20), parameter :: FILELIST = "ls " ! Only file names! 15 | character(len=20), parameter :: REDIRECT = ">" 16 | character(len=20), parameter :: TEMPDIR = "/tmp/" 17 | 18 | character(len=20), parameter :: BG_CMD_PREFIX = "nohup" 19 | character(len=20), parameter :: BG_CMD_SUFFIX = "&" 20 | character(len=20), parameter :: SUPPRESS_MSG = "2>/dev/null" 21 | end module 22 | 23 | -------------------------------------------------------------------------------- /_support/SupportSystem_windows.f90: -------------------------------------------------------------------------------- 1 | !> Contains Parameters/Data that are system/architecture specific, autogenerated by Makefile 2 | module SystemParameters 3 | implicit none 4 | !WINDOWS 5 | character(len=10), parameter :: OSNAME = "windows" 6 | character(len=1), parameter :: SLASH = '\' !< Path separator. 7 | character(len=1), parameter :: BADSLASH = '/' !< Bad slash 8 | character(len=1), parameter :: SWITCH = '/' !< switch for command-line options. 9 | character(len=20), parameter :: COPY = "copy /y " 10 | character(len=20), parameter :: RENAME = "ren " 11 | character(len=20), parameter :: REMOVE = "del /q " 12 | character(len=20), parameter :: MKDIR = "md " 13 | character(len=20), parameter :: RMDIR = "rd " 14 | character(len=20), parameter :: FILELIST = "dir /b " ! Only file names! 15 | character(len=20), parameter :: REDIRECT = ">" 16 | character(len=20), parameter :: TEMPDIR = "c:\tmp\" 17 | 18 | character(len=20), parameter :: BG_CMD_PREFIX = "start /nowait" 19 | character(len=20), parameter :: BG_CMD_SUFFIX = "" 20 | character(len=20), parameter :: SUPPRESS_MSG = "2>nul" 21 | end module 22 | -------------------------------------------------------------------------------- /_support_dll/Makefile: -------------------------------------------------------------------------------- 1 | CCOMPILER=0 2 | 3 | include ../_mkf/MakefileOS.mk 4 | include ../_mkf/MakefileC.mk 5 | 6 | all: compile tests clean 7 | 8 | compile: 9 | @$(CC) include_me_in_C_programs.c -o include_me 10 | 11 | 12 | tests: 13 | @./include_me 14 | 15 | clean: 16 | @$(RM) include_me 17 | -------------------------------------------------------------------------------- /_support_dll/README.md: -------------------------------------------------------------------------------- 1 | For more on dlls with small tests see: 2 | https://gitlab.windenergy.dtu.dk/ebra/hawc2-dll-tests 3 | -------------------------------------------------------------------------------- /_support_dll/include_me_in_C_programs.c: -------------------------------------------------------------------------------- 1 | #include // for CHAR_BIT 2 | #include 3 | 4 | int main(){ 5 | // The line below wont compile if a double is not 64 bits 6 | // It's a safety if you want to make sure C and fortran agrees 7 | // on the size of those variables. On Fortran size use real(REAL64) 8 | char DUMMY1[sizeof(double) * CHAR_BIT == 64]; 9 | char DUMMY2[sizeof(float) * CHAR_BIT == 32]; 10 | char DUMMY3[sizeof(int) * CHAR_BIT == 32]; 11 | 12 | printf("[ OK ] C double is 64 bits \n"); 13 | 14 | return 0; 15 | } 16 | -------------------------------------------------------------------------------- /_support_lib/SupportMKL_0.f90: -------------------------------------------------------------------------------- 1 | !> 2 | module SupportMKL 3 | implicit none 4 | 5 | TYPE, PUBLIC :: DFTI_DESCRIPTOR 6 | PRIVATE 7 | INTEGER :: dontuse 8 | ! Structure of this type is not used in Fortran code 9 | ! the pointer to this type is used only 10 | END TYPE DFTI_DESCRIPTOR 11 | 12 | contains 13 | 14 | ! -------------------------------------------------------------------------------- 15 | ! --- 16 | ! -------------------------------------------------------------------------------- 17 | SUBROUTINE D_INIT_HELMHOLTZ_3D(AX,BX,AY,BY,AZ,BZ,NX,NY,NZ,BCTYPE,Q,IPAR,DPAR,STAT) 18 | INTEGER NX, NY, NZ, STAT 19 | INTEGER IPAR(*) 20 | DOUBLE PRECISION AX,BX,AY,BY,AZ,BZ,Q 21 | CHARACTER(6) BCTYPE 22 | DOUBLE PRECISION DPAR(*) 23 | 24 | if(.false.) then 25 | Nx=0; Ny=0; Nz=0; Stat=0; iPar(1)=0; 26 | AX=0;AY=0;BX=0;BY=0;AZ=0;BZ=0;Q=0; DPar(1)=0; 27 | BCTYPE='' 28 | endif 29 | print*,'Fake Helmholtz' 30 | 31 | END SUBROUTINE 32 | 33 | !--------------------------------------------------------------------- 34 | 35 | SUBROUTINE D_COMMIT_HELMHOLTZ_3D(F,BD_AX,BD_BX,BD_AY,BD_BY,BD_AZ,BD_BZ,XHANDLE,YHANDLE,IPAR,DPAR,STAT) 36 | 37 | INTEGER STAT 38 | INTEGER IPAR(*) 39 | DOUBLE PRECISION DPAR(*) 40 | DOUBLE PRECISION F(IPAR(11)+1,IPAR(12)+1,*) 41 | DOUBLE PRECISION BD_AX(IPAR(12)+1,*),BD_BX(IPAR(12)+1,*),BD_AY(IPAR(11)+1,*),BD_BY(IPAR(11)+1,*) 42 | DOUBLE PRECISION BD_AZ(IPAR(11)+1,*),BD_BZ(IPAR(11)+1,*) 43 | TYPE(DFTI_DESCRIPTOR), POINTER :: XHANDLE, YHANDLE 44 | if(.false.) then 45 | Stat=0; iPar(1)=0; 46 | F(1,1,1)=0 47 | BD_AX(1,1)=0; 48 | BD_AY(1,1)=0; 49 | BD_BX(1,1)=0; 50 | BD_BY(1,1)=0; 51 | BD_AZ(1,1)=0; 52 | BD_BZ(1,1)=0; 53 | DPar(1)=0; 54 | xhandle%dontuse=1 55 | yhandle%dontuse=1 56 | endif 57 | print*,'Fake Helmholtz' 58 | END SUBROUTINE 59 | 60 | !--------------------------------------------------------------------- 61 | 62 | 63 | SUBROUTINE D_HELMHOLTZ_3D(F,BD_AX,BD_BX,BD_AY,BD_BY,BD_AZ,BD_BZ,XHANDLE,YHANDLE,IPAR,DPAR,STAT) 64 | 65 | INTEGER STAT 66 | INTEGER IPAR(*) 67 | DOUBLE PRECISION F(IPAR(11)+1,IPAR(12)+1,*) 68 | DOUBLE PRECISION BD_AX(IPAR(12)+1,*),BD_BX(IPAR(12)+1,*),BD_AY(IPAR(11)+1,*),BD_BY(IPAR(11)+1,*) 69 | DOUBLE PRECISION BD_AZ(IPAR(11)+1,*),BD_BZ(IPAR(11)+1,*) 70 | DOUBLE PRECISION DPAR(*) 71 | TYPE(DFTI_DESCRIPTOR), POINTER :: XHANDLE, YHANDLE 72 | if(.false.) then 73 | Stat=0; iPar(1)=0; 74 | F(1,1,1)=0 75 | BD_AX(1,1)=0; 76 | BD_AY(1,1)=0; 77 | BD_BX(1,1)=0; 78 | BD_BY(1,1)=0; 79 | BD_AZ(1,1)=0; 80 | BD_BZ(1,1)=0; 81 | DPar(1)=0; 82 | xhandle%dontuse=1 83 | yhandle%dontuse=1 84 | endif 85 | END SUBROUTINE 86 | 87 | !--------------------------------------------------------------------- 88 | 89 | SUBROUTINE FREE_HELMHOLTZ_3D(XHANDLE,YHANDLE,IPAR,STAT) 90 | 91 | INTEGER STAT 92 | INTEGER IPAR(*) 93 | TYPE(DFTI_DESCRIPTOR), POINTER :: XHANDLE, YHANDLE 94 | if(.false.) then 95 | Stat=0; iPar(1)=0; 96 | xhandle%dontuse=1 97 | yhandle%dontuse=1 98 | endif 99 | END SUBROUTINE 100 | 101 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 102 | !!!!!!!!!!!!!!INTERFACES FOR 2D CASE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 103 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 104 | 105 | 106 | SUBROUTINE D_INIT_HELMHOLTZ_2D(AX,BX,AY,BY,NX,NY,BCTYPE,Q,IPAR,DPAR,STAT) 107 | INTEGER NX, NY, STAT 108 | INTEGER IPAR(*) 109 | DOUBLE PRECISION AX,BX,AY,BY,Q 110 | CHARACTER(4) BCTYPE 111 | DOUBLE PRECISION DPAR(*) 112 | if(.false.) then 113 | Nx=0; Ny=0; Stat=0; iPar(1)=0; 114 | AX=0;AY=0;BX=0;BY=0;Q=0; DPar(1)=0; 115 | BCTYPE='' 116 | endif 117 | END SUBROUTINE 118 | 119 | !--------------------------------------------------------------------- 120 | 121 | SUBROUTINE D_COMMIT_HELMHOLTZ_2D(F,BD_AX,BD_BX,BD_AY,BD_BY,HANDLE,IPAR,DPAR,STAT) 122 | INTEGER STAT 123 | INTEGER IPAR(*) 124 | DOUBLE PRECISION F(IPAR(11)+1,*) 125 | DOUBLE PRECISION BD_AX(*),BD_BX(*),BD_AY(*),BD_BY(*) 126 | DOUBLE PRECISION DPAR(*) 127 | TYPE(DFTI_DESCRIPTOR), POINTER :: HANDLE 128 | if(.false.) then 129 | Stat=0; iPar(1)=0; 130 | F(1,1)=0 131 | BD_AX(1)=0; 132 | BD_AY(1)=0; 133 | BD_BX(1)=0; 134 | BD_BY(1)=0; 135 | DPar(1)=0; 136 | handle%dontuse=1 137 | endif 138 | END SUBROUTINE 139 | 140 | !--------------------------------------------------------------------- 141 | 142 | SUBROUTINE D_HELMHOLTZ_2D(F,BD_AX,BD_BX,BD_AY,BD_BY,HANDLE,IPAR,DPAR,STAT) 143 | INTEGER STAT 144 | INTEGER IPAR(*) 145 | DOUBLE PRECISION F(IPAR(11)+1,*) 146 | DOUBLE PRECISION BD_AX(*),BD_BX(*),BD_AY(*),BD_BY(*) 147 | DOUBLE PRECISION DPAR(*) 148 | TYPE(DFTI_DESCRIPTOR), POINTER :: HANDLE 149 | if(.false.) then 150 | Stat=0; iPar(1)=0; 151 | F(1,1)=0 152 | BD_AX(1)=0; 153 | BD_AY(1)=0; 154 | BD_BX(1)=0; 155 | BD_BY(1)=0; 156 | DPar(1)=0; 157 | handle%dontuse=1 158 | endif 159 | END SUBROUTINE 160 | 161 | !--------------------------------------------------------------------- 162 | 163 | SUBROUTINE FREE_HELMHOLTZ_2D(HANDLE,IPAR,STAT) 164 | INTEGER STAT 165 | INTEGER IPAR(*) 166 | TYPE(DFTI_DESCRIPTOR), POINTER :: HANDLE 167 | if(.false.) then 168 | Stat=0; iPar(1)=0; 169 | handle%dontuse=1 170 | endif 171 | END SUBROUTINE 172 | end module SupportMKL 173 | -------------------------------------------------------------------------------- /_support_lib/SupportMKL_1.f90: -------------------------------------------------------------------------------- 1 | !> 2 | module SupportMKL 3 | use MKL_DFTI 4 | use MKL_POISSON 5 | 6 | end module SupportMKL 7 | -------------------------------------------------------------------------------- /_support_lib/SupportMPI_0.TEMPLATE.F90: -------------------------------------------------------------------------------- 1 | #def list_me($var,$ndim) 2 | #set $list='%s1'%$var 3 | #for $dim in range($ndim-1) 4 | #set $list=$list+',%s%s'%($var,$dim+2) 5 | #end for 6 | #return $list 7 | #end def 8 | #def list_dimensions($ndim) 9 | #if $ndim==0: 10 | #set $list='' 11 | #else: 12 | #set $list=', dimension(:' 13 | #for $dim in range($ndim-1) 14 | #set $list=$list+',:' 15 | #end for 16 | #set $list=$list+')' 17 | #end if 18 | #return $list 19 | #end def 20 | #def list_dimensions_n($var,$ndim) 21 | #if $ndim==0: 22 | #set $list='' 23 | #else: 24 | #set $list=', dimension('+$list_me($var,$ndim)+')' 25 | #end if 26 | #return $list 27 | #end def 28 | #set $dims=[0,1,2,3,4] 29 | #set $vars =['integer','real','double precision','logical'] 30 | #set $vars_short=['i','r','d','b'] 31 | #set $nvars=len($vars) 32 | !> 33 | ! This modules provides SIMPLE interfaces that replaces MPI calls if MPI is not supported. 34 | ! The modules present the following limitations: 35 | ! - Not all MPI routines are implemented. 36 | ! - The send and receive types are assumed to be the same 37 | ! - For now, most routines require that the send and receive buffers have the exact same dimensions and sizes 38 | ! 39 | module SupportMPI 40 | implicit none 41 | 42 | #set $routines=['MPI_reduce','MPI_Allreduce','MPI_Bcast','MPI_Send','MPI_Gather','MPI_Gatherv','MPI_Recv','MPI_SendRecv'] 43 | 44 | 45 | #for $routine_base in $routines: 46 | interface ${routine_base}; module procedure & 47 | #set $routines='' 48 | #set $nroutines=len($vars)*len($dims) 49 | #set $iroutines=0 50 | #for $dim in dims 51 | #for $ivar in range(len($vars)) 52 | #set $iroutines=$iroutines+1 53 | #set $td='%s%s'%($vars_short[$ivar],$dim) 54 | #set $routines=$routines+$routine_base+'_'+$td 55 | #if $iroutines<$nroutines: 56 | #set $routines=$routines+',' 57 | #if $iroutines%5==0: 58 | #set $routines=$routines+'&\n ' 59 | #end if 60 | #end if 61 | #end for 62 | #end for 63 | $routines 64 | end interface 65 | #end for 66 | 67 | ! 68 | integer, parameter :: MPI_STATUS_SIZE=0 69 | integer, parameter :: MPI_ANY_TAG=0 70 | integer, parameter :: MPI_PROC_NULL=-2 71 | ! Types 72 | integer, parameter :: MPI_INTEGER=0 73 | integer, parameter :: MPI_REAL=0 74 | integer, parameter :: MPI_DOUBLE=0 75 | integer, parameter :: MPI_DOUBLE_PRECISION=0 76 | ! Operations 77 | integer, parameter :: MPI_SUM=0 78 | integer, parameter :: MPI_MAX=0 79 | integer, parameter :: MPI_MIN=0 80 | ! Groups 81 | integer, parameter :: MPI_COMM_WORLD=0 82 | 83 | 84 | contains 85 | 86 | ! -------------------------------------------------------------------------------- 87 | ! --- Standard subroutines 88 | ! -------------------------------------------------------------------------------- 89 | subroutine MPI_init(ierr) 90 | integer, intent(inout) :: ierr 91 | ierr=0 92 | end subroutine 93 | 94 | subroutine MPI_finalize(ierr) 95 | integer, intent(inout) :: ierr 96 | ierr=0 97 | end subroutine 98 | 99 | subroutine MPI_comm_rank(MPI_group,rank,ierr) 100 | integer, intent(in) :: MPI_group 101 | integer, intent(inout) :: rank 102 | integer, intent(inout) :: ierr 103 | rank=0 104 | ierr=0*MPI_group 105 | end subroutine 106 | 107 | subroutine MPI_comm_size(MPI_group,nprocs,ierr) 108 | integer, intent(in) :: MPI_group 109 | integer, intent(inout) :: nprocs 110 | integer, intent(inout) :: ierr 111 | nprocs=1 112 | ierr=0*MPI_group 113 | end subroutine 114 | 115 | subroutine MPI_barrier(MPI_group,ierr) 116 | integer, intent(in) :: MPI_group 117 | integer, intent(inout) :: ierr 118 | ierr=0*MPI_group 119 | end subroutine 120 | 121 | 122 | 123 | ! -------------------------------------------------------------------------------- 124 | ! --- 125 | ! -------------------------------------------------------------------------------- 126 | 127 | #for $dim in $dims 128 | #for $ivar in range(len($vars)) 129 | #set $td='%s%s'%($vars_short[$ivar],$dim) 130 | #set $TD='%s%s'%($vars[$ivar],$list_dimensions($dim)) 131 | #set $TD2='%s%s'%($vars[$ivar],$list_dimensions($dim+1)) 132 | 133 | subroutine MPI_reduce_${td}( Isent, Irecv, n1, MPI_type,MPI_oper , root, MPI_group ,ierr ) 134 | ${TD}, intent(in) :: Isent 135 | ${TD}, intent(inout) :: Irecv 136 | integer, intent(in) :: n1 137 | integer, intent(in) :: MPI_type 138 | integer, intent(in) :: MPI_oper 139 | integer, intent(in) :: MPI_group 140 | integer, intent(in) :: root 141 | integer, intent(inout) :: ierr 142 | 143 | Irecv=Isent 144 | if(.false.) then 145 | print*,MPI_type,MPI_oper,MPI_group,root,ierr,n1 146 | endif 147 | end subroutine 148 | 149 | subroutine MPI_Allreduce_${td}( Isent, Irecv, n1, MPI_type,MPI_oper , MPI_group ,ierr ) 150 | ${TD}, intent(in) :: Isent 151 | ${TD}, intent(inout) :: Irecv 152 | integer, intent(in) :: n1 153 | integer, intent(in) :: MPI_type 154 | integer, intent(in) :: MPI_oper 155 | integer, intent(in) :: MPI_group 156 | integer, intent(inout) :: ierr 157 | 158 | Irecv=Isent 159 | if(.false.) then 160 | print*,MPI_type,MPI_oper,MPI_group,ierr,n1 161 | endif 162 | end subroutine 163 | 164 | subroutine MPI_Bcast_${td}( SendRecv, n1, MPI_type, RankRecv, MPI_group ,ierr ) 165 | ${TD}, intent(inout) :: SendRecv 166 | integer, intent(in) :: n1 167 | integer, intent(in) :: MPI_type 168 | integer, intent(in) :: RankRecv 169 | integer, intent(in) :: MPI_group 170 | integer, intent(inout) :: ierr 171 | SendRecv=SendRecv 172 | 173 | if(.false.) then 174 | print*,MPI_type,MPI_group,ierr,n1,rankrecv 175 | endif 176 | end subroutine 177 | 178 | subroutine MPI_Send_${td}( SendRecvBuf, SendCount, SendType, dest, tag, MPI_group ,ierr ) 179 | ${TD}, intent(inout) :: SendRecvBuf 180 | integer, intent(in) :: SendCount 181 | integer, intent(in) :: SendType 182 | integer, intent(in) :: dest 183 | integer, intent(in) :: tag 184 | integer, intent(in) :: MPI_group 185 | integer, intent(inout) :: ierr 186 | if(.false.) then 187 | print*,SendRecvBuf,SendType,SendCount,dest,tag,MPI_group,ierr 188 | endif 189 | end subroutine 190 | 191 | subroutine MPI_Gather_${td}( SendBuf, SendCount, SendType, RecvBuf, RecvCount, RecvType, root, MPI_group, ierr) 192 | ${TD}, intent(in) :: SendBuf 193 | integer, intent(in) :: SendCount 194 | integer, intent(in) :: SendType 195 | #if dim==0: 196 | ${TD2}, intent(out) :: RecvBuf 197 | #else: 198 | ${TD}, intent(out) :: RecvBuf 199 | #end if 200 | integer, intent(in) :: RecvCount 201 | integer, intent(in) :: RecvType 202 | integer, intent(in) :: root 203 | integer, intent(in) :: MPI_group 204 | integer, intent(inout) :: ierr 205 | RecvBuf=SendBuf 206 | if(.false.) then 207 | print*,SendCount,SendType,RecvCount,RecvType,root,MPI_group,ierr 208 | endif 209 | end subroutine 210 | 211 | subroutine MPI_Gatherv_${td}( SendBuf, SendCount, SendType, RecvBuf, RecvCount, Displs, RecvType, root, MPI_group, ierr) 212 | ${TD}, intent(in) :: SendBuf 213 | integer, intent(in) :: SendCount 214 | integer, intent(in) :: SendType 215 | ${TD}, intent(out) :: RecvBuf 216 | integer, dimension(:), intent(in) :: RecvCount 217 | integer, dimension(:), intent(in) :: Displs 218 | integer, intent(in) :: RecvType 219 | integer, intent(in) :: root 220 | integer, intent(in) :: MPI_group 221 | integer, intent(inout) :: ierr 222 | #if dim>=1: 223 | if(size(SendBuf)/=SendCount) then 224 | print*,'Fake MPI_Gatherv: sendcount should match size(SendBuf)' 225 | endif 226 | if(size(RecvBuf) 2 | module SupportOMP 3 | implicit none 4 | public :: omp_init 5 | public :: omp_term 6 | !public :: omp_set_num_threads 7 | !public :: omp_get_max_threads 8 | !public :: omp_get_num_procs 9 | public :: omp_set_proc_nthreads 10 | public :: omp_get_proc_init_nthreads 11 | public :: omp_get_proc_max_nthreads 12 | public :: omp_initialized 13 | contains 14 | ! -------------------------------------------------------------------------------- 15 | ! --- Mains 16 | ! -------------------------------------------------------------------------------- 17 | subroutine omp_init() 18 | use BadgerData, only: Device ! Exception 19 | Device%bOMPInitialized = .true. 20 | end subroutine 21 | 22 | subroutine omp_term() 23 | use BadgerData, only: Device ! Exception 24 | Device%bOMPInitialized = .false. 25 | end subroutine 26 | 27 | ! -------------------------------------------------------------------------------- 28 | ! --- Mutator 29 | ! -------------------------------------------------------------------------------- 30 | subroutine omp_set_proc_nthreads(n) 31 | integer, intent(in) :: n 32 | if(n==-1) then 33 | endif 34 | end subroutine 35 | 36 | ! -------------------------------------------------------------------------------- 37 | ! --- Accessor 38 | ! -------------------------------------------------------------------------------- 39 | integer function omp_get_proc_init_nthreads() result(n) 40 | use BadgerData, only: Device ! Exception 41 | n=Device%nthreads_init 42 | end function 43 | 44 | integer function omp_get_proc_max_nthreads() result(n) 45 | n=1 46 | end function 47 | 48 | logical function omp_initialized() result(b) 49 | use BadgerData, only: Device ! Exception 50 | b=Device%bOMPInitialized 51 | end function 52 | 53 | end module SupportOMP 54 | -------------------------------------------------------------------------------- /_support_lib/SupportOMP_1.f90: -------------------------------------------------------------------------------- 1 | !> 2 | module SupportOMP 3 | use OMP_LIB 4 | use ProcTypes, only:T_Proc 5 | implicit none 6 | 7 | private 8 | public :: omp_init 9 | public :: omp_term 10 | public :: omp_set_proc_nthreads 11 | public :: omp_get_proc_init_nthreads 12 | public :: omp_get_proc_max_nthreads 13 | public :: omp_initialized 14 | contains 15 | 16 | ! -------------------------------------------------------------------------------- 17 | ! --- Mains 18 | ! -------------------------------------------------------------------------------- 19 | subroutine omp_init(Proc) 20 | type(T_Proc), intent(inout) :: Proc 21 | Proc%nthreads_init=omp_get_max_threads() !OTHER-COMPILER 22 | Proc%nthreads_max =omp_get_num_procs()!OTHER-COMPILER 23 | Proc%bOMPInitialized = .true. 24 | !call log_info('Number of procs: '//num2str(nprocs)//' - max number of threads: '//num2str(nmax_threads)) 25 | !if(nprocs>nmax_threads) then 26 | ! call log_warning('Not using full openmp capacity: '//num2str(nmax_threads)//'/'//num2str(nprocs)) 27 | !endif 28 | end subroutine 29 | 30 | subroutine omp_term(Proc) 31 | type(T_Proc), intent(inout) :: Proc 32 | Proc%nthreads_init =-1 33 | Proc%nthreads_max =-1 34 | Proc%bOMPInitialized = .false. 35 | end subroutine 36 | ! -------------------------------------------------------------------------------- 37 | ! --- Mutator 38 | ! -------------------------------------------------------------------------------- 39 | subroutine omp_set_proc_nthreads(Proc,n) 40 | type(T_Proc), intent(inout) :: Proc 41 | integer, intent(in) :: n 42 | call omp_set_num_threads(n) 43 | Proc%nthreads=n 44 | end subroutine 45 | 46 | ! -------------------------------------------------------------------------------- 47 | ! --- Accessor 48 | ! -------------------------------------------------------------------------------- 49 | integer function omp_get_proc_init_nthreads(Proc) result(n) 50 | type(T_Proc), intent(in) :: Proc 51 | n=Proc%nthreads_init 52 | end function 53 | 54 | integer function omp_get_proc_max_nthreads(Proc) result(n) 55 | type(T_Proc), intent(in) :: Proc 56 | n=Proc%nthreads_max 57 | end function 58 | 59 | logical function omp_initialized(Proc) result(b) 60 | type(T_Proc), intent(in) :: Proc 61 | b=Proc%bOMPInitialized 62 | end function 63 | end module SupportOMP 64 | -------------------------------------------------------------------------------- /_tools/CStrings.f90: -------------------------------------------------------------------------------- 1 | module CStrings 2 | implicit none 3 | contains 4 | subroutine cstring2fortran(s_c,s) 5 | use SupportPrecision, only: C_CHAR 6 | character(kind=C_CHAR,len=1),dimension(*),intent(in) :: s_c 7 | character(len=*),intent(inout):: s 8 | integer :: i 9 | loop_string: do i=1,len(s) 10 | if ( s_c(i) == CHAR(0) ) then 11 | exit loop_string 12 | else 13 | s(i:i) = s_c(i) 14 | end if 15 | end do loop_string 16 | 17 | if(i==1) then 18 | s='' 19 | else 20 | s = s(1:(i-1)) 21 | s = trim(s) 22 | endif 23 | end subroutine 24 | 25 | subroutine fortranstring2c(s_f,s_c,n) 26 | use SupportPrecision, only: C_CHAR 27 | character(len=*),intent(in):: s_f 28 | character(kind=C_CHAR,len=1),dimension(*),intent(inout) :: s_c 29 | integer, intent(out), optional :: n 30 | integer :: i 31 | loop_string: do i=1,len(s_f) 32 | if ( s_f(i:i) == CHAR(0) ) then 33 | exit loop_string 34 | else 35 | s_c(i) = s_f(i:i) 36 | end if 37 | end do loop_string 38 | if(present(n))then 39 | n=i-1 40 | endif 41 | end subroutine 42 | end module 43 | -------------------------------------------------------------------------------- /_tools/FileSystem.f90: -------------------------------------------------------------------------------- 1 | !> 2 | module FileSystem 3 | implicit none 4 | character(len=1), parameter :: SP=' ' 5 | 6 | interface string2filename 7 | module procedure string2filename, string2filename2 8 | end interface 9 | 10 | contains 11 | 12 | 13 | subroutine system_rename(name1,name2) 14 | use SupportSystem, only:RENAME 15 | character(len=*), intent(in) :: name1,name2 16 | ! integer stat 17 | call system(RENAME//trim(name1)//SP//trim(name2)) 18 | end subroutine 19 | 20 | 21 | subroutine system_mkdir(dirname) 22 | use SupportSystem, only:MKDIR 23 | character(len=*), intent(in) :: dirname 24 | ! integer stat 25 | ! print*,'Making directory',trim(dirname) 26 | ! print*,'Command: ',MKDIR//trim(dirname)//' ;' 27 | call system(MKDIR//trim(dirname)) 28 | end subroutine 29 | 30 | !> Makes sure the string in input has a proper file format depending on OS 31 | subroutine string2filename(string) 32 | use SupportSystem, only:BADSLASH, SLASH 33 | use MatlabFunctions, only: strrep 34 | character(len=*),intent(inout) :: string 35 | ! 36 | string=trim(string) 37 | ! print*,'before',trim(string) 38 | call strrep(string,BADSLASH,SLASH) 39 | ! print*,'after ',trim(string) 40 | end subroutine 41 | 42 | !> Makes sure the string in input has a proper file format depending on OS, returns the filename and containing folder 43 | subroutine string2filename2(string,folder) 44 | use SupportSystem, only:BADSLASH, SLASH 45 | use MatlabFunctions, only: strrep 46 | character(len=*),intent(inout) :: string !< Gets an input string, returns the filename in it 47 | character(len=*),intent(out) :: folder !< returns containing folder of the file 48 | ! 49 | integer :: islash 50 | ! 51 | string=trim(string) 52 | !print*,'before',trim(string) 53 | ! Replacing slashes with system one 54 | call strrep(string,BADSLASH,SLASH) 55 | 56 | ! Find the last slash if any 57 | islash=index(string,SLASH,.true.) 58 | ! Retrieve folder and filename from it 59 | folder=string(1:islash) 60 | 61 | !print*,'after:',trim(string),':folder:',trim(folder),':' 62 | 63 | end subroutine 64 | 65 | !> Joins a fodler and a filename, or two folders 66 | subroutine path_join(path1,path2,path_joined) 67 | use MatlabFunctions, only: strrep 68 | character(len=*),intent(in) :: path1,path2 69 | character(len=*),intent(out) :: path_joined 70 | ! 71 | character(len=255) :: path_tmp 72 | ! 73 | path_joined='' 74 | ! -------------------------------------------------------------------------------- 75 | ! --- Special cases 76 | ! -------------------------------------------------------------------------------- 77 | ! Empty path 1 78 | if(len_trim(path1)==0) then 79 | path_joined=trim(path2) 80 | return 81 | endif 82 | ! Empty path 2 83 | if(len_trim(path2)==0) then 84 | path_joined=trim(path1) 85 | return 86 | endif 87 | ! -------------------------------------------------------------------------------- 88 | ! --- 89 | ! -------------------------------------------------------------------------------- 90 | ! - We put path1 in path_joined and we convert it to a folder 91 | path_joined=trim(path1) 92 | call string2folder(path_joined) 93 | ! - We make sure path2 has the proper format 94 | path_tmp=path2 95 | call string2filename(path_tmp) 96 | ! - We join the path 97 | path_joined=trim(path_joined)//trim(path_tmp) 98 | end subroutine 99 | 100 | 101 | !> Joins two folders 102 | subroutine folder_join(path1,path2,path_joined) 103 | use MatlabFunctions, only: strrep 104 | character(len=*),intent(in) :: path1,path2 105 | character(len=*),intent(out) :: path_joined 106 | ! 107 | character(len=255) :: path_tmp 108 | ! 109 | ! -------------------------------------------------------------------------------- 110 | ! --- Special cases 111 | ! -------------------------------------------------------------------------------- 112 | ! Empty path 1 113 | if(len_trim(path1)==0) then 114 | path_joined=trim(path2) 115 | call string2folder(path_joined) 116 | return 117 | endif 118 | ! Empty path 2 119 | if(len_trim(path2)==0) then 120 | path_joined=trim(path1) 121 | call string2folder(path_joined) 122 | return 123 | endif 124 | if(path2=='./') then 125 | path_joined=trim(path1) 126 | call string2folder(path_joined) 127 | return 128 | endif 129 | ! -------------------------------------------------------------------------------- 130 | ! --- None of them are empty 131 | ! -------------------------------------------------------------------------------- 132 | path_joined=trim(path1) 133 | call string2folder(path_joined) 134 | ! 135 | path_tmp=trim(path2) 136 | call string2folder(path_tmp) 137 | path_joined=trim(path_joined)//trim(path_tmp) 138 | end subroutine 139 | 140 | 141 | 142 | 143 | !> Makes sure the string in input has proper folder format depending on OS 144 | subroutine string2folder(string) 145 | use SupportSystem, only:SLASH 146 | character(len=*),intent(inout) :: string 147 | integer :: ipos 148 | ! 149 | ! replacing bad slashes in name 150 | call string2filename(string) 151 | 152 | ! empty string case 153 | if(string=='') then 154 | string='.'//SLASH 155 | else 156 | ! 157 | ipos=scan(string,SLASH,.true.) ! back search 158 | if(ipos/=len_trim(string)) then 159 | string=trim(string)//SLASH 160 | endif 161 | endif 162 | end subroutine 163 | 164 | 165 | 166 | !> 167 | logical function file_exists(filename) 168 | character(len=*),intent(in) ::filename ! 'input.txt' '/input.txt' 169 | INQUIRE(FILE=trim(filename), EXIST=file_exists) ! file_exists will be TRUE if the file 170 | end function file_exists 171 | 172 | 173 | 174 | !> Didn't manage to do something that works.. 175 | logical function isdir(dirname) 176 | character(len=*),intent(in) ::dirname ! './dir/' 177 | character(len=255)::dirn 178 | character(1) :: DOT = char(46) ! New Line character 179 | logical :: try1 180 | logical :: try2 181 | logical :: try3 182 | integer :: n 183 | dirn=dirname 184 | call string2folder(dirn) ! makes sure there are proper slashes, and ends up with a slash 185 | ! trying with directory with slash at the end 186 | inquire( file=trim(dirn), exist=try1) 187 | ! print*,'Exist Directory:',trim(dirn),try1 188 | 189 | ! trying with directory with slash and dot at the end 190 | dirn=trim(dirn)//DOT 191 | inquire( file=trim(dirn), exist=try2) 192 | ! print*,'Exist Directory:',trim(dirn),try2 193 | 194 | ! trying with directory without slash and dot at the end 195 | n=len_trim(dirn) 196 | dirn=trim(dirn(1:n-2)) 197 | inquire(file=trim(dirn), exist=try3) 198 | ! print*,'Exist Directory:',trim(dirn),try3 199 | isdir=try1.or.try2.or.try3 200 | end function 201 | 202 | 203 | !> Performs necessary checks for opening file 204 | subroutine prepare_file_write(filename) 205 | !use FileSystem, only: isdir, string2folder,string2filename,system_mkdir 206 | !use OmnivorData, only: bDEBUG, prefix, sim_folder,suffix 207 | ! Arguments 208 | character(len=*), intent(inout) :: filename !< filename (may contain folder) 209 | ! 210 | character(len=255) :: folder !< containing folders if any 211 | ! 212 | if (filename=='') then 213 | print'(A)','Error: FileSystem: prepare file open called with an empty filename' 214 | STOP 215 | endif 216 | ! Safety check on the simulation folder structure, if provided 217 | !call string2folder(filename) 218 | ! Safety checks on files input from user (if any) 219 | call string2filename ( filename , folder ) 220 | !print*,'filename:',trim(filename) 221 | !print*,'folder :',trim(folder) 222 | ! Creating directory structure 223 | if(folder/='') then 224 | call system_mkdir(folder) 225 | endif 226 | end subroutine 227 | 228 | end module FileSystem 229 | -------------------------------------------------------------------------------- /_tools/MainIO.f90: -------------------------------------------------------------------------------- 1 | !> General Input Output module 2 | module MainIO 3 | implicit none 4 | contains 5 | !> Returns a free unit for an open statement 6 | integer function get_free_unit() 7 | integer :: i 8 | integer :: ios 9 | logical :: bopen 10 | 11 | get_free_unit = 0 12 | do i = 10, 99 13 | inquire ( unit = i, opened = bopen, iostat = ios ) 14 | if ( ios == 0 ) then 15 | if ( .not. bopen ) then 16 | get_free_unit = i 17 | return 18 | end if 19 | end if 20 | end do 21 | end function 22 | 23 | 24 | !> Counts number of lines in a file 25 | integer function line_count(iunit) 26 | integer, intent(in) :: iunit 27 | character(len=512) :: line 28 | ! safety for infinite loop.. 29 | integer :: i 30 | integer, parameter :: nline_max=100000000 ! 100 M 31 | line_count=0 32 | do i=1,nline_max 33 | line='' 34 | read(iunit,'(A)',END=100)line 35 | line_count=line_count+1 36 | !print*,'l ',trim(line),i 37 | enddo 38 | if (line_count==nline_max) then 39 | print*,'Error: MainIO: maximum number of line exceeded' 40 | STOP 41 | endif 42 | 100 if(len(trim(line))>0) then 43 | !print*,'le ',trim(line),i 44 | line_count=line_count+1 45 | endif 46 | rewind(iunit) 47 | return 48 | end function 49 | 50 | ! subroutine filesize( filename, size ) 51 | ! ! This routine calls the routine Stat to obtain the file size 52 | ! ! corresponding to a file name or returns -1 on error. 53 | ! ! The standard version of the routine uses the file unit instead of file name. 54 | ! ! Argument declarations: 55 | ! #if defined __INTEL_COMPILER 56 | ! use ifport 57 | ! #elif defined __GNUC__ 58 | ! ! intrinsic declarations: 59 | ! integer(kind=1) :: stat 60 | ! #else 61 | ! #endif 62 | ! 63 | ! integer, intent(out) :: size 64 | ! character(*), intent(in) :: filename 65 | ! ! local declarations: 66 | ! integer :: statarray(13) 67 | ! integer :: status 68 | ! 69 | ! #ifdef __INTEL_COMPILER 70 | ! integer :: ios 71 | ! integer :: unit 72 | ! !bjj: unit is not set before it is used!!! should it also be an input parameter? 73 | ! open( unit, file=trim( filename ), status='old', iostat=ios, action='read' ) 74 | ! if ( ios /= 0 ) then 75 | ! size = -1 76 | ! else 77 | ! status = fstat( unit , statarray ) 78 | ! end if 79 | ! #elif defined __GNUC__ 80 | ! status = stat( filename, statarray ) 81 | ! #else 82 | ! call error(__file__,__line__,'compiler unknown'); 83 | ! #endif 84 | ! 85 | ! if ( status /= 0 ) then 86 | ! size = -1 87 | ! else 88 | ! size = statarray(8) 89 | ! end if 90 | ! return 91 | ! end subroutine filesize ! ( filename, size ) 92 | end module MainIO 93 | 94 | 95 | 96 | 97 | 98 | 99 | -------------------------------------------------------------------------------- /_tools/MemoryManager.f90: -------------------------------------------------------------------------------- 1 | module MemoryManager 2 | use SupportPrecision, only: MK 3 | implicit none 4 | 5 | 6 | !> Allocates and copy. (compiler dependent and fortran version dependent) 7 | ! In fortran 2003 allocate(A,source=B), or simply A=B 8 | ! gfortran supported 9 | ! ifortran use the flag -assume realloc_lhs 10 | ! interface allocate_copy 11 | ! module procedure allocate_copy1, allocate_copy2 12 | ! end interface 13 | 14 | interface resize_array 15 | module procedure rresize_array1,iresize_array1,lresize_array1, rresize_array2, iresize_array2 16 | end interface 17 | interface allocate_safe; module procedure & 18 | rallocate_safe1,iallocate_safe1,ballocate_safe1,iallocate_safe2,rallocate_safe2,rallocate_safe3,& 19 | rallocate_safe4 20 | end interface 21 | interface append_arrays 22 | module procedure rappend_arrays2 23 | end interface 24 | 25 | private 26 | public :: append_arrays 27 | public :: resize_array 28 | public :: allocate_safe 29 | contains 30 | 31 | ! -------------------------------------------------------------------------------- 32 | ! --- Append arrays 33 | ! -------------------------------------------------------------------------------- 34 | !> Real, dimension 2 35 | subroutine rappend_arrays2(array1,n1,array2,n2,margin_factor,default_val_in) 36 | real(MK),dimension(:,:), allocatable :: array1 37 | real(MK),dimension(:,:) :: array2 38 | integer , intent(inout) :: n1 !< SIDE EFFECTS 39 | integer , intent(in) :: n2 40 | real(MK), intent(in), optional :: margin_factor !< value >1 Used if reallocation is needed to allow for additional empty space 41 | real(MK), intent(in), optional :: default_val_in !< default value for empty space (in combination with margin_factor) 42 | ! Local variables 43 | integer :: nNew, nVar 44 | real(MK) :: default_val 45 | ! --- Safety 46 | nVar=size(array1,1) 47 | if(size(array2,1)/=nVar) then 48 | print*, 'Append array: leading dimension mismatch' 49 | !call log_error('Append array: leading dimension mismatch') 50 | STOP 51 | endif 52 | 53 | 54 | nNew=n1+n2 55 | ! --- Making enough space if needed 56 | if(nNew>size(array1,2)) then 57 | if(.not.present(default_val_in)) then 58 | default_val=0.0_MK 59 | else 60 | default_val=default_val_in 61 | endif 62 | if(present(margin_factor)) then 63 | nNew=int(nNew*margin_factor) 64 | endif 65 | call resize_array(array1,nNew,default_val) 66 | endif 67 | 68 | ! --- Appending 69 | array1(1:nVar,(n1+1):(n1+n2))=array2(1:nVar,1:n2) 70 | 71 | ! updating n1 72 | n1=n1+n2; 73 | 74 | end subroutine 75 | 76 | 77 | ! -------------------------------------------------------------------------------- 78 | ! --- Resize array 79 | ! -------------------------------------------------------------------------------- 80 | 81 | 82 | !> Real, dimension 1 83 | subroutine rresize_array1(array,nNewSize,default_val) 84 | real(MK),dimension(:),allocatable,intent(inout) :: array 85 | integer , intent(in) :: nNewSize 86 | real(MK), intent(in) :: default_val 87 | ! Local variables 88 | real(MK),dimension(:),allocatable :: tmp !< backup of input 89 | integer :: nDimTmp 90 | integer :: AllocateStatus 91 | ! To save memory, if nNewSize is below second dim, we take the min 92 | nDimTmp= min(size(array,1),nNewSize) 93 | 94 | ! Making of copy of the input 95 | allocate(tmp(1:nDimTmp), STAT = AllocateStatus) 96 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 97 | tmp(1:nDimTmp)=array(1:nDimTmp) 98 | ! Reallocating the array 99 | deallocate(array) 100 | allocate(array(1:nNewSize), STAT = AllocateStatus) 101 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 102 | ! We copy the original data into it 103 | array(1:nDimTmp)=tmp(1:nDimTmp) 104 | if(nDimTmp+1<=nNewSize) array(nDimTmp+1:nNewSize)=default_val 105 | end subroutine 106 | 107 | !> Logical, dimension 1 108 | subroutine lresize_array1(array,nNewSize,default_val) 109 | logical,dimension(:),allocatable,intent(inout) :: array 110 | integer , intent(in) :: nNewSize 111 | logical, intent(in) :: default_val 112 | ! Local variables 113 | logical,dimension(:),allocatable :: tmp !< backup of input 114 | integer :: nDimTmp 115 | integer :: AllocateStatus 116 | ! To save memory, if nNewSize is below second dim, we take the min 117 | nDimTmp= min(size(array,1),nNewSize) 118 | 119 | ! Making of copy of the input 120 | allocate(tmp(1:nDimTmp), STAT = AllocateStatus) 121 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 122 | tmp(1:nDimTmp)=array(1:nDimTmp) 123 | ! Reallocating the array 124 | deallocate(array) 125 | allocate(array(1:nNewSize), STAT = AllocateStatus) 126 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 127 | ! We copy the original data into it 128 | array(1:nDimTmp)=tmp(1:nDimTmp) 129 | if(nDimTmp+1<=nNewSize) array(nDimTmp+1:nNewSize)=default_val 130 | end subroutine 131 | 132 | !> Integer, dimension 1 133 | subroutine iresize_array1(array,nNewSize,default_val) 134 | integer,dimension(:),allocatable,intent(inout) :: array 135 | integer , intent(in) :: nNewSize 136 | integer, intent(in) :: default_val 137 | ! Local variables 138 | integer,dimension(:),allocatable :: tmp !< backup of input 139 | integer :: nDimTmp 140 | integer :: AllocateStatus 141 | ! To save memory, if nNewSize is below second dim, we take the min 142 | nDimTmp= min(size(array,1),nNewSize) 143 | 144 | ! Making of copy of the input 145 | allocate(tmp(1:nDimTmp), STAT = AllocateStatus) 146 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 147 | tmp(1:nDimTmp)=array(1:nDimTmp) 148 | ! Reallocating the array 149 | deallocate(array) 150 | allocate(array(1:nNewSize), STAT = AllocateStatus) 151 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 152 | ! We copy the original data into it 153 | array(1:nDimTmp)=tmp(1:nDimTmp) 154 | if(nDimTmp+1<=nNewSize) array(nDimTmp+1:nNewSize)=default_val 155 | end subroutine 156 | 157 | !> Real, dimension 2 158 | subroutine rresize_array2(array,nNewSize,default_val) 159 | real(MK),dimension(:,:),allocatable,intent(inout) :: array 160 | integer , intent(in) :: nNewSize 161 | real(MK), intent(in) :: default_val 162 | ! Local variables 163 | real(MK),dimension(:,:),allocatable :: tmp !< backup of input 164 | integer :: nFirstDim 165 | integer :: nSecondDimTmp 166 | integer :: AllocateStatus 167 | nFirstDim= size(array,1) 168 | ! To save memory, if nNewSize is below second dim, we take the min 169 | nSecondDimTmp= min(size(array,2),nNewSize) 170 | 171 | ! Making of copy of the input 172 | allocate(tmp(1:nFirstDim, 1:nSecondDimTmp), STAT = AllocateStatus) 173 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 174 | tmp(1:nFirstDim,1:nSecondDimTmp)=array(1:nFirstDim,1:nSecondDimTmp) 175 | ! Reallocating the array 176 | deallocate(array) 177 | allocate(array(1:nFirstDim,1:nNewSize), STAT = AllocateStatus) 178 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 179 | ! We copy the original data into it 180 | array(1:nFirstDim,1:nSecondDimTmp)=tmp(1:nFirstDim,1:nSecondDimTmp) 181 | if(nSecondDimTmp+1<=nNewSize) array(1:nFirstDim,nSecondDimTmp+1:nNewSize)=default_val 182 | 183 | end subroutine 184 | 185 | 186 | !> Integer, dimension 2 187 | subroutine iresize_array2(array,nNewSize,default_val) 188 | integer,dimension(:,:),allocatable,intent(inout) :: array 189 | integer , intent(in) :: nNewSize 190 | integer, intent(in) :: default_val 191 | ! Local variables 192 | integer,dimension(:,:),allocatable :: tmp !< backup of input 193 | integer :: nFirstDim 194 | integer :: nSecondDimTmp 195 | integer :: AllocateStatus 196 | nFirstDim= size(array,1) 197 | ! To save memory, if nNewSize is below second dim, we take the min 198 | nSecondDimTmp= min(size(array,2),nNewSize) 199 | 200 | ! Making of copy of the input 201 | allocate(tmp(1:nFirstDim, 1:nSecondDimTmp), STAT = AllocateStatus) 202 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 203 | tmp(1:nFirstDim,1:nSecondDimTmp)=array(1:nFirstDim,1:nSecondDimTmp) 204 | ! integerlocating the array 205 | deallocate(array) 206 | allocate(array(1:nFirstDim,1:nNewSize), STAT = AllocateStatus) 207 | if (AllocateStatus /= 0) STOP "*** Not enough memory ***" 208 | ! We copy the original data into it 209 | array(1:nFirstDim,1:nSecondDimTmp)=tmp(1:nFirstDim,1:nSecondDimTmp) 210 | if(nSecondDimTmp+1<=nNewSize) array(1:nFirstDim,nSecondDimTmp+1:nNewSize)=default_val 211 | 212 | end subroutine 213 | 214 | ! -------------------------------------------------------------------------------- 215 | ! --- Allocate safe 216 | ! -------------------------------------------------------------------------------- 217 | 218 | subroutine iallocate_safe1(array_name,array,dim1,default_val,bDealloc) 219 | character(len=*), intent(in) :: array_name 220 | integer, dimension(:),allocatable,intent(inout) :: array 221 | integer , intent(in) :: dim1 222 | integer, intent(in) :: default_val 223 | logical, intent(in) :: bDealloc 224 | ! 225 | integer :: ierr 226 | 227 | if(allocated(array)) then 228 | if (.not.bDealloc) then 229 | print*, 'Array '//trim(array_name)//' is already allocated' 230 | !call log_error('Array '//trim(array_name)//' is already allocated') 231 | STOP 232 | endif 233 | deallocate(array,stat=ierr) 234 | if(ierr/=0) then 235 | print*, 'Deallocation of '//trim(array_name)//' failed' 236 | !call log_warning('Deallocation of '//trim(array_name)//' failed') 237 | endif 238 | endif 239 | if(.not.allocated(array)) then 240 | allocate(array(1:dim1),stat=ierr) 241 | if(ierr/=0) then 242 | print*, 'Cannot allocate array'//trim(array_name)//'. status:',ierr 243 | !call log_error('Cannot allocate array'//trim(array_name)//'.') 244 | STOP 245 | else 246 | array(1:dim1)=default_val 247 | endif 248 | endif 249 | 250 | end subroutine 251 | 252 | subroutine ballocate_safe1(array_name,array,dim1,default_val,bDealloc) 253 | character(len=*), intent(in) :: array_name 254 | logical, dimension(:),allocatable,intent(inout) :: array 255 | integer , intent(in) :: dim1 256 | logical, intent(in) :: default_val 257 | logical, intent(in) :: bDealloc 258 | ! 259 | integer :: ierr 260 | 261 | if(allocated(array)) then 262 | if (.not.bDealloc) then 263 | print*, 'Array '//trim(array_name)//' is already allocated' 264 | !call log_error('Array '//trim(array_name)//' is already allocated') 265 | STOP 266 | endif 267 | deallocate(array,stat=ierr) 268 | if(ierr/=0) then 269 | print*, 'Deallocation of '//trim(array_name)//' failed' 270 | !call log_warning('Deallocation of '//trim(array_name)//' failed') 271 | STOP 272 | endif 273 | endif 274 | if(.not.allocated(array)) then 275 | allocate(array(1:dim1),stat=ierr) 276 | if(ierr/=0) then 277 | print*, 'Cannot allocate array'//trim(array_name)//'. status:',ierr 278 | !call log_error('Cannot allocate array'//trim(array_name)//'.') 279 | STOP 280 | else 281 | array(1:dim1)=default_val 282 | endif 283 | endif 284 | 285 | end subroutine 286 | 287 | subroutine rallocate_safe1(array_name,array,dim1,default_val,bDealloc) 288 | character(len=*), intent(in) :: array_name 289 | real(MK), dimension(:),allocatable,intent(inout) :: array 290 | integer , intent(in) :: dim1 291 | real(MK), intent(in) :: default_val 292 | logical, intent(in) :: bDealloc 293 | ! 294 | integer :: ierr 295 | 296 | if(allocated(array)) then 297 | if (.not.bDealloc) then 298 | print*, 'Array '//trim(array_name)//' is already allocated' 299 | !call log_error('Array '//trim(array_name)//' is already allocated') 300 | STOP 301 | endif 302 | deallocate(array,stat=ierr) 303 | if(ierr/=0) then 304 | print*, 'Deallocation of '//trim(array_name)//' failed' 305 | !call log_warning('Deallocation of '//trim(array_name)//' failed') 306 | endif 307 | endif 308 | if(.not.allocated(array)) then 309 | allocate(array(1:dim1),stat=ierr) 310 | if(ierr/=0) then 311 | print*, 'Cannot allocate array'//trim(array_name)//'. status:',ierr 312 | !call log_error('Cannot allocate array'//trim(array_name)//'.') 313 | STOP 314 | else 315 | array(1:dim1)=default_val 316 | endif 317 | endif 318 | 319 | end subroutine 320 | 321 | 322 | subroutine iallocate_safe2(array_name,array,dim1,dim2,default_val,bDealloc) 323 | character(len=*), intent(in) :: array_name 324 | integer,dimension(:,:),allocatable,intent(inout) :: array 325 | integer , intent(in) :: dim1 326 | integer , intent(in) :: dim2 327 | integer, intent(in) :: default_val 328 | logical, intent(in) :: bDealloc 329 | ! 330 | integer :: ierr 331 | 332 | if(allocated(array)) then 333 | if (.not.bDealloc) then 334 | print*, 'Array '//trim(array_name)//' is already allocated' 335 | !call log_error('Array '//trim(array_name)//' is already allocated') 336 | STOP 337 | endif 338 | deallocate(array,stat=ierr) 339 | if(ierr/=0) then 340 | print*, 'Deallocation of '//trim(array_name)//' failed' 341 | !call log_warning('Deallocation of '//trim(array_name)//' failed') 342 | endif 343 | endif 344 | if(.not.allocated(array)) then 345 | allocate(array(1:dim1,1:dim2),stat=ierr) 346 | if(ierr/=0) then 347 | print*, 'Cannot allocate array'//trim(array_name)//'. status:',ierr 348 | !call log_error('Cannot allocate array'//trim(array_name)//'.') 349 | STOP 350 | else 351 | array(1:dim1,1:dim2)=default_val 352 | endif 353 | endif 354 | 355 | end subroutine 356 | 357 | 358 | subroutine rallocate_safe2(array_name,array,dim1,dim2,default_val,bDealloc) 359 | character(len=*), intent(in) :: array_name 360 | real(MK),dimension(:,:),allocatable,intent(inout) :: array 361 | integer , intent(in) :: dim1 362 | integer , intent(in) :: dim2 363 | real(MK), intent(in) :: default_val 364 | logical, intent(in) :: bDealloc 365 | ! 366 | integer :: ierr 367 | 368 | if(allocated(array)) then 369 | if (.not.bDealloc) then 370 | print*, 'Array '//trim(array_name)//' is already allocated' 371 | !call log_error('Array '//trim(array_name)//' is already allocated') 372 | STOP 373 | endif 374 | deallocate(array,stat=ierr) 375 | if(ierr/=0) then 376 | print*, 'Deallocation of '//trim(array_name)//' failed' 377 | !call log_warning('Deallocation of '//trim(array_name)//' failed') 378 | endif 379 | endif 380 | if(.not.allocated(array)) then 381 | allocate(array(1:dim1,1:dim2),stat=ierr) 382 | if(ierr/=0) then 383 | print*, 'Cannot allocate array'//trim(array_name)//'. status:',ierr 384 | !call log_error('Cannot allocate array'//trim(array_name)//'.') 385 | STOP 386 | else 387 | array(1:dim1,1:dim2)=default_val 388 | endif 389 | endif 390 | 391 | end subroutine 392 | 393 | subroutine rallocate_safe3(array_name,array,dim1,dim2,dim3,default_val,bDealloc) 394 | character(len=*), intent(in) :: array_name 395 | real(MK),dimension(:,:,:),allocatable,intent(inout) :: array 396 | integer , intent(in) :: dim1 397 | integer , intent(in) :: dim2 398 | integer , intent(in) :: dim3 399 | real(MK), intent(in) :: default_val 400 | logical, intent(in) :: bDealloc 401 | ! 402 | integer :: ierr 403 | 404 | if(allocated(array)) then 405 | if (.not.bDealloc) then 406 | print*, 'Array '//trim(array_name)//' is already allocated' 407 | !call log_error('Array '//trim(array_name)//' is already allocated') 408 | STOP 409 | endif 410 | deallocate(array,stat=ierr) 411 | if(ierr/=0) then 412 | print*, 'Deallocation of '//trim(array_name)//' failed' 413 | !call log_warning('Deallocation of '//trim(array_name)//' failed') 414 | endif 415 | endif 416 | if(.not.allocated(array)) then 417 | allocate(array(1:dim1,1:dim2,1:dim3),stat=ierr) 418 | if(ierr/=0) then 419 | print*, 'Cannot allocate array'//trim(array_name)//'. status:',ierr 420 | !call log_error('Cannot allocate array'//trim(array_name)//'.') 421 | STOP 422 | else 423 | array(1:dim1,1:dim2,1:dim3)=default_val 424 | endif 425 | endif 426 | 427 | end subroutine 428 | 429 | subroutine rallocate_safe4(array_name,array,dim1,dim2,dim3,dim4,default_val,bDealloc) 430 | character(len=*), intent(in) :: array_name 431 | real(MK),dimension(:,:,:,:),allocatable,intent(inout) :: array 432 | integer , intent(in) :: dim1 433 | integer , intent(in) :: dim2 434 | integer , intent(in) :: dim3 435 | integer , intent(in) :: dim4 436 | real(MK), intent(in) :: default_val 437 | logical, intent(in) :: bDealloc 438 | ! 439 | integer :: ierr 440 | 441 | if(allocated(array)) then 442 | if (.not.bDealloc) then 443 | print*, 'Array '//trim(array_name)//' is already allocated' 444 | STOP 445 | !call log_error('Array '//trim(array_name)//' is already allocated') 446 | endif 447 | deallocate(array,stat=ierr) 448 | if(ierr/=0) then 449 | print*, 'Deallocation of '//trim(array_name)//' failed' 450 | !call log_warning('Deallocation of '//trim(array_name)//' failed') 451 | endif 452 | endif 453 | if(.not.allocated(array)) then 454 | allocate(array(1:dim1,1:dim2,1:dim3,1:dim4),stat=ierr) 455 | if(ierr/=0) then 456 | print*, 'Cannot allocate array'//trim(array_name)//'. status:',ierr 457 | !call log_error('Cannot allocate array'//trim(array_name)//'.') 458 | STOP 459 | else 460 | array(1:dim1,1:dim2,1:dim3,1:dim4)=default_val 461 | endif 462 | endif 463 | 464 | end subroutine 465 | 466 | end module MemoryManager 467 | -------------------------------------------------------------------------------- /_tools/PackFunctions.f90: -------------------------------------------------------------------------------- 1 | !> 2 | module PackFunctions 3 | use SupportPrecision, only: MK 4 | implicit none 5 | contains 6 | 7 | !> Performs exactly like I_out=pack(I_in,bMask), but performs the allocation within the function. (kindof rhs_alloc..) 8 | ! But some compilers fail for large arrays. 9 | subroutine pack_alloc(I_in,bMask,I_out) 10 | integer,dimension(:),intent(in) :: I_in !< 11 | logical,dimension(:),intent(in) :: bMask 12 | integer,dimension(:),allocatable,intent(out) :: I_out 13 | integer :: n_in,n_out,i,k 14 | integer :: ierr 15 | 16 | n_out=count(bMask) 17 | if(allocated(I_out)) then 18 | print*,'Warning: Pack_Alloc: I_out already allocated' 19 | deallocate(I_out) 20 | endif 21 | 22 | allocate(I_out(1:n_out),stat=ierr) 23 | if(ierr/=0) then 24 | print*,'Error: Pack_Alloc: allocation error',ierr,n_out 25 | STOP 26 | else 27 | k=0 28 | n_in=size(I_in) 29 | if(size(bMask)/=n_in) then 30 | print*,'Error: Pack_Alloc: Mask size different than input size' 31 | STOP 32 | endif 33 | do i=1,n_in 34 | if(bMask(i)) then 35 | k=k+1 36 | I_out(k)=I_in(i) 37 | endif 38 | enddo 39 | endif 40 | end subroutine 41 | 42 | !> Performs exactly like I_out=pack(I_in,bMask), wherer I_in=(/i,i=1,n/) and performs the allocation within the function. (kindof rhs_alloc..) 43 | subroutine packindex_alloc(bMask,I_out,n_out_opt) 44 | ! 45 | logical,dimension(:),intent(in) :: bMask 46 | integer,dimension(:),allocatable,intent(out) :: I_out 47 | integer, intent(out), optional :: n_out_opt !< = size(I_out) = count(bMask) 48 | ! 49 | integer :: n_in,n_out,i,k 50 | integer :: ierr 51 | 52 | n_out=count(bMask) 53 | if(present(n_out_opt)) then 54 | n_out_opt=n_out 55 | endif 56 | 57 | if(allocated(I_out)) then 58 | print*,'Warning: Packindex_Alloc: Warning, I_out already allocated' 59 | deallocate(I_out) 60 | endif 61 | 62 | allocate(I_out(1:n_out),stat=ierr) 63 | if(ierr/=0) then 64 | print*,'Error: Packindex_Alloc: allocation error',ierr,n_out 65 | STOP 66 | else 67 | k=0 68 | n_in=size(bMask) 69 | do i=1,n_in 70 | if(bMask(i)) then 71 | k=k+1 72 | I_out(k)=i 73 | endif 74 | enddo 75 | endif 76 | end subroutine 77 | 78 | !> Performs exactly like I_out=pack(I_in,bMask), wherer I_in=(/i,i=1,n/) 79 | ! The size of I_out is already known, and I_out is allocated 80 | subroutine packindex(bMask,I_out,n_out) 81 | logical,dimension(:),intent(in) :: bMask 82 | integer, intent(in) :: n_out 83 | integer,dimension(n_out),intent(out) :: I_out 84 | integer :: i,k,n_in 85 | 86 | if(n_out==0) then 87 | return 88 | endif 89 | if(n_out/=count(bMask)) then 90 | print*,'Error: Pack_index: Count(bMask) is different than n_in ' 91 | STOP 92 | endif 93 | k=0 94 | n_in=size(bMask) 95 | do i=1,n_in 96 | if(bMask(i)) then 97 | k=k+1 98 | I_out(k)=i 99 | endif 100 | enddo 101 | end subroutine 102 | 103 | 104 | end module PackFunctions 105 | -------------------------------------------------------------------------------- /_unit_tests/Makefile: -------------------------------------------------------------------------------- 1 | # General makefile propagating to all subdirectories 2 | # -------------------------------------------------------------------------------- 3 | # --- Defining subdirectories and rule names 4 | # -------------------------------------------------------------------------------- 5 | # Subdirectories with rule suffix 6 | #SUBDIRS = $(shell find . -maxdepth 1 -mindepth 1 -type d) 7 | SUBDIRS = ${sort ${dir ${wildcard ./*/*/}}} 8 | SUBCLEAN = $(addsuffix .clean,$(SUBDIRS)) 9 | SUBALL = $(addsuffix .all,$(SUBDIRS)) 10 | SUBTESTS = $(addsuffix .tests,$(SUBDIRS)) 11 | 12 | 13 | # -------------------------------------------------------------------------------- 14 | # --- General rules 15 | # -------------------------------------------------------------------------------- 16 | .PHONY: clean all tests $(SUBCLEAN) $(SUBALL) $(SUBTESTS) 17 | 18 | all: $(SUBALL) 19 | 20 | clean: $(SUBCLEAN) 21 | 22 | tests: $(SUBTESTS) 23 | 24 | echo: 25 | @echo $(SUBDIRS) 26 | 27 | # -------------------------------------------------------------------------------- 28 | # --- Rules for sub directories 29 | # -------------------------------------------------------------------------------- 30 | $(SUBALL): %.all: 31 | @$(MAKE) --no-print-directory -C $* all 32 | $(SUBCLEAN):%.clean: 33 | @$(MAKE) --no-print-directory -C $* clean 34 | $(SUBTESTS): %.tests: 35 | @$(MAKE) --no-print-directory -C $* tests 36 | -------------------------------------------------------------------------------- /_unit_tests/character_arrays/Makefile: -------------------------------------------------------------------------------- 1 | PROG=test_char_array 2 | S=$(PROG).f90 3 | 4 | FCC=gfortran 5 | # FCC=ifort 6 | 7 | 8 | all:test 9 | 10 | 11 | test: 12 | @$(FCC) -Wall $(S) -o $(PROG) 13 | @./$(PROG) 14 | 15 | clean: 16 | rm -f *.dat $(PROG) *.o 17 | -------------------------------------------------------------------------------- /_unit_tests/character_arrays/test_char_array.f90: -------------------------------------------------------------------------------- 1 | program test 2 | ! character(len=20), dimension(5) :: v_s 3 | character*20 :: v_s(5) 4 | ! character(:), allocatable :: v_s2(:) 5 | ! character(len=:), dimension(:), pointer :: v_s2 6 | character(len=20), dimension(:), allocatable :: strings2 ! fine 7 | 8 | ! allocate(v_s2(size(v_s,1),size(v_s,2))) 9 | v_s(1)='a' 10 | v_s(2)='b' 11 | v_s(3)='c' 12 | 13 | 14 | print*,v_s(1)(1:20) 15 | print*,len(v_s(1)),size(v_s,1) 16 | ! allocate(character(len=len(v_s(1))) :: v_s2(size(v_s,1))) 17 | allocate(character(len=len(v_s(1))) :: strings2(size(v_s,1))) 18 | ! v_s2(1)='a' 19 | strings2(1)='a' 20 | 21 | call disp(v_s(1)) 22 | 23 | contains 24 | subroutine disp(msg) 25 | CHARACTER*(*) msg 26 | print*,msg 27 | end subroutine 28 | 29 | end program 30 | -------------------------------------------------------------------------------- /_unit_tests/fortran-c/Makefile: -------------------------------------------------------------------------------- 1 | # -------------------------------------------------------------------------------- 2 | # --- Defining OS and Archi 3 | # -------------------------------------------------------------------------------- 4 | include ../../_mkf/MakefileOS.mk 5 | 6 | # -------------------------------------------------------------------------------- 7 | # --- Directories 8 | # -------------------------------------------------------------------------------- 9 | OBJ_DIR_BASE=../../_build 10 | LIB_DIR_BASE=../../_lib 11 | 12 | # -------------------------------------------------------------------------------- 13 | # --- Setup Compilers 14 | # -------------------------------------------------------------------------------- 15 | ifeq ($(RELEASE),) 16 | RELEASE=1 17 | endif 18 | ifeq ($(FCOMPILER),) 19 | ifeq ($(OSNAME),windows) 20 | FCOMPILER=1 21 | else 22 | FCOMPILER=1 23 | endif 24 | endif 25 | ifeq ($(CCOMPILER),) 26 | ifeq ($(OSNAME),windows) 27 | CCOMPILER=2 28 | else 29 | CCOMPILER=1 30 | endif 31 | endif 32 | 33 | # --- Generic COMPILERS Makefiles 34 | include ../../_mkf/MakefileC.mk 35 | include ../../_mkf/MakefileFortran.mk 36 | 37 | CFLAGS= 38 | FFLAGS=$(FFNOLOGO) 39 | DEFS= 40 | INCS= 41 | LIBS= 42 | 43 | # -------------------------------------------------------------------------------- 44 | # --- Setup Support 45 | # -------------------------------------------------------------------------------- 46 | include ../../_mkf/MakefileSupport.mk 47 | 48 | 49 | 50 | 51 | # -------------------------------------------------------------------------------- 52 | # --- General Rules 53 | # -------------------------------------------------------------------------------- 54 | TESTFILES_F =$(wildcard *.$(f)) 55 | TESTFILES_C =$(wildcard *.$(c)) 56 | TESTPROGS =$(patsubst %.$(f),%, $(TESTFILES_F) ) $(patsubst %.$(c),%,$(TESTFILES_C) ) 57 | RULES_COMPILE =$(patsubst %,comp-%, $(TESTPROGS) ) 58 | RULES_RUN =$(patsubst %,run-%, $(TESTPROGS) ) 59 | RULES_CLEAN =$(patsubst %,clean-%, $(TESTPROGS) ) 60 | 61 | all: compile run clean 62 | 63 | compile: $(RULES_COMPILE) 64 | 65 | run: $(RULES_RUN) 66 | 67 | clean:$(RULES_CLEAN) 68 | 69 | # C Compilation 70 | comp-%: %.$(c) 71 | @$(CC) $(DEFS) $(INCS) $(CFLAGS) $(LDFLAGS) $*.$(c) $(LIBS) $(COUT)$* 72 | # Fortran Compilation 73 | comp-%: %.$(f) 74 | @$(FC) $(DEFS) $(INCS) $(FFLAGS) $(LDFLAGS) $*.$(f) $(LIBS) $(FOUT_EXE)$* 75 | 76 | # Run requires compilation 77 | run-%: comp-% 78 | @echo "> Running test ($(SUPPORT))" $* 79 | @./$* 80 | 81 | clean-%: 82 | @$(RM) $*$(EXE) *.$(o) 83 | 84 | echo: 85 | @echo "RULES_RUN: " $(RULES_RUN) 86 | @echo "TESTPROGS: " $(TESTPROGS) 87 | @echo "TESTFILES: " $(TESTFILES_F) $(TESTFILES_C) 88 | 89 | # -------------------------------------------------------------------------------- 90 | # --- Setup some easy rules 91 | # -------------------------------------------------------------------------------- 92 | include ../../_mkf/MakefileSimpleRules.mk 93 | -------------------------------------------------------------------------------- /_unit_tests/fortran-c/test_c_precision.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | #include // for CHAR_BIT 4 | #include // for standards int types 5 | 6 | int main(){ 7 | // The line below wont compile if a double is not 64 bits 8 | char DUMMY[sizeof(double) * CHAR_BIT == 64]; 9 | 10 | int a; 11 | float b; 12 | double c; 13 | char d; 14 | int8_t i8; 15 | int32_t i32; 16 | printf(" Size of byte : %2d bits\n",CHAR_BIT); 17 | printf(" Size of char : %2d bits\n" ,sizeof(d)*CHAR_BIT); 18 | printf(" Size of int8_t : %2d bits\n",sizeof(i8)*CHAR_BIT); 19 | printf(" Size of int32_t: %2d bits\n",sizeof(i32)*CHAR_BIT); 20 | printf(" Size of int : %2d bits\n",sizeof(a)*CHAR_BIT); 21 | printf(" Size of float : %2d bits\n",sizeof(b)*CHAR_BIT); 22 | printf(" Size of double : %2d bits\n",sizeof(c)*CHAR_BIT); 23 | 24 | printf("[ OK ] C double is 64 bits\n"); 25 | return 0; 26 | } 27 | -------------------------------------------------------------------------------- /_unit_tests/precision_iso/Makefile: -------------------------------------------------------------------------------- 1 | # -------------------------------------------------------------------------------- 2 | # --- Defining OS and Archi 3 | # -------------------------------------------------------------------------------- 4 | include ../../_mkf/MakefileOS.mk 5 | 6 | # -------------------------------------------------------------------------------- 7 | # --- Directories 8 | # -------------------------------------------------------------------------------- 9 | OBJ_DIR_BASE=../../_build 10 | LIB_DIR_BASE=../../_lib 11 | 12 | # -------------------------------------------------------------------------------- 13 | # --- Setup Compilers 14 | # -------------------------------------------------------------------------------- 15 | ifeq ($(RELEASE),) 16 | RELEASE=1 17 | endif 18 | ifeq ($(FCOMPILER),) 19 | ifeq ($(OSNAME),windows) 20 | FCOMPILER=1 21 | else 22 | FCOMPILER=1 23 | endif 24 | endif 25 | # --- Generic COMPILERS Makefiles 26 | include ../../_mkf/MakefileFortran.mk 27 | FFLAGS= $(FFNOLOGO) 28 | LDFLAGS= 29 | DEFS= $(FCOMPILERDEF) $(OSDEF) 30 | INCS= 31 | LIBS= 32 | # -------------------------------------------------------------------------------- 33 | # --- Setup Support 34 | # -------------------------------------------------------------------------------- 35 | include ../../_mkf/MakefileSupport.mk 36 | 37 | # -------------------------------------------------------------------------------- 38 | # --- General Rules 39 | # -------------------------------------------------------------------------------- 40 | TESTFILES_F = \ 41 | ..$(SLASH)..$(SLASH)_support$(SLASH)SupportISO_$(FCNAME).f90 \ 42 | ..$(SLASH)..$(SLASH)_support$(SLASH)SupportCompiler_$(FCNAME).f90 \ 43 | ..$(SLASH)..$(SLASH)_support$(SLASH)SupportPrecision.f90 \ 44 | test_precision_iso.f90 45 | TESTPROG = iso 46 | 47 | all: compile run clean 48 | 49 | compile: comp 50 | 51 | # Fortran Compilation 52 | comp: $(TESTFILES_F) 53 | $(FC) $(DEFS) $(INCS) $(FFLAGS) $(LDFLAGS) $^ $(LIBS) $(FOUT_EXE)$(TESTPROG)$(EXE) 54 | 55 | # Run requires compilation 56 | run: comp 57 | @echo "> Running test ($(SUPPORT))" $(TESTPROG) 58 | @./$(TESTPROG) 59 | 60 | clean: 61 | @$(RM) $(TESTPROG)$(EXE) *.$(o) *.mod 62 | 63 | # -------------------------------------------------------------------------------- 64 | # --- Setup some easy rules 65 | # -------------------------------------------------------------------------------- 66 | include ../../_mkf/MakefileSimpleRules.mk 67 | 68 | -------------------------------------------------------------------------------- /_unit_tests/precision_iso/test_precision_iso.f90: -------------------------------------------------------------------------------- 1 | 2 | program test_precision_iso 3 | use SupportPrecision, only: print_precision_kinds 4 | 5 | 6 | call print_precision_kinds() 7 | ! print'(A)','[ OK ] preprocessor ( human check needed )' 8 | 9 | 10 | end program 11 | -------------------------------------------------------------------------------- /_unit_tests/preproc/Makefile: -------------------------------------------------------------------------------- 1 | # -------------------------------------------------------------------------------- 2 | # --- Defining OS and Archi 3 | # -------------------------------------------------------------------------------- 4 | include ../../_mkf/MakefileOS.mk 5 | 6 | # -------------------------------------------------------------------------------- 7 | # --- Directories 8 | # -------------------------------------------------------------------------------- 9 | OBJ_DIR_BASE=../../_build 10 | LIB_DIR_BASE=../../_lib 11 | 12 | # -------------------------------------------------------------------------------- 13 | # --- Setup Compilers 14 | # -------------------------------------------------------------------------------- 15 | ifeq ($(RELEASE),) 16 | RELEASE=1 17 | endif 18 | ifeq ($(FCOMPILER),) 19 | ifeq ($(OSNAME),windows) 20 | FCOMPILER=1 21 | else 22 | FCOMPILER=1 23 | endif 24 | endif 25 | ifeq ($(CCOMPILER),) 26 | ifeq ($(OSNAME),windows) 27 | CCOMPILER=2 28 | else 29 | CCOMPILER=1 30 | endif 31 | endif 32 | # --- Generic COMPILERS Makefiles 33 | include ../../_mkf/MakefileC.mk 34 | include ../../_mkf/MakefileFortran.mk 35 | CFLAGS= 36 | FFLAGS= $(FFNOLOGO) $(FFFPP) 37 | #FFLAGS= $(FFNOLOGO) 38 | LDFLAGS= 39 | #DEFS= $(FCOMPILERDEF) $(OSDEF) -D__MYMACRO__ 40 | DEFS= $(FCOMPILERDEF) $(OSDEF) -D__MYMACRO__ 41 | #DEFS= $(FCOMPILERDEF) $(OSDEF) 42 | #DEFS=-D__MYMACRO__ 43 | #DEFS= 44 | INCS= 45 | LIBS= 46 | # -------------------------------------------------------------------------------- 47 | # --- Setup Support 48 | # -------------------------------------------------------------------------------- 49 | include ../../_mkf/MakefileSupport.mk 50 | 51 | # -------------------------------------------------------------------------------- 52 | # --- General Rules 53 | # -------------------------------------------------------------------------------- 54 | TESTFILES_F = test_preproc.f90 55 | # TESTFILES_F =$(wildcard *.$(f)) 56 | TESTFILES_C =$(wildcard *.$(c)) 57 | TESTPROGS =$(patsubst %.$(f),%, $(TESTFILES_F) ) $(patsubst %.$(c),%,$(TESTFILES_C) ) 58 | RULES_COMPILE =$(patsubst %,comp-%, $(TESTPROGS) ) 59 | RULES_RUN =$(patsubst %,run-%, $(TESTPROGS) ) 60 | RULES_CLEAN =$(patsubst %,clean-%, $(TESTPROGS) ) 61 | 62 | all: compile run clean 63 | 64 | compile: $(RULES_COMPILE) 65 | 66 | run: $(RULES_RUN) 67 | 68 | clean:$(RULES_CLEAN) 69 | 70 | # C Compilation 71 | comp-%: %.$(c) 72 | @$(CC) $(DEFS) $(INCS) $(CFLAGS) $(LDFLAGS) $*.$(c) $(LIBS) $(COUT)$* 73 | # Fortran Compilation 74 | comp-%: %.$(f) 75 | @$(FC) $(DEFS) $(INCS) $(FFLAGS) $(LDFLAGS) $*.$(f) $(LIBS) $(FOUT_EXE)$* 76 | 77 | # Run requires compilation 78 | run-%: comp-% 79 | @echo "> Running test ($(SUPPORT))" $* 80 | @./$* 81 | 82 | clean-%: 83 | @$(RM) $*$(EXE) *.$(o) 84 | echo: 85 | @echo "RULES_RUN: " $(RULES_RUN) 86 | @echo "TESTPROGS: " $(TESTPROGS) 87 | @echo "TESTFILES: " $(TESTFILES_F) $(TESTFILES_C) 88 | 89 | # -------------------------------------------------------------------------------- 90 | # --- Setup some easy rules 91 | # -------------------------------------------------------------------------------- 92 | include ../../_mkf/MakefileSimpleRules.mk 93 | 94 | 95 | # -------------------------------------------------------------------------------- 96 | # --- Overriding rules 97 | # -------------------------------------------------------------------------------- 98 | comp-test_preproc:FFLAGS_EXTRA+=-D__MYMACRO__ 99 | comp-test_preproc: 100 | 101 | 102 | 103 | # -------------------------------------------------------------------------------- 104 | # --- 105 | # -------------------------------------------------------------------------------- 106 | show_macros:FFLAGS_EXTRA+=-D__MYMACRO__ 107 | show_macros: 108 | ifeq ($(FCOMPILER),0) 109 | gfortran -cpp -E -dM $(FFLAGS) empty.f90 > _macros-$(SUPPORT) 110 | endif 111 | ifeq ($(FCOMPILER),1) 112 | ifort -E -fpp $(FFLAGS) empty.f90 -dryrun 2> _macros-$(SUPPORT) 113 | endif 114 | -------------------------------------------------------------------------------- /_unit_tests/preproc/_macros-linux-amd64-gfortran: -------------------------------------------------------------------------------- 1 | # 1 "empty.f90" 2 | # 1 "" 3 | # 1 "" 4 | # 1 "empty.f90" 5 | 6 | #define __ATOMIC_ACQUIRE 2 7 | #define __CHAR_BIT__ 8 8 | #define __FLOAT_WORD_ORDER__ __ORDER_LITTLE_ENDIAN__ 9 | #define __ORDER_LITTLE_ENDIAN__ 1234 10 | #define __ORDER_PDP_ENDIAN__ 3412 11 | #define __FINITE_MATH_ONLY__ 0 12 | #define __GNUC_PATCHLEVEL__ 2 13 | #define __OPTIMIZE__ 1 14 | #define __SIZEOF_INT__ 4 15 | #define __SIZEOF_POINTER__ 8 16 | #define __GFORTRAN__ 1 17 | #define __STDC_HOSTED__ 0 18 | #define __MYMACRO__ 1 19 | #define __SIZEOF_FLOAT__ 4 20 | #define __pic__ 2 21 | #define _LANGUAGE_FORTRAN 1 22 | #define __SIZEOF_LONG__ 8 23 | #define __SIZEOF_SHORT__ 2 24 | #define __GNUC__ 4 25 | #define __SIZEOF_LONG_DOUBLE__ 16 26 | #define __BIGGEST_ALIGNMENT__ 16 27 | #define __ATOMIC_RELAXED 0 28 | #define _LP64 1 29 | #define __ORDER_BIG_ENDIAN__ 4321 30 | #define __BYTE_ORDER__ __ORDER_LITTLE_ENDIAN__ 31 | #define __SIZEOF_SIZE_T__ 8 32 | #define __PIC__ 2 33 | #define __SIZEOF_DOUBLE__ 8 34 | #define __ATOMIC_CONSUME 1 35 | #define __GNUC_MINOR__ 9 36 | #define __LP64__ 1 37 | #define __ATOMIC_SEQ_CST 5 38 | #define __SIZEOF_LONG_LONG__ 8 39 | #define __ATOMIC_ACQ_REL 4 40 | #define __ATOMIC_RELEASE 3 41 | #define __VERSION__ "4.9.2" 42 | 43 | -------------------------------------------------------------------------------- /_unit_tests/preproc/_macros-linux-amd64-ifort: -------------------------------------------------------------------------------- 1 | /opt/intel/composer_xe_2013_sp1.1.106/bin/intel64/fpp \ 2 | -D__INTEL_COMPILER=1400 \ 3 | -D__INTEL_COMPILER_UPDATE=1 \ 4 | -D__unix__ \ 5 | -D__unix \ 6 | -D__linux__ \ 7 | -D__linux \ 8 | -D__gnu_linux__ \ 9 | -Dunix \ 10 | -Dlinux \ 11 | -D__ELF__ \ 12 | -D__x86_64 \ 13 | -D__x86_64__ \ 14 | -D_MT \ 15 | -D__INTEL_COMPILER_BUILD_DATE=20131008 \ 16 | -D__PIC__ \ 17 | -D__pic__ \ 18 | -D__INTEL_OFFLOAD \ 19 | -D__i686 \ 20 | -D__i686__ \ 21 | -D__pentiumpro \ 22 | -D__pentiumpro__ \ 23 | -D__pentium4 \ 24 | -D__pentium4__ \ 25 | -D__tune_pentium4__ \ 26 | -D__SSE2__ \ 27 | -D__SSE__ \ 28 | -D__MMX__ \ 29 | -D__MYMACRO__ \ 30 | -I. \ 31 | -I/opt/intel/composer_xe_2013_sp1.1.106/mkl/include \ 32 | -I/opt/intel/composer_xe_2013_sp1.1.106/compiler/include/intel64 \ 33 | -I/opt/intel/composer_xe_2013_sp1.1.106/compiler/include \ 34 | -I/usr/local/include \ 35 | -I/usr/lib/gcc/x86_64-linux-gnu/4.9/include \ 36 | -I/usr/lib/gcc/x86_64-linux-gnu/4.9/include-fixed \ 37 | -I/usr/include \ 38 | -I/usr/include/x86_64-linux-gnu \ 39 | -free \ 40 | -4Ycpp \ 41 | -4Ncvf \ 42 | -f_com=yes \ 43 | empty.f90 44 | 45 | rm /tmp/ifortlibgccrBTzwG 46 | rm /tmp/ifortgnudirsSY10LV 47 | rm /tmp/ifortdummyOtpghq.c 48 | rm /tmp/ifortdashvZC5TwF 49 | rm /tmp/ifortargQeufNU 50 | -------------------------------------------------------------------------------- /_unit_tests/preproc/_macros-windows-ia32-compaq: -------------------------------------------------------------------------------- 1 | 2 | # -------------------------------------------------------------------------------- 3 | # --- Note: 4 | # -------------------------------------------------------------------------------- 5 | When using dec directive, the follwoing can be used to detect compaq: 6 | _DF_VERSION_ 7 | 8 | But when using the cpreprocessor, this is not defined, so it's best to explicitly define it! 9 | 10 | 11 | 12 | 13 | 14 | # -------------------------------------------------------------------------------- 15 | # --- 16 | # -------------------------------------------------------------------------------- 17 | When only using the Fortran preprocessor FPP, to request that symbol values 18 | defined by /define apply only to FPP and are not seen by compiler directives, 19 | also specify /nodefine on the DF command line. 20 | In the visual development environment, specify the Predefined Preprocessor 21 | Symbols in the General or Preprocessor Compiler Option Category. 22 | You can use the directives to detect symbol definitions, such as the IF Directive 23 | Construct. Like certain other compiler options, an equivalent directive exists 24 | (DEFINE directive). 25 | The following preprocessor symbols are predefined by the compiler system and 26 | are available to compiler directives and FPP (except _DF_VERSION_ and 27 | _VF_VERSION_): 28 | Predefined Preprocessor Symbols 29 | Predefined Symbol Name 30 | and Value Conditions When this Symbol is Defined 31 | _DF_VERSION_=660 (660 for 32 | Version 6.6) Compiler only 33 | _DLL=1 Only if /libs:dll, /MDs, /MD, /dll, or /LD is 34 | specified, but not when /libs:static is 35 | specified 36 | _INTEGRAL_MAX_BITS=32 Only for ia32 (32-bit) systems 37 | _INTEGRAL_MAX_BITS=64 Only for ia64 (64-bit) systemsCompiler and Linker Options 38 | Page 35 of 130 39 | _ITANIUM_A3_=1 Only for ia64 (64-bit) systems 40 | _MSFORTRAN_=401 Only if /fpscomp:symbols is specified or you 41 | use the FL32 command 42 | _MT=1 Only if /threads or /MT is specified 43 | _M_IX86=500 Only for ia32 (32-bit) systems 44 | _M_IA64=64100 Only for ia64 (64-bit) systems 45 | _VF_VERSION_=660 (660 for 46 | Version 6.6) Compiler only 47 | _WIN32=1 Always defined (both ia32 and ia64 48 | systems) 49 | _WIN64=1 Only for ia64 (64-bit) systems 50 | _WIN95=1 Only for ia32 (32-bit) systems running the 51 | Windows 95 operating system 52 | _WIN98=1 Only for ia32 (32-bit) systems running the 53 | Windows 98 operating system 54 | _WINME=1 Only for ia32 (32-bit) systems running the 55 | Windows Me operating system 56 | _X86_=1 Only for ia32 (32-bit) systems 57 | -------------------------------------------------------------------------------- /_unit_tests/preproc/_macros-windows-ia32-ifort: -------------------------------------------------------------------------------- 1 | ifort: command line warning #10006: ignoring unknown option '/dryrun' 2 | C:\PROGRA~1\Intel\COMPOS~1\bin\ia32\fpp \ 3 | -D__INTEL_COMPILER=1200 \ 4 | -D_M_IX86=700 \ 5 | -D_MSC_VER=1600 \ 6 | -D_MSC_FULL_VER=160030319 \ 7 | -D_MSC_EXTENSIONS \ 8 | -D_USE_ATTRIBUTES_FOR_SAL=0 \ 9 | -DSAL_NO_ATTRIBUTE_DECLARATIONS \ 10 | -D_MT \ 11 | -D_WIN32 \ 12 | -D__INTEL_COMPILER_BUILD_DATE=20110719 \ 13 | -D_INTEGRAL_MAX_BITS=64 \ 14 | -D__SSE2__ \ 15 | -D__SSE__ \ 16 | -I. \ 17 | -IC:\PROGRA~1\Intel\COMPOS~1\compiler\include\ia32 \ 18 | "-IC:\Program Files\Intel\ComposerXE-2011\compiler\include" \ 19 | "-IC:\Program Files\Intel\ComposerXE-2011\compiler\include\ia32" \ 20 | "-IC:\Program Files\Microsoft Visual Studio 10.0\VC\INCLUDE" \ 21 | "-IC:\Program Files\Microsoft Visual Studio 10.0\VC\ATLMFC\INCLUDE" \ 22 | "-IC:\Program Files\Microsoft SDKs\Windows\v7.0A\include" \ 23 | "-IC:\Program Files\Intel\ComposerXE-2011\mkl\include" \ 24 | "-IC:\Program Files\Microsoft Visual Studio 10.0\VC\INCLUDE" \ 25 | "-IC:\Program Files\Microsoft Visual Studio 10.0\VC\ATLMFC\INCLUDE" \ 26 | "-IC:\Program Files\Microsoft SDKs\Windows\v7.0A\include" \ 27 | "-IC:\Program Files\Microsoft Visual Studio\DF98\IMSL\INCLUDE" \ 28 | "-IC:\Program Files\Microsoft Visual Studio\DF98\INCLUDE" \ 29 | "-IC:\Program Files\Microsoft Visual Studio\VC98\INCLUDE" \ 30 | -free \ 31 | -4Ycpp \ 32 | -4Ncvf \ 33 | -f_com=yes \ 34 | empty.f90 35 | 36 | del C:\DOCUME~1\manu\LOCALS~1\Temp\18602arg 37 | 38 | -------------------------------------------------------------------------------- /_unit_tests/preproc/empty.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ebranlard/fortran-guidelines/79b26de29c63c036d2f38c3d3c6c9142c8b3350b/_unit_tests/preproc/empty.f90 -------------------------------------------------------------------------------- /_unit_tests/preproc/test_preproc.f90: -------------------------------------------------------------------------------- 1 | ! -------------------------------------------------------------------------------- 2 | ! --- Conclusions from this test 3 | ! -------------------------------------------------------------------------------- 4 | ! C -Prepro IS case sensitive 5 | ! DEC-Preproc IS NOT case sensitive 6 | 7 | program test_preproc 8 | 9 | #if defined __LINUX__ 10 | print*,'C __LINUX__' 11 | #endif 12 | #if defined __linux__ 13 | print*,'C __linux__' 14 | #endif 15 | #if defined _WIN32 16 | print*,'C _WIN32' 17 | #endif 18 | #if defined _WIN64 19 | print*,'C _WIN64' 20 | #endif 21 | 22 | #if defined __UNIX__ 23 | print*,'C __UNIX__' 24 | #endif 25 | #if defined __unix__ 26 | print*,'C __unix__' 27 | #endif 28 | !DEC$ if defined(__LINUX__) 29 | print*,'DEC __LINUX__' 30 | !DEC$ endif 31 | !dec$ if defined(__linux__) 32 | print*,'Intel __linux__' 33 | !DEC$ endif 34 | 35 | #if defined _DF_VERSION_ 36 | print*,'C _DF_VERSION' 37 | #endif 38 | !dec$ if defined(_DF_VERSION_) 39 | print*,'DEC _DF_VERSION_' 40 | !dec$ endif 41 | #if defined __INTEL_COMPILER 42 | print*,'C __INTEL_COMPILER' 43 | #endif 44 | #ifndef _DF_VERSION_ 45 | !dec$ if defined(__INTEL_COMPILER) 46 | print*,'DEC __INTEL_COMPILER' 47 | !dec$ endif 48 | #endif 49 | 50 | 51 | #if defined __MYMACRO__ 52 | print*,'C __MYMACRO__' 53 | #endif 54 | #if defined __mymacro__ 55 | print*,'C __mymacro__' 56 | #endif 57 | !dec$ if defined (__MYMACRO__) 58 | print*,'DEC __MYMACRO__' 59 | !dec$ endif 60 | !dec$ if defined(__mymacro__) 61 | print*,'DEC __mymacro__' 62 | !DEC$ endif 63 | 64 | 65 | print'(A)','[ OK ] preprocessor ( human check needed )' 66 | 67 | 68 | end program 69 | -------------------------------------------------------------------------------- /_unit_tests/small_tests/Makefile: -------------------------------------------------------------------------------- 1 | # -------------------------------------------------------------------------------- 2 | # --- Defining OS and Archi 3 | # -------------------------------------------------------------------------------- 4 | include ../../_mkf/MakefileOS.mk 5 | 6 | # -------------------------------------------------------------------------------- 7 | # --- Directories 8 | # -------------------------------------------------------------------------------- 9 | OBJ_DIR_BASE=../../_build 10 | LIB_DIR_BASE=../../_lib 11 | 12 | # -------------------------------------------------------------------------------- 13 | # --- Setup Compilers 14 | # -------------------------------------------------------------------------------- 15 | ifeq ($(RELEASE),) 16 | RELEASE=1 17 | endif 18 | ifeq ($(FCOMPILER),) 19 | ifeq ($(OSNAME),windows) 20 | FCOMPILER=1 21 | else 22 | FCOMPILER=1 23 | endif 24 | endif 25 | ifeq ($(CCOMPILER),) 26 | ifeq ($(OSNAME),windows) 27 | CCOMPILER=2 28 | else 29 | CCOMPILER=1 30 | endif 31 | endif 32 | 33 | # --- Generic COMPILERS Makefiles 34 | include ../../_mkf/MakefileC.mk 35 | include ../../_mkf/MakefileFortran.mk 36 | CFLAGS= 37 | FFLAGS=$(FFNOLOGO) 38 | DEFS= 39 | INCS= 40 | LIBS= 41 | 42 | # -------------------------------------------------------------------------------- 43 | # --- Setup Support 44 | # -------------------------------------------------------------------------------- 45 | include ../../_mkf/MakefileSupport.mk 46 | 47 | # -------------------------------------------------------------------------------- 48 | # --- General Rules 49 | # -------------------------------------------------------------------------------- 50 | TESTFILES_F =$(wildcard *.$(f)) 51 | TESTFILES_C =$(wildcard *.$(c)) 52 | TESTPROGS =$(patsubst %.$(f),%, $(TESTFILES_F) ) $(patsubst %.$(c),%,$(TESTFILES_C) ) 53 | RULES_COMPILE =$(patsubst %,comp-%, $(TESTPROGS) ) 54 | RULES_RUN =$(patsubst %,run-%, $(TESTPROGS) ) 55 | RULES_CLEAN =$(patsubst %,clean-%, $(TESTPROGS) ) 56 | 57 | all: compile run clean 58 | 59 | compile: $(RULES_COMPILE) 60 | 61 | run: $(RULES_RUN) 62 | 63 | clean:$(RULES_CLEAN) 64 | 65 | # C Compilation 66 | comp-%: %.$(c) 67 | @$(CC) $(DEFS) $(INCS) $(CFLAGS) $(LDFLAGS) $*.$(c) $(LIBS) $(COUT)$* 68 | # Fortran Compilation 69 | comp-%: %.$(f) 70 | @$(FC) $(DEFS) $(INCS) $(FFLAGS) $(LDFLAGS) $*.$(f) $(LIBS) $(FOUT_EXE)$* 71 | 72 | # Run requires compilation 73 | run-%: comp-% 74 | @echo "> Running test ($(SUPPORT))" $* 75 | @./$* 76 | 77 | clean-%: 78 | @$(RM) $*$(EXE) *.$(o) 79 | 80 | 81 | echo: 82 | @echo "RULES_RUN: " $(RULES_RUN) 83 | @echo "TESTPROGS: " $(TESTPROGS) 84 | @echo "TESTFILES: " $(TESTFILES_F) $(TESTFILES_C) 85 | 86 | # -------------------------------------------------------------------------------- 87 | # --- Setup some easy rules 88 | # -------------------------------------------------------------------------------- 89 | include ../../_mkf/MakefileSimpleRules.mk 90 | -------------------------------------------------------------------------------- /_unit_tests/small_tests/test_save.f90: -------------------------------------------------------------------------------- 1 | program test_save 2 | implicit none 3 | logical :: bGood 4 | bGood=.true. 5 | bGood=bGood.and.test_init_bad()==0 6 | bGood=bGood.and.test_init_bad()==5 7 | bGood=bGood.and.test_init_good()==0 8 | bGood=bGood.and.test_init_good()==0 9 | if (bGood) then 10 | print'(A)','[ OK ]' 11 | else 12 | print'(A)','[FAIL]' 13 | endif 14 | contains 15 | ! 16 | integer function test_init_bad() result(i) 17 | integer :: var =0! bad 18 | !print *, var 19 | i=var 20 | var = 5 21 | end function 22 | ! 23 | integer function test_init_good() result(i) 24 | integer :: var 25 | var = 0 26 | !print *, var 27 | i=var 28 | var = 5 29 | end function 30 | end program 31 | -------------------------------------------------------------------------------- /fortran-guidelines.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ebranlard/fortran-guidelines/79b26de29c63c036d2f38c3d3c6c9142c8b3350b/fortran-guidelines.pdf -------------------------------------------------------------------------------- /opencmd.bat: -------------------------------------------------------------------------------- 1 | cmd -------------------------------------------------------------------------------- /setenv.bat: -------------------------------------------------------------------------------- 1 | @echo OFF 2 | 3 | 4 | :: -------------------------------------------- 5 | :: --- First make windows less annoying 6 | :: -------------------------------------------- 7 | :: A better variable editor http://eveditor.com/download/ :: A better command line ConEmu 8 | :: A better Command line ConEmu: http://www.fosshub.com/ConEmu.html 9 | :: A Windows placement manager Wind Split revolution version 11 10 | 11 | 12 | 13 | :: -------------------------------------------- 14 | :: --- Setting up ifortran 15 | :: -------------------------------------------- 16 | :: (you need to have the proper folder of Visual Studio in your environment variable PATH) 17 | :: For Example: C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC 18 | ::call vcvarsall.bat x86 19 | call vcvarsall.bat amd64 20 | 21 | :: -------------------------------------------- 22 | :: --- Setting up ifortran 23 | :: -------------------------------------------- 24 | :: (you need to have the folder bin of intel in your environment variable PATH) 25 | :: For example: C:\Program Files (x86)\Intel\ComposerXE-2011\bin 26 | ::call ifortvars.bat ia32 vs2010 27 | ::call ifortvars.bat intel64 vs2010 28 | call ifortvars.bat intel64 vs2010 29 | 30 | 31 | 32 | :: -------------------------------------------- 33 | :: --- OMNIVOR ENVIRONMENT VARIABLES (if not set globally!!) 34 | :: -------------------------------------------- 35 | ::set OMNIVOR_MKF_DIR=./_includes/ 36 | set OMNIVOR_MKF_DIR=%CD%\_includes\ 37 | set OMNIVOR_LIB_DIR=%CD%\_lib\ 38 | set OMNIVOR_BIN_DIR=%CD%\_bin\windows-ia32\ 39 | set OMNIVOR_OBJ_DIR=%CD%\_build/windows-ia32\ 40 | set OMNIVOR_SRC_DIR=%CD%\ 41 | 42 | echo OMNIVOR_MKF_DIR: %OMNIVOR_MKF_DIR% 43 | 44 | 45 | cmd 46 | 47 | -------------------------------------------------------------------------------- /tex/.gitignore: -------------------------------------------------------------------------------- 1 | tVersion.tex 2 | -------------------------------------------------------------------------------- /tex/Makefile: -------------------------------------------------------------------------------- 1 | #---------------------------------------------------- 2 | # DOCUMENT OPTIONS 3 | #---------------------------------------------------- 4 | MASTER=fortran-guidelines 5 | USE_BIBTEX=0 6 | USE_MAKEINDEX=0 7 | USE_MAKEGLOSS=0 8 | USE_PSTRICKS=0 9 | WINDOWS=0 10 | #---------------------------------------------------- 11 | # PATHS 12 | #---------------------------------------------------- 13 | FIGSDIR=figs 14 | FIGSDUMPDIR=figsdump 15 | SVGDIR=svg 16 | SVGTEXDIR=svgtex 17 | TKZDIR=figstkz 18 | TEXOUTDIR=figs 19 | BIBDIR=bib 20 | SRCDIR=. 21 | OUTDIR=out 22 | #---------------------------------------------------- 23 | # BINARIES 24 | #---------------------------------------------------- 25 | LATEX = latex 26 | BIBTEX = bibtex 27 | DVIPS =dvips 28 | PDFLATEX =pdflatex 29 | MAKEINDEX= makeindex 30 | LATEXHTML= latex2html 31 | PS4PDF= ps4pdf 32 | 33 | 34 | CONVERT=convert 35 | LN=ln 36 | RM=rm -f 37 | CP=cp 38 | PDFTOEPS=pdftops -eps 39 | EPSTOPDF=epstopdf 40 | SVGTOLATEX=svg2latex.py # OLD METHOD 41 | SVGTOLATEX=inkscape -z -D 42 | SVGTOPDF=inkscape -D -A 43 | #SVGTEXTOPDF=inkscape -z -D --file=A.svg --export-pdf=A.pdf --export-latex 44 | SVGTOEPS=inkscape -D -E 45 | SLASH="/" 46 | ifeq ($(WINDOWS),1) 47 | CONVERT=C:/bin/ImageMagick/convert.exe 48 | LN=copy 49 | RM=del 50 | CP=copy 51 | PDFTOEPS=pdftops -eps 52 | EPSTOPDF=epstopdf 53 | SVGTOLATEX=svg2latex.py 54 | SVGTOLATEX=C:/bin/InkscapePortable/App/Inkscape/inkscape.exe -z -D 55 | SVGTOPDF=C:/bin/InkscapePortable/App/Inkscape/inkscape.exe -D -A 56 | SVGTOEPS=C:/bin/InkscapePortable/App/Inkscape/inkscape.exe -D -E 57 | SLASH="/" 58 | endif 59 | 60 | #---------------------------------------------------- 61 | # FLAGS 62 | #---------------------------------------------------- 63 | TEX_FLAGS = --file-line-error --interaction=nonstopmode #--output-directory out --jobname NewReport 64 | BIB_FLAGS = 65 | HTML_FLAGS = 66 | PDFLATEX_FLAGS = -synctex=1 --file-line-error-style --shell-escape --interaction=nonstopmode #--output-directory out --jobname NewReport 67 | PS2PDF_FLAGS = -dMaxSubsetPct=100 -dCompatibilityLevel=1.2 -dSubsetFonts=true -dEmbedAllFonts=true 68 | MAKEINDEX_FLAGS = -s pre/index_style.ist 69 | MAKEGLOSS_FLAGS = -s pre/glossaire_style.ist 70 | DVIPS_FLAGS = -Ppdf -G0 71 | 72 | #---------------------------------------------------- 73 | # SRC FILES 74 | #---------------------------------------------------- 75 | FIGS=$(notdir $(wildcard $(FIGSDUMPDIR)/*)) 76 | FIGSRC=$(patsubst %,$(FIGSDUMPDIR)/%,$(FIGS)) 77 | 78 | TEXSRC = $(wildcard $(SRCDIR)/pre/*.tex) \ 79 | $(wildcard $(SRCDIR)/tex/*.tex) 80 | 81 | BIBSRC = $(wildcard $(BIBDIR)/*.bib) 82 | # Using Bibtex 83 | ifneq ($(strip $(BIBSRC)),) 84 | BBLSRC = $(MASTER).bbl 85 | endif 86 | 87 | 88 | #---------------------------------------------------- 89 | # Display Codes (this is so we can track passes) 90 | #---------------------------------------------------- 91 | SETCOLOR_BLACK = @echo "\\033[0;30m" 92 | SETCOLOR_RED = @echo "\\033[0;31m" 93 | SETCOLOR_GREEN = @echo "\\033[0;32m" 94 | SETCOLOR_BLUE = @echo "\\033[0;34m" 95 | 96 | 97 | 98 | 99 | 100 | #---------------------------------------------------- 101 | # PNG 102 | #----------------------------------------------------- 103 | PNGS=$(notdir $(wildcard $(FIGSDUMPDIR)/*.png)) 104 | PNGS2PNGS=$(patsubst %,$(FIGSDIR)/%,$(PNGS:.png=.png)) # a choice... 105 | PNGS2EPSS=$(patsubst %,$(FIGSDIR)/%,$(PNGS:.png=.eps)) 106 | PNGS2PDFS=$(patsubst %,$(FIGSDIR)/%,$(PNGS:.png=.pdf)) 107 | #----------------------------------------------------- 108 | # JPG 109 | #----------------------------------------------------- 110 | JPGS=$(notdir $(wildcard $(FIGSDUMPDIR)/*.jpg)) 111 | JPGS2EPSS=$(patsubst %,$(FIGSDIR)/%,$(JPGS:.jpg=.eps)) 112 | JPGS2PDFS=$(patsubst %,$(FIGSDIR)/%,$(JPGS:.jpg=.pdf)) 113 | #----------------------------------------------------- 114 | # EPS 115 | #----------------------------------------------------- 116 | EPSS=$(notdir $(wildcard $(FIGSDUMPDIR)/*.eps)) 117 | EPSS2EPSS=$(patsubst %,$(FIGSDIR)/%,$(EPSS:.eps=.eps)) 118 | EPSS2PDFS=$(patsubst %,$(FIGSDIR)/%,$(EPSS:.eps=.pdf)) 119 | #----------------------------------------------------- 120 | # PDF 121 | #----------------------------------------------------- 122 | PDFS=$(notdir $(wildcard $(FIGSDUMPDIR)/*.pdf)) 123 | PDFS2EPSS=$(patsubst %,$(FIGSDIR)/%,$(PDFS:.pdf=.eps)) 124 | PDFS2PDFS=$(patsubst %,$(FIGSDIR)/%,$(PDFS:.pdf=.pdf)) 125 | #----------------------------------------------------- 126 | # SVGTEX 127 | #----------------------------------------------------- 128 | SVGTEXS=$(notdir $(wildcard $(SVGTEXDIR)/*.svg)) 129 | SVGTEXS2PDFS=$(patsubst %,$(TEXOUTDIR)/%,$(SVGTEXS:.svg=.pdf)) 130 | SVGTEX2SEPSS=$(patsubst %,$(TEXOUTDIR)/%,$(SVGTEXS:.svg=.eps)) 131 | #----------------------------------------------------- 132 | # SVG 133 | #----------------------------------------------------- 134 | SVGS=$(notdir $(wildcard $(SVGDIR)/*.svg)) 135 | SVGS2PDFS=$(patsubst %,$(FIGSDIR)/%,$(SVGS:.svg=.pdf)) 136 | SVGS2SEPSS=$(patsubst %,$(FIGSDIR)/%,$(SVGS:.svg=.eps)) 137 | #----------------------------------------------------- 138 | 139 | # TKZ 140 | #----------------------------------------------------- 141 | TKZS=$(notdir $(wildcard $(TKZDIR)/*.tkz)) 142 | TKZ2PDFS=$(patsubst %,$(FIGSDIR)/%, $(TKZS:.tkz=.pdf)) 143 | TKZ2SEPSS=$(patsubst %,$(FIGSDIR)/%,$(TKZS:.tkz=.eps)) 144 | #----------------------------------------------------- 145 | 146 | 147 | 148 | 149 | 150 | 151 | #----------------------------------------------------- 152 | # If chosen to keep pngs.. 153 | #----------------------------------------------------- 154 | $(FIGSDIR)/%.png : $(FIGSDUMPDIR)/%.png 155 | $(LN) "$<" "$@" 156 | #----------------------------------------------------- 157 | # CONVERSION TO EPS 158 | #----------------------------------------------------- 159 | $(FIGSDIR)/%.eps : $(FIGSDUMPDIR)/%.png 160 | $(CONVERT) "$<" EPS3:"$@" 161 | 162 | $(FIGSDIR)/%.eps : $(FIGSDUMPDIR)/%.jpg 163 | $(CONVERT) "$<" EPS3:"$@" 164 | 165 | $(FIGSDIR)/%.eps : $(FIGSDUMPDIR)/%.pdf 166 | $(PDFTOEPS) "$<" "$@" 167 | 168 | $(FIGSDIR)/%.eps : $(FIGSDUMPDIR)/%.eps 169 | $(LN) "$<" "$@" 170 | 171 | $(FIGSDIR)/%.eps: $(SVGTEXDIR)/%.svg 172 | $(SVGTOLATEX) -f "$<" -l "$(FIGSDIR)/$*.tex" -e -o 173 | 174 | $(FIGSDIR)/%.eps: $(SVGDIR)/%.svg 175 | $(SVGTOEPS) "$@" "$<" 176 | 177 | #----------------------------------------------------- 178 | # CONVERSION TO PDF 179 | #----------------------------------------------------- 180 | 181 | $(FIGSDIR)/%.pdf : $(FIGSDUMPDIR)/%.png 182 | $(CONVERT) "$<" "$@" 183 | 184 | $(FIGSDIR)/%.pdf : $(FIGSDUMPDIR)/%.jpg 185 | $(CONVERT) "$<" "$@" 186 | 187 | $(FIGSDIR)/%.pdf : $(FIGSDUMPDIR)/%.eps 188 | $(EPSTOPDF) "$<" --outfile="$@" 189 | 190 | $(FIGSDIR)/%.pdf : $(FIGSDUMPDIR)/%.pdf 191 | $(LN) "$<" "$@" 192 | 193 | $(TEXOUTDIR)/%.pdf: $(SVGTEXDIR)/%.svg 194 | #SVGTEXTOPDF=inkscape -z -D --file=A.svg --export-pdf=A.pdf --export-latex 195 | $(SVGTOLATEX) --file="$<" --export-pdf="$(TEXOUTDIR)/$*.pdf" --export-latex 196 | mv "$(TEXOUTDIR)/$*.pdf_tex" "$(TEXOUTDIR)/$*.tex" 197 | #OLD METHOD $(SVGTOLATEX) -f "$<" -l "$(FIGSDIR)/$*.tex" -o 198 | 199 | $(FIGSDIR)/%.pdf: $(SVGDIR)/%.svg 200 | $(SVGTOPDF) "$@" "$<" 201 | 202 | $(FIGSDIR)/%.pdf: $(TKZDIR)/%.tkz 203 | $(SETCOLOR_GREEN) 204 | @echo " ----------------- TIKZ -----------------------" 205 | $(SETCOLOR_BLACK) 206 | MakeStandaloneTikz $(MASTER) "$<" 207 | $(PDFLATEX) --file-line-error-style --shell-escape --interaction=nonstopmode tmp_tikz.tex >/dev/null 208 | @mv tmp_tikz.pdf "$@" 209 | @rm tmp_tikz* 210 | 211 | 212 | #----------------------------------------------------- 213 | # VERSIONS 214 | #----------------------------------------------------- 215 | #echo %date:~10,4%%date:~4,2%%date:~7,2% 216 | #DATE=echo %date:~10,4% 217 | DATE=$(shell echo _%date:~10,4%-%date:~4,2%-%date:~7,2%) 218 | 219 | FVN=$(notdir $(wildcard $(OUTDIR)/*.pdf)) 220 | FVN2=$(patsubst $(MASTER)_v%,%,$(FVN)) 221 | FVN3=$(FVN2:.pdf=) 222 | FVN4=$(subst ' ',\n,$(FVN3)) 223 | FVN5=$(filter _v%_,$(FVN2)) 224 | FVN5=$(shell FOR /F %i in ($(FVN3)) DO echo %i) 225 | #FVN2=$(FVN:Tip%=Caca%) 226 | 227 | 228 | 229 | #----------------------------------------------------- 230 | # MAIN COMMANDS 231 | #----------------------------------------------------- 232 | all:allpdf 233 | # 234 | # diff: 235 | # git ldiff 236 | 237 | diff: 238 | latexdiff $(MASTER)-sub.tex $(MASTER).tex > $(MASTER)-diff.tex 239 | cp $(MASTER).aux $(MASTER)-diff.aux 240 | cp $(MASTER).bbl $(MASTER)-diff.bbl 241 | cp $(MASTER).blg $(MASTER)-diff.blg 242 | pdflatex -interaction batchmode $(MASTER)-diff.tex 243 | public: 244 | 245 | tkz: $(TKZ2PDFS) 246 | 247 | 248 | version: allpdf dateit 249 | 250 | allpdf: gitversion figspdf pdfall 251 | 252 | gitversion: 253 | @chmod +x make_version.sh 254 | @./make_version.sh 255 | @cat tVersion.tex 256 | 257 | 258 | dateit: 259 | @echo $(DATE) 260 | @echo $(FVN) 261 | @echo $(FVN2) 262 | @echo $(FVN3) 263 | @echo $(FVN4) 264 | @echo $(FVN5) 265 | # $(CP) $(MASTER).pdf $(MASTER)$(DATE).pdf 266 | 267 | 268 | # $(MASTER).pdf 269 | 270 | #$(MASTER).pdf $(TEXSRC) $(FIGSRC) $(BIBSRC) 271 | 272 | 273 | clean : 274 | @$(RM) *.aux *.bbl *.blg *.log *.dvi *.idx *.ilg *.ind *.toc *.lot *.thm *.cb *.cb2 *.gls *.mtc0\ 275 | *.lof *~ *.bak *.blg *.exa *.adx *.bmt *.mtc *.out *.som *.glo *.glx *.tns *.tpt *.maf *.brf *.gz 276 | 277 | cleansvgs: 278 | $(RM) $(SVGTEXS2PDFS) $(SVGS2PDFS) 279 | 280 | figssvg: $(SVGTEXS2PDFS) $(SVGS2PDFS) 281 | 282 | 283 | cleanfigs: 284 | $(RM) $(FIGSDIR)/* 285 | $(RM) $(TEXOUTDIR)/* 286 | 287 | 288 | figspdf: $(JPGS2PDFS) $(PNGS2PDFS) $(SVGTEXS2PDFS) $(SVGS2PDFS) $(EPSS2PDFS) $(PDFS2PDFS) $(TKZ2PDFS) 289 | 290 | figseps: $(JPGS2EPSS) $(PNGS2EPSS) $(SVGTEXS2EPSS) $(SVGS2EPSS) $(EPSS2EPSS) $(PDFS2EPSS) 291 | 292 | fipspng: 293 | 294 | figslower: 295 | for i in figsdump/* ;do ext=`echo $${i#*.}|tr '[:upper:]' '[:lower:]'`; mv "$$i" "$${i%.*}.$$ext"; done 296 | 297 | vimcrash: 298 | $(RM) *.swp /A H 299 | $(RM) bib\*.swp /A H 300 | $(RM) tex\*.swp /A H 301 | $(RM) anx\*.swp /A H 302 | $(RM) pre\*.swp /A H 303 | 304 | 305 | 306 | 307 | 308 | 309 | #----------------------------------------------------- 310 | # SEQUENCES 311 | #----------------------------------------------------- 312 | pdf: figspdf 313 | $(PDFLATEX) $(PDFLATEX_FLAGS) $(MASTER) 314 | 315 | 316 | pdfall: figspdf 317 | ifeq ($(USE_PSTRICKS),1) 318 | @echo "======================================= PSTRICKS ================================================" 319 | $(PS4PDF) $(MASTER).tex 320 | endif 321 | @echo "======================================= PDFLATEX1 ================================================" 322 | $(PDFLATEX) $(PDFLATEX_FLAGS) $(MASTER) 323 | ifeq ($(USE_BIBTEX),1) 324 | @echo "======================================= BIBTEX ================================================" 325 | $(BIBTEX) $(BIB_FLAGS) $(MASTER) 326 | endif 327 | ifeq ($(USE_MAKEINDEX),1) 328 | @echo "======================================= MAKEINDEX ================================================" 329 | $(MAKEINDEX) $(MAKEINDEX_FLAGS) $(MASTER) 330 | endif 331 | ifeq ($(USE_MAKEGLOSS),1) 332 | @echo "======================================= MAKEGLOSS ================================================" 333 | $(MAKEINDEX) $(MAKEGLOSS_FLAGS) -o $(MASTER).gls $(MASTER).glo 334 | endif 335 | @echo "======================================= PDFLATEX2 ================================================" 336 | $(PDFLATEX) $(PDFLATEX_FLAGS) $(MASTER) 337 | @echo "======================================= PDFLATEX3 ================================================" 338 | $(PDFLATEX) $(PDFLATEX_FLAGS) $(MASTER) 339 | 340 | #~ $(LATEX) $(TEX_FLAGS) $(MASTER) 341 | #~ $(DVIPS) $(DVIPS_FLAGS) -o $(FIGSDIR)/PSTRICKSFIGURES.ps $(MASTER).dvi 342 | #~ $(PS2PDF) -dAutoRotatePages=/None pst-pdf-example1-pics.pdf 343 | #~ $(PDFLATEX) $(PDFLATEX_FLAGS) $(MASTER) 344 | 345 | 346 | latexquick: 347 | latex $(MASTER) 348 | 349 | latex: 350 | $(LATEX) $(TEX_FLAGS) $(MASTER) 351 | $(BIBTEX) $(BIB_FLAGS) $(MASTER) 352 | $(LATEX) $(TEX_FLAGS) $(MASTER) 353 | $(LATEX) $(TEX_FLAGS) $(MASTER) 354 | 355 | 356 | 357 | 358 | 359 | 360 | #----------------------------------------------------- 361 | # LATEX 362 | #----------------------------------------------------- 363 | # To accomplish 2 compilation we chain from tex->aux->dvi 364 | 365 | # To generate a .aux file from a .tex file 366 | 367 | 368 | # To generate a .dvi file from a .tex file 369 | $(MASTER).dvi : $(MASTER).aux 370 | $(LATEX) $(TEX_FLAGS) $< >/dev/null 371 | 372 | # To generate a .ps file from a .dvi file 373 | $(MASTER).ps :$(MASTER).dvi 374 | $(DVIPS) $(DVIPS_FLAGS) -o $@ $< 375 | 376 | 377 | #----------------------------------------------------- 378 | # INDEX 379 | #----------------------------------------------------- 380 | index: $(MASTER).aux $(MASTER).idx $(MASTER).ilg $(MASTER).ind 381 | 382 | 383 | #----------------------------------------------------- 384 | # INDEX 385 | #----------------------------------------------------- 386 | bibtex: 387 | $(BIBTEX) $(BIB_FLAGS) $(MASTER) 388 | 389 | 390 | 391 | 392 | # To generate a .idx file from a .tex file 393 | %.ilg : %.idx 394 | $(MAKEINDEX) $(MAKEINDEX_FLAGS) $(*F) 395 | 396 | 397 | bibindex : bibtex index 398 | #makeindex -s bibidx/manuel.ist $(MASTER) 399 | #makeindex -s bibidx/glossaire.ist $(MASTER).glo -o $(MASTER).glx 400 | #bibtex $(MASTER) 401 | 402 | 403 | 404 | #----------------------------------------------------- 405 | # HTML Output 406 | #----------------------------------------------------- 407 | html : $(MASTER).html fipspng 408 | 409 | #----------------------------------------------------- 410 | # PDFLATEX 411 | #----------------------------------------------------- 412 | $(MASTER).pdf : $(MASTER).tex 413 | $(PDFLATEX) $(PDFLATEX_FLAGS) $< 414 | 415 | %.aux : %.tex 416 | $(PDFLATEX) $(PDFLATEX_FLAGS) $< 417 | 418 | #----------------------------------------------------- 419 | # BIBTEX 420 | #----------------------------------------------------- 421 | %.bbl : %.tex 422 | ifneq ($(strip $(BIBSRC)),) 423 | echo "Here" 424 | $(BIBTEX) $(BIB_FLAGS) $(*F) 425 | endif 426 | 427 | 428 | 429 | 430 | 431 | 432 | # Dependencies 433 | #$(MASTER).tex : $(TEXSRC) $(FIGSRC) 434 | #$(MASTER).aux : $(TEXSRC) $(FIGSRC) $(BBLSRC) 435 | #$(MASTER).bbl : $(BIBSRC) $(MASTER).aux 436 | #$(MASTER).pdf : $(MASTER).aux $(TEXSRC) $(FIGSRC) $(BBLSRC) $(BIBSRC) 437 | #$(MASTER).dvi : $(TEXSRC) $(FIGSRC) $(BBLSRC) 438 | -------------------------------------------------------------------------------- /tex/_preamble.tex: -------------------------------------------------------------------------------- 1 | \usepackage[T1]{fontenc} 2 | % macro to select a scaled-down version of Bera Mono (for instance) 3 | % \makeatletter 4 | % \newcommand\BeraMonottfamily{% 5 | % \def\fvm@Scale{0.9}% scales the font down 6 | % \fontfamily{fvm}\selectfont% selects the Bera Mono font 7 | % } 8 | % \makeatother 9 | 10 | % \usepackage{DejaVuSansMono} 11 | % \usepackage{dejavu} 12 | %% which loads the DejaVu Serif and DejaVu Sans fonts as well 13 | % \renewcommand*\familydefault{\ttdefault} 14 | \usepackage{lmodern} 15 | \usepackage{amsmath} 16 | \usepackage{amssymb} 17 | \usepackage{listings} % a inclure pour la fonction listing 18 | \usepackage{longtable} 19 | \usepackage{geometry} 20 | \usepackage{ifpdf} 21 | \ifpdf 22 | \usepackage{graphicx} 23 | \usepackage{epstopdf} %don't forget the shell-escape flag for pdflatex 24 | \else 25 | \usepackage{graphicx} 26 | \fi 27 | \usepackage{hyperref} 28 | \usepackage{color} 29 | \definecolor{mygreen}{rgb}{0,0.6,0} 30 | \definecolor{gret}{rgb}{0,0.6,0} 31 | \definecolor{mygray}{rgb}{0.5,0.5,0.5} 32 | \definecolor{mymauve}{rgb}{0.58,0,0.82} 33 | \definecolor{orange}{rgb}{1,0.5,0} 34 | \definecolor{grey}{rgb}{0.88,0.88,0.88} 35 | \definecolor{midgrey}{rgb}{0.5,0.5,0.50} 36 | \definecolor{greylight}{rgb}{0.95,0.95,0.95} 37 | \definecolor{greensoft}{rgb}{0.25,0.95,0.25} 38 | %%for dtu 39 | \definecolor{dtured}{rgb}{0.6706,0.20784,0.227451} 40 | \definecolor{dtugrey}{rgb}{0.5,0.5,0.5} 41 | 42 | \geometry{ 43 | a4paper, 44 | body={175mm,265mm}, 45 | left=17mm, 46 | top=15mm, 47 | headheight=7mm, 48 | headsep=4mm, 49 | footskip=4mm, 50 | marginparsep=4mm, 51 | marginparwidth=27mm} 52 | % ---SPACING TWEAKS 53 | \usepackage{titlesec} 54 | % \titlespacing\section{0pt}{12pt plus 4pt minus 2pt}{0pt plus 2pt minus 2pt} 55 | % \titlespacing\subsection{0pt}{0pt}{-0pt} 56 | % \setlength{\aboveitemizeskip}{-05pt} 57 | % \setlength{\belowitemizeskip}{-3pt} 58 | % \setlength{\superparsep}{0.2cm} 59 | % \setlength{\captiontabsep}{-0.2cm} 60 | %\linespread{1.5} % line spacing 61 | % ---TOC tweaks 62 | %\setlength{\cftbeforechapskip}{2ex} 63 | %\setlength{\cftbeforepartskip}{1mm} 64 | % \setlength{\cftbeforesecskip}{0.05cm} 65 | % \setlength{\cftsecindent}{1cm} 66 | % \renewcommand{\cftsecfont}{} 67 | % \renewcommand{\cftsecdotsep}{\cftdotsep} 68 | %\setlength{\cftbeforesubsecskip}{-6pt} 69 | % --- Maths 70 | \setlength{\abovedisplayskip}{0.05cm} %space before maths/equations 71 | \setlength{\belowdisplayskip}{0.05cm} %space after maths 72 | % --- PARAGRAPHS 73 | \setlength{\parskip}{0.1cm} 74 | \setlength{\parindent}{0in} 75 | 76 | % -------------------------------------------------------------------------------- 77 | % --- Code 78 | % -------------------------------------------------------------------------------- 79 | \newcommand{\basiclstset}{% 80 | \lstset{ % 81 | backgroundcolor=\color{white}, % choose the background color; 82 | basicstyle=\ttfamily\footnotesize, % the size of the fonts that are used for the code 83 | % basicstyle=\BeraMonottfamily, 84 | breakatwhitespace=false, % sets if automatic breaks should only happen at whitespace 85 | breaklines=true, % sets automatic line breaking 86 | commentstyle=\color{mygreen}, % comment style 87 | deletekeywords={...}, % if you want to delete keywords from the given language 88 | escapeinside={\%*}{*)}, % if you want to add LaTeX within your code 89 | extendedchars=true, % lets you use non-ASCII characters; for 8-bits encodings only, does not work with UTF-8 90 | frame=single, % adds a frame around the code 91 | keepspaces=true, % keeps spaces in text, useful for keeping indentation of code (possibly needs columns=flexible) 92 | keywordstyle=\color{blue}, % keyword style 93 | language=Fortran, % the language of the code 94 | otherkeywords={defined}, % if you want to add more keywords to the set 95 | % numbersep=5pt, % how far the line-numbers are from the code 96 | % numberstyle=\tiny\color{mygray}, % the style that is used for the line-numbers 97 | rulecolor=\color{black}, % if not set, the frame-color may be changed on line-breaks within not-black text (e.g. comments (green here)) 98 | showspaces=false, % show spaces everywhere adding particular underscores; it overrides 'showstringspaces' 99 | showstringspaces=false, % underline spaces within strings only 100 | showtabs=false, % show tabs within strings adding particular underscores 101 | % stepnumber=2, % the step between two line-numbers. If it's 1, each line will be numbered 102 | stringstyle=\color{mymauve}, % string literal style 103 | % tabsize=2, % sets default tabsize to 2 spaces 104 | % title=\lstname, % show the filename of files included with \lstinputlisting; also try caption instead of title 105 | % belowskip=-2.0 \baselineskip, 106 | % belowcaptionskip=0cm, 107 | % abovecaptionskip=0cm, 108 | % aboveskip=0.1cm, 109 | belowskip=0em, 110 | % linewidth=\linewidth 111 | } 112 | } 113 | \basiclstset 114 | % \lstset{ 115 | % basicstyle=\BeraMonottfamily, 116 | % frame=single, 117 | % } 118 | \newcommand{\cmd}[1]{\texttt{\detokenize{#1}}} 119 | 120 | % -------------------------------------------------------------------------------- 121 | % --- Code related commands 122 | % -------------------------------------------------------------------------------- 123 | \lstloadlanguages{Fortran} 124 | 125 | \lstnewenvironment{code} 126 | {\null\hfill\minipage{0.48\textwidth}} 127 | {\endminipage\hfill\null} 128 | 129 | \lstnewenvironment{codea} 130 | {\hfill\minipage[b]{0.48\textwidth}} 131 | {\endminipage} 132 | \lstnewenvironment{codeb} 133 | {\hfill\minipage[b]{0.48\textwidth}} 134 | {\endminipage\hfill\ \newline\null} 135 | 136 | \lstnewenvironment{codefull} 137 | {\minipage{1.0\textwidth}} 138 | {\endminipage\newline\null} 139 | 140 | \lstnewenvironment{good} 141 | {\hfill\minipage{0.47\textwidth}\lstset{title=\textbf{good}}} 142 | {\endminipage\hfill\null} 143 | 144 | \lstnewenvironment{bad} 145 | {\hfill\minipage{0.47\textwidth}\lstset{title=\textbf{bad}}} 146 | {\endminipage\hfill\null} 147 | 148 | \newcommand{\includecode}[1]{\lstinputlisting[title=\texttt{\detokenize{#1}}]{#1}} 149 | % -------------------------------------------------------------------------------- 150 | % --- User-defined commands 151 | % -------------------------------------------------------------------------------- 152 | \newcommand{\weird}[1]{\textcolor{red}{!!!#1 }} 153 | 154 | \newcommand{\topict}[1]{% 155 | \multicolumn{2}{p{\textwidth}}{\newline\textbf{#1}}\\ 156 | } 157 | \newcommand{\reasont}[1]{% 158 | \multicolumn{2}{p{\textwidth}}{#1}\\ 159 | } 160 | \newcommand{\topic}[1]{% 161 | ~\vspace{-0.2cm}\par\textbf{#1}\\ 162 | } 163 | \newcommand{\reason}[1]{% 164 | #1\\ 165 | } 166 | -------------------------------------------------------------------------------- /tex/fortran-guidelines.tex: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \input{_preamble.tex} 3 | \input{tVersion.tex} 4 | % \renewcommand{\weird}[1]{} 5 | \title{Some Fortran guidelines and pitfalls} 6 | \author{E. Branlard - https://github.com/elmanuelito/fortran-guidelines} 7 | \date{Version: \gitversion} 8 | % -------------------------------------------------------------------------------- 9 | % --- Document 10 | % -------------------------------------------------------------------------------- 11 | \begin{document} 12 | \maketitle 13 | 14 | \tableofcontents 15 | 16 | \subsection*{Introduction} 17 | \paragraph{Portability Portability Portability} 18 | It is rather easy to write a code that is \textit{none standards, platform-dependent, architecture-dependent, compiler-dependent and library-dependent}. 19 | Writing a portable code takes more effort on the programmer's level but it has its benefits: robustness, re-usability and more users. You learn a lot and find a lot of bugs simply by using different compilers. 20 | 21 | \paragraph{Strategies} 22 | There is probably two main strategies to ensure portability: (i) using preprocessor directives or (ii) wrapping non-portable code in separate files. 23 | (i) Preprocessors directives are widely used, they are written close to the code which makes them easy to implement. The down side is they pollute the code and make it often very hard to read. Also, there is an inherent dependence on a specific preprocessor, and thus this reduces portability. The C-preprocessor is built-in in most compilers, and is probably the one that should be used if a preprocessor approach is chosen. 24 | (ii) Choosing to wrap non-portable code into separate files keeps the whole code perfectly readable. Further, the developers responsible for a given library, architecture or OS have only a few files to work with, the rest of the code being ``universal''. 25 | The down side is that it increases the number of source files and requires the ``Makefile'' or the ``Project'' to select the proper files. 26 | Also, not all the power of the preprocessor can be achieved in this way. 27 | This is for instance the case for decoration of procedures or data like \texttt{bind(C)} or \texttt{DLLEXPORT} (see \autoref{sec:dlls}). 28 | A combination of both approaches is likely to be the optimal solution. 29 | 30 | \paragraph{In this document} 31 | The guidelines written in this document are an attempt to lean towards portability. The content of the document might evolve in the future. 32 | Wrapping of non-portable code into a separate module is the solution generally applied in this document. Different files are used to provide the different implementations of the interface of a given wrap-module. Portability modules are called \verb|Support*| and their source code is located in the folder \cmd{_support*}. 33 | For instance, the kind of a real is stored as \verb|MK| in the \verb|SupportPrecision| module (see \autoref{sec:precision}). 34 | 35 | If recent standards offer options that helps portability, then this document will tend to favor these options despite the broken compatibility with regards to older compilers. This is the case for the \texttt{bind(C)} decoration which is very helpful for portability. 36 | 37 | The following convention is used in this document:\\ 38 | \begin{codea} 39 | ! BAD PRACTICE 40 | \end{codea} 41 | \begin{codeb} 42 | ! GOOD PRACTICE 43 | \end{codeb} 44 | 45 | 46 | \paragraph{In this repository} Preliminary attempts of ``portable'' modules and makefiles are provided in this repository. Most of the code originates from \cmd{Omnivor}'s implementation. It used to be compatible linux/windows and gfortran/intel/compaq/sun/portland, though it was not fully tested recently. 47 | They are far from ``universal'' and will hopefully evolve in the future. 48 | 49 | \section{Recommendations} 50 | 51 | 52 | % -------------------------------------------------------------------------------- 53 | % --- Files 54 | % -------------------------------------------------------------------------------- 55 | \subsection{Files and modules: towards a modular library-oriented code} 56 | \label{sec:modules} 57 | \topic{Files and modules: general guidelines} 58 | \begin{enumerate} 59 | \item Non-portable code should be placed in a separate directory to avoid polluting the ``universal'' code. 60 | \item Modules containing derived types definitions should not contain anything else: no data or routines (though parameters/constants can be fine). This seriously reduces the chances to run into circular dependencies problems. 61 | \item Modules containing data should only contain this data: no types or routines. This reduces circular dependencies problems. This helps the identification of the data ``stored'' by the libraries. In fact, it's best to reduce data modules to a minimum (see next point). 62 | \item Data modules should be avoided. In a ``library''-like implementation, the ``user'' owns the data, not the library. The library is made of tools that manipulate the user's data but does not store anything. This makes the library thread safe and the code implemented can be more readily re-used. 63 | \item Use one module per files, it makes it easier to find them and reduces circular dependencies problem. 64 | \item The following structure can be adopted: 65 | \begin{itemize} 66 | \item \verb|AirfoilTypes.f90| (contains no data) 67 | \item \verb|AirfoilParams.f90| (contains compile time constants, e.g. to increase code readibility) 68 | \item \verb|AirfoilTools.f90| (contains no data, manipulate derive type instances as arguments) 69 | \item \verb|AirfoilData.f90| (fine, but the aim is to remove this module at the end, see point 4 above) 70 | \end{itemize} 71 | \item File extensions: Some OS are case-sensitive. Make sure you display file extensions in your file manager. It's good to stay consistent in the extension you use for your source files. It helps creating makefiles that can be used on any platforms. Some general conventions are: 72 | \begin{itemize} 73 | \item \verb|.f90|: Fortran 90 code 74 | \item \verb|.f| : Old fortran code 75 | \item \verb|.F*| : Fortran code that needs a preprocessor or Template for code generator (e.g. cheetah) 76 | \end{itemize} 77 | \item Avoid having two files with the same name in your project. It's easier to implement makefiles then. 78 | \end{enumerate} 79 | 80 | \topic{Modules: write implicit none in module only, it propagates to contained routines} 81 | \begin{codea} 82 | module SupportCompiler 83 | implicit none 84 | contains 85 | subroutine foo() 86 | implicit none ! Not needed 87 | end subroutine 88 | end module 89 | \end{codea} 90 | \begin{codeb} 91 | module SupportCompiler 92 | implicit none 93 | contains 94 | subroutine foo() 95 | 96 | end subroutine 97 | end module 98 | \end{codeb}\\ 99 | 100 | \topic{Modules: write explicit use-statements to avoid polluting your scope and help the reader} 101 | \begin{codefull} 102 | subroutine foo() 103 | use SupportCompiler, only: FORTRAN_COMPILER 104 | use AirfoilTools, only: airfoil_load, airfoil_interp 105 | use NewTools, only: init ! using the subroutine init from NewTools 106 | use OldTools, only: init_old => init ! renaming the subroutine init from OldTools 107 | ![...] 108 | call init() 109 | call init_old() 110 | ![...] 111 | end subroutine 112 | \end{codefull} 113 | 114 | 115 | 116 | 117 | % -------------------------------------------------------------------------------- 118 | % --- Variables init 119 | % -------------------------------------------------------------------------------- 120 | \subsection{Declarations, initialization, allocations} 121 | \topic{Initialization: not in definitions but straight after (except for derived types, see~\autoref{sec:derivedtypes})} 122 | \begin{codea} 123 | subroutine foo() 124 | integer :: i = 0 !< implies save, bad!!!! 125 | real(MK), pointer :: p=>null() !< idem 126 | 127 | 128 | end subroutine 129 | \end{codea} 130 | \begin{codeb} 131 | subroutine foo() 132 | integer :: i 133 | real(MK), pointer :: p 134 | i=0 ! safe 135 | nullify(p) ! safe 136 | end subroutine 137 | \end{codeb} 138 | \reason{Finalizing in the definition implies the attribute \cmd{save}, it's very bad practice and can lead to disastrous surprises (see examples in \cmd{_unit_tests}). Save is in general a bad practice (like global variables).} 139 | % -------------------------------------------------------------------------------- 140 | \topic{Arguments declaration: use intent in declarations, except for pointers} 141 | \begin{codea} 142 | function(x,y,i,p) 143 | ! Arguments 144 | real(MK) :: x !< 145 | real(MK) :: y !< 146 | integer :: i !< 147 | integer, pointer :: p !< 148 | ! Variables 149 | end 150 | \end{codea} 151 | \begin{codeb} 152 | function(x,y,i,p) 153 | ! Arguments 154 | real(MK), intent(in) :: x !< best 155 | real(MK), intent(out) :: y !< best 156 | integer, intent(inout) :: i !< best 157 | integer, pointer :: p 158 | ! Variables 159 | end 160 | \end{codeb} 161 | \reason{More compiler optimizations can take place and errors detected at compilation time.} 162 | % -------------------------------------------------------------------------------- 163 | \topic{Initialization: always initialize after allocation} 164 | \begin{codea} 165 | allocate(x(1:10));! x is garbage 166 | \end{codea} 167 | \begin{codeb} 168 | allocate(x(1:10)); x(1:10)= 0.0_MK ! safe 169 | \end{codeb} 170 | \reason{Compilers have flags to define the behavior of allocate (e.g. set to 0 or NaN). It's more portable not to rely on it. In statements and declarations, specifying the bounds explicitly is good practice: it reminds the reader of the dimensions, it helps the compiler, and bound mismatch can be found by the compiler.} 171 | % -------------------------------------------------------------------------------- 172 | \topic{Allocations: the safe way} 173 | \begin{codea} 174 | allocate(x(1:10)); 175 | ! Code above can crash with no backtrace 176 | x(1:10)=0.0_MK 177 | 178 | 179 | ! 180 | ! 181 | \end{codea} 182 | \begin{codeb} 183 | allocate(x(1:10),stat=ierr); 184 | if (ierr/=0) print*,'x alloc error'; STOP 185 | x(1:10)=0.0_MK 186 | 187 | ! or, using a wrapped function: 188 | use MemoryManager, only: allocate_safe 189 | call allocate_safe('x', x, 10, 0.0_MK) 190 | \end{codeb} 191 | 192 | % -------------------------------------------------------------------------------- 193 | \topic{Data declaration within module: use save and initialization} 194 | \begin{codea} 195 | module A 196 | ! save is more or less implied 197 | integer :: i 198 | integer, pointer :: p 199 | end module 200 | \end{codea} 201 | \begin{codeb} 202 | module A 203 | ! good practice to write 'save', and init 204 | integer, save :: i = 0 205 | integer, save, pointer :: p => null() 206 | end module 207 | \end{codeb} 208 | \reason{The value of \cmd{i} may be lost if the module becomes out of scope. In practice it doesn't occur, but it's just safe to write \cmd{save}... It's probably the only time the \cmd{save} attribute should be used. As mentionned in \autoref{sec:modules}, data modules are to be reduced to a minimal and it's best if they contain only data. Note: for \cmd{common} blocks, save should be used as well for the same reasons. } 209 | 210 | \subsection{Stack pitfalls} 211 | \label{sec:stack} 212 | % -------------------------------------------------------------------------------- 213 | \topic{Stack: do not use assumed size local variable in routines} 214 | \begin{codea} 215 | function(x,n) 216 | ! Arguments 217 | integer,intent(in) :: n 218 | real(MK),dimension(n),intent(inout) :: x !< ok 219 | ! Variables 220 | real(MK), dimension(n) :: y !< BAD! 221 | 222 | end 223 | \end{codea} 224 | \begin{codeb} 225 | function(x,n) 226 | ! Arguments 227 | integer,intent(in) :: n 228 | real(MK),dimension(n),intent(inout) :: x !< ok 229 | ! Variables 230 | real(MK), dimension(:), allocatable :: y !< OK 231 | allocate(y(1:n)); y(1:n)= 0.0_MK ! OK 232 | end 233 | \end{codeb} 234 | \reason{The assumed size local variables are allocated on the stack and this might result in stack overflows or corruptions.} 235 | % -------------------------------------------------------------------------------- 236 | \topic{Stack: do not use intrinsic functions for large arrays/vectors (they sometimes use the stack)} 237 | \begin{codea} 238 | maxval ! Examples of known functions 239 | maxloc ! acting on array/vector that can use 240 | pack ! the stack (e.g. Intel compiler) 241 | \end{codea} 242 | \begin{codeb} 243 | ! Instead, write your own custom function 244 | ! using a for loop and no assumed size! 245 | ! See e.g. PackFunction in folder _tools 246 | \end{codeb} 247 | \reason{Segmentation faults can result from not following this guideline (if your stack is indeed too small).} 248 | % -------------------------------------------------------------------------------- 249 | \topic{Stack: linux systems} 250 | \begin{codea} 251 | \end{codea} 252 | \begin{codeb} 253 | ulimit -s unlimited 254 | \end{codeb} 255 | % \reason{Segmentation faults can result from not following this guideline.} 256 | % -------------------------------------------------------------------------------- 257 | 258 | 259 | % -------------------------------------------------------------------------------- 260 | % --- If statements 261 | % -------------------------------------------------------------------------------- 262 | \subsection{If-statements / comparisons} 263 | \label{sec:if} 264 | \topic{If-statements: logical comparison} 265 | \begin{codea} 266 | if(my_logical.eq.your_logical) print*,'bad' 267 | if(my_logical.eq..true.) print*,'bad' 268 | if(my_logical.eq..false.) print*,'bad' 269 | \end{codea} 270 | \begin{codeb} 271 | if(my_logical.eqv.your_logical.) print*,'good' 272 | if(my_logical) print*,'good' 273 | if(.not.my_logical) print*,'good' 274 | \end{codeb} 275 | \reason{For logical comparison \texttt{.eqv.} should be used. Most of the time, it can be omitted.} 276 | % -------------------------------------------------------------------------------- 277 | \topic{If-statements: real equality comparison} 278 | \begin{codea} 279 | if(x == 12.0_MK) ! dangerous real comparison 280 | 281 | 282 | 283 | ! 284 | \end{codea} 285 | \begin{codeb} 286 | if(.not.(abs(x-12.0_MK)>0.0_MK)) ! ex1 287 | ! 288 | if(precision_equal(x,12.0_MK)) ! ex1b 289 | ! 290 | if(abs(x-12.0_MK)0) then 298 | ! Compiler might evaluate x>0 first 299 | ! =>Segfault if x is not present 300 | endif 301 | \end{codea} 302 | \begin{codeb} 303 | if (present(x)) then 304 | if (x>0) then ! safe 305 | endif 306 | endif 307 | \end{codeb} 308 | % -------------------------------------------------------------------------------- 309 | 310 | % -------------------------------------------------------------------------------- 311 | % --- Do loops 312 | % -------------------------------------------------------------------------------- 313 | \subsection{Do loops and memory order} 314 | \label{sec:do} 315 | \topic{Do loops: first index should runs the fastest to respect memory order} 316 | \begin{codea} 317 | do i=1,n 318 | do j=1,m ! bad, j run the fastest 319 | a(i,j)=1.0_MK 320 | enddo 321 | enddo 322 | \end{codea} 323 | \begin{codeb} 324 | do j=1,m 325 | do i=1,n ! good 326 | a(i,j)=1.0_MK 327 | enddo 328 | enddo 329 | \end{codeb} 330 | % -------------------------------------------------------------------------------- 331 | \topic{Memory: typical array dimensions for 3D geometry} 332 | \begin{codea} 333 | real(MK), dimension(n,3) :: Points ! bad 334 | \end{codea} 335 | \begin{codeb} 336 | real(MK), dimension(3,n) :: Points ! ok 337 | \end{codeb} 338 | % -------------------------------------------------------------------------------- 339 | \topic{Do loops: iteration on reals are bad practice} 340 | \begin{codea} 341 | do x=0._MK, 10._MK, 0.1_MK 342 | enddo 343 | \end{codea} 344 | \begin{codeb} 345 | ! Bad practice 346 | ! use loop on integer instead 347 | \end{codeb} 348 | % -------------------------------------------------------------------------------- 349 | 350 | 351 | 352 | % -------------------------------------------------------------------------------- 353 | % --- Derived types 354 | % -------------------------------------------------------------------------------- 355 | \subsection{Derived types} 356 | \label{sec:derivedtypes} 357 | \topic{Derived types: use initializations, especially for pointers, always =>null() them} 358 | \begin{codea} 359 | type T_mytype 360 | real(MK), pointer :: p 361 | integer :: i 362 | end type 363 | \end{codea} 364 | \begin{codeb} 365 | type T_mytype 366 | real(MK), pointer :: p=>null() !< always! 367 | integer :: i=0 !< safe to rely on it 368 | end type 369 | \end{codeb} 370 | \reason{Components initialization is standard.} 371 | % -------------------------------------------------------------------------------- 372 | \topic{Derived types: component access} 373 | \begin{codea} 374 | T.i = 0 ! . is not standard 375 | \end{codea} 376 | \begin{codeb} 377 | T%i = 0 ! % is OK 378 | \end{codeb} 379 | % -------------------------------------------------------------------------------- 380 | \topic{Derived types: deallocate the components before the parent} 381 | \begin{codea} 382 | type T_mytype 383 | real(MK), pointer :: p=>null() 384 | end type 385 | ![...] 386 | type(T_mytype), pointer :: t 387 | nullify(t) 388 | ![...] 389 | if (associated(t)) then 390 | 391 | deallocate(t) ! potential memory loss 392 | endif 393 | \end{codea} 394 | \begin{codeb} 395 | type T_mytype 396 | real(MK), pointer :: p=>null() 397 | end type 398 | ![...] 399 | type(T_mytype), pointer :: t 400 | nullify(t) 401 | ![...] 402 | if (associated(t)) then 403 | if (associated(t%p)) deallocate(t%p) 404 | deallocate(t) ! fine 405 | endif 406 | \end{codeb} 407 | % -------------------------------------------------------------------------------- 408 | \topic{Derived types: automatic code generation} 409 | A bit of advertisement here, \cmd{simple-fortran-parser} can generate automatic code for derived types (like read/write to binary, init/dealloc). 410 | 411 | 412 | 413 | % -------------------------------------------------------------------------------- 414 | % --- Characters 415 | % -------------------------------------------------------------------------------- 416 | \subsection{Characters} 417 | \label{sec:characters} 418 | \topic{Characters: use the \texttt{len} specification} 419 | \begin{codea} 420 | character*16 :: s ! not standard 421 | \end{codea} 422 | \begin{codeb} 423 | character(len=16) :: s 424 | \end{codeb} 425 | % -------------------------------------------------------------------------------- 426 | \topic{Characters: use the \texttt{len} specification for arguments} 427 | \begin{codea} 428 | function f(s) 429 | character*(*) :: s ! akward character array 430 | end 431 | \end{codea} 432 | \begin{codeb} 433 | function f(s) 434 | character(len=*), intent(in) :: s 435 | end 436 | \end{codeb} 437 | 438 | % -------------------------------------------------------------------------------- 439 | \topic{Characters array: it's best to used fixed length for old compilers} 440 | \begin{codefull} 441 | character(len=20), dimension(5) :: strings ! fine 442 | character(len=20), dimension(:), allocatable :: strings2 ! fine 443 | character(len=:), dimension(:), allocatable :: strings3 ! fine but not for old compilers 444 | strings(1)='a' 445 | print*,string(1)(1:20) 446 | ! Allocation: 447 | ! allocate(strings2(size(strings,1),size(strings,2))) ! WRONG 448 | allocate(character(len=len(strings(1))) :: strings2(size(strings,1)))! GOOD 449 | \end{codefull}\par 450 | % -------------------------------------------------------------------------------- 451 | \topic{Characters: retrieving a string from C} 452 | \begin{codefull} 453 | subroutine string_switch(s_c) BIND(C, NAME='string_switch') 454 | use SupportPrecision, only: C_CHAR 455 | use CStrings, only: cstring2fortran, fortranstring2c ! see folder _tools 456 | ! Argument 457 | character(kind=C_CHAR,len=1),dimension(*),intent(inout) :: s_c !< c string 458 | ! Variable 459 | character(len=255) :: s_f !< fortran string 460 | ! [...] 461 | call cstring2fortran(s_c,s_f) 462 | ! [...] 463 | s_f='fortran' 464 | call fortranstring2c(s_f,s_c) 465 | end 466 | \end{codefull} 467 | 468 | 469 | % -------------------------------------------------------------------------------- 470 | % --- Arrays 471 | % -------------------------------------------------------------------------------- 472 | \subsection{Arrays} 473 | \label{sec:arrays} 474 | \topic{Arrays: array construct with double dot is not standard} 475 | \begin{codea} 476 | integer, dimension(10) :: x 477 | 478 | x=[1:10] ! not standard 479 | 480 | 481 | 482 | 483 | ! 484 | \end{codea} 485 | \begin{codeb} 486 | integer, dimension(10) :: x 487 | integer :: i 488 | x=[ (i,i=1,10) ] ! allright 489 | x=(/(i,i=1,10)/) ! even more portable 490 | 491 | do i=1,10 492 | x(i)=i ! readable, less bug 493 | enddo 494 | \end{codeb} 495 | % -------------------------------------------------------------------------------- 496 | \topic{Unroll loops for large arrays} 497 | \begin{codea} 498 | M(1:3,1:n)=0.0_MK ! n is a large number 499 | 500 | 501 | ! 502 | \end{codea} 503 | \begin{codeb} 504 | ! Unrolled loop (segfault observed otherwise) 505 | do i=1,n 506 | M(1:3,i)=0.0_MK 507 | enddo 508 | \end{codeb} 509 | \reason{Depending on the compiler and the compiler version, the code on the left may result in a segmentation fault without obvious reason, this can be hard to debug. Unrolling loops when manipulating large arrays is highly recommended. See also the stack pitfalls \autoref{sec:stack}} 510 | 511 | 512 | % -------------------------------------------------------------------------------- 513 | % --- File IO 514 | % -------------------------------------------------------------------------------- 515 | \subsection{File IO} 516 | \label{sec:fileio} 517 | \topic{Unit value: don't use a fixed value} 518 | \begin{codea} 519 | 520 | 521 | open(99, ...) ! what if 99 is already opened? 522 | read(99) 523 | \end{codea} 524 | \begin{codeb} 525 | use MainIO, only: get_free_unit() 526 | iunit=get_free_unit() 527 | open(iunit, ...) 528 | read(iunit) 529 | \end{codeb} 530 | \reason{MainIO is defined in \texttt{\_tools}} 531 | % -------------------------------------------------------------------------------- 532 | \topic{Binaries with direct access (e.g. Mann box): watch for the record length, wrap it in a module!} 533 | \begin{codea} 534 | ! 535 | open(iunit,file='u',recl=1,& !no standard 536 | access='direct',form='unformatted',& 537 | status='old') 538 | \end{codea} 539 | \begin{codeb} 540 | use SupportCompiler, only: RECORD_LENGTH 541 | open(iunit,file='u',recl=RECORD_LENGTH,& 542 | access='direct',form='unformatted',& 543 | status='old') 544 | \end{codeb} 545 | \reason{Unfortunately, there is no standard for what recl should be. For intel and compaq by default \texttt{recl=1}. For gfortran (or intel with the flag \texttt{-assume byterecl}) \texttt{recl=4} } 546 | % -------------------------------------------------------------------------------- 547 | \topic{Binaries with stream access (e.g. VTK bin): not available on old compilers} 548 | \begin{codea} 549 | open(iunit,'a.dat',form='UNFORMATTED',& 550 | access = 'stream', action = 'WRITE',& 551 | convert='BIG_ENDIAN') 552 | \end{codea} 553 | \begin{codeb} 554 | use SupportCompiler, only: open_stream_write 555 | call open_stream_write('a.dat') 556 | ! 557 | \end{codeb} 558 | %% -------------------------------------------------------------------------------- 559 | \topic{Namelists: fine for derived types, but no pointers or allocatable.} 560 | \begin{codefull} 561 | type T_RandomVar ! No pointers or allocatables 562 | character(len=56) :: sname = '' 563 | real(MK) :: value = 0._MK 564 | type(T_Stats) :: stats ! No pointers or allocatables 565 | end type 566 | type T_Stats ! No pointers or allocatables 567 | real(MK), dimension(4) :: moments = (/0._MK,0._MK,0._MK,0._MK/) 568 | end type 569 | ![...] 570 | type(T_RandomVar) :: RandomVar 571 | ![...] 572 | namelist/RandomVarInputs/RandomVar 573 | read(iunit,RandomVarInputs,iostat=ierr) 574 | \end{codefull} 575 | % -------------------------------------------------------------------------------- 576 | \topic{STOP and return status: } 577 | \begin{codea} 578 | STOP -1 ! not supported by Compaq 579 | \end{codea} 580 | \begin{codeb} 581 | ! 582 | \end{codeb} 583 | 584 | % -------------------------------------------------------------------------------- 585 | % --- Precision 586 | % -------------------------------------------------------------------------------- 587 | \subsection{Precision} 588 | \label{sec:precision} 589 | 590 | \topic{Precision: in general, use a custom module} 591 | \begin{codea} 592 | 593 | real*8 594 | integer(int_ptr_kind()) 595 | \end{codea} 596 | \begin{codeb} 597 | use SupportPrecision, only: MK, PK 598 | real(MK) 599 | integer(PK) 600 | 601 | \end{codeb} 602 | \reason{The syntax \texttt{*8} is depreciated. It is convenient if you need a real that takes exactly 8 bytes, but still, it's depreciated (see next paragraph). Note that \cmd{real*8} and \cmd{real(8)} have no reason to be the same (the kinds are compiler dependent). \cmd{int_ptr_kind} is convenient to support multiple architecture (32/64bits) but is not standard (hence the SupportPrecision module).} 603 | % -------------------------------------------------------------------------------- 604 | \topic{Precision: If you really want to precise the size in bytes (8 bit)} 605 | \begin{codea} 606 | 607 | real*4, real*8, 608 | integer*4, integer*8 609 | \end{codea} 610 | \begin{codeb} 611 | use iso_fortran_env 612 | real(REAL32), real(REAL64) 613 | integer(INT32), real(INT64) 614 | \end{codeb} 615 | \reason{The syntax \texttt{*4} is depreciated. The \cmd{iso_fortran_env} module is not available on old compilers => Use a SupportCompiler module wrapped in a SupportPrecision module. See \cmd{_support/SupportPrecision.f90} \autoref{fil:precision}} 616 | % -------------------------------------------------------------------------------- 617 | \topic{Precision: If you need to communicate with C (recommended for DLLs)} 618 | \begin{codea} 619 | 620 | real 621 | double precision 622 | integer 623 | character 624 | logical 625 | \end{codea} 626 | \begin{codeb} 627 | use iso_c_binding 628 | real(C_FLOAT) 629 | real(C_DOUBLE) 630 | integer(C_INT) 631 | character(kind=C_CHAR) 632 | logical(C_BOOL) 633 | \end{codeb} 634 | \reason{The \cmd{iso_c_binding} module is not available on old compilers => Use a SupportCompiler module wrapped in a SupportPrecision module. See \cmd{_support/SupportPrecision.f90} \autoref{fil:precision}} 635 | % -------------------------------------------------------------------------------- 636 | \topic{Precision: use explicit type conversions (with compiler warnings)} 637 | \begin{codea} 638 | ! 639 | real*4 :: x 640 | double precision :: y 641 | ![...] 642 | y = x !implicit type conversion 643 | \end{codea} 644 | \begin{codeb} 645 | use SupportPrecision, only: MPI_DOUBLE, MK 646 | real(MK) :: x 647 | real(MPI_DOUBLE) :: y 648 | ![...] 649 | y = real(x, MPI_DOUBLE) ! explicit conversion 650 | \end{codeb} 651 | % % 652 | % \topic{Summary} 653 | % \includecode{_modules_parts/SupportPrecision.f90} 654 | 655 | % -------------------------------------------------------------------------------- 656 | % --- OS 657 | % -------------------------------------------------------------------------------- 658 | \subsection{Operating System and filesystem} 659 | \label{sec:os} 660 | A lot of fortran builtin routines are cross-platform. 661 | The main problems can be found when creating directories and inquiring about files. 662 | Compilers have some non-standards extensions. Cross platform solutions can easily be implemented. 663 | The solution advised here is to put OS-specific parameters (like commands, and slash) in a module \cmd{SupportSystem} (see folder \cmd{_support}) which is then included by a \cmd{FileSystem} module (in folder \cmd{_tools}). 664 | 665 | 666 | \topic{Checking if a file exist: do not use stat, it's not standard, use the old inquire} 667 | 668 | \begin{codea} 669 | integer :: iFileExist 670 | iFileExist=stat(filename,info_array) 671 | if (iFileExist/=0) then 672 | ! file does not exist 673 | else 674 | ! file exists 675 | endif 676 | 677 | 678 | 679 | 680 | ! 681 | \end{codea} 682 | \begin{codeb} 683 | logical :: bFileExist 684 | inquire(file=filename, exist=bFileExist) 685 | if (.not.bFileExist) then 686 | ! file does not exist 687 | else 688 | ! file exists 689 | endif 690 | 691 | ! Or even better: use a wrapped function 692 | use FileSystem, only: file_exists !see _tools 693 | if(.not.file_exists(filename)) then 694 | ! [..] 695 | 696 | \end{codeb} 697 | 698 | % -------------------------------------------------------------------------------- 699 | % --- Makefile 700 | % -------------------------------------------------------------------------------- 701 | \subsection{Makefile} 702 | \label{sec:makefile} 703 | Makefiles are convenient to compile code on multiple platforms using different compilers and libraries. The current repository contains examples in the \cmd{_\mkf} folder. 704 | \cmd{MakefileOS.mk} attempts to detect the OS and architecure and unify OS-specific parameters. 705 | \cmd{MakefileFortran.mk} attempts to unify Fortan compiler flags. 706 | 707 | % -------------------------------------------------------------------------------- 708 | % --- Preprocessor 709 | % -------------------------------------------------------------------------------- 710 | \subsection{Preprocessor} 711 | \label{sec:preprocessor} 712 | This section presents some generalities about preprocessors and examples of cases where the preprocessor directives can be replaced by wrapped code in separate modules. 713 | Examples where this approach is not possible are found in \autoref{sec:dlls}. 714 | As mentioned in the introduction, relying on a preprocessor is not really portable and the wrapped approach should be preferred whenever possible. Also, the C-preprocessor being the most used one, it's best to use this one. 715 | 716 | \topic{Macros} 717 | The most used feature is something of the form \cmd{if defined MACRO then ... endif}. 718 | The string \cmd{MACRO} is defined by the compiler or the user. 719 | Macros are defined on the command line using \cmd{-DMACRO}. Since it is a compiler variable intended to be defined in the entire scope of the program, a convention is to surround the macro name with double underscores, e.g. \cmd{__dtu__} (see POSIX standard and ANSI-C standards). 720 | For a list of predefined macros for Compilers/OS/Archi:~\url{http://sourceforge.net/p/predef/wiki/Home/}\\ 721 | Given the variability of definitions, it is advised to always (re)define the macros that your are using on the command line: e.g. \cmd{-D__linux__}, \cmd{-D_WIN32}, \cmd{D__intel__}, \cmd{D__compaq__},\cmd{D__amd64__},\cmd{D__i386__}. For instance \cmd{-D__linux__} is not defined by gfortran on linux. 722 | 723 | \topic{C-Preprocessor} 724 | The C-Preprocessor is supported by: intel, gfortran, compaq, sun, pgi portland.\\ 725 | Macros are \textbf{case sensitive}. 726 | 727 | gfortran: 728 | \cmd{-cpp}: use C-preprocessor, 729 | \cmd{-E -dM}: show preprocessor macros\\ 730 | ifort : 731 | \cmd{-fpp}: use C-preprocessor, 732 | \cmd{-E -dM -dryrun}: show preprocessor macros\\ 733 | sun : 734 | \cmd{-xpp}: use C-preprocessor\\ 735 | pgf90: 736 | \cmd{-Mpreproc} : use C-preprocessor\\ 737 | % 738 | \topic{DEC-Preprocessor} 739 | The DEC-Preprocessor is supported by: intel and compaq.\\ 740 | Macros are \textbf{case in-sensitive}. 741 | 742 | \topic{GNU-Preprocessor} 743 | The GNU-Preprocessor is supported by: gfortran.\\ 744 | It is only used to define \cmd{ATTRIBUTES}, it doesn't support \cmd{if defined}.\\ 745 | \cmd{!GCC$ ATTRIBUTES DLLEXPORT :: init} 746 | 747 | 748 | 749 | \topic{Preprocessor: Examples where preprocessor directives can be removed} 750 | \begin{codea} 751 | !DEC$ IF DEFINED(__HDF5__) 752 | call hdf5_init() 753 | !DEC$ END IF 754 | \end{codea} 755 | \begin{codeb} 756 | use SupportHDF5, only: hdf5_init() 757 | call hdf5_init() 758 | ! 759 | \end{codeb}\\ 760 | \begin{codea} 761 | ! C preprocessor 762 | #if defined _WIN32 763 | call mkdir_windows('fold') 764 | #elif defined __unix__ 765 | call mkdir_linux('fold') 766 | #endif 767 | \end{codea} 768 | \begin{codeb} 769 | ! FileSystem is found in _tools, it uses SupportSystem 770 | use FileSystem, only: system_mkdir 771 | 772 | call system_mkdir('fold') 773 | ! 774 | \end{codeb} 775 | A possible variation (not as clean):\\ 776 | \begin{codea} 777 | ! C preprocessor 778 | #if defined _WIN32 779 | !do something 780 | #elif defined __unix__ 781 | !do another thing 782 | #endif 783 | \end{codea} 784 | \begin{codeb} 785 | use SupportSystem, only: OSNAME 786 | if (OSNAME(1:7)=='windows') then 787 | !do something 788 | elseif if (OSNAME(1:5)=='linux') then 789 | !do another thing 790 | endif 791 | \end{codeb} 792 | \reason{The if statements will not affect performances since they relies on compile time constants. Compiler optimization should remove dead-code and dead-if statements. This method cannot be used around ``use'' statements or routines declarations.} 793 | 794 | 795 | \subsection{DLLs, cross-language interoperability} 796 | 797 | \label{sec:dlls} 798 | -For C-strings see \autoref{sec:characters} and the file \verb|CStrings.f90|\\ 799 | -For C-types see \autoref{sec:precision}\\ 800 | 801 | 802 | 803 | \topic{Procedure names/alias: bind(C) is really convenient, but not supported by Compaq} 804 | \begin{codea} 805 | subroutine init(array1) 806 | !DEC$ ATTRIBUTES C, ALIAS:'init'::init 807 | \end{codea} 808 | \begin{codeb} 809 | subroutine init(array1) bind(C,name='init') 810 | ! 811 | \end{codeb} 812 | \reason{The code on the left is standard 2003, cross-platform, cross-compiler, preprocessor-independent and just easy to use. The only down side is that the Compaq compiler does not support it. Note: for dllexport it makes it easier if the subroutine name and the bind-name are the same. 813 | NOTE: An array dummy argument of a BIND(C) procedure must be an explicit shape (\cmd{dimension(n), dimension(n,m)}) or assumed size array (\cmd{dimension(*), dimension(lda,*)}). 814 | If it's an assumed size array, the size of the array is not computable and thus the upper bound should always be precised, i.e. \cmd{A(1,:)} should be something like \cmd{A(1,1:n)} } 815 | 816 | 817 | 818 | \topic{Procedure exports for dll: the problem of the def file} 819 | \begin{codea} 820 | subroutine init(array1) bind(c,name='init') 821 | !DEC$ IF .NOT. DEFINED(__LINUX__) 822 | !DEC$ ATTRIBUTES DLLEXPORT ::init 823 | !GCC$ ATTRIBUTES DLLEXPORT ::init 824 | !DEC$ END IF 825 | \end{codea} 826 | \begin{codeb} 827 | subroutine init(array1) bind(C,name='init') 828 | 829 | 830 | 831 | ! Generate the def file yourself 832 | \end{codeb} 833 | \reason{The code above is not compatible with old compilers like Compaq due to the \texttt{bind(C)} directive. The code on the left should work for Intel and GCC but it relies on preprocessor directives. 834 | The code on the right is clean and portable. It requires more work on the windows users since the \texttt{.def} file needs to be written. A dll interface is not expected to change that often, so the work is not that heavy. The python tool \texttt{simple-fortran-parser} can generate the \texttt{.def} automatically based on all the \texttt{bind(C)} subroutines it finds in the code.} 835 | 836 | 837 | 838 | \topic{Procedure exports for dll: a more-or-less portable way} 839 | \begin{codea} 840 | #if defined OLD_COMPILER 841 | subroutine init(array1) 842 | !DEC$ ATTRIBUTES C, ALIAS:'init'::init 843 | #else 844 | subroutine init(array1) bind(c,name='init') 845 | #endif 846 | !DEC$ IF .NOT. DEFINED(__LINUX__) 847 | !DEC$ ATTRIBUTES DLLEXPORT ::init 848 | !GCC$ ATTRIBUTES DLLEXPORT ::init 849 | !DEC$ END IF 850 | \end{codea} 851 | \begin{codeb} 852 | #if defined OLD_COMPILER 853 | subroutine init(array1) 854 | !DEC$ ATTRIBUTES C, ALIAS:'init'::init 855 | #else 856 | subroutine init(array1) bind(c,name='init') 857 | #endif 858 | ! 859 | ! 860 | ! Generate the def file yourself 861 | ! 862 | \end{codeb} 863 | \reason{The above should work with compaq,intel,gcc on windows and linux as long a C preprocessor flag is given to the compilers (i.e. \texttt{-fpp} or \texttt{-cpp}) and as long as the Compaq compiler defines the flag \texttt{-DOLD\_COMPILER}. On linux with gfortran the \texttt{-Wno-attributes} could be use to avoid the warning. } 864 | 865 | 866 | 867 | 868 | 869 | 870 | 871 | 872 | % -------------------------------------------------------------------------------- 873 | % --- 874 | % -------------------------------------------------------------------------------- 875 | \section{Compilers} 876 | Preprocessor directives defined by compilers to identify themselves (see \cmd{_unit_tests/preproc}): 877 | \cmd{__INTEL_COMPILER}, 878 | \cmd{__GFORTRAN__}, 879 | \cmd{_DF_VERSION_} 880 | % Note: \cmd{_DF_VERSION_} is also present with intel compiler..=> Use a user defined \cmd{-DCOMPAQ} directive! 881 | 882 | 883 | \topic{Compaq} 884 | Setup the path:\\ 885 | \cmd{call dfvars.bat} (32 bits)\\ 886 | The script is likely located in:\\ 887 | \cmd{C:\Program Files\Microsoft Visual Studio\Df98\BIN} 888 | 889 | If you see messages like ``cannot find dfort.lib'' then you probably didnt run dfvars.bat.\\ 890 | If you see messages like ``LINK: fatal error .. /ignore:505'' then you probably didnt run dfvars.bat. 891 | 892 | 893 | \topic{Visual studio C compiler} 894 | Setup the path:\\ 895 | \cmd{call vcvarsall.bat x86} (32bit)\\ 896 | \cmd{call vcvarsall.bat amd64} (64 bits)\\ 897 | The script is likely located in:\\ 898 | \cmd{C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC} 899 | 900 | \topic{Intel fortran} 901 | Setup the path:\\ 902 | \cmd{call ifortvars.bat ia32 vs2010} (32 bits) \\ 903 | \cmd{call ifortvars.bat intel64 vs2010} (64 bits) \\ 904 | The script is likely located in:\\ 905 | \cmd{C:\Program Files (x86)\Intel\ComposerXE-2011\bin} 906 | 907 | 908 | % -------------------------------------------------------------------------------- 909 | % --- 910 | % -------------------------------------------------------------------------------- 911 | \section{Support files} 912 | % \topic{Summary} 913 | \subsection{Compiler (example for intel)} 914 | \label{fil:compiler} 915 | \includecode{../_support/SupportCompiler_intel.f90} 916 | 917 | 918 | 919 | \subsection{Precision} 920 | \label{fil:precision} 921 | \includecode{../_support/SupportPrecision.f90} 922 | 923 | 924 | \subsection{Sytem (example for linux)} 925 | \label{fil:system} 926 | \includecode{../_support/SupportSystem_linux.f90} 927 | 928 | 929 | \subsection{C Strings} 930 | \label{fil:cstrings} 931 | \includecode{../_tools/CStrings.f90} 932 | 933 | 934 | \end{document} 935 | -------------------------------------------------------------------------------- /tex/make_version.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | git rev-parse --short HEAD | awk '{print "\\newcommand{\\gitrevision}{"$1"}"}' > tVersion.tex 3 | git rev-parse --abbrev-ref HEAD | awk '{print "\\newcommand{\\gitbranch}{"$1"}"}' >> tVersion.tex 4 | git describe --dirty=-dev | awk '{print "\\newcommand{\\gitversion}{"$1"}"}' >> tVersion.tex 5 | 6 | --------------------------------------------------------------------------------