├── tutorial ├── LOCATION.LOC ├── .gitignore ├── SWANOUT.mat ├── SWANOUT_Dir.png ├── SWANOUT_Hsig.png ├── SWANOUT_TDir.png ├── SWANOUT_RTpeak.png ├── Relative_Capture_Width.txt ├── POWER_ABS.OUT ├── INPUT ├── Power.txt ├── SPECOUT_1D.DAT ├── PRINT └── plot_swan.py ├── .gitattributes ├── .gitignore ├── bin ├── snl-swan-unix-omp-ifort.exe ├── snl-swan-unix-ser-ifort.exe ├── snl-swan-win-omp-ifort-32.exe ├── snl-swan-win-omp-ifort-64.exe ├── snl-swan-win-ser-ifort-32.exe └── snl-swan-win-ser-ifort-64.exe ├── README.md ├── NOTICE ├── src ├── machinefile ├── hcat.nml ├── which.cmd ├── macros.inc ├── m_constants.ftn90 ├── plotunswan.m ├── plotgrid.m ├── Pincident.ftn90 ├── swanrun.bat ├── SwanCompdata.ftn90 ├── SwanSumOverNodes.ftn90 ├── SwanMaxOverNodes.ftn90 ├── SwanMinOverNodes.ftn90 ├── INSTALL.README ├── SwanReadGrid.ftn90 ├── Bivariate_1.ftn90 ├── SWANRUN.README ├── SwanGridTopology.ftn90 ├── switch.pl ├── SwanPrepComp.ftn90 ├── SwanGridVert.ftn90 ├── SwanGriddata.ftn90 ├── SwanCrossObstacle.ftn90 ├── SwanDispParm.ftn90 ├── SwanPropvelX.ftn90 ├── swanrun ├── SwanPointinMesh.ftn90 ├── SwanInitCompGrid.ftn90 ├── SwanFindObstacles.ftn90 ├── SwanReadEasymeshGrid.ftn90 ├── SwanThreadBounds.ftn90 ├── SwanReadfort18.ftn90 ├── SwanPrintGridInfo.ftn90 ├── SwanFindPoint.ftn90 ├── SwanReadTriangleGrid.ftn90 ├── SwanCheckGrid.ftn90 ├── SwanCreateEdges.ftn90 ├── SwanVertlist.ftn90 ├── SwanTranspX.ftn90 ├── SwanReadADCGrid.ftn90 ├── SwanBndStruc.ftn90 ├── Makefile ├── SwanPunCollect.ftn90 └── SwanTranspAc.ftn90 └── INSTALL.README /tutorial/LOCATION.LOC: -------------------------------------------------------------------------------- 1 | 375 425 2 | 410 425 3 | 425 425 -------------------------------------------------------------------------------- /tutorial/.gitignore: -------------------------------------------------------------------------------- 1 | *.tws 2 | *.pptx 3 | Errfile 4 | swanmain.ftn 5 | units.py 6 | norm_end 7 | -------------------------------------------------------------------------------- /tutorial/SWANOUT.mat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/tutorial/SWANOUT.mat -------------------------------------------------------------------------------- /tutorial/SWANOUT_Dir.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/tutorial/SWANOUT_Dir.png -------------------------------------------------------------------------------- /tutorial/SWANOUT_Hsig.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/tutorial/SWANOUT_Hsig.png -------------------------------------------------------------------------------- /tutorial/SWANOUT_TDir.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/tutorial/SWANOUT_TDir.png -------------------------------------------------------------------------------- /tutorial/SWANOUT_RTpeak.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/tutorial/SWANOUT_RTpeak.png -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | $ cat .gitattributes 2 | *.* linguist-language=fortran 3 | *.h5 filter=lfs diff=lfs merge=lfs -text 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.tws 2 | *.mod 3 | *.f 4 | *.for 5 | *.f90 6 | *.obj 7 | *.o 8 | *~ 9 | norm_end 10 | swaninit -------------------------------------------------------------------------------- /bin/snl-swan-unix-omp-ifort.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/bin/snl-swan-unix-omp-ifort.exe -------------------------------------------------------------------------------- /bin/snl-swan-unix-ser-ifort.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/bin/snl-swan-unix-ser-ifort.exe -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Please visit the [SNL-SWAN website](http://sandialabs.github.io/SNL-SWAN/index.html#) for more information. 2 | -------------------------------------------------------------------------------- /bin/snl-swan-win-omp-ifort-32.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/bin/snl-swan-win-omp-ifort-32.exe -------------------------------------------------------------------------------- /bin/snl-swan-win-omp-ifort-64.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/bin/snl-swan-win-omp-ifort-64.exe -------------------------------------------------------------------------------- /bin/snl-swan-win-ser-ifort-32.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/bin/snl-swan-win-ser-ifort-32.exe -------------------------------------------------------------------------------- /bin/snl-swan-win-ser-ifort-64.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sandialabs/SNL-SWAN/HEAD/bin/snl-swan-win-ser-ifort-64.exe -------------------------------------------------------------------------------- /tutorial/Relative_Capture_Width.txt: -------------------------------------------------------------------------------- 1 | 3 0.05 2 | 4 0.13 3 | 5 0.22 4 | 6 0.41 5 | 7 0.53 6 | 8 0.70 7 | 9 0.86 8 | 10 0.90 9 | 11 0.97 10 | 12 0.84 11 | 13 0.77 12 | 14 0.53 13 | 15 0.38 14 | 16 0.32 15 | 17 0.30 -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | SNL-SWAN (Sandia National Laboratories - Simulating WAves Nearshore) 2 | Copyright 2014 Sandia Corporation 3 | 4 | Principal Developers: 5 | Chris Chartrand (Sandia National Laboratories) 6 | Ari J Posner (DOE EERE) 7 | 8 | Contributors: 9 | Kelley Ruehl (Sandia National Laboratories) 10 | 11 | -------------------------------------------------------------------------------- /src/machinefile: -------------------------------------------------------------------------------- 1 | # This file lists the names of the node that together form the 2 | # parallel computer to be used. 3 | # Put one node per line in the file. You can specify a number 4 | # after the node name to indicate how many processes to launch 5 | # on the node. 6 | # The run procedure will cycle through this list until all the 7 | # requested processes are launched. 8 | -------------------------------------------------------------------------------- /src/hcat.nml: -------------------------------------------------------------------------------- 1 | &arg_nml !namelist identifier 2 | basefile = "hotfile_example", !(required) base file name (w/o mpi node tag) 3 | free = .true. !(optional) free format (default .true.) 4 | halo = 3, !(optional) halo size (default is 3) 5 | verbose = .false., !(optional) verbose screen ouput (default .false.) 6 | stomp = .false. !(optional) overwrite basefile (default .false.) 7 | / !end-of-namelist marker 8 | -------------------------------------------------------------------------------- /tutorial/POWER_ABS.OUT: -------------------------------------------------------------------------------- 1 | Iteration: 1 2 | Power absorbed by obstacle 1 = 2.24170594E+05 W 3 | Power absorbed by obstacle 2 = 2.24581875E+05 W 4 | Iteration: 2 5 | Power absorbed by obstacle 1 = 2.24169219E+05 W 6 | Power absorbed by obstacle 2 = 2.24580406E+05 W 7 | Iteration: 3 8 | Power absorbed by obstacle 1 = 2.24169219E+05 W 9 | Power absorbed by obstacle 2 = 2.24580406E+05 W 10 | Iteration: 4 11 | Power absorbed by obstacle 1 = 2.24169219E+05 W 12 | Power absorbed by obstacle 2 = 2.24580406E+05 W 13 | -------------------------------------------------------------------------------- /src/which.cmd: -------------------------------------------------------------------------------- 1 | @echo off 2 | rem found on http://superuser.com/questions/21067/windows-equivalent-of-whereis 3 | 4 | @echo off 5 | @set PATH=.;%PATH% 6 | 7 | @rem 8 | @rem about: something similar like the unix-alike-which, but with 9 | @rem within pure cmd 10 | @rem 11 | 12 | if "%1" == "" ( 13 | @echo Usage: 14 | @echo. 15 | @echo which 'cmd' 16 | @echo. 17 | @echo.if 'cmd' is not found, ERRORLEVEL is set to 1 18 | @echo. 19 | ) else ( 20 | ( @for %%f in (%1 %1.exe %1.cmd %1.bat %1.pif) do if not "%%~$PATH:f" == "" ( @echo %%~$PATH:f ) else @set ERRORLEVEL=1) 21 | ) 22 | -------------------------------------------------------------------------------- /src/macros.inc: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # IA32_Intel/EM64T_Intel: Intel Pentium with MS Windows using Intel compiler 17. 3 | ############################################################################## 4 | F90_SER = ifort 5 | F90_OMP = ifort 6 | F90_MPI = ifort 7 | FLAGS_OPT = /O2 8 | FLAGS_MSC = /assume:byterecl /traceback /nowarn /nologo /Qdiag-disable:8290 /Qdiag-disable:8291 /Qdiag-disable:8293 9 | FLAGS90_MSC = $(FLAGS_MSC) 10 | FLAGS_DYN = 11 | FLAGS_SER = 12 | FLAGS_OMP = /Qopenmp 13 | FLAGS_MPI = 14 | INCS_SER = 15 | INCS_OMP = 16 | INCS_MPI = /include:"C:\PROGRA~1\MPICH2\include" 17 | LIBS_SER = 18 | LIBS_OMP = 19 | LIBS_MPI = C:\PROGRA~1\MPICH2\lib\fmpich2.lib 20 | O_DIR = 21 | OUT = /exe: 22 | EXTO = obj 23 | MAKE = nmake 24 | RM = del 25 | swch = -dos -impi -cvis 26 | -------------------------------------------------------------------------------- /INSTALL.README: -------------------------------------------------------------------------------- 1 | Instructions for quick installation of SWAN 2 | ------------------------------------------- 3 | 4 | 1) Ensure that the Perl package is available on your computer. 5 | In most cases, it is available for Linux and a Unix operating 6 | system. Check it by typing 'perl -v'. Otherwise, you may 7 | download a free distribution for Linux, Solaris and Windows 8 | called ActivePerl (www.activestate.com/activeperl/downloads). 9 | The Perl version should be at least 5.0.0 or higher! 10 | 11 | 2) From the 'src' directory, type 'perl platform.pl' to set up macros.ini file 12 | On Linux: 13 | Type 'make ser' for serial compilation. 14 | Type 'make omp' for an openMP compilation 15 | On Windows: 16 | Enter the VS compiler environment 17 | Type 'nmake ser' for serial compilation. 18 | Type 'nmake omp' for an openMP compilation 19 | -------------------------------------------------------------------------------- /tutorial/INPUT: -------------------------------------------------------------------------------- 1 | PROJECT 'SNLSWAN TUTORIAL' 'TEST' 2 | 3 | $***********MODEL INPUT********************************* 4 | SET CARTESIAN 5 | SET inrhog = 1 6 | SET obcase = 0 7 | MODE STAT TWOD 8 | COORD CARTESIAN 9 | 10 | CGRID REG 0.0 0.0 0.0 1000 1000 100 100 CIRCLE 180 .05 .5 25 11 | INPGRID BOTTOM REG 0.0 0.0 0.0 100 100 10 10 12 | READINP BOTTOM 1.0000 'Bathymetry.bot' 3 0 FREE 13 | 14 | BOUND SHAPESPEC JONSWAP 1 PEAK DSPR POWER 15 | BOUNDSPEC SIDE N CON PAR 1 10 0 20 16 | BOUNDSPEC SIDE W CON PAR 1 10 0 20 17 | BOUNDSPEC SIDE S CON PAR 1 10 0 20 18 | 19 | BREAKING 20 | FRICTION 21 | OFF QUADRUPL 22 | OBSTACLE TRANS 0.3 REFL 0.00 LINE 400 400 400 450 23 | OBSTACLE TRANS 0.3 REFL 0.00 LINE 450 500 450 550 24 | 25 | $************ OUTPUT REQUESTS ************************* 26 | TABLE 'COMPGRID' HEAD 'SWANOUT.DAT' XP YP HSIGN DIR RTP TDIR 27 | BLOCK 'COMPGRID' NOHEAD 'SWANOUT.mat' LAY 3 HSIGN DIR RTP TDIR 28 | 29 | POINTS 'TEST' FILE 'LOCATION.LOC' 30 | SPEC 'TEST' SPEC1D 'SPECOUT_1D.DAT' 31 | SPEC 'TEST' SPEC2D 'SPECOUT.DAT' 32 | 33 | COMPUTE 34 | STOP 35 | -------------------------------------------------------------------------------- /src/m_constants.ftn90: -------------------------------------------------------------------------------- 1 | !------------------------------------------------------------------------------ 2 | module m_constants 3 | !------------------------------------------------------------------------------ 4 | ! 5 | ! physical constants 6 | ! 7 | real sqrtg ! square root of grav 8 | real gsq ! square of grav 9 | real nu ! kinematic viscosity of water 10 | ! 11 | real d_water ! density of water 12 | real d_air ! density of air 13 | ! 14 | real trshdep ! treshold depth (=DEPMIN as given by SWAN) 15 | ! 16 | ! mathematical constants 17 | ! 18 | real pih ! pi/2 19 | real dera ! conversion from degrees to radians 20 | real rade ! conversion from radians to degrees 21 | real expmin ! min argument for exp. function to avoid underflow 22 | real expmax ! max argument for exp. function to avoid overflow 23 | real sqrt2 ! square root of 2 ~ 1.41 24 | ! 25 | contains 26 | ! 27 | !------------------------------------------------------------------------------ 28 | subroutine init_constants 29 | !------------------------------------------------------------------------------ 30 | ! 31 | use SWCOMM3 32 | ! 33 | pih = 0.5*PI 34 | dera = PI/180. 35 | rade = 180./PI 36 | ! 37 | expmin = -20. 38 | expmax = 20. 39 | ! 40 | ! physical constants 41 | ! 42 | sqrtg = sqrt(GRAV) 43 | gsq = GRAV*GRAV 44 | nu = 1.e-6 45 | d_air = PWIND(16) 46 | d_water = PWIND(17) 47 | ! 48 | trshdep = DEPMIN 49 | ! 50 | end subroutine 51 | ! 52 | end module 53 | -------------------------------------------------------------------------------- /src/plotunswan.m: -------------------------------------------------------------------------------- 1 | function plotunswan(matfile,basename,wavepar); 2 | % Plots a wave parameter on unstructured grid 3 | % 4 | % Example: 5 | % 6 | % SWAN generated a binary Matlab file called 'f32har01.mat' 7 | % TRIANGLE generated files with basename 'f32hari', e.g. 'f32hari.ele' 8 | % To make a plot of the significant wave height, give the following 9 | % command in Matlab: 10 | % 11 | % plotunswan('f32har01','f32hari','Hsig') 12 | % 13 | % For other wave parameters, type the following command: 14 | % 15 | % who -file f32har01 16 | % 17 | % 18 | % Author : Marcel Zijlema 19 | % Date : February 13, 2008 20 | % Version : 1.0 21 | 22 | if nargin~=3 23 | error('Wrong number of arguments. See "help plotunswan"') 24 | end 25 | 26 | eval(['load ' matfile]); % load binary file containing SWAN results 27 | % obtained using BLOCK command with COMPGRID-set 28 | elefile=[basename '.ele']; 29 | fid = fopen(elefile); % load TRIANGLE element based connectivity file 30 | [nelem] = fscanf(fid,'%i',[1 3]); % get number of triangles 31 | ncol = 4+nelem(3); % specify number of columns in elefile 32 | tri = fscanf(fid,'%i',[ncol nelem(1)])'; % get connectivity table 33 | z=eval([wavepar]); % get wave parameter 34 | trisurf(tri(:,2:4),Xp,Yp,z) % make plot using trisurf 35 | view(0,90);shading interp; % make 2D view and smooth plot 36 | colormap(jet);colorbar;axis equal % include colorbar and equal axes 37 | -------------------------------------------------------------------------------- /src/plotgrid.m: -------------------------------------------------------------------------------- 1 | function plotgrid(basename); 2 | % Plots unstructured grid generated by TRIANGLE 3 | % 4 | % Example: 5 | % 6 | % TRIANGLE generated files with basename 'f32hari', e.g. 'f32hari.node' and 'f32hari.ele' 7 | % To make a plot of the unstructured grid, give the following command in Matlab: 8 | % 9 | % plotgrid('f32hari') 10 | % 11 | % 12 | % Author : Marcel Zijlema 13 | % Date : February 13, 2008 14 | % Version : 1.0 15 | 16 | if nargin~=1 17 | error('Wrong number of arguments. See "help plotgrid"') 18 | end 19 | 20 | nodefile=[basename '.node']; 21 | elefile=[basename '.ele']; 22 | fid = fopen(nodefile); % load TRIANGLE vertex based connectivity file 23 | [nnode] = fscanf(fid,'%i',[1 4]); % get number of nodes 24 | ncol = 3+nnode(3)+nnode(4); % specify number of columns in nodefile 25 | data = fscanf(fid,'%f',[ncol nnode(1)])'; % get data 26 | x=data(:,2); y=data(:,3); % get coordinates 27 | fid = fopen(elefile); % load TRIANGLE element based connectivity file 28 | [nelem] = fscanf(fid,'%i',[1 3]); % get number of triangles 29 | ncol = 4+nelem(3); % specify number of columns in elefile 30 | tri = fscanf(fid,'%i',[ncol nelem(1)])'; % get connectivity table 31 | trimesh(tri(:,2:4),x,y, zeros(size(x)), ... % make grid using trimesh 32 | 'EdgeColor', 'k', ... 33 | 'FaceColor', 'none', ... 34 | 'LineWidth', 0.5) 35 | view(2) % make 2D view 36 | axis equal % equal axes 37 | -------------------------------------------------------------------------------- /src/Pincident.ftn90: -------------------------------------------------------------------------------- 1 | real function Pincident ( spcsig, theta, cg, acloc ) 2 | ! use ocpcomm4 3 | use swcomm1 4 | use swcomm3 5 | ! 6 | implicit none 7 | ! 8 | ! Argument variables 9 | ! 10 | ! 11 | real, dimension(MDC,MSC), intent(in) :: acloc ! action density at one location 12 | real, dimension(MSC), intent(in) :: spcsig ! relative frequency bins 13 | real, dimension(MDC), intent(in) :: theta ! spectral directions 14 | real, dimension(MSC), intent(in) :: cg ! group velocity 15 | ! 16 | ! Local variables 17 | ! 18 | integer :: id ! loop counter over direction bins 19 | integer :: isigm ! loop counter over frequency bins 20 | ! 21 | real :: dsig ! width of frequency bin 22 | real :: cs, cge 23 | 24 | ! total power transport 25 | CGE = 0.0 26 | DO ISIGM = 1, MSC 27 | IF (ISIGM.EQ.1) THEN 28 | DSIG = 0.5 * (SPCSIG(2) - SPCSIG(1)) 29 | ELSE IF (ISIGM.EQ.MSC) THEN 30 | DSIG = 0.5 * (SPCSIG(MSC) - SPCSIG(MSC-1)) 31 | ELSE 32 | DSIG = 0.5 * (SPCSIG(ISIGM+1) - SPCSIG(ISIGM-1)) 33 | ENDIF 34 | 35 | ! groupvel * sigma * ds 36 | CS = CG(ISIGM)*SPCSIG(ISIGM)*DSIG 37 | 38 | DO ID=1,MDC 39 | ! groupvel * sigma * ds * action density 40 | CGE = CGE + CS * ACLOC(ID,ISIGM) 41 | ! = energy * groupvel * ds 42 | ENDDO 43 | ENDDO 44 | ! = rho * grav * energy * groupvel * ds * dtheta 45 | Pincident = CGE * RHO * GRAV * DDIR 46 | 47 | 48 | end function Pincident 49 | -------------------------------------------------------------------------------- /tutorial/Power.txt: -------------------------------------------------------------------------------- 1 | 50 2 | 15 3 | 0.5 4 | 1 5 | 1.5 6 | 2 7 | 2.5 8 | 3 9 | 3.5 10 | 4 11 | 4.5 12 | 5 13 | 5.5 14 | 6 15 | 6.5 16 | 7 17 | 7.5 18 | 15 19 | 3 20 | 4 21 | 5 22 | 6 23 | 7 24 | 8 25 | 9 26 | 10 27 | 11 28 | 12 29 | 13 30 | 14 31 | 15 32 | 16 33 | 17 34 | 4.44 5.07 7.97 12.15 16.77 17.14 11.94 9.16 6.57 4.39 4.00 3.00 2.86 1.95 1.71 35 | 16.65 19.00 29.48 46.94 56.61 52.38 37.14 28.73 19.84 16.62 12.94 9.33 7.29 7.40 4.49 36 | 0.00 41.54 63.14 92.37 110.74 109.49 64.96 55.91 38.49 29.09 22.06 19.26 12.74 11.21 11.50 37 | 0.00 66.29 99.03 150.67 200.97 164.91 105.27 85.30 58.63 52.31 40.56 28.76 24.22 19.31 17.57 38 | 0.00 0.00 160.23 241.82 261.83 226.36 166.20 117.65 83.09 69.87 57.47 39.24 28.51 26.20 23.73 39 | 0.00 0.00 212.52 319.26 372.09 327.17 210.96 151.98 116.43 93.66 75.42 66.09 44.81 42.09 30.83 40 | 0.00 0.00 270.15 436.02 503.15 407.75 292.71 203.22 148.33 115.49 92.63 74.81 57.97 44.27 41.16 41 | 0.00 0.00 0.00 553.82 540.26 521.33 355.46 260.73 191.66 144.19 122.78 84.04 81.01 55.80 53.24 42 | 0.00 0.00 0.00 645.46 746.22 586.83 378.72 302.18 236.42 189.64 154.41 105.88 89.58 74.26 55.78 43 | 0.00 0.00 0.00 796.15 926.13 694.67 485.91 341.08 287.07 211.41 167.83 135.72 111.21 93.81 77.53 44 | 0.00 0.00 0.00 939.38 954.73 807.95 603.12 429.61 343.03 231.19 201.49 150.14 120.29 96.75 89.90 45 | 0.00 0.00 0.00 0.00 1161.42 956.67 642.03 480.81 329.09 289.47 212.26 171.77 145.82 110.89 100.85 46 | 0.00 0.00 0.00 0.00 1476.47 1039.27 702.04 487.62 396.60 311.56 236.66 203.88 153.43 120.26 102.25 47 | 0.00 0.00 0.00 0.00 1664.93 1197.05 820.77 612.40 465.98 384.59 251.62 222.70 180.55 146.28 131.44 48 | 0.00 0.00 0.00 0.00 1608.45 1407.61 922.63 703.98 508.65 373.47 325.45 229.49 190.53 151.78 149.26 49 | -------------------------------------------------------------------------------- /src/swanrun.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | rem 3 | rem swanrun.bat 4 | rem 5 | rem Run the SWAN program by means of the SWAN input file 6 | rem Note: it is assumed that the extension of the input file is '.swn' 7 | rem 8 | rem Usage: swanrun inputfile [nprocs] 9 | rem 10 | 11 | set nprocs=1 12 | 13 | if not "%1"=="" goto OK1 14 | echo. 15 | echo Usage: swanrun inputfile [nprocs] 16 | goto END 17 | :OK1 18 | 19 | set inputfile=%1 20 | shift 21 | 22 | if exist %inputfile%.swn goto OK2 23 | echo. 24 | echo Error: file %inputfile%.swn does not exist 25 | goto END 26 | :OK2 27 | 28 | if "%1"=="" goto OK3 29 | set nprocs=%1 30 | :OK3 31 | 32 | copy %inputfile%.swn INPUT >> nul 33 | 34 | if not %nprocs%==1 goto PARALLEL1 35 | swan.exe 36 | goto OK4 37 | 38 | :PARALLEL1 39 | mpiexec -n %nprocs% swan.exe 40 | 41 | :OK4 42 | if errorlevel 1 goto END 43 | 44 | if not %nprocs%==1 goto PARALLEL2 45 | if exist PRINT copy PRINT %inputfile%.prt >> nul 46 | if exist PRINT del PRINT 47 | goto OK5 48 | :PARALLEL2 49 | if not exist PRINT-001 goto OK5 50 | if %nprocs% GTR 9 goto RANGE1 51 | for /L %%i in (1,1,%nprocs%) do copy PRINT-00%%i %inputfile%.prt-00%%i >> nul 52 | for /L %%i in (1,1,%nprocs%) do del PRINT-00%%i 53 | goto OK5 54 | :RANGE1 55 | if %nprocs% GTR 99 goto RANGE2 56 | for /L %%i in (1,1,9) do copy PRINT-00%%i %inputfile%.prt-00%%i >> nul 57 | for /L %%i in (1,1,9) do del PRINT-00%%i 58 | for /L %%i in (10,1,%nprocs%) do copy PRINT-0%%i %inputfile%.prt-0%%i >> nul 59 | for /L %%i in (10,1,%nprocs%) do del PRINT-0%%i 60 | goto OK5 61 | :RANGE2 62 | if %nprocs% GTR 999 goto ERR 63 | for /L %%i in (1,1,9) do copy PRINT-00%%i %inputfile%.prt-00%%i >> nul 64 | for /L %%i in (1,1,9) do del PRINT-00%%i 65 | for /L %%i in (10,1,99) do copy PRINT-0%%i %inputfile%.prt-0%%i >> nul 66 | for /L %%i in (10,1,99) do del PRINT-0%%i 67 | for /L %%i in (100,1,%nprocs%) do copy PRINT-%%i %inputfile%.prt-%%i >> nul 68 | for /L %%i in (100,1,%nprocs%) do del PRINT-%%i 69 | goto OK5 70 | :ERR 71 | echo Error: too many processes 72 | goto END 73 | :OK5 74 | 75 | if exist Errfile copy Errfile %inputfile%.erf >> nul 76 | if exist Errfile del Errfile 77 | if exist ERRPTS copy ERRPTS %inputfile%.erp >> nul 78 | if exist ERRPTS del ERRPTS 79 | del INPUT 80 | if not exist norm_end goto END 81 | type norm_end 82 | 83 | :END 84 | 85 | set inputfile= 86 | set nprocs= 87 | -------------------------------------------------------------------------------- /src/SwanCompdata.ftn90: -------------------------------------------------------------------------------- 1 | module SwanCompdata 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 40.92: Marcel Zijlema 36 | ! 37 | ! Updates 38 | ! 39 | ! 40.80, July 2007: New Module 40 | ! 40.92, June 2008: changes with respect to boundary polygons 41 | ! 42 | ! Purpose 43 | ! 44 | ! Module containing data for computation with unstructured grid 45 | ! 46 | ! Method 47 | ! 48 | ! Data based on unstructured grid 49 | ! 50 | ! Modules used 51 | ! 52 | use swcomm3 53 | ! 54 | implicit none 55 | ! 56 | ! Module parameters 57 | ! 58 | ! 59 | ! Module variables 60 | ! 61 | integer :: nbpol ! total number of boundary polygons 62 | integer, dimension(10000) :: nbpt ! number of boundary vertices for each boundary polygon 63 | ! 64 | integer, dimension(MICMAX) :: vs ! computational stencil, i.e. set of vertices 65 | ! needed for the computation of a new value 66 | ! in the present vertex 67 | !$omp threadprivate(vs) 68 | ! 69 | integer, dimension(:,:), save, allocatable :: blist ! list of boundary vertices in ascending order for each boundary polygon 70 | integer, dimension(:) , save, allocatable :: vlist ! vertex list 71 | ! 72 | ! Source text 73 | ! 74 | end module SwanCompdata 75 | -------------------------------------------------------------------------------- /src/SwanSumOverNodes.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanSumOverNodes ( rval ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.95: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.95, July 2008: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Performs a global sum of reals over all nodes 43 | ! 44 | ! Modules used 45 | ! 46 | use ocpcomm4 47 | !PUN use SIZES, only: MNPROC 48 | !PUN use GLOBAL, only: COMM 49 | !PUN use MESSENGER, only: IERR 50 | !PUN use mpi 51 | ! 52 | implicit none 53 | ! 54 | ! Argument variables 55 | ! 56 | real, intent(inout) :: rval ! input value 57 | ! 58 | ! Local variables 59 | ! 60 | integer :: count ! length of array to be collect 61 | integer, save :: ient = 0 ! number of entries in this subroutine 62 | real :: sumval ! sum total of all input values from all subdomains 63 | ! 64 | ! Structure 65 | ! 66 | ! Description of the pseudo code 67 | ! 68 | ! Source text 69 | ! 70 | if (ltrace) call strace (ient,'SwanSumOverNodes') 71 | ! 72 | ! if not parallel, return 73 | ! 74 | !PUN if ( MNPROC==1 ) return 75 | ! 76 | !TIMG call SWTSTA(202) 77 | sumval = 0. 78 | count = 1 79 | !PUN call MPI_ALLREDUCE ( rval, sumval, count, MPI_REAL4, MPI_SUM, COMM, IERR ) 80 | ! 81 | rval = sumval 82 | !TIMG call SWTSTO(202) 83 | ! 84 | end subroutine SwanSumOverNodes 85 | -------------------------------------------------------------------------------- /src/SwanMaxOverNodes.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanMaxOverNodes ( rval ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.95: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.95, July 2008: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Performs a global maximum of reals over all nodes 43 | ! 44 | ! Modules used 45 | ! 46 | use ocpcomm4 47 | !PUN use SIZES, only: MNPROC 48 | !PUN use GLOBAL, only: COMM 49 | !PUN use MESSENGER, only: IERR 50 | !PUN use mpi 51 | ! 52 | implicit none 53 | ! 54 | ! Argument variables 55 | ! 56 | real, intent(inout) :: rval ! input value 57 | ! 58 | ! Local variables 59 | ! 60 | integer :: count ! length of array to be collect 61 | integer, save :: ient = 0 ! number of entries in this subroutine 62 | real :: maxval ! maximum of all input values from all subdomains 63 | ! 64 | ! Structure 65 | ! 66 | ! Description of the pseudo code 67 | ! 68 | ! Source text 69 | ! 70 | if (ltrace) call strace (ient,'SwanMaxOverNodes') 71 | ! 72 | ! if not parallel, return 73 | ! 74 | !PUN if ( MNPROC==1 ) return 75 | ! 76 | !TIMG call SWTSTA(202) 77 | maxval = 0. 78 | count = 1 79 | !PUN call MPI_ALLREDUCE ( rval, maxval, count, MPI_REAL4, MPI_MAX, COMM, IERR ) 80 | ! 81 | rval = maxval 82 | !TIMG call SWTSTO(202) 83 | ! 84 | end subroutine SwanMaxOverNodes 85 | -------------------------------------------------------------------------------- /src/SwanMinOverNodes.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanMinOverNodes ( rval ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.95: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.95, July 2008: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Performs a global minimum of reals over all nodes 43 | ! 44 | ! Modules used 45 | ! 46 | use ocpcomm4 47 | !PUN use SIZES, only: MNPROC 48 | !PUN use GLOBAL, only: COMM 49 | !PUN use MESSENGER, only: IERR 50 | !PUN use mpi 51 | ! 52 | implicit none 53 | ! 54 | ! Argument variables 55 | ! 56 | real, intent(inout) :: rval ! input value 57 | ! 58 | ! Local variables 59 | ! 60 | integer :: count ! length of array to be collect 61 | integer, save :: ient = 0 ! number of entries in this subroutine 62 | real :: minval ! minimum of all input values from all subdomains 63 | ! 64 | ! Structure 65 | ! 66 | ! Description of the pseudo code 67 | ! 68 | ! Source text 69 | ! 70 | if (ltrace) call strace (ient,'SwanMinOverNodes') 71 | ! 72 | ! if not parallel, return 73 | ! 74 | !PUN if ( MNPROC==1 ) return 75 | ! 76 | !TIMG call SWTSTA(202) 77 | minval = 0. 78 | count = 1 79 | !PUN call MPI_ALLREDUCE ( rval, minval, count, MPI_REAL4, MPI_MIN, COMM, IERR ) 80 | ! 81 | rval = minval 82 | !TIMG call SWTSTO(202) 83 | ! 84 | end subroutine SwanMinOverNodes 85 | -------------------------------------------------------------------------------- /src/INSTALL.README: -------------------------------------------------------------------------------- 1 | Instructions for fast installation of SWAN 2 | ------------------------------------------ 3 | 4 | Full automatic installation of SWAN can be done by means of 5 | the make and perl utilities. Please carry out the following 6 | tasks: 7 | 8 | 1) Ensure that the Perl package is available on your computer. 9 | In most cases, it is available for Linux and a Unix operating 10 | system. Check it by typing 'perl -v'. Otherwise, you may 11 | download a free distribution for Linux, Solaris and Windows 12 | called ActivePerl (www.activestate.com/activeperl/downloads). 13 | The Perl version should be at least 5.0.0 or higher! 14 | 15 | 2) Type 'make config' or 'nmake config' (in case of MS Windows) 16 | to create configuration file. This file (macros.inc) contains 17 | machine-dependent macros to be needed by the Makefile. 18 | 19 | The following platforms and compilers are supported: 20 | 21 | platform OS compiler 22 | ----------------------------------------------------------- 23 | SGI Origin 3000 (Silicon Graphics) IRIX SGI 24 | IBM SP AIX IBM 25 | Compaq True 64 Alpha (DEC ALFA) OSF1 Compaq 26 | Sun SPARC Solaris Sun 27 | PA-RISC (HP 9000 series 700/800) HP-UX v11 HP 28 | IBM Power6 (pSeries 575) Linux IBM 29 | Intel Pentium (32-bit) PC Linux GNU (g95) 30 | Intel Pentium (32-bit) PC Linux GNU (gfortran) 31 | Intel Pentium (32-bit) PC Linux Intel 32 | Intel Pentium (64-bit) PC Linux Intel 33 | Intel Itanium (64-bit) PC Linux Intel 34 | Intel Pentium (64-bit) PC Linux Portland Group 35 | Intel Pentium (32-bit) PC Linux Lahey 36 | Intel Pentium (32-bit) PC MS Windows Intel 37 | Intel Pentium (64-bit) PC MS Windows Intel 38 | Intel Pentium (32-bit) PC MS Windows Compaq Visual 39 | Power Mac G4 Mac OS X IBM 40 | MacBook macOS gfortran 41 | MacBook macOS Intel 42 | 43 | 3) Compilation of the SWAN source code for sequential runs can 44 | be done by typing 'make ser' or 'nmake ser' (in case of 45 | MS Windows). For parallel runs, however, the user may 46 | choose between linking the MPI libraries for distributed 47 | memory machines and using OpenMP directives for shared memory 48 | systems for appropriate compilation by typing, respectively, 49 | 'make mpi' and 'make omp'. However, for parallel, unstructured 50 | mesh simulation on a distributed memory system, type 'make punswan'. 51 | NOTE: One of these commands must be preceded once by 'make config'. 52 | 53 | 4) For more information, please consult the Implementation Manual. 54 | -------------------------------------------------------------------------------- /src/SwanReadGrid.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanReadGrid ( basenm, lenfnm ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Reads unstructured grid generated by a grid generator 43 | ! 44 | ! Method 45 | ! 46 | ! Reads data from either ADCIRC, Triangle or Easymesh 47 | ! 48 | ! Modules used 49 | ! 50 | use ocpcomm4 51 | use SwanGriddata 52 | ! 53 | implicit none 54 | ! 55 | ! Argument variables 56 | ! 57 | integer, intent(in) :: lenfnm ! length of file names 58 | character(lenfnm), intent(in) :: basenm ! base name of unstructured grid files 59 | ! 60 | ! Local variables 61 | ! 62 | integer, save :: ient = 0 ! number of entries in this subroutine 63 | ! 64 | ! Structure 65 | ! 66 | ! Description of the pseudo code 67 | ! 68 | ! Source text 69 | ! 70 | if (ltrace) call strace (ient,'SwanReadGrid') 71 | ! 72 | if ( grid_generator == meth_adcirc ) then 73 | ! 74 | ! grid is given in ADCIRC grid file (fort.14) 75 | ! 76 | call SwanReadADCGrid 77 | ! 78 | elseif ( grid_generator == meth_triangle ) then 79 | ! 80 | ! grid is generated by Triangle 81 | ! 82 | call SwanReadTriangleGrid ( basenm, lenfnm ) 83 | ! 84 | elseif ( grid_generator == meth_easy ) then 85 | ! 86 | ! grid is generated by Easymesh 87 | ! 88 | call SwanReadEasymeshGrid ( basenm, lenfnm ) 89 | ! 90 | else 91 | ! 92 | call msgerr ( 4, 'Unknown grid generator' ) 93 | return 94 | ! 95 | endif 96 | ! 97 | end subroutine SwanReadGrid 98 | -------------------------------------------------------------------------------- /src/Bivariate_1.ftn90: -------------------------------------------------------------------------------- 1 | SUBROUTINE polin2(x1a,x2a,ya,ni,nj,x1,x2,y,dy) 2 | IMPLICIT NONE 3 | INTEGER ni,nj 4 | REAL dy,x1,x2,y,x1a(ni),x2a(nj),ya(ni,nj) 5 | REAL yitmp(ni),yjtmp(nj) 6 | 7 | ! C USES polint 8 | ! Given arrays x1a(1:ni) and x2a(1:nj) of independent variables, and an ni by nj array of 9 | ! function values ya(1:ni,1:nj), tabulated at the grid points defined by x1a and x2a; and 10 | ! given values x1 and x2 of the independent variables; this routine returns an interpolated 11 | ! function value y, and an accuracy indication dy (based only on the interpolation in the x1 12 | ! direction, however). 13 | 14 | INTEGER i,j 15 | 16 | if ( x1 < x1a(1) .or. x1 >x1a(ni) .or. & 17 | x2 < x2a(1) .or. x2 >x2a(nj) ) then 18 | y=0.0 19 | dy=0.0 20 | !write(*,*) 'warning interpolation value out of range' 21 | return 22 | endif 23 | 24 | do i=1,ni 25 | yjtmp(1:nj)=ya(i,1:nj) 26 | 27 | do j=1,nj-1 28 | if( x2>=x2a(j) .AND. x2=x1a(i) .AND. x1xa(n).or.x swanout &] 56 | 57 | where SWAN-inputfile is the name of your inputfile 58 | without extension (it is assumed that the extension 59 | is '.swn') and n is the number of processors. 60 | The parameter '-omp n' specifies a parallel run on n 61 | threads using OpenMP. The parameter '-mpi n' specifies 62 | a parallel run on n cores using MPI. The parameter 63 | '-input' is obliged, whereas the parameters '-omp n' or 64 | '-mpi n' can be omitted (default: n=1). 65 | 66 | This script is also suited when no MPI is available 67 | (of course, n must be 1). 68 | 69 | You may redirect the output of swanrun to the file 70 | swanout (in this case). It is also possible to run 71 | your model in the background as indicated by the 72 | ampersand. 73 | 74 | *) For a parallel MPI run, you may also need a machinefile 75 | that contains the names of the nodes in your parallel 76 | environment. Put one node per line in the file. You 77 | can specify a number followed by a colon after the node 78 | name to indicate how many processes to launch on the 79 | node. This is useful e.g., for multi-core processors. 80 | The run procedure will cycle through this list until 81 | all the requested processes are launched. Example file: 82 | 83 | node1 84 | node2:2 85 | node4 86 | node7:4 87 | -------------------------------------------------------------------------------- /src/SwanGridTopology.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanGridTopology 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Setups the SWAN grid topology 43 | ! 44 | ! Method 45 | ! 46 | ! Returns information about the grid and the topology of the 47 | ! region in a structure useful to the rest of the program 48 | ! 49 | ! Modules used 50 | ! 51 | use ocpcomm4 52 | use SwanGriddata 53 | use SwanGridobjects 54 | ! 55 | implicit none 56 | ! 57 | ! Local variables 58 | ! 59 | integer, save :: ient = 0 ! number of entries in this subroutine 60 | integer :: istat ! indicate status of allocation 61 | ! 62 | ! Structure 63 | ! 64 | ! Description of the pseudo code 65 | ! 66 | ! Source text 67 | ! 68 | if (ltrace) call strace (ient,'SwanGridTopology') 69 | ! 70 | ! allocate arrays vert, cell and face 71 | ! 72 | allocate(gridobject%vert_grid(nverts), stat = istat) 73 | if ( istat == 0 ) allocate(gridobject%cell_grid(ncells), stat = istat) 74 | if ( istat == 0 ) allocate(gridobject%face_grid(nfaces), stat = istat) 75 | if ( istat /= 0 ) then 76 | call msgerr ( 4, 'Allocation problem in SwanGridTopology: array vert, cell or face' ) 77 | return 78 | endif 79 | ! 80 | ! setup the vertices 81 | ! 82 | call SwanGridVert ( nverts, xcugrd, ycugrd, vmark ) 83 | ! 84 | ! setup the cells 85 | ! 86 | call SwanGridCell ( ncells, nverts, xcugrd, ycugrd, kvertc ) 87 | ! 88 | ! setup the faces 89 | ! 90 | call SwanGridFace ( nfaces, ncells, nverts, xcugrd, ycugrd, kvertf ) 91 | ! 92 | ! print some info about the grid 93 | ! 94 | call SwanPrintGridInfo 95 | ! 96 | end subroutine SwanGridTopology 97 | -------------------------------------------------------------------------------- /src/switch.pl: -------------------------------------------------------------------------------- 1 | # --- parsing arguments 2 | $esmf = "FALSE"; 3 | $tim = "FALSE"; 4 | $jac = "FALSE"; 5 | $mpi = "FALSE"; 6 | $pun = "FALSE"; 7 | $f95 = "FALSE"; 8 | $dos = "FALSE"; 9 | $unx = "FALSE"; 10 | $cry = "FALSE"; 11 | $sgi = "FALSE"; 12 | $imp = "FALSE"; 13 | $cvi = "FALSE"; 14 | $adc = "FALSE"; 15 | $coh = "FALSE"; 16 | $ncf = "FALSE"; 17 | $mv4 = "FALSE"; 18 | while ( $ARGV[0]=~/-.*/ ) 19 | { 20 | if ($ARGV[0]=~/-esmf/) {$esmf="TRUE";shift;} 21 | if ($ARGV[0]=~/-timg/) {$tim="TRUE";shift;} 22 | if ($ARGV[0]=~/-jac/) {$jac="TRUE";shift;} 23 | if ($ARGV[0]=~/-mpi/) {$mpi="TRUE";shift;} 24 | if ($ARGV[0]=~/-pun/) {$pun="TRUE";shift;} 25 | if ($ARGV[0]=~/-f95/) {$f95="TRUE";shift;} 26 | if ($ARGV[0]=~/-dos/) {$dos="TRUE";shift;} 27 | if ($ARGV[0]=~/-unix/) {$unx="TRUE";shift;} 28 | if ($ARGV[0]=~/-cray/) {$cry="TRUE";shift;} 29 | if ($ARGV[0]=~/-sgi/) {$sgi="TRUE";shift;} 30 | if ($ARGV[0]=~/-impi/) {$imp="TRUE";shift;} 31 | if ($ARGV[0]=~/-cvis/) {$cvi="TRUE";shift;} 32 | if ($ARGV[0]=~/-adcirc/) {$adc="TRUE";shift;} 33 | if ($ARGV[0]=~/-coh/) {$coh="TRUE";shift;} 34 | if ($ARGV[0]=~/-netcdf/) {$ncf="TRUE";shift;} 35 | if ($ARGV[0]=~/-matl4/) {$mv4="TRUE";shift;} 36 | } 37 | 38 | # --- make a list of all files 39 | @files = (); 40 | foreach (@ARGV) { 41 | @files = (@files , glob ); 42 | } 43 | 44 | # --- change each file if necessary 45 | foreach $file (@files) 46 | { 47 | # --- set output file name 48 | if ($unx=~/TRUE/) 49 | { 50 | ($tempf)=split(/.ftn/, $file); 51 | $ext = ($file =~ m/ftn90/) ? "f90" : "f"; 52 | $outfile = join(".",$tempf,$ext); 53 | } 54 | else 55 | { 56 | ($tempf)=split(/.ftn/, $file); 57 | $ext = ($file =~ m/ftn90/) ? "f90" : "for"; 58 | $outfile = join(".",$tempf,$ext); 59 | } 60 | # --- process file 61 | if ( (! -e $outfile) #outfile doesn't exist 62 | || (-M $file < -M $outfile) ) #.ftn file recently modified 63 | { 64 | open file or die "can't open $file\n"; 65 | open(OUTFILE,">".$outfile); 66 | while ($line=) 67 | { 68 | $newline=$line; 69 | # ESMF must be processed first 70 | if ($esmf=~/TRUE/) {$newline=~s/^!ESMF//;} 71 | else {$newline=~s/^!!ESMF//;} #second "!" is negation 72 | if ($tim=~/TRUE/) {$newline=~s/^!TIMG//;} 73 | if ($jac=~/TRUE/) {$newline=~s/^!JAC//;} 74 | else {$newline=~s/^!WFR//;} 75 | if ($mpi=~/TRUE/) {$newline=~s/^!MPI//;} 76 | if ($pun=~/TRUE/) {$newline=~s/^!PUN//;} 77 | if ($pun=~/FALSE/) {$newline=~s/^!NPUN//;} 78 | if ($f95=~/TRUE/) {$newline=~s/^!F95//;} 79 | if ($dos=~/TRUE/) {$newline=~s/^!DOS//;} 80 | if ($unx=~/TRUE/) {$newline=~s/^!UNIX//;} 81 | if ($cry=~/TRUE/) {$newline=~s/^!\/Cray//;} 82 | if ($sgi=~/TRUE/) {$newline=~s/^!\/SGI//;} 83 | if ($imp=~/TRUE/) {$newline=~s/^!\/impi//;} 84 | if ($cvi=~/TRUE/) {$newline=~s/^!CVIS//;} 85 | if ($adc=~/TRUE/) {$newline=~s/^!ADC//;} 86 | if ($adc=~/FALSE/) {$newline=~s/^!NADC//;} 87 | if ($coh=~/TRUE/) {$newline=~s/^!COH//;} 88 | if ($coh=~/FALSE/){$newline=~s/^!NCOH//;} 89 | if ($ncf=~/TRUE/) {$newline=~s/^!NCF//;} 90 | if ($ncf=~/FALSE/){$newline=~s/^!NNCF//;} 91 | if ($mv4=~/TRUE/) {$newline=~s/^!MatL4//;} 92 | if ($mv4=~/FALSE/) {$newline=~s/^!MatL5//;} 93 | print OUTFILE $newline; 94 | } 95 | close file; 96 | close(OUTFILE); 97 | } 98 | } 99 | -------------------------------------------------------------------------------- /src/SwanPrepComp.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanPrepComp ( cross ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Does some preparations before computation is started 43 | ! 44 | ! Modules used 45 | ! 46 | use ocpcomm4 47 | use swcomm3 48 | use SwanGriddata 49 | !PUN use SwanGridobjects 50 | ! 51 | implicit none 52 | ! 53 | ! Argument variables 54 | ! 55 | integer, dimension(nfaces), intent(out) :: cross ! contains sequence number of obstacles for each face 56 | ! where they crossing or zero if no crossing 57 | ! 58 | ! Local variables 59 | ! 60 | integer, save :: ient = 0 ! number of entries in this subroutine 61 | !PUN integer :: ivert ! loop counter over vertices 62 | ! 63 | !PUN type(verttype), dimension(:), pointer :: vert ! datastructure for vertices with their attributes 64 | ! 65 | ! Structure 66 | ! 67 | ! Description of the pseudo code 68 | ! 69 | ! Source text 70 | ! 71 | if (ltrace) call strace (ient,'SwanPrepComp') 72 | ! 73 | !PUN ! point to vertex object 74 | !PUN ! 75 | !PUN vert => gridobject%vert_grid 76 | !PUN ! 77 | ! deallocate arrays kvertc and kvertf (we don't use them anymore!) 78 | ! 79 | if (allocated(kvertc)) deallocate(kvertc) 80 | if (allocated(kvertf)) deallocate(kvertf) 81 | ! 82 | !PUN ! ghost vertices are regarded as vertices with boundary condition 83 | !PUN ! 84 | !PUN do ivert = 1, nverts 85 | !PUN if ( vmark(ivert) == 999 ) vert(ivert)%atti(VBC) = 1 86 | !PUN enddo 87 | !PUN ! 88 | ! setup a vertex list 89 | ! 90 | call SwanVertlist 91 | ! 92 | ! find obstacles in computational grid, if present 93 | ! 94 | if ( NUMOBS > 0 ) call SwanFindObstacles ( cross ) 95 | ! 96 | end subroutine SwanPrepComp 97 | -------------------------------------------------------------------------------- /src/SwanGridVert.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanGridVert ( nverts, xcugrd, ycugrd, vmark ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Fills vertex-based data structure 43 | ! 44 | ! Method 45 | ! 46 | ! Based on unstructured grid 47 | ! 48 | ! Modules used 49 | ! 50 | use ocpcomm4 51 | use SwanGridobjects 52 | ! 53 | implicit none 54 | ! 55 | ! Argument variables 56 | ! 57 | integer, intent(in) :: nverts ! number of vertices in grid 58 | ! 59 | integer, dimension(nverts), intent(in) :: vmark ! boundary marker for vertices 60 | ! 61 | real, dimension(nverts), intent(in) :: xcugrd ! the x-coordinates of the grid vertices 62 | real, dimension(nverts), intent(in) :: ycugrd ! the y-coordinates of the grid vertices 63 | ! 64 | ! Local variables 65 | ! 66 | integer, save :: ient = 0 ! number of entries in this subroutine 67 | integer :: ivert ! loop counter over vertices 68 | ! 69 | type(verttype), dimension(:), pointer :: vert ! datastructure for vertices with their attributes 70 | ! 71 | ! Structure 72 | ! 73 | ! Description of the pseudo code 74 | ! 75 | ! Source text 76 | ! 77 | if (ltrace) call strace (ient,'SwanGridVert') 78 | ! 79 | ! point to vertex object 80 | ! 81 | vert => gridobject%vert_grid 82 | ! 83 | ! loop over all vertices 84 | ! 85 | do ivert = 1, nverts 86 | ! 87 | ! identification number 88 | ! 89 | vert(ivert)%atti(VERTID) = ivert 90 | ! 91 | ! marks boundary vertex 92 | ! 93 | vert(ivert)%atti(VMARKER) = min(1,vmark(ivert)) 94 | ! 95 | ! initially, this vertex is no boundary condition point 96 | ! 97 | vert(ivert)%atti(VBC) = 0 98 | ! 99 | ! initially, this vertex is active 100 | ! 101 | vert(ivert)%active = .true. 102 | ! 103 | ! store coordinates 104 | ! 105 | vert(ivert)%attr(VERTX) = xcugrd(ivert) 106 | vert(ivert)%attr(VERTY) = ycugrd(ivert) 107 | ! 108 | enddo 109 | 110 | end subroutine SwanGridVert 111 | -------------------------------------------------------------------------------- /src/SwanGriddata.ftn90: -------------------------------------------------------------------------------- 1 | module SwanGriddata 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New Module 39 | ! 40 | ! Purpose 41 | ! 42 | ! Module containing data of unstructured grid 43 | ! 44 | ! Method 45 | ! 46 | ! Data with respect to unstructured grid need to be filled by a grid generator 47 | ! 48 | ! Modules used 49 | ! 50 | ! none 51 | ! 52 | implicit none 53 | ! 54 | ! Module parameters 55 | ! 56 | integer, parameter :: meth_adcirc = 1 ! 57 | integer, parameter :: meth_triangle = 2 ! 58 | integer, parameter :: meth_easy = 3 ! 59 | ! 60 | ! Module variables 61 | ! 62 | integer :: grid_generator ! used grid generator 63 | ! 64 | integer :: ncells ! number of cells in (subdomain) grid 65 | integer :: ncellsg ! number of cells in global grid 66 | integer :: nfaces ! number of faces in grid 67 | integer :: nverts ! number of vertices in (subdomain) grid 68 | integer :: nvertsg ! number of vertices in global grid 69 | ! 70 | integer, dimension(:,:), save, allocatable :: kvertc ! 71 | integer, dimension(:,:), save, allocatable :: kvertf ! 72 | ! 73 | integer, dimension(:), save, allocatable :: ivertg ! vertex index in global grid 74 | integer, dimension(:), save, allocatable :: vmark ! boundary marker for vertices 75 | ! 76 | real :: asort ! ordering of vertices along a user-given direction 77 | real :: maxgsiz ! maximum gridsize 78 | real :: mingsiz ! minimum gridsize 79 | ! 80 | real, dimension(:), save, allocatable :: xcugrd ! the x-coordinates of the grid vertices 81 | real, dimension(:), save, allocatable :: xcugrdgl ! the x-coordinates of the grid vertices in global grid 82 | real, dimension(:), save, allocatable :: ycugrd ! the y-coordinates of the grid vertices 83 | real, dimension(:), save, allocatable :: ycugrdgl ! the y-coordinates of the grid vertices in global grid 84 | ! 85 | ! Source text 86 | ! 87 | end module SwanGriddata 88 | -------------------------------------------------------------------------------- /tutorial/SPECOUT_1D.DAT: -------------------------------------------------------------------------------- 1 | SWAN 1 Swan standard spectral file, version 2 | $ Data produced by SWAN version 41.20 3 | $ Project: SNLSWAN TUTORIAL; run number: TEST 4 | LOCATIONS locations in x-y-space 5 | 3 number of locations 6 | 375.0000 425.0000 7 | 410.0000 425.0000 8 | 425.0000 425.0000 9 | AFREQ absolute frequencies in Hz 10 | 26 number of frequencies 11 | 0.0500 12 | 0.0548 13 | 0.0601 14 | 0.0659 15 | 0.0723 16 | 0.0792 17 | 0.0869 18 | 0.0953 19 | 0.1045 20 | 0.1145 21 | 0.1256 22 | 0.1377 23 | 0.1510 24 | 0.1656 25 | 0.1815 26 | 0.1991 27 | 0.2183 28 | 0.2393 29 | 0.2624 30 | 0.2877 31 | 0.3155 32 | 0.3459 33 | 0.3793 34 | 0.4159 35 | 0.4560 36 | 0.5000 37 | QUANT 38 | 3 number of quantities in table 39 | EnDens energy densities in J/m2/Hz 40 | J/m2/Hz unit 41 | -0.9900E+02 exception value 42 | CDIR average Cartesian direction in degr 43 | degr unit 44 | -0.9990E+03 exception value 45 | DSPRDEGR directional spreading 46 | degr unit 47 | -0.9000E+01 exception value 48 | LOCATION 1 49 | -0.9900E+02 -999.0 -9.0 50 | -0.9900E+02 -999.0 -9.0 51 | 0.2787E+02 0.0 12.4 52 | 0.3359E+03 360.0 12.4 53 | 0.1632E+04 0.0 12.4 54 | 0.4225E+04 360.0 12.4 55 | 0.7080E+04 360.0 12.4 56 | 0.8781E+04 0.0 12.4 57 | 0.8843E+04 360.0 12.4 58 | 0.7710E+04 0.0 12.4 59 | 0.6085E+04 360.0 12.4 60 | 0.4482E+04 0.0 12.4 61 | 0.3148E+04 360.0 12.4 62 | 0.2139E+04 360.0 12.4 63 | 0.1420E+04 0.0 12.4 64 | 0.9286E+03 0.0 12.4 65 | 0.6004E+03 360.0 12.4 66 | 0.3853E+03 360.0 12.4 67 | 0.2460E+03 0.0 12.4 68 | 0.1564E+03 360.0 12.4 69 | 0.9924E+02 0.0 12.4 70 | 0.6284E+02 360.0 12.4 71 | 0.3974E+02 360.0 12.4 72 | 0.2510E+02 360.0 12.4 73 | 0.1584E+02 0.0 12.4 74 | 0.9980E+01 0.0 12.4 75 | LOCATION 2 76 | -0.9900E+02 -999.0 -9.0 77 | -0.9900E+02 -999.0 -9.0 78 | 0.2622E+01 360.0 13.1 79 | 0.3161E+02 360.0 13.1 80 | 0.1535E+03 360.0 13.1 81 | 0.3975E+03 0.0 13.1 82 | 0.6661E+03 360.0 13.1 83 | 0.8261E+03 0.0 13.1 84 | 0.8319E+03 360.0 13.1 85 | 0.7254E+03 0.0 13.1 86 | 0.5725E+03 360.0 13.1 87 | 0.4217E+03 0.0 13.1 88 | 0.2961E+03 360.0 13.1 89 | 0.2012E+03 360.0 13.1 90 | 0.1336E+03 0.0 13.1 91 | 0.8736E+02 0.0 13.1 92 | 0.5649E+02 360.0 13.1 93 | 0.3625E+02 360.0 13.1 94 | 0.2314E+02 0.0 13.1 95 | 0.1472E+02 360.0 13.1 96 | 0.9337E+01 360.0 13.1 97 | 0.5912E+01 360.0 13.1 98 | 0.3738E+01 360.0 13.1 99 | 0.2361E+01 360.0 13.1 100 | 0.1489E+01 0.0 13.1 101 | 0.9386E+00 0.0 13.1 102 | LOCATION 3 103 | -0.9900E+02 -999.0 -9.0 104 | -0.9900E+02 -999.0 -9.0 105 | 0.2972E+01 0.0 14.7 106 | 0.3583E+02 360.0 14.7 107 | 0.1740E+03 360.0 14.7 108 | 0.4506E+03 0.0 14.7 109 | 0.7551E+03 360.0 14.7 110 | 0.9364E+03 0.0 14.7 111 | 0.9430E+03 360.0 14.7 112 | 0.8222E+03 0.0 14.7 113 | 0.6489E+03 360.0 14.7 114 | 0.4780E+03 0.0 14.7 115 | 0.3357E+03 360.0 14.7 116 | 0.2281E+03 360.0 14.7 117 | 0.1515E+03 0.0 14.7 118 | 0.9903E+02 0.0 14.7 119 | 0.6403E+02 360.0 14.7 120 | 0.4109E+02 360.0 14.7 121 | 0.2623E+02 0.0 14.7 122 | 0.1668E+02 360.0 14.7 123 | 0.1058E+02 0.0 14.7 124 | 0.6701E+01 360.0 14.7 125 | 0.4237E+01 360.0 14.7 126 | 0.2676E+01 360.0 14.7 127 | 0.1688E+01 0.0 14.7 128 | 0.1064E+01 0.0 14.7 129 | -------------------------------------------------------------------------------- /src/SwanCrossObstacle.ftn90: -------------------------------------------------------------------------------- 1 | logical function SwanCrossObstacle ( xv, yv, xobs, yobs ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, March 2008: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Checks whether an obstacle line cross a face in computational grid 43 | ! 44 | ! Method 45 | ! 46 | ! See Technical documentation 47 | ! 48 | ! Modules used 49 | ! 50 | use ocpcomm4 51 | ! 52 | implicit none 53 | ! 54 | ! Argument variables 55 | ! 56 | real, dimension(2), intent(in) :: xobs ! x-coordinate of obstacle point 57 | real, dimension(2), intent(in) :: xv ! x-coordinate of vertex of face 58 | real, dimension(2), intent(in) :: yobs ! y-coordinate of obstacle point 59 | real, dimension(2), intent(in) :: yv ! y-coordinate of vertex of face 60 | ! 61 | ! Local variables 62 | ! 63 | integer, save :: ient = 0 ! number of entries in this subroutine 64 | ! 65 | real :: a ! dummy variable 66 | real :: b ! dummy variable 67 | real :: c ! dummy variable 68 | real :: d ! dummy variable 69 | real :: det ! determinant 70 | real :: e ! dummy variable 71 | real :: f ! dummy variable 72 | real :: p ! dummy variable 73 | real :: q ! dummy variable 74 | ! 75 | logical :: EQREAL ! indicate whether two reals are equal or not 76 | ! 77 | ! Structure 78 | ! 79 | ! Description of the pseudo code 80 | ! 81 | ! Source text 82 | ! 83 | if (ltrace) call strace (ient,'SwanCrossObstacle') 84 | ! 85 | ! initially, we assume there is crossing 86 | ! 87 | SwanCrossObstacle = .true. 88 | ! 89 | a = xv(1) - xobs(1) 90 | b = yv(1) - yobs(1) 91 | ! 92 | c = xv(2) - xv(1) 93 | d = yv(2) - yv(1) 94 | ! 95 | e = xobs(2) - xobs(1) 96 | f = yobs(2) - yobs(1) 97 | ! 98 | ! compute determinant 99 | ! 100 | det = e*d - f*c 101 | ! 102 | if ( .not.EQREAL(det,0.) ) then 103 | ! 104 | p = (a*d - b*c)/det 105 | q = (a*f - b*e)/det 106 | ! 107 | if ( p<0. .or. p>1. .or. q<0. .or. q>1. ) SwanCrossObstacle = .false. 108 | ! 109 | else 110 | ! 111 | SwanCrossObstacle = .false. 112 | ! 113 | endif 114 | ! 115 | end function SwanCrossObstacle 116 | -------------------------------------------------------------------------------- /src/SwanDispParm.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanDispParm ( kwave, cgo, dmw, dep2, mudl2, spcsig ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.59: Erick Rogers 35 | ! 40.80: Marcel Zijlema 36 | ! 37 | ! Updates 38 | ! 39 | ! 40.59, August 2007: muddy bottom included 40 | ! 40.80, July 2007: New subroutine 41 | ! 42 | ! Purpose 43 | ! 44 | ! computes dispersion parameters, wave number and group velocity, 45 | ! in vertices of computational stencil 46 | ! 47 | ! Modules used 48 | ! 49 | use ocpcomm4 50 | use swcomm2 51 | use swcomm3 52 | use SwanGriddata 53 | use SwanCompdata 54 | ! 55 | implicit none 56 | ! 57 | ! Argument variables 58 | ! 59 | real, dimension(MSC,ICMAX), intent(out) :: cgo ! group velocity 60 | real, dimension(nverts), intent(in) :: dep2 ! water depth at current time level 61 | real, dimension(MSC,ICMAX), intent(out) :: dmw ! mud dissipation rate 62 | real, dimension(MSC,ICMAX), intent(out) :: kwave ! wave number 63 | real, dimension(nverts), intent(in) :: mudl2 ! mud thickness at current time level 64 | real, dimension(MSC), intent(in) :: spcsig ! relative frequency bins 65 | ! 66 | ! Local variables 67 | ! 68 | integer :: ic ! loop counter over stencil 69 | integer, save :: ient = 0 ! number of entries in this subroutine 70 | integer :: is ! loop counter over frequency bins 71 | integer :: ivert ! vertex index 72 | ! 73 | real :: deploc ! local depth 74 | real :: dm ! local mud layer 75 | real, dimension(MSC) :: n ! ratio of group and phase velocity 76 | real, dimension(MSC) :: nd ! derivative of N with respect to depth 77 | ! 78 | ! Structure 79 | ! 80 | ! Description of the pseudo code 81 | ! 82 | ! Source text 83 | ! 84 | if (ltrace) call strace (ient,'SwanDispParm') 85 | 86 | do ic = 1, ICMAX 87 | ! 88 | ivert = vs(ic) ! points in computational stencil 89 | deploc = dep2(ivert) 90 | ! 91 | if (VARMUD) then 92 | dm = mudl2(ivert) 93 | else 94 | dm = PMUD(1) 95 | endif 96 | ! 97 | if ( deploc > DEPMIN ) then 98 | ! 99 | call KSCIP1 (MSC, spcsig, deploc, kwave(1,ic), cgo(1,ic), n, nd) 100 | if ( IMUD == 1 ) call KSCIP2 (MSC, spcsig, deploc, kwave(1,ic), cgo(1,ic), n, nd, dmw(1,ic), dm) 101 | ! 102 | else 103 | ! 104 | do is = 1, MSC 105 | kwave(is,ic) = -1. 106 | cgo (is,ic) = 0. 107 | dmw (is,ic) = 0. 108 | enddo 109 | ! 110 | endif 111 | enddo 112 | ! 113 | end subroutine SwanDispParm 114 | -------------------------------------------------------------------------------- /src/SwanPropvelX.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanPropvelX ( cax, cay, ux2, uy2, cgo, ecos, esin ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 41.02: Marcel Zijlema 36 | ! 37 | ! Updates 38 | ! 39 | ! 40.80, July 2007: New subroutine 40 | ! 41.02, February 2009: adaption of velocities in case of diffraction 41 | ! 42 | ! Purpose 43 | ! 44 | ! computes wave transport velocities of energy in geographical space 45 | ! 46 | ! Modules used 47 | ! 48 | use ocpcomm4 49 | use swcomm3 50 | use m_diffr 51 | use SwanGriddata 52 | use SwanCompdata 53 | ! 54 | implicit none 55 | ! 56 | ! Argument variables 57 | ! 58 | real, dimension(MDC,MSC,ICMAX), intent(out) :: cax ! wave transport velocity in x-direction 59 | real, dimension(MDC,MSC,ICMAX), intent(out) :: cay ! wave transport velocity in y-direction 60 | real, dimension(MSC,ICMAX), intent(in) :: cgo ! group velocity 61 | real, dimension(MDC), intent(in) :: ecos ! help array containing cosine of spectral directions 62 | real, dimension(MDC), intent(in) :: esin ! help array containing sine of spectral directions 63 | real, dimension(nverts), intent(in) :: ux2 ! ambient velocity in x-direction at current time level 64 | real, dimension(nverts), intent(in) :: uy2 ! ambient velocity in y-direction at current time level 65 | ! 66 | ! Local variables 67 | ! 68 | integer :: ic ! loop counter over stencil 69 | integer :: id ! loop counter over direction bins 70 | integer, save :: ient = 0 ! number of entries in this subroutine 71 | integer :: is ! loop counter over frequency bins 72 | integer :: ivert ! vertex index 73 | ! 74 | ! 75 | ! Structure 76 | ! 77 | ! Description of the pseudo code 78 | ! 79 | ! Source text 80 | ! 81 | if (ltrace) call strace (ient,'SwanPropvelX') 82 | 83 | do ic = 1, ICMAX 84 | ! 85 | ivert = vs(ic) ! points in computational stencil 86 | ! 87 | do is = 1, MSC 88 | do id = 1, MDC 89 | cax(id,is,ic) = cgo(is,ic) * ecos(id) 90 | cay(id,is,ic) = cgo(is,ic) * esin(id) 91 | enddo 92 | enddo 93 | ! 94 | ! adapt the celerities in case of diffraction 95 | ! 96 | if ( IDIFFR /= 0 .and. PDIFFR(3) /= 0. ) then 97 | do is = 1, MSC 98 | do id = 1 ,MDC 99 | cax(id,is,ic) = cax(id,is,ic)*DIFPARAM(ivert) 100 | cay(id,is,ic) = cay(id,is,ic)*DIFPARAM(ivert) 101 | enddo 102 | enddo 103 | endif 104 | ! 105 | ! ambient currents added 106 | ! 107 | if ( ICUR /= 0 ) then 108 | do is = 1, MSC 109 | do id = 1, MDC 110 | cax(id,is,ic) = cax(id,is,ic) + ux2(ivert) 111 | cay(id,is,ic) = cay(id,is,ic) + uy2(ivert) 112 | enddo 113 | enddo 114 | endif 115 | ! 116 | enddo 117 | ! 118 | end subroutine SwanPropvelX 119 | -------------------------------------------------------------------------------- /src/swanrun: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | #----------------------------------------------------------------------- 4 | # initialize procedure parameters 5 | #----------------------------------------------------------------------- 6 | # 7 | input= 8 | npmpi=1 9 | npomp=1 10 | export OMP_NUM_THREADS=1 11 | # 12 | #----------------------------------------------------------------------- 13 | # read procedure parameters from run call 14 | #----------------------------------------------------------------------- 15 | # 16 | while [ $# -ge 2 ] 17 | do 18 | case $1 in 19 | -input) input=`basename $2 .swn`;; 20 | -omp) npomp=$2;; 21 | -mpi) npmpi=$2;; 22 | *) echo unknown parameter: $1 23 | echo ' Usage: swanrun -input file [-omp n | -mpi n]' 24 | echo 25 | exit ;; 26 | esac 27 | shift 2 28 | done 29 | # 30 | #----------------------------------------------------------------------- 31 | # if input file is not given, produce error 32 | #----------------------------------------------------------------------- 33 | # 34 | if [ -z "$input" ]; then 35 | echo 36 | echo '***ERROR: no name SWAN input file given!' 37 | echo 38 | echo ' Usage: swanrun -input file [-omp n | -mpi n]' 39 | echo 40 | exit 1 41 | fi 42 | # 43 | #----------------------------------------------------------------------- 44 | # check whether MPI is available in case of parallel MPI run 45 | #----------------------------------------------------------------------- 46 | # 47 | IFS="${IFS= }"; IFS="${IFS}:" 48 | for dir in $PATH; do 49 | test -z "$dir" && dir=. 50 | if test -f $dir/mpirun; then 51 | mpi=1 52 | break 53 | fi 54 | done 55 | if [ $npmpi -gt 1 -a -z "$mpi" ]; then 56 | echo 57 | echo "***ERROR: MPI is not available!" 58 | echo 59 | exit 1 60 | fi 61 | # 62 | #----------------------------------------------------------------------- 63 | # check whether machinefile is available (if necessary) 64 | #----------------------------------------------------------------------- 65 | # 66 | # Note: no machinefile is needed on small multi-core shared-memory Linux machine or on SGI platform 67 | # 68 | os=`uname -s` 69 | if [ "$os" = Linux ]; then 70 | ncore=`grep -ic ^processor /proc/cpuinfo` 71 | if [ $ncore -le 8 ]; then 72 | nmf=1 73 | fi 74 | fi 75 | os=`echo $os | tr "[a-z]" "[A-Z]" | awk '{print substr($0,1,4)}'` 76 | if [ "$os" = IRIX ]; then 77 | nmf=1 78 | fi 79 | if [ $npmpi -gt 1 -a ! -z "$mpi" -a -z "$nmf" ]; then 80 | if [ ! -f machinefile -a ! -h machinefile ]; then 81 | echo 82 | echo "***ERROR: no machinefile is present in current directory!" 83 | echo 84 | exit 1 85 | fi 86 | fi 87 | # 88 | #----------------------------------------------------------------------- 89 | # run SWAN 90 | #----------------------------------------------------------------------- 91 | # 92 | # adapt PATH to ensure a locally present executable is executed 93 | PATH=.:$PATH 94 | 95 | type swan.exe 96 | if [ -r $input.swn ]; then 97 | orig=n 98 | cp $input.swn INPUT 99 | if [ $npomp -gt 1 ]; then 100 | export OMP_NUM_THREADS=$npomp 101 | swan.exe 102 | elif [ $npmpi -gt 1 -o ! -z "$mpi" ]; then 103 | if [ ! -f swan.exe ]; then 104 | ln -s `which swan.exe` swan.exe 105 | orig=y 106 | fi 107 | if [ -z "$nmf" ]; then 108 | if [ $npmpi -gt 1 ]; then 109 | mpirun -np $npmpi -machinefile machinefile swan.exe 110 | else 111 | swan.exe 112 | fi 113 | else 114 | mpirun -np $npmpi swan.exe 115 | fi 116 | else 117 | swan.exe 118 | fi 119 | if [ $npmpi -gt 1 ]; then 120 | inode=0 121 | while [ $inode -lt $npmpi ]; do 122 | inode=`expr $inode + 1` 123 | inode=`echo $inode | awk '{ printf "%03.0f", $0 }'` 124 | if [ -f PRINT-$inode ]; then 125 | mv PRINT-$inode $input.prt-$inode 126 | fi 127 | if [ -r Errfile-$inode ]; then 128 | mv Errfile-$inode $input.erf-$inode 129 | fi 130 | done 131 | else 132 | if [ -f PRINT ]; then 133 | mv PRINT $input.prt 134 | fi 135 | if [ -r Errfile ]; then 136 | mv Errfile $input.erf 137 | fi 138 | fi 139 | if [ -r ERRPTS ]; then 140 | mv ERRPTS $input.erp 141 | fi 142 | if [ -f norm_end ]; then 143 | cat norm_end 144 | fi 145 | if [ -h swan.exe -a "$orig" = y ]; then 146 | rm -f swan.exe 147 | fi 148 | rm -f INPUT 149 | else 150 | echo "file $input.swn does not exist" 151 | exit 1 152 | fi 153 | # 154 | -------------------------------------------------------------------------------- /src/SwanPointinMesh.ftn90: -------------------------------------------------------------------------------- 1 | logical function SwanPointinMesh ( x, y ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, June 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Checks whether the given point is inside the mesh 43 | ! 44 | ! Method 45 | ! 46 | ! draw a vertical line from the point and count the number of crossings with boundary faces 47 | ! if the number of crossings is odd then the given point is inside the mesh 48 | ! 49 | ! Modules used 50 | ! 51 | use ocpcomm4 52 | use SwanGriddata 53 | use SwanGridobjects 54 | ! 55 | implicit none 56 | ! 57 | ! Argument variables 58 | ! 59 | real, intent(in) :: x ! x-coordinate of given point 60 | real, intent(in) :: y ! y-coordinate of given point 61 | ! 62 | ! Local variables 63 | ! 64 | integer, save :: ient = 0 ! number of entries in this subroutine 65 | integer :: iface ! loop counter over faces 66 | integer :: numcrs ! number of crossings with boundary faces 67 | integer :: v1 ! first vertex of present face 68 | integer :: v2 ! second vertex of present face 69 | ! 70 | real :: x1 ! x-coordinate of begin of boundary face 71 | real :: x2 ! x-coordinate of end of boundary face 72 | real :: y1 ! y-coordinate of begin of boundary face 73 | real :: y2 ! y-coordinate of end of boundary face 74 | real :: yc ! y-coordinate of cross point 75 | ! 76 | type(facetype), dimension(:), pointer :: face ! datastructure for faces with their attributes 77 | ! 78 | ! Structure 79 | ! 80 | ! Description of the pseudo code 81 | ! 82 | ! Source text 83 | ! 84 | if (ltrace) call strace (ient,'SwanPointinMesh') 85 | ! 86 | ! point to face object 87 | ! 88 | face => gridobject%face_grid 89 | ! 90 | numcrs = 0 91 | ! 92 | ! loop over faces (both internal and boundary faces) 93 | ! 94 | do iface = 1, nfaces 95 | ! 96 | if ( face(iface)%atti(FMARKER) == 1 ) then ! boundary face 97 | ! 98 | v1 = face(iface)%atti(FACEV1) 99 | v2 = face(iface)%atti(FACEV2) 100 | ! 101 | x1 = xcugrd(v1) 102 | y1 = ycugrd(v1) 103 | x2 = xcugrd(v2) 104 | y2 = ycugrd(v2) 105 | ! 106 | if ( ( (x1 > x) .and. (x2 <= x) ) .or. ( (x2 > x) .and. (x1 <= x) ) ) then 107 | ! 108 | if ( y1 > y .or. y2 > y ) then 109 | ! 110 | yc = y1 + (x-x1) * (y2-y1) / (x2-x1) 111 | if ( yc > y ) numcrs = numcrs + 1 112 | ! 113 | endif 114 | ! 115 | endif 116 | ! 117 | endif 118 | ! 119 | enddo 120 | ! 121 | ! if number of crossings is odd then point is inside the grid 122 | ! 123 | if ( mod(numcrs,2) == 1 ) then 124 | SwanPointinMesh = .true. 125 | else 126 | SwanPointinMesh = .false. 127 | endif 128 | ! 129 | end function SwanPointinMesh 130 | -------------------------------------------------------------------------------- /src/SwanInitCompGrid.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanInitCompGrid ( logcom ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Initialise arrays for description of computational grid 43 | ! in case of unstructured grid 44 | ! 45 | ! Modules used 46 | ! 47 | use ocpcomm4 48 | use swcomm2 49 | use swcomm3 50 | use m_genarr 51 | use m_parall 52 | use SwanGriddata 53 | ! 54 | implicit none 55 | ! 56 | ! Argument variables 57 | ! 58 | logical, dimension(6), intent(inout) :: logcom ! give status of which command has been given 59 | ! 60 | ! Local variables 61 | ! 62 | integer :: i ! loop counter 63 | integer, save :: ient = 0 ! number of entries in this subroutine 64 | integer :: istat ! indicate status of allocation 65 | ! 66 | ! Structure 67 | ! 68 | ! Description of the pseudo code 69 | ! 70 | ! Source text 71 | ! 72 | if (ltrace) call strace (ient,'SwanInitCompGrid') 73 | ! 74 | ! compute coordinate offsets and reset grid coordinates 75 | ! 76 | do i = 1, nverts 77 | if ( .not.LXOFFS ) then 78 | XOFFS = xcugrd(i) 79 | YOFFS = ycugrd(i) 80 | LXOFFS = .true. 81 | xcugrd(i) = 0. 82 | ycugrd(i) = 0. 83 | else 84 | xcugrd(i) = real(xcugrd(i) - dble(XOFFS)) 85 | ycugrd(i) = real(ycugrd(i) - dble(YOFFS)) 86 | endif 87 | enddo 88 | ! 89 | ! check the grid 90 | ! 91 | call SwanCheckGrid 92 | ! 93 | ! compute XCGMIN, XCGMAX, YCGMIN, YCGMAX 94 | ! 95 | XCGMIN = 1.e9 96 | YCGMIN = 1.e9 97 | XCGMAX = -1.e9 98 | YCGMAX = -1.e9 99 | do i = 1, nverts 100 | if (xcugrd(i) < XCGMIN) XCGMIN = xcugrd(i) 101 | if (ycugrd(i) < YCGMIN) YCGMIN = ycugrd(i) 102 | if (xcugrd(i) > XCGMAX) XCGMAX = xcugrd(i) 103 | if (ycugrd(i) > YCGMAX) YCGMAX = ycugrd(i) 104 | enddo 105 | ! 106 | !PUN XCGMIN = XCGMIN + XOFFS 107 | !PUN YCGMIN = YCGMIN + YOFFS 108 | !PUN XCGMAX = XCGMAX + XOFFS 109 | !PUN YCGMAX = YCGMAX + YOFFS 110 | !PUN ! 111 | !PUN call SwanMinOverNodes ( XCGMIN ) 112 | !PUN call SwanMinOverNodes ( YCGMIN ) 113 | !PUN call SwanMaxOverNodes ( XCGMAX ) 114 | !PUN call SwanMaxOverNodes ( YCGMAX ) 115 | !PUN ! 116 | !PUN XCGMIN = XCGMIN - XOFFS 117 | !PUN YCGMIN = YCGMIN - YOFFS 118 | !PUN XCGMAX = XCGMAX - XOFFS 119 | !PUN YCGMAX = YCGMAX - YOFFS 120 | !PUN ! 121 | XCLEN = XCGMAX - XCGMIN 122 | YCLEN = YCGMAX - YCGMIN 123 | ! 124 | istat = 0 125 | if(.not.allocated(ac2)) allocate(ac2(MDC,MSC,nverts), stat = istat) 126 | if ( istat /= 0 ) then 127 | call msgerr ( 4, 'Allocation problem in SwanInitCompGrid: array ac2 ' ) 128 | return 129 | endif 130 | ac2 = 0. 131 | logcom(6) = .true. 132 | ! 133 | ! set number of vertices and cells in global domain in case of serial run 134 | ! 135 | if ( nvertsg == 0 ) then 136 | nvertsg = nverts 137 | ncellsg = ncells 138 | endif 139 | ! 140 | ! the following arrays for structured grids (regular and curvilinear) 141 | ! are allocated as empty ones 142 | ! 143 | if ( .not.allocated(KGRPNT) ) allocate(KGRPNT(0,0)) 144 | if ( .not.allocated(KGRBND) ) allocate(KGRBND(0) ) 145 | ! 146 | ! for sake of convenience, set MCGRD to nverts (for allocating AC1 and COMPDA) 147 | ! 148 | MCGRD = nverts 149 | MCGRDGL = nvertsg 150 | MXCGL = nvertsg 151 | MYCGL = 1 152 | ! 153 | end subroutine SwanInitCompGrid 154 | -------------------------------------------------------------------------------- /src/SwanFindObstacles.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanFindObstacles ( cross ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, March 2008: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Search for obstacles in computational grid and store them 43 | ! 44 | ! Method 45 | ! 46 | ! for each face an obstacle is found when they crossed each other 47 | ! 48 | ! Modules used 49 | ! 50 | use ocpcomm4 51 | use swcomm3 52 | use m_obsta 53 | use SwanGriddata 54 | use SwanGridobjects 55 | ! 56 | implicit none 57 | ! 58 | ! Argument variables 59 | ! 60 | integer, dimension(nfaces), intent(out) :: cross ! contains sequence number of obstacles for each face 61 | ! where they crossing or zero if no crossing 62 | ! 63 | ! Local variables 64 | ! 65 | integer, save :: ient = 0 ! number of entries in this subroutine 66 | integer :: iface ! loop counter over faces 67 | integer :: j ! loop counter 68 | integer :: k ! loop counter 69 | integer :: vb ! vertex of begin of present face 70 | integer :: ve ! vertex of end of present face 71 | ! 72 | real, dimension(2) :: xobs ! x-coordinate of obstacle point 73 | real, dimension(2) :: xv ! x-coordinate of vertex of face 74 | real, dimension(2) :: yobs ! y-coordinate of obstacle point 75 | real, dimension(2) :: yv ! y-coordinate of vertex of face 76 | ! 77 | logical :: SwanCrossObstacle ! indicate whether a face cross an obstacle 78 | ! 79 | type(OBSTDAT), pointer :: cobst ! pointer to a considered obstacle 80 | ! 81 | type(facetype), dimension(:), pointer :: face ! datastructure for faces with their attributes 82 | type(verttype), dimension(:), pointer :: vert ! datastructure for vertices with their attributes 83 | ! 84 | ! Structure 85 | ! 86 | ! Description of the pseudo code 87 | ! 88 | ! Source text 89 | ! 90 | if (ltrace) call strace (ient,'SwanFindObstacles') 91 | ! 92 | ! point to vertex and face objects 93 | ! 94 | vert => gridobject%vert_grid 95 | face => gridobject%face_grid 96 | ! 97 | ! initialize array cross 98 | ! 99 | cross = 0 100 | ! 101 | ! go to first obstacle 102 | ! 103 | cobst => FOBSTAC 104 | ! 105 | do j = 1, NUMOBS 106 | ! 107 | xobs(1) = cobst%XCRP(1) 108 | yobs(1) = cobst%YCRP(1) 109 | ! 110 | do k = 2, cobst%NCRPTS ! number of corner points of considered obstacle 111 | ! 112 | xobs(2) = cobst%XCRP(k) 113 | yobs(2) = cobst%YCRP(k) 114 | ! 115 | ! loop over faces 116 | ! 117 | faceloop : do iface = 1, nfaces 118 | ! 119 | if ( face(iface)%atti(FMARKER) == 1 ) cycle faceloop ! boundary face 120 | ! 121 | vb = face(iface)%atti(FACEV1) 122 | ve = face(iface)%atti(FACEV2) 123 | ! 124 | xv(1) = vert(vb)%attr(VERTX) 125 | yv(1) = vert(vb)%attr(VERTY) 126 | xv(2) = vert(ve)%attr(VERTX) 127 | yv(2) = vert(ve)%attr(VERTY) 128 | ! 129 | if ( SwanCrossObstacle( xv, yv, xobs, yobs ) ) cross(iface) = j 130 | ! 131 | enddo faceloop 132 | ! 133 | xobs(1) = xobs(2) 134 | yobs(1) = yobs(2) 135 | ! 136 | enddo 137 | ! 138 | ! go to next obstacle, if present 139 | ! 140 | if (.not.associated(cobst%NEXTOBST)) exit 141 | cobst => cobst%NEXTOBST 142 | ! 143 | enddo 144 | ! 145 | end subroutine SwanFindObstacles 146 | -------------------------------------------------------------------------------- /src/SwanReadEasymeshGrid.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanReadEasymeshGrid ( basenm, lenfnm ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Reads Easymesh grid described in .n and .e 43 | ! 44 | ! Method 45 | ! 46 | ! Grid coordinates of vertices are read from file .n and stored in Swan data structure 47 | ! Vertices of triangles are read from file .e and stored in Swan data structure 48 | ! 49 | ! Modules used 50 | ! 51 | use ocpcomm4 52 | use SwanGriddata 53 | ! 54 | implicit none 55 | ! 56 | ! Argument variables 57 | ! 58 | integer, intent(in) :: lenfnm ! length of file names 59 | character(lenfnm), intent(in) :: basenm ! base name of Easymesh files 60 | ! 61 | ! Local variables 62 | ! 63 | character(lenfnm) :: filenm ! file name 64 | integer, save :: ient = 0 ! number of entries in this subroutine 65 | integer :: iostat ! I/O status in call FOR 66 | integer :: istat ! indicate status of allocation 67 | integer :: j ! loop counter 68 | integer :: ndsd ! unit reference number of file 69 | character(80) :: line ! auxiliary textline 70 | logical :: stpnow ! indicate whether program must be terminated or not 71 | ! 72 | ! Structure 73 | ! 74 | ! Description of the pseudo code 75 | ! 76 | ! Source text 77 | ! 78 | if (ltrace) call strace (ient,'SwanReadEasymeshGrid') 79 | ! 80 | ! open file .n containing the coordinates of vertices 81 | ! 82 | filenm = trim(basenm)//'.n' 83 | ndsd = 0 84 | iostat = 0 85 | call for (ndsd, filenm, 'OF', iostat) 86 | if (stpnow()) goto 900 87 | ! 88 | ! read first line to determine number of vertices 89 | ! 90 | read(ndsd, *, end=950, err=910) nverts 91 | istat = 0 92 | if(.not.allocated(xcugrd)) allocate (xcugrd(nverts), stat = istat) 93 | if ( istat == 0 ) then 94 | if(.not.allocated(ycugrd)) allocate (ycugrd(nverts), stat = istat) 95 | endif 96 | if ( istat == 0 ) then 97 | if(.not.allocated(vmark)) allocate (vmark(nverts), stat = istat) 98 | endif 99 | if ( istat /= 0 ) then 100 | call msgerr ( 4, 'Allocation problem in SwanReadEasymeshGrid: array xcugrd, ycugrd or vmark ' ) 101 | goto 900 102 | endif 103 | ! 104 | ! read coordinates of vertices and boundary marker 105 | ! 106 | do j = 1, nverts 107 | read(ndsd, 100, end=950, err=910) xcugrd(j), ycugrd(j), vmark(j) 108 | enddo 109 | ! 110 | ! close file .n 111 | ! 112 | close(ndsd) 113 | ! 114 | ! open file .e containing the (Delaunay) triangles 115 | ! 116 | filenm = trim(basenm)//'.e' 117 | ndsd = 0 118 | iostat = 0 119 | call for (ndsd, filenm, 'OF', iostat) 120 | if (stpnow()) goto 900 121 | ! 122 | ! read first line to determine number of triangles 123 | ! 124 | read(ndsd, *, end=950, err=910) ncells 125 | if(.not.allocated(kvertc)) allocate (kvertc(3,ncells), stat = istat) 126 | if ( istat /= 0 ) then 127 | call msgerr ( 4, 'Allocation problem in SwanReadEasymeshGrid: array kvertc ' ) 128 | goto 900 129 | endif 130 | ! 131 | ! read vertices of triangles 132 | ! 133 | do j = 1, ncells 134 | read(ndsd, 200, end=950, err=910) kvertc(1,j), kvertc(2,j), kvertc(3,j), line 135 | enddo 136 | ! 137 | ! close file .e 138 | ! 139 | close(ndsd) 140 | ! 141 | ! Easymesh counters vertices starting from 0 (C style), therefore add 1 142 | ! 143 | kvertc = kvertc + 1 144 | ! 145 | 900 return 146 | ! 147 | 910 inquire (unit=ndsd, name=filenm) 148 | call msgerr (4, 'error reading data from Easymesh file '//filenm ) 149 | goto 900 150 | 950 inquire (unit=ndsd, name=filenm) 151 | call msgerr (4, 'unexpected end of file in Easymesh file '//filenm ) 152 | goto 900 153 | ! 154 | 100 format((6x,2e22.15,i3)) 155 | 200 format((5x,3i5,a)) 156 | ! 157 | end subroutine SwanReadEasymeshGrid 158 | -------------------------------------------------------------------------------- /src/SwanThreadBounds.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanThreadBounds ( nwetp, ivlow, ivup, tlist ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 41.10: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 41.10, August 2009: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Determines load-balanced loop bounds for calling thread 43 | ! 44 | ! Modules used 45 | ! 46 | use ocpcomm4 47 | use SwanGriddata 48 | use SwanGridobjects 49 | use SwanCompdata 50 | ! 51 | implicit none 52 | ! 53 | ! Argument variables 54 | ! 55 | integer, intent(out) :: ivlow ! lower index in range of vertices in calling thread 56 | integer, intent(out) :: ivup ! upper index in range of vertices in calling thread 57 | integer, dimension(nverts), intent(out) :: tlist ! vertex list for calling thread 58 | ! 59 | real, intent(in) :: nwetp ! total number of active vertices 60 | ! 61 | ! Local variables 62 | ! 63 | integer :: i ! counter 64 | integer, save :: ient = 0 ! number of entries in this subroutine 65 | integer :: ith ! thread counter 66 | integer :: ivert ! vertex index 67 | integer :: j ! counter 68 | integer :: kvert ! loop counter over vertices 69 | integer, dimension(10) :: nacvt ! number of active vertices for i-th thread 70 | integer :: ncurvt ! number of currently assigned vertices to a thread 71 | integer :: nvcum ! cumulative number of vertices 72 | integer :: nth ! number of threads 73 | integer :: tid ! thread number 74 | ! 75 | type(verttype), dimension(:), pointer :: vert ! datastructure for vertices with their attributes 76 | ! 77 | !$ integer, external :: omp_get_num_threads ! number of OpenMP threads being used 78 | !$ integer, external :: omp_get_thread_num ! get thread number 79 | ! 80 | ! Structure 81 | ! 82 | ! Description of the pseudo code 83 | ! 84 | ! Source text 85 | ! 86 | if (ltrace) call strace (ient,'SwanThreadBounds') 87 | ! 88 | ! point to vertex object 89 | ! 90 | vert => gridobject%vert_grid 91 | ! 92 | ! determine number of threads and thread number 93 | ! 94 | nth = 1 95 | tid = 0 96 | !$ nth = omp_get_num_threads() 97 | !$ tid = omp_get_thread_num() 98 | tid = tid + 1 99 | ! 100 | ! determine load-balanced sizes for all threads 101 | ! 102 | nvcum = 0 103 | do i = 1, nth 104 | nacvt(i) = (nint(nwetp)*i)/nth - nvcum 105 | nvcum = (nint(nwetp)*i)/nth 106 | enddo 107 | ! 108 | ! determine loop bounds for calling thread 109 | ! 110 | ivlow = nverts+1 111 | ivup = 0 112 | ! 113 | ith = 1 114 | ncurvt = 0 115 | ! 116 | do kvert = 1, nverts 117 | ! 118 | ivert = vlist(kvert) 119 | ! 120 | if ( vert(ivert)%active ) then 121 | ! 122 | if ( ith == tid ) then 123 | ivlow = min(kvert,ivlow) 124 | ivup = max(kvert,ivup ) 125 | endif 126 | ncurvt = ncurvt + 1 127 | ! 128 | if ( ncurvt >= nacvt(ith) ) then 129 | ith = ith + 1 130 | ncurvt = 0 131 | endif 132 | ! 133 | endif 134 | ! 135 | enddo 136 | ! 137 | ! determine vertex list for calling thread based on vlist 138 | ! first active vertices followed by inactive ones 139 | ! 140 | i = ivlow 141 | j = ivup 142 | ! 143 | do kvert = ivlow, ivup 144 | ! 145 | ivert = vlist(kvert) 146 | ! 147 | if ( vert(ivert)%active ) then 148 | ! 149 | tlist(i) = ivert 150 | i = i + 1 151 | ! 152 | else 153 | ! 154 | tlist(j) = ivert 155 | j = j - 1 156 | ! 157 | endif 158 | ! 159 | enddo 160 | ! 161 | end subroutine SwanThreadBounds 162 | -------------------------------------------------------------------------------- /src/SwanReadfort18.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanReadfort18 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | !PUN! 32 | !PUN! Authors 33 | !PUN! 34 | !PUN! 40.95: Marcel Zijlema 35 | !PUN! 41.36: Marcel Zijlema 36 | !PUN! 37 | !PUN! Updates 38 | !PUN! 39 | !PUN! 40.95, June 2008: New subroutine 40 | !PUN! 41.36, June 2012: global grid indices included 41 | !PUN! 42 | !PUN! Purpose 43 | !PUN! 44 | !PUN! Reads fort.18 to obtain the following ADCIRC variables 45 | !PUN! 46 | !PUN! MNE, MNP, NSTAE, NSTAV, NSTAM and NSTAC 47 | !PUN! 48 | !PUN! These variables are needed by the message-passing routines in module MESSENGER 49 | !PUN! 50 | !PUN! Next, we also need the number of elements and nodes in global domain for SWAN computation 51 | !PUN! 52 | !PUN! Modules used 53 | !PUN! 54 | !PUN use ocpcomm2 55 | !PUN use ocpcomm4 56 | !PUN use SwanGriddata, only: nvertsg, ncellsg, ivertg 57 | !PUN use SIZES 58 | !PUN use GLOBAL, only: NSTAE, NSTAV, NSTAM, NSTAC 59 | !PUN! 60 | !PUN implicit none 61 | !PUN! 62 | !PUN! Local variables 63 | !PUN! 64 | !PUN integer, save :: ient = 0 ! number of entries in this subroutine 65 | !PUN integer :: idum1 ! dummy integer 1 66 | !PUN integer :: idum2 ! dummy integer 2 67 | !PUN integer :: idum3 ! dummy integer 3 68 | !PUN integer :: idum4 ! dummy integer 4 69 | !PUN integer :: iostat ! I/O status in call FOR 70 | !PUN integer :: istat ! indicate status of allocation 71 | !PUN integer :: j ! loop counter 72 | !PUN character(80) :: msgfil ! name of message-passing file including path 73 | !PUN integer :: ndsd ! unit reference number of file 74 | !PUN logical :: stpnow ! indicate whether program must be terminated or not 75 | !PUN! 76 | !PUN! Structure 77 | !PUN! 78 | !PUN! Description of the pseudo code 79 | !PUN! 80 | !PUN! Source text 81 | !PUN! 82 | !PUN if (ltrace) call strace (ient,'SwanReadfort18') 83 | !PUN ! 84 | !PUN ! open file fort.18 85 | !PUN ! 86 | !PUN ndsd = 0 87 | !PUN iostat = 0 88 | !PUN msgfil = trim(INPUTDIR)//DIRCH2//'fort.18' 89 | !PUN call for (ndsd, msgfil, 'OF', iostat) 90 | !PUN if (stpnow()) goto 900 91 | !PUN ! 92 | !PUN read(ndsd,100, end=950, err=910) idum1, idum2, idum3 93 | !PUN ! 94 | !PUN read(ndsd,'(8x,3i12)', end=950, err=910) ncellsg, idum2, MNE ! number of elements 95 | !PUN do j = 1, MNE 96 | !PUN read(ndsd,'(i12)', end=950, err=910) idum4 97 | !PUN enddo 98 | !PUN ! 99 | !PUN read(ndsd,100, end=950, err=910) nvertsg, idum2, MNP ! number of nodes 100 | !PUN if(.not.allocated(ivertg)) allocate (ivertg(MNP), stat = istat) 101 | !PUN if ( istat /= 0 ) then 102 | !PUN call msgerr ( 4, 'Allocation problem in SwanReadfort18: array ivertg ' ) 103 | !PUN goto 900 104 | !PUN endif 105 | !PUN ! 106 | !PUN do j = 1, MNP 107 | !PUN read(ndsd,'(i12)', end=950, err=910) ivertg(j) 108 | !PUN enddo 109 | !PUN ! 110 | !PUN read(ndsd,'(8x,i12)', end=950, err=910) idum1 111 | !PUN ! 112 | !PUN read(ndsd,100, end=950, err=910) idum1, idum2, idum3 113 | !PUN do j = 1, idum3 114 | !PUN read(ndsd,'(i12)', end=950, err=910) idum4 115 | !PUN enddo 116 | !PUN ! 117 | !PUN read(ndsd,100, end=950, err=910) idum1, idum2, NSTAE ! number of elevation stations 118 | !PUN do j = 1, NSTAE 119 | !PUN read(ndsd,'(i12)', end=950, err=910) idum4 120 | !PUN enddo 121 | !PUN ! 122 | !PUN read(ndsd,100, end=950, err=910) idum1, idum2, NSTAV ! number of velocity stations 123 | !PUN do j = 1, NSTAV 124 | !PUN read(ndsd,'(i12)', end=950, err=910) idum4 125 | !PUN enddo 126 | !PUN ! 127 | !PUN read(ndsd,100, end=950, err=910) idum1, idum2, NSTAM ! number of meteorlogical stations 128 | !PUN do j = 1, NSTAM 129 | !PUN read(ndsd,'(i12)', end=950, err=910) idum4 130 | !PUN enddo 131 | !PUN ! 132 | !PUN read(ndsd,100, end=950, err=910) idum1, idum2, NSTAC ! number of concentration stations 133 | !PUN ! 134 | !PUN ! close file fort.18 135 | !PUN ! 136 | !PUN close(ndsd) 137 | !PUN ! 138 | !PUN 900 return 139 | !PUN ! 140 | !PUN 910 call msgerr (4, 'error reading data from grid file fort.18' ) 141 | !PUN goto 900 142 | !PUN 950 call msgerr (4, 'unexpected end of file in grid file fort.18' ) 143 | !PUN goto 900 144 | !PUN ! 145 | !PUN 100 format((8x,3i12)) 146 | !PUN ! 147 | end subroutine SwanReadfort18 148 | -------------------------------------------------------------------------------- /tutorial/PRINT: -------------------------------------------------------------------------------- 1 | 1 2 | 3 | Execution started at 20180919.165537 4 | 5 | 6 | 7 | --------------------------------------- 8 | SWAN 9 | SIMULATION OF WAVES IN NEAR SHORE AREAS 10 | VERSION NUMBER 41.20 11 | --------------------------------------- 12 | 13 | 14 | 15 | PROJECT 'SNLSWAN TUTORIAL' 'TEST' 16 | 17 | 18 | 19 | $***********MODEL INPUT********************************* 20 | 21 | SET CARTESIAN 22 | 23 | SET inrhog = 1 24 | 25 | SET obcase = 0 26 | 27 | MODE STAT TWOD 28 | 29 | COORD CARTESIAN 30 | 31 | 32 | 33 | CGRID REG 0.0 0.0 0.0 1000 1000 100 100 CIRCLE 180 .05 .5 25 34 | Resolution in sigma-space: df/f = 0.0965 35 | 36 | INPGRID BOTTOM REG 0.0 0.0 0.0 100 100 10 10 37 | 38 | READINP BOTTOM 1.0000 'Bathymetry.bot' 3 0 FREE 39 | 40 | 41 | 42 | BOUND SHAPESPEC JONSWAP 1 PEAK DSPR POWER 43 | 44 | BOUNDSPEC SIDE N CON PAR 1 10 0 20 45 | 46 | BOUNDSPEC SIDE W CON PAR 1 10 0 20 47 | 48 | BOUNDSPEC SIDE S CON PAR 1 10 0 20 49 | 50 | 51 | 52 | BREAKING 53 | 54 | FRICTION 55 | 56 | OFF QUADRUPL 57 | 58 | OBSTACLE TRANS 0.3 REFL 0.00 LINE 400 400 400 450 59 | 60 | OBSTACLE TRANS 0.3 REFL 0.00 LINE 450 500 450 550 61 | 62 | 63 | 64 | $************ OUTPUT REQUESTS ************************* 65 | 66 | TABLE 'COMPGRID' HEAD 'SWANOUT.DAT' XP YP HSIGN DIR RTP TDIR 67 | 68 | BLOCK 'COMPGRID' NOHEAD 'SWANOUT.mat' LAY 3 HSIGN DIR RTP TDIR 69 | 70 | 71 | 72 | POINTS 'TEST' FILE 'LOCATION.LOC' 73 | 74 | SPEC 'TEST' SPEC1D 'SPECOUT_1D.DAT' 75 | 76 | SPEC 'TEST' SPEC2D 'SPECOUT.DAT' 77 | 78 | 79 | 80 | COMPUTE 81 | ** Warning : Obstacle points moved 82 | OBSTACLE POINTS ( 400.00, 400.00), and ( 400.00, 450.00),moved to: ( 400.10, 400.00), and ( 400.10, 450.00), because OBSTACLE line piece was on computational grid point ( 400.00, 400.00). 83 | ** Warning : Obstacle points moved 84 | OBSTACLE POINTS ( 450.00, 500.00), and ( 450.00, 550.00),moved to: ( 450.10, 500.00), and ( 450.10, 550.00), because OBSTACLE line piece was on computational grid point ( 450.00, 500.00). 85 | ** Warning : Limiter is de-activated in case of no quadruplets 86 | 87 | ---------------------------------------------------------------- 88 | COMPUTATIONAL PART OF SWAN 89 | ---------------------------------------------------------------- 90 | 91 | Gridresolution : MXC 101 MYC 101 92 | : MCGRD 10202 93 | : MSC 26 MDC 180 94 | : MTC 1 95 | : NSTATC 0 ITERMX 50 96 | Propagation flags : ITFRE 1 IREFR 1 97 | Source term flags : IBOT 1 ISURF 1 98 | : IWCAP 1 IWIND 0 99 | : ITRIAD 0 IQUAD 0 100 | : IVEG 0 ITURBV 0 101 | : IMUD 0 102 | Spatial step : DX 0.1000E+02 DY 0.1000E+02 103 | Spectral bin : df/f 0.9648E-01 DDIR 0.2000E+01 104 | Physical constants : GRAV 0.9810E+01 RHO 0.1025E+04 105 | Wind input : WSPEED 0.0000E+00 DIR 0.0000E+00 106 | Tail parameters : E(f) 0.4000E+01 E(k) 0.2500E+01 107 | : A(f) 0.5000E+01 A(k) 0.3000E+01 108 | Accuracy parameters : DREL 0.1000E-01 NPNTS 0.9950E+02 109 | : DHABS 0.5000E-02 CURVAT 0.5000E-02 110 | : GRWMX 0.1000E+21 111 | Drying/flooding : LEVEL 0.0000E+00 DEPMIN 0.5000E-01 112 | The Cartesian convention for wind and wave directions is used 113 | Scheme for geographic propagation is SORDUP 114 | Scheme geogr. space : PROPSC 2 ICMAX 7 115 | Scheme spectral space: CSS 0.5000E+00 CDD 0.5000E+00 116 | Current is off 117 | Quadruplets is off 118 | Triads is off 119 | JONSWAP (`73) : GAMMA 0.3800E-01 120 | Vegetation is off 121 | Turbulence is off 122 | Fluid mud is off 123 | W-cap Komen (`84) : EMPCOF (CDS2): 0.2360E-04 124 | W-cap Komen (`84) : APM (STPM) : 0.3020E-02 125 | W-cap Komen (`84) : POWST : 0.2000E+01 126 | W-cap Komen (`84) : DELTA : 0.1000E+01 127 | W-cap Komen (`84) : POWK : 0.1000E+01 128 | Battjes&Janssen (`78): ALPHA 0.1000E+01 GAMMA 0.7300E+00 129 | Set-up is off 130 | Diffraction is off 131 | Janssen (`89,`90) : ALPHA 0.1000E-01 KAPPA 0.4100E+00 132 | Janssen (`89,`90) : RHOA 0.1280E+01 RHOW 0.1025E+04 133 | 134 | 1st and 2nd gen. wind: CF10 0.1880E+03 CF20 0.5900E+00 135 | : CF30 0.1200E+00 CF40 0.2500E+03 136 | : CF50 0.2300E-02 CF60 -0.2230E+00 137 | : CF70 0.0000E+00 CF80 -0.5600E+00 138 | : RHOAW 0.1249E-02 EDMLPM 0.3600E-02 139 | : CDRAG 0.1230E-02 UMIN 0.1000E+01 140 | : LIM_PM 0.1300E+00 141 | 142 | iteration 1; sweep 1 143 | iteration 1; sweep 2 144 | iteration 1; sweep 3 145 | iteration 1; sweep 4 146 | not possible to compute, first iteration 147 | 148 | iteration 2; sweep 1 149 | iteration 2; sweep 2 150 | iteration 2; sweep 3 151 | iteration 2; sweep 4 152 | accuracy OK in 97.05 % of wet grid points ( 99.50 % required) 153 | 154 | iteration 3; sweep 1 155 | iteration 3; sweep 2 156 | iteration 3; sweep 3 157 | iteration 3; sweep 4 158 | accuracy OK in 2.96 % of wet grid points ( 99.50 % required) 159 | 160 | iteration 4; sweep 1 161 | iteration 4; sweep 2 162 | iteration 4; sweep 3 163 | iteration 4; sweep 4 164 | accuracy OK in 100.00 % of wet grid points ( 99.50 % required) 165 | 166 | 167 | 168 | STOP 169 | -------------------------------------------------------------------------------- /src/SwanPrintGridInfo.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanPrintGridInfo 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Prints some relevant information concerning the grid 43 | ! 44 | ! Modules used 45 | ! 46 | use ocpcomm4 47 | use SwanGriddata 48 | use SwanGridobjects 49 | ! 50 | implicit none 51 | ! 52 | ! Local variables 53 | ! 54 | integer :: i ! loop counter 55 | integer, save :: ient = 0 ! number of entries in this subroutine 56 | integer :: iface ! actual face of the present cell 57 | integer :: j ! loop counter 58 | integer :: ncellsb ! number of boundary cells 59 | integer :: ncellsi ! number of internal cells 60 | integer :: nfacesb ! number of boundary faces 61 | integer :: nfacesi ! number of internal faces 62 | ! 63 | real :: area ! area of cell 64 | real :: gridsize ! actual gridsize of cell 65 | real, dimension(3) :: h ! altitudes of triangle 66 | ! 67 | character(80), dimension(2) :: helptxt ! auxiliary textlines 68 | ! 69 | type(celltype), dimension(:), pointer :: cell ! datastructure for cells with their attributes 70 | type(facetype), dimension(:), pointer :: face ! datastructure for faces with their attributes 71 | ! 72 | ! Structure 73 | ! 74 | ! Description of the pseudo code 75 | ! 76 | ! Source text 77 | ! 78 | if (ltrace) call strace (ient,'SwanPrintGridInfo') 79 | ! 80 | ! point to cell and face objects 81 | ! 82 | cell => gridobject%cell_grid 83 | face => gridobject%face_grid 84 | ! 85 | if ( grid_generator == meth_adcirc ) then 86 | ! 87 | ! grid is generated by SMS/ADCIRC 88 | ! 89 | write (helptxt(1),'(a)') 'solely triangles' 90 | write (helptxt(2),'(a)') 'SMS/ADCIRC' 91 | ! 92 | elseif ( grid_generator == meth_triangle ) then 93 | ! 94 | ! grid is generated by Triangle 95 | ! 96 | write (helptxt(1),'(a)') 'solely triangles' 97 | write (helptxt(2),'(a)') 'Triangle' 98 | ! 99 | elseif ( grid_generator == meth_easy ) then 100 | ! 101 | ! grid is generated by Easymesh 102 | ! 103 | write (helptxt(1),'(a)') 'solely triangles' 104 | write (helptxt(2),'(a)') 'Easymesh' 105 | ! 106 | else 107 | ! 108 | write (helptxt(1),'(a)') 'triangles or hybrid cells' 109 | write (helptxt(2),'(a)') 'unknown' 110 | ! 111 | endif 112 | ! 113 | ! determine number of boundary faces and boundary cells 114 | ! 115 | nfacesb = 0 116 | do i = 1, nfaces 117 | if ( face(i)%atti(FMARKER) == 1 ) nfacesb = nfacesb + 1 118 | enddo 119 | nfacesi = nfaces - nfacesb 120 | ncellsb = 0 121 | do i = 1, ncells 122 | if ( cell(i)%atti(CMARKER) == 1 ) ncellsb = ncellsb + 1 123 | enddo 124 | ncellsi = ncells - ncellsb 125 | ! 126 | ! write some constant with respect to the grid to PRINT file 127 | ! 128 | write(PRINTF,100) trim(helptxt(1)), trim(helptxt(2)), nverts, ncells, & 129 | ncellsi, ncellsb, nfaces, nfacesi, nfacesb 130 | ! 131 | ! determine minimum and maximum gridsize of the grid 132 | ! 133 | mingsiz = 1.0e10 134 | maxgsiz = 0.0 135 | ! 136 | do i = 1, ncells 137 | ! 138 | ! area of cell 139 | ! 140 | area = cell(i)%attr(CELLAREA) 141 | ! 142 | ! altitude of cell 143 | ! 144 | do j = 1, cell(i)%nof 145 | iface = cell(i)%face(j)%atti(FACEID) 146 | h(j) = 2.*area/face(iface)%attr(FACELEN) 147 | enddo 148 | ! 149 | ! compute gridsize of current cell 150 | ! 151 | gridsize = 1./sqrt((h(1)**(-2)+h(2)**(-2)+h(3)**(-2))/3.) 152 | ! 153 | ! determine minimum and maximum gridsize 154 | ! 155 | if ( gridsize < mingsiz ) then 156 | mingsiz = gridsize 157 | elseif ( gridsize > maxgsiz ) then 158 | maxgsiz = gridsize 159 | endif 160 | ! 161 | enddo 162 | ! 163 | write(PRINTF,200) mingsiz 164 | write(PRINTF,300) maxgsiz 165 | ! 166 | ! format statements 167 | ! 168 | 100 format(// ' The unstructured grid contains ',a,' generated by ',a// & 169 | ' Number of vertices = ',i7// & 170 | ' Number of cells = ', i7/ & 171 | ' Number of internal cells = ', i7/ & 172 | ' Number of boundary cells = ',i7// & 173 | ' Number of faces = ',i7/ & 174 | ' Number of internal faces = ',i7/ & 175 | ' Number of boundary faces = ',i7//) 176 | 200 format(' The minimum gridsize =',f12.5) 177 | 300 format(' The maximum gridsize =',f12.5) 178 | 179 | end subroutine SwanPrintGridInfo 180 | -------------------------------------------------------------------------------- /src/SwanFindPoint.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanFindPoint ( x, y, kvert ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, June 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Finds the closest vertex index of the given point 43 | ! 44 | ! Modules used 45 | ! 46 | use ocpcomm4 47 | use swcomm3 48 | use SwanGriddata 49 | use SwanGridobjects 50 | ! 51 | implicit none 52 | ! 53 | ! Argument variables 54 | ! 55 | integer, intent(out) :: kvert ! closest vertex index of given point 56 | ! Note: kvert = -1 indicate point is not found 57 | real, intent(in) :: x ! x-coordinate of given point 58 | real, intent(in) :: y ! y-coordinate of given point 59 | ! 60 | ! Local variables 61 | ! 62 | integer, save :: ient = 0 ! number of entries in this subroutine 63 | integer :: iface ! loop counter over faces 64 | integer :: ivert ! loop counter over vertices 65 | integer :: v1 ! first vertex of present face 66 | integer :: v2 ! second vertex of present face 67 | ! 68 | real :: dismin ! minimal distance found 69 | real :: dist ! computed distance 70 | real :: dxb ! x-component of length of boundary face 71 | real :: dyb ! y-component of length of boundary face 72 | real :: r ! relative distance of point to begin of boundary face 73 | real :: reldis ! relative distance of point to boundary face 74 | real :: x1 ! x-coordinate of begin of boundary face 75 | real :: x2 ! x-coordinate of end of boundary face 76 | real :: xc ! x-coordinate of closest vertex 77 | real :: y1 ! y-coordinate of begin of boundary face 78 | real :: y2 ! y-coordinate of end of boundary face 79 | real :: yc ! y-coordinate of closest vertex 80 | ! 81 | logical :: SwanPointinMesh ! indicate whether a point is inside mesh 82 | ! 83 | type(facetype), dimension(:), pointer :: face ! datastructure for faces with their attributes 84 | ! 85 | ! Structure 86 | ! 87 | ! Description of the pseudo code 88 | ! 89 | ! Source text 90 | ! 91 | if (ltrace) call strace (ient,'SwanFindPoint') 92 | ! 93 | ! point to face object 94 | ! 95 | face => gridobject%face_grid 96 | ! 97 | ! check whether point is outside the grid 98 | ! 99 | if ( x < XCGMIN .or. x > XCGMAX .or. y < YCGMIN .or. y > YCGMAX ) then 100 | ! 101 | kvert = -1 102 | return 103 | ! 104 | endif 105 | ! 106 | if ( SwanPointinMesh( x, y ) ) then 107 | ! 108 | ! if point is inside the mesh then compute closest index 109 | ! 110 | dismin = 1.e20 111 | ! 112 | do ivert = 1, nverts 113 | ! 114 | xc = xcugrd(ivert) 115 | yc = ycugrd(ivert) 116 | ! 117 | dist = sqrt( (x-xc)**2 + (y-yc)**2 ) 118 | if ( dist < dismin ) then 119 | kvert = ivert 120 | dismin = dist 121 | endif 122 | ! 123 | enddo 124 | ! 125 | else 126 | ! 127 | ! scan the boundary to look for the given point 128 | ! 129 | ! loop over faces (both internal and boundary faces) 130 | ! 131 | faceloop: do iface = 1, nfaces 132 | ! 133 | if ( face(iface)%atti(FMARKER) == 1 ) then ! boundary face 134 | ! 135 | v1 = face(iface)%atti(FACEV1) 136 | v2 = face(iface)%atti(FACEV2) 137 | ! 138 | x1 = xcugrd(v1) 139 | y1 = ycugrd(v1) 140 | x2 = xcugrd(v2) 141 | y2 = ycugrd(v2) 142 | ! 143 | dxb = x2 - x1 144 | dyb = y2 - y1 145 | ! 146 | reldis = abs( dyb*(x-x1) - dxb*(y-y1) ) / ( dxb*dxb + dyb*dyb ) 147 | ! 148 | if ( reldis < 0.01 ) then 149 | ! 150 | r = ( dxb*(x-x1) + dyb*(y-y1) ) / ( dxb*dxb + dyb*dyb ) 151 | ! 152 | if ( r < -0.01 .or. r > 1.01 ) then ! 41.13 153 | kvert = -1 154 | else 155 | ! 156 | if ( r < 0.5 ) then 157 | kvert = v1 158 | else 159 | kvert = v2 160 | endif 161 | exit faceloop 162 | ! 163 | endif 164 | ! 165 | else 166 | kvert = -1 167 | endif 168 | ! 169 | endif 170 | ! 171 | enddo faceloop 172 | ! 173 | endif 174 | ! 175 | end subroutine SwanFindPoint 176 | -------------------------------------------------------------------------------- /src/SwanReadTriangleGrid.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanReadTriangleGrid ( basenm, lenfnm ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Reads Triangle grid described in .node and .ele 43 | ! 44 | ! Method 45 | ! 46 | ! Grid coordinates of vertices are read from file .node and stored in Swan data structure 47 | ! Vertices of triangles are read from file .ele and stored in Swan data structure 48 | ! 49 | ! Modules used 50 | ! 51 | use ocpcomm4 52 | use SwanGriddata 53 | ! 54 | implicit none 55 | ! 56 | ! Argument variables 57 | ! 58 | integer, intent(in) :: lenfnm ! length of file names 59 | character(lenfnm), intent(in) :: basenm ! base name of Triangle files 60 | ! 61 | ! Local variables 62 | ! 63 | character(lenfnm) :: filenm ! file name 64 | integer, save :: ient = 0 ! number of entries in this subroutine 65 | integer :: idum ! dummy integer 66 | integer :: ii ! auxiliary integer 67 | integer :: iostat ! I/O status in call FOR 68 | integer :: istat ! indicate status of allocation 69 | integer :: j ! loop counter 70 | integer :: nattr ! number of attributes 71 | integer :: nbmark ! number of boundary markers (0 or 1) 72 | integer :: ndim ! dimension of Triangle (must be 2) 73 | integer :: ndsd ! unit reference number of file 74 | integer :: nnodes ! number of nodes per triangle 75 | real :: rdum ! dummy value 76 | character(80) :: line ! auxiliary textline 77 | logical :: stpnow ! indicate whether program must be terminated or not 78 | ! 79 | ! Structure 80 | ! 81 | ! Description of the pseudo code 82 | ! 83 | ! Source text 84 | ! 85 | if (ltrace) call strace (ient,'SwanReadTriangleGrid') 86 | ! 87 | ! open file .node containing the coordinates of vertices 88 | ! 89 | filenm = trim(basenm)//'.node' 90 | ndsd = 0 91 | iostat = 0 92 | call for (ndsd, filenm, 'OF', iostat) 93 | if (stpnow()) goto 900 94 | ! 95 | ! read first line to determine number of vertices 96 | ! 97 | read(ndsd, *, end=950, err=910) nverts, ndim, nattr, nbmark 98 | istat = 0 99 | if(.not.allocated(xcugrd)) allocate (xcugrd(nverts), stat = istat) 100 | if ( istat == 0 ) then 101 | if(.not.allocated(ycugrd)) allocate (ycugrd(nverts), stat = istat) 102 | endif 103 | if ( istat == 0 ) then 104 | if(.not.allocated(vmark)) allocate (vmark(nverts), stat = istat) 105 | endif 106 | if ( istat /= 0 ) then 107 | call msgerr ( 4, 'Allocation problem in SwanReadTriangleGrid: array xcugrd, ycugrd or vmark ' ) 108 | goto 900 109 | endif 110 | ! 111 | ! check if boundary marker has been specified 112 | ! 113 | if ( nbmark == 0 ) then 114 | call msgerr ( 4, 'boundary marker for vertices/faces must be specified ' ) 115 | goto 900 116 | endif 117 | ! 118 | ! read coordinates of vertices and boundary marker 119 | ! 120 | if ( nattr == 0 ) then 121 | do j = 1, nverts 122 | read(ndsd, *, end=950, err=910) ii, xcugrd(ii), ycugrd(ii), vmark(ii) 123 | if ( ii/=j ) call msgerr ( 1, 'numbering of vertices is not sequential in Triangle file '//filenm ) 124 | enddo 125 | else 126 | do j = 1, nverts 127 | read(ndsd, *, end=950, err=910) ii, xcugrd(ii), ycugrd(ii), rdum, vmark(ii) 128 | if ( ii/=j ) call msgerr ( 1, 'numbering of vertices is not sequential in Triangle file '//filenm ) 129 | enddo 130 | endif 131 | ! 132 | ! close file .node 133 | ! 134 | close(ndsd) 135 | ! 136 | ! open file .ele containing the (Delaunay) triangles 137 | ! 138 | filenm = trim(basenm)//'.ele' 139 | ndsd = 0 140 | iostat = 0 141 | call for (ndsd, filenm, 'OF', iostat) 142 | if (stpnow()) goto 900 143 | ! 144 | ! read first line to determine number of triangles 145 | ! 146 | read(ndsd, *, end=950, err=910) ncells, nnodes, nattr 147 | if(.not.allocated(kvertc)) allocate (kvertc(3,ncells), stat = istat) 148 | if ( istat /= 0 ) then 149 | call msgerr ( 4, 'Allocation problem in SwanReadTriangleGrid: array kvertc ' ) 150 | goto 900 151 | endif 152 | ! 153 | ! read vertices of triangles 154 | ! 155 | if ( nnodes == 3 .and. nattr == 0 ) then 156 | do j = 1, ncells 157 | read(ndsd, *, end=950, err=910) ii, kvertc(1,ii), kvertc(2,ii), kvertc(3,ii) 158 | if ( ii/=j ) call msgerr ( 1, 'numbering of triangles is not sequential in Triangle file '//filenm ) 159 | enddo 160 | else 161 | do j = 1, ncells 162 | read(ndsd, *, end=950, err=910) ii, kvertc(1,ii), kvertc(2,ii), kvertc(3,ii), line 163 | if ( ii/=j ) call msgerr ( 1, 'numbering of triangles is not sequential in Triangle file '//filenm ) 164 | enddo 165 | endif 166 | ! 167 | ! close file .ele 168 | ! 169 | close(ndsd) 170 | ! 171 | 900 return 172 | ! 173 | 910 inquire (unit=ndsd, name=filenm) 174 | call msgerr (4, 'error reading data from Triangle file '//filenm ) 175 | goto 900 176 | 950 inquire (unit=ndsd, name=filenm) 177 | call msgerr (4, 'unexpected end of file in Triangle file '//filenm ) 178 | goto 900 179 | ! 180 | end subroutine SwanReadTriangleGrid 181 | -------------------------------------------------------------------------------- /src/SwanCheckGrid.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanCheckGrid 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Checks whether the grid is suited for computation 43 | ! 44 | ! Method 45 | ! 46 | ! For the following aspects the grid is checked for: 47 | ! 1) the number of cells around vertex must be at least 4 and not larger than 10 48 | ! 2) the angles in each triangle must be smaller than 143 degrees 49 | ! 50 | ! Modules used 51 | ! 52 | use ocpcomm4 53 | use SwanGriddata 54 | ! 55 | implicit none 56 | ! 57 | ! Local variables 58 | ! 59 | integer :: i ! loop counter 60 | integer, save :: ient = 0 ! number of entries in this subroutine 61 | integer :: j ! loop counter 62 | integer :: v1 ! first vertex of present cell 63 | integer :: v2 ! second vertex of present cell 64 | integer :: v3 ! third vertex of present cell 65 | ! 66 | real :: cosphi1 ! cosine of the angle of first vertex in a triangle 67 | real :: cosphi2 ! cosine of the angle of second vertex in a triangle 68 | real :: cosphi3 ! cosine of the angle of third vertex in a triangle 69 | real :: len12 ! squared length of face between vertices 1 and 2 70 | real :: len13 ! squared length of face between vertices 1 and 3 71 | real :: len23 ! squared length of face between vertices 2 and 3 72 | real :: xdif12 ! difference in x-coordinate of vertices 1 and 2 73 | real :: xdif13 ! difference in x-coordinate of vertices 1 and 3 74 | real :: xdif23 ! difference in x-coordinate of vertices 2 and 3 75 | real :: ydif12 ! difference in y-coordinate of vertices 1 and 2 76 | real :: ydif13 ! difference in y-coordinate of vertices 1 and 3 77 | real :: ydif23 ! difference in y-coordinate of vertices 2 and 3 78 | ! 79 | integer, dimension(:), allocatable :: vcount ! counts number of cells around each vertex 80 | ! 81 | logical :: acute ! indicates whether triangles are acute (.TRUE.) or not (.FALSE.) 82 | logical :: badvertex ! indicates vertex has too less cells surrounded 83 | ! 84 | ! Structure 85 | ! 86 | ! Description of the pseudo code 87 | ! 88 | ! Source text 89 | ! 90 | if (ltrace) call strace (ient,'SwanCheckGrid') 91 | ! 92 | ! check whether the number of cells that meet at each internal vertex is at least 4 93 | ! (vertices at the boundaries not taken into account) 94 | ! check also whether the number of cells around each vertex is not larger than 10 95 | ! 96 | allocate (vcount(nverts)) 97 | vcount = 0 98 | ! 99 | do i = 1, ncells 100 | ! 101 | v1 = kvertc(1,i) 102 | v2 = kvertc(2,i) 103 | v3 = kvertc(3,i) 104 | ! 105 | do j = 1, nverts 106 | if ( v1 == j ) vcount(j) = vcount(j) + 1 107 | if ( v2 == j ) vcount(j) = vcount(j) + 1 108 | if ( v3 == j ) vcount(j) = vcount(j) + 1 109 | enddo 110 | ! 111 | enddo 112 | ! 113 | badvertex = .false. 114 | do i = 1, nverts 115 | !NADC if ( vcount(i) > 0 .and. vcount(i) < 4 .and. vmark(i) == 0 ) badvertex = .true. 116 | !ADC if ( vcount(i) > 0 .and. vcount(i) < 4 .and. vmark(i) == 0 ) vmark(i) = 1 117 | if ( vcount(i) > 10 ) badvertex = .true. 118 | enddo 119 | ! 120 | if ( badvertex ) call msgerr (2, 'number of cells around vertex is smaller than 4 or larger than 10') 121 | deallocate(vcount) 122 | ! 123 | acute = .true. 124 | ! 125 | ! check whether the angles in each triangle are smaller than a certain value (=143 degrees) 126 | ! 127 | do i = 1, ncells 128 | ! 129 | v1 = kvertc(1,i) 130 | v2 = kvertc(2,i) 131 | v3 = kvertc(3,i) 132 | ! 133 | xdif12 = xcugrd(v2) - xcugrd(v1) 134 | ydif12 = ycugrd(v2) - ycugrd(v1) 135 | xdif13 = xcugrd(v3) - xcugrd(v1) 136 | ydif13 = ycugrd(v3) - ycugrd(v1) 137 | xdif23 = xcugrd(v3) - xcugrd(v2) 138 | ydif23 = ycugrd(v3) - ycugrd(v2) 139 | ! 140 | len12 = xdif12*xdif12 + ydif12*ydif12 141 | len13 = xdif13*xdif13 + ydif13*ydif13 142 | len23 = xdif23*xdif23 + ydif23*ydif23 143 | ! 144 | ! is triangle acute ? 145 | ! 146 | if (acute) acute = (len12+len23>len13) .and. (len23+len13>len12) .and. (len13+len12>len23) 147 | ! 148 | cosphi1 =( xdif12*xdif13 + ydif12*ydif13)/(sqrt(len12*len13)) 149 | cosphi2 =(-xdif12*xdif23 - ydif12*ydif23)/(sqrt(len12*len23)) 150 | cosphi3 =( xdif13*xdif23 + ydif13*ydif23)/(sqrt(len13*len23)) 151 | ! 152 | if ( cosphi1 <= -0.8 .or. cosphi2 <= -0.8 .or. cosphi3 <= -0.8 ) then 153 | !NADC call msgerr (2, 'an angle in a triangle is too large ') 154 | endif 155 | ! 156 | enddo 157 | ! 158 | if (acute) call msgerr (0, 'The grid contains solely acute triangles ') 159 | ! 160 | end subroutine SwanCheckGrid 161 | -------------------------------------------------------------------------------- /src/SwanCreateEdges.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanCreateEdges 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 36 | ! Updates 37 | ! 38 | ! 40.80, July 2007: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Generates edge-based data structure 43 | ! 44 | ! Method 45 | ! 46 | ! Faces of triangles are computed from elements and stored in Swan data structure 47 | ! 48 | ! Modules used 49 | ! 50 | use ocpcomm4 51 | use SwanGriddata 52 | ! 53 | implicit none 54 | ! 55 | ! Local variables 56 | ! 57 | integer, save :: ient = 0 ! number of entries in this subroutine 58 | integer :: iface ! actual face of present cell 59 | integer :: istat ! indicate status of allocation 60 | integer :: j ! loop counter 61 | integer :: k ! loop counter 62 | integer :: m ! counter 63 | integer :: maxnf ! maximum number of faces 64 | integer :: n ! counter 65 | integer :: v1 ! first vertex of present cell 66 | integer :: v2 ! second vertex of present cell 67 | integer :: v3 ! third vertex of present cell 68 | integer, dimension(2,3) :: vf ! vertices of faces of present cell 69 | ! 70 | integer, dimension(: ), allocatable :: cntv1 ! array of vertex counter for for vertex 1 71 | integer, dimension(: ), allocatable :: cntv2 ! array of vertex counter for for vertex 2 72 | integer, dimension(:,:), allocatable :: iflist1 ! list of index faces stored for vertex 1 73 | integer, dimension(:,:), allocatable :: iflist2 ! list of index faces stored for vertex 2 74 | ! 75 | logical :: facefound ! true if face is found 76 | ! 77 | ! Structure 78 | ! 79 | ! Description of the pseudo code 80 | ! 81 | ! Source text 82 | ! 83 | if (ltrace) call strace (ient,'SwanCreateEdges') 84 | ! 85 | ! determine and store vertices of faces 86 | ! 87 | maxnf = 3*ncells ! maximum number of faces 88 | ! 89 | istat = 0 90 | if(.not.allocated(kvertf)) allocate (kvertf(2,maxnf), stat = istat) 91 | if ( istat /= 0 ) then 92 | call msgerr ( 4, 'Allocation problem in SwanCreateEdges: array kvertf ' ) 93 | return 94 | endif 95 | kvertf = 0 96 | ! 97 | allocate(cntv1 (nverts )) 98 | allocate(cntv2 (nverts )) 99 | allocate(iflist1(nverts,10)) 100 | allocate(iflist2(nverts,10)) 101 | ! 102 | cntv1 = 0 103 | cntv2 = 0 104 | iflist1 = -1 105 | iflist2 = -2 106 | ! 107 | nfaces = 0 108 | ! 109 | do j = 1, ncells 110 | ! 111 | v1 = kvertc(1,j) 112 | v2 = kvertc(2,j) 113 | v3 = kvertc(3,j) 114 | ! 115 | vf(1,1) = v2 116 | vf(2,1) = v3 117 | vf(1,2) = v3 118 | vf(2,2) = v1 119 | vf(1,3) = v1 120 | vf(2,3) = v2 121 | ! 122 | kloop: do k = 1, 3 123 | ! 124 | ! get two vertices of a face 125 | ! 126 | v1 = vf(1,k) 127 | v2 = vf(2,k) 128 | ! 129 | ! search for identification number of that face 130 | ! 131 | facefound = .false. 132 | ! 133 | mloop: do m = 1, 10 134 | ! 135 | iface = iflist1(v1,m) 136 | ! 137 | do n = 1, 10 138 | if ( iflist2(v2,n) == iface ) then 139 | facefound = .true. 140 | exit mloop 141 | endif 142 | enddo 143 | ! 144 | enddo mloop 145 | ! 146 | if ( .not.facefound ) then 147 | ! 148 | nloop: do n = 1, 10 149 | ! 150 | iface = iflist2(v1,n) 151 | ! 152 | do m = 1, 10 153 | if ( iflist1(v2,m) == iface ) then 154 | facefound = .true. 155 | exit nloop 156 | endif 157 | enddo 158 | ! 159 | enddo nloop 160 | ! 161 | endif 162 | ! 163 | if ( facefound ) cycle kloop 164 | ! 165 | nfaces = nfaces + 1 166 | if ( nfaces > maxnf ) then 167 | call msgerr ( 4, 'inconsistency found in SwanCreateEdges: more than maximum allowable faces found ' ) 168 | return 169 | endif 170 | ! 171 | m = cntv1(v1) +1 172 | if ( m > 10 ) then 173 | call msgerr ( 4, 'SwanCreateEdges: more than 10 faces around vertex ' ) 174 | return 175 | endif 176 | cntv1 (v1 ) = m 177 | iflist1(v1,m) = nfaces 178 | ! 179 | m = cntv2(v2) +1 180 | if ( m > 10 ) then 181 | call msgerr ( 4, 'SwanCreateEdges: more than 10 faces around vertex ' ) 182 | return 183 | endif 184 | cntv2 (v2 ) = m 185 | iflist2(v2,m) = nfaces 186 | ! 187 | kvertf(1,nfaces) = v1 188 | kvertf(2,nfaces) = v2 189 | ! 190 | enddo kloop 191 | ! 192 | enddo 193 | ! 194 | deallocate(cntv1,cntv2,iflist1,iflist2) 195 | ! 196 | end subroutine SwanCreateEdges 197 | -------------------------------------------------------------------------------- /src/SwanVertlist.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanVertlist 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 41.07: Casey Dietrich 36 | ! 41.48: Marcel Zijlema 37 | ! 38 | ! Updates 39 | ! 40 | ! 40.80, July 2007: New subroutine 41 | ! 41.07, July 2009: small fix (assign ref.point to deepest point in case of no b.c.) 42 | ! 41.48, March 2013: including order along a user-given direction 43 | ! 44 | ! Purpose 45 | ! 46 | ! Makes vertex list with specific order 47 | ! 48 | ! Method 49 | ! 50 | ! Sorting based on distance with respect to a reference point 51 | ! This reference point can be either a vertex with boundary condition or a deepest point 52 | ! 53 | ! Modules used 54 | ! 55 | use ocpcomm4 56 | use m_genarr, only: DEPTH 57 | use SwanGriddata 58 | use SwanGridobjects 59 | use SwanCompdata 60 | ! 61 | implicit none 62 | ! 63 | ! Local variables 64 | ! 65 | integer, save :: ient = 0 ! number of entries in this subroutine 66 | integer :: istat ! indicate status of allocation 67 | integer :: itmp ! temporary stored integer for swapping 68 | integer :: j ! loop counter over vertices 69 | integer :: k ! counter 70 | integer, dimension(1) :: kd ! location of minimum value in array dist 71 | integer, dimension(1) :: kx ! location of minimum value in array of x-coordinates of boundary vertices 72 | integer, dimension(1) :: ky ! location of minimum value in array of y-coordinates of boundary vertices 73 | ! 74 | real :: d1 ! distance of a point to origin 75 | real :: d2 ! distance of another point to origin 76 | real :: depmax ! maximum depth found 77 | real :: rtmp ! temporary stored real for swapping 78 | real :: x0 ! x-coordinate of reference point 79 | real :: y0 ! y-coordinate of reference point 80 | ! 81 | real, dimension(:), allocatable :: dist ! distance of each point with respect to reference point 82 | ! 83 | type(verttype), dimension(:), pointer :: vert ! datastructure for vertices with their attributes 84 | ! 85 | ! Structure 86 | ! 87 | ! Description of the pseudo code 88 | ! 89 | ! Source text 90 | ! 91 | if (ltrace) call strace (ient,'SwanVertlist') 92 | ! 93 | ! point to vertex object 94 | ! 95 | vert => gridobject%vert_grid 96 | ! 97 | istat = 0 98 | if(.not.allocated(vlist)) allocate (vlist(nverts), stat = istat) 99 | if ( istat /= 0 ) then 100 | call msgerr ( 4, 'Allocation problem in SwanVertlist: array vlist ' ) 101 | return 102 | endif 103 | ! 104 | allocate (dist(nverts)) 105 | ! 106 | if ( asort > -999. ) then 107 | ! 108 | ! order direction asort 109 | ! 110 | do j = 1, nverts 111 | dist(j) = vert(j)%attr(VERTX) * cos(asort) + vert(j)%attr(VERTY) * sin(asort) 112 | enddo 113 | ! 114 | else 115 | ! 116 | ! determine reference point 117 | ! 118 | if ( all(mask=vert(:)%atti(VBC)==0) ) then 119 | ! 120 | ! if no boundary condition is given then find the vertex with the maximum depth 121 | ! 122 | depmax = -999. 123 | ! 124 | do j = 1, nverts 125 | ! 126 | if ( DEPTH(j) > depmax ) then 127 | ! 128 | depmax = DEPTH(j) 129 | kx(1) = j 130 | ky(1) = j 131 | ! 132 | endif 133 | ! 134 | enddo 135 | ! 136 | else 137 | ! 138 | ! reference point is one of the vertices nearest to the origin where boundary condition is given 139 | ! 140 | kx = minloc(vert(:)%attr(VERTX), vert(:)%atti(VBC)/=0) 141 | ky = minloc(vert(:)%attr(VERTY), vert(:)%atti(VBC)/=0) 142 | ! 143 | endif 144 | ! 145 | if ( kx(1) == ky(1) ) then 146 | x0 = vert(kx(1))%attr(VERTX) 147 | y0 = vert(ky(1))%attr(VERTY) 148 | else 149 | ! 150 | d1 = sqrt((vert(kx(1))%attr(VERTX))**2+(vert(kx(1))%attr(VERTY))**2) 151 | d2 = sqrt((vert(ky(1))%attr(VERTX))**2+(vert(ky(1))%attr(VERTY))**2) 152 | ! 153 | if ( d1 < d2 ) then 154 | x0 = vert(kx(1))%attr(VERTX) 155 | y0 = vert(kx(1))%attr(VERTY) 156 | else 157 | x0 = vert(ky(1))%attr(VERTX) 158 | y0 = vert(ky(1))%attr(VERTY) 159 | endif 160 | ! 161 | endif 162 | ! 163 | ! calculate distance of each point with respect to reference point 164 | ! 165 | do j = 1, nverts 166 | dist(j) = sqrt((vert(j)%attr(VERTX)-x0)**2 + (vert(j)%attr(VERTY)-y0)**2) 167 | enddo 168 | ! 169 | endif 170 | ! 171 | ! sort vertex list in order of increasing distance 172 | ! 173 | vlist=(/ (j, j=1, nverts) /) 174 | ! 175 | do j = 1, nverts-1 176 | ! 177 | kd = minloc(dist(j:nverts)) 178 | k = kd(1) + j-1 179 | ! 180 | if ( k /= j ) then 181 | ! 182 | rtmp = dist(j) 183 | dist(j) = dist(k) 184 | dist(k) = rtmp 185 | ! 186 | itmp = vlist(j) 187 | vlist(j) = vlist(k) 188 | vlist(k) = itmp 189 | ! 190 | endif 191 | ! 192 | enddo 193 | ! 194 | deallocate(dist) 195 | ! 196 | end subroutine SwanVertlist 197 | -------------------------------------------------------------------------------- /src/SwanTranspX.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanTranspX ( amat , rhs , ac2 , ac1 , cax , cay , & 2 | rdx , rdy , obredf, idcmin, idcmax, isslow, & 3 | isstop , trac0, trac1 ) 4 | ! 5 | ! --|-----------------------------------------------------------|-- 6 | ! | Delft University of Technology | 7 | ! | Faculty of Civil Engineering and Geosciences | 8 | ! | Environmental Fluid Mechanics Section | 9 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 10 | ! | | 11 | ! | Programmer: Marcel Zijlema | 12 | ! --|-----------------------------------------------------------|-- 13 | ! 14 | ! 15 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 16 | ! Copyright (C) 1993-2017 Delft University of Technology 17 | ! 18 | ! This program is free software; you can redistribute it and/or 19 | ! modify it under the terms of the GNU General Public License as 20 | ! published by the Free Software Foundation; either version 2 of 21 | ! the License, or (at your option) any later version. 22 | ! 23 | ! This program is distributed in the hope that it will be useful, 24 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 25 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 26 | ! GNU General Public License for more details. 27 | ! 28 | ! A copy of the GNU General Public License is available at 29 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 30 | ! or by writing to the Free Software Foundation, Inc., 31 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 32 | ! 33 | ! 34 | ! Authors 35 | ! 36 | ! 40.80: Marcel Zijlema 37 | ! 38 | ! Updates 39 | ! 40 | ! 40.80, August 2007: New subroutine 41 | ! 40.85, August 2008: add xy-propagation for output purposes 42 | ! 43 | ! Purpose 44 | ! 45 | ! Computes transport in x-y space using the lowest order upwind scheme 46 | ! 47 | ! Modules used 48 | ! 49 | use ocpcomm4 50 | use swcomm2 51 | use swcomm3 52 | use swcomm4 53 | use SwanGriddata 54 | use SwanCompdata 55 | ! 56 | implicit none 57 | ! 58 | ! Argument variables 59 | ! 60 | integer, intent(in) :: isslow ! minimum frequency that is propagated within a sweep 61 | integer, intent(in) :: isstop ! maximum frequency that is propagated within a sweep 62 | ! 63 | integer, dimension(MSC), intent(in) :: idcmax ! maximum frequency-dependent counter in directional space 64 | integer, dimension(MSC), intent(in) :: idcmin ! minimum frequency-dependent counter in directional space 65 | ! 66 | real, dimension(MDC,MSC,nverts), intent(in) :: ac1 ! action density at previous time level 67 | real, dimension(MDC,MSC,nverts), intent(in) :: ac2 ! action density at current time level 68 | real, dimension(MDC,MSC,5), intent(inout) :: amat ! coefficient matrix of system of equations in (sigma,theta) space 69 | ! 1: correspond to point (l ,m ) 70 | ! 2: correspond to point (l-1,m ) 71 | ! 3: correspond to point (l+1,m ) 72 | ! 4: correspond to point (l ,m-1) 73 | ! 5: correspond to point (l ,m+1) 74 | real, dimension(MDC,MSC,ICMAX), intent(in) :: cax ! wave transport velocity in x-direction 75 | real, dimension(MDC,MSC,ICMAX), intent(in) :: cay ! wave transport velocity in y-direction 76 | real, dimension(MDC,MSC,2), intent(in) :: obredf ! action reduction coefficient based on transmission 77 | real, dimension(2), intent(in) :: rdx ! first component of contravariant base vector rdx(b) = a^(b)_1 78 | real, dimension(2), intent(in) :: rdy ! second component of contravariant base vector rdy(b) = a^(b)_2 79 | real, dimension(MDC,MSC), intent(inout) :: rhs ! right-hand side of system of equations in (sigma,theta) space 80 | real, dimension(MDC,MSC,MTRNP), intent(out) :: trac0 ! explicit part of propagation in present vertex for output purposes 81 | real, dimension(MDC,MSC,MTRNP), intent(out) :: trac1 ! implicit part of propagation in present vertex for output purposes 82 | ! 83 | ! Local variables 84 | ! 85 | integer :: id ! loop counter over direction bins 86 | integer :: iddum ! counter in directional space for considered sweep 87 | integer, save :: ient = 0 ! number of entries in this subroutine 88 | integer :: is ! loop counter over frequency bins 89 | integer :: iv1 ! first index in computational stencil 90 | integer :: iv2 ! second index in computational stencil 91 | integer :: iv3 ! third index in computational stencil 92 | ! 93 | real :: acold ! action density at previous time level 94 | real :: asum ! contributions to the matrix 95 | real :: fac1 ! auxiliary factor 96 | real :: fac2 ! another auxiliary factor 97 | real :: rsum ! contributions to the right-hand side 98 | ! 99 | ! Structure 100 | ! 101 | ! Description of the pseudo code 102 | ! 103 | ! Source text 104 | ! 105 | if (ltrace) call strace (ient,'SwanTranspX') 106 | ! 107 | iv1 = vs(1) 108 | iv2 = vs(2) 109 | iv3 = vs(3) 110 | ! 111 | if ( KSPHER == 0 ) then 112 | ! 113 | fac1 = 1. 114 | fac2 = 1. 115 | ! 116 | else 117 | ! 118 | fac1 = COSLAT(2)/COSLAT(1) 119 | fac2 = COSLAT(3)/COSLAT(1) 120 | ! 121 | endif 122 | ! 123 | do is = isslow, isstop 124 | ! 125 | do iddum = idcmin(is), idcmax(is) 126 | id = mod ( iddum - 1 + MDC , MDC ) + 1 127 | ! 128 | ! compute the contributions based on the lowest order upwind scheme 129 | ! 130 | asum = (rdx(1)+rdx(2))*cax(id,is,1) + (rdy(1)+rdy(2))*cay(id,is,1) 131 | ! 132 | rsum = (rdx(1)*cax(id,is,2) + rdy(1)*cay(id,is,2)*fac1)*obredf(id,is,1)*ac2(id,is,iv2) + & 133 | (rdx(2)*cax(id,is,3) + rdy(2)*cay(id,is,3)*fac2)*obredf(id,is,2)*ac2(id,is,iv3) 134 | ! 135 | ! build the system 136 | ! 137 | amat(id,is,1) = amat(id,is,1) + asum 138 | rhs (id,is ) = rhs (id,is ) + rsum 139 | ! 140 | trac0(id,is,1) = trac0(id,is,1) - rsum 141 | trac1(id,is,1) = trac1(id,is,1) + asum 142 | ! 143 | if ( NSTATC == 1 ) then 144 | ! 145 | if ( ITERMX == 1 ) then 146 | acold = ac2(id,is,iv1) 147 | else 148 | acold = ac1(id,is,iv1) 149 | endif 150 | ! 151 | amat(id,is,1) = amat(id,is,1) + RDTIM 152 | rhs (id,is ) = rhs (id,is ) + acold*RDTIM 153 | ! 154 | trac0(id,is,1) = trac0(id,is,1) - acold*RDTIM 155 | trac1(id,is,1) = trac1(id,is,1) + RDTIM 156 | ! 157 | endif 158 | ! 159 | enddo 160 | ! 161 | enddo 162 | ! 163 | end subroutine SwanTranspX 164 | -------------------------------------------------------------------------------- /src/SwanReadADCGrid.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanReadADCGrid 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 40.80: Marcel Zijlema 35 | ! 40.95: Marcel Zijlema 36 | ! 41.07: Casey Dietrich 37 | ! 38 | ! Updates 39 | ! 40 | ! 40.80, December 2007: New subroutine 41 | ! 40.95, June 2008: parallelization of unSWAN using MESSENGER of ADCIRC 42 | ! 41.07, August 2009: use ADCIRC boundary info to mark all boundary vertices 43 | ! 44 | ! Purpose 45 | ! 46 | ! Reads ADCIRC grid described in fort.14 47 | ! 48 | ! Method 49 | ! 50 | ! Grid coordinates of vertices are read from file fort.14 and stored in Swan data structure 51 | ! Vertices of triangles are read from file fort.14 and stored in Swan data structure 52 | ! 53 | ! Bottom topography from file fort.14 will also be stored 54 | ! 55 | ! Modules used 56 | ! 57 | !PUN use ocpcomm2 58 | use ocpcomm4 59 | use m_genarr 60 | use SwanGriddata 61 | !PUN use SIZES 62 | !PUN use MESSENGER 63 | ! 64 | implicit none 65 | ! 66 | ! Local variables 67 | ! 68 | character(80) :: grdfil ! name of grid file including path 69 | integer, save :: ient = 0 ! number of entries in this subroutine 70 | integer :: idum ! dummy integer 71 | integer :: ii ! auxiliary integer 72 | integer :: iostat ! I/O status in call FOR 73 | integer :: istat ! indicate status of allocation 74 | integer :: itype ! ADCIRC boundary type 75 | integer :: ivert ! vertex index 76 | integer :: ivert1 ! another vertex index 77 | integer :: j ! loop counter 78 | integer :: k ! loop counter 79 | integer :: n1 ! auxiliary integer 80 | integer :: n2 ! another auxiliary integer 81 | integer :: ndsd ! unit reference number of file 82 | integer :: nopbc ! number of open boundaries in ADCIRC 83 | integer :: vm ! boundary marker 84 | character(80) :: line ! auxiliary textline 85 | logical :: stpnow ! indicate whether program must be terminated or not 86 | ! 87 | ! Structure 88 | ! 89 | ! Description of the pseudo code 90 | ! 91 | ! Source text 92 | ! 93 | if (ltrace) call strace (ient,'SwanReadADCGrid') 94 | ! 95 | ! open file fort.14 96 | ! 97 | ndsd = 0 98 | iostat = 0 99 | grdfil = 'fort.14' 100 | !PUN grdfil = trim(INPUTDIR)//DIRCH2//trim(grdfil) 101 | call for (ndsd, grdfil, 'OF', iostat) 102 | if (stpnow()) goto 900 103 | ! 104 | ! skip first line 105 | ! 106 | read(ndsd,'(a80)', end=950, err=910) line 107 | ! 108 | ! read number of elements and number of vertices 109 | ! 110 | read(ndsd, *, end=950, err=910) ncells, nverts 111 | istat = 0 112 | if(.not.allocated(xcugrd)) allocate (xcugrd(nverts), stat = istat) 113 | if ( istat == 0 ) then 114 | if(.not.allocated(ycugrd)) allocate (ycugrd(nverts), stat = istat) 115 | endif 116 | if ( istat == 0 ) then 117 | if(.not.allocated(DEPTH)) allocate (DEPTH(nverts), stat = istat) 118 | endif 119 | if ( istat /= 0 ) then 120 | call msgerr ( 4, 'Allocation problem in SwanReadADCGrid: array xcugrd, ycugrd or depth ' ) 121 | goto 900 122 | endif 123 | ! 124 | ! read coordinates of vertices and bottom topography 125 | ! 126 | do j = 1, nverts 127 | read(ndsd, *, end=950, err=910) ii, xcugrd(ii), ycugrd(ii), DEPTH(ii) 128 | if ( ii/=j ) call msgerr ( 1, 'numbering of vertices is not sequential in grid file fort.14 ' ) 129 | enddo 130 | ! 131 | if(.not.allocated(kvertc)) allocate (kvertc(3,ncells), stat = istat) 132 | if ( istat /= 0 ) then 133 | call msgerr ( 4, 'Allocation problem in SwanReadADCGrid: array kvertc ' ) 134 | goto 900 135 | endif 136 | ! 137 | ! read vertices of triangles 138 | ! 139 | do j = 1, ncells 140 | read(ndsd, *, end=950, err=910) ii, idum, kvertc(1,ii), kvertc(2,ii), kvertc(3,ii) 141 | if ( ii/=j ) call msgerr ( 1, 'numbering of triangles is not sequential in grid file fort.14 ' ) 142 | enddo 143 | ! 144 | if(.not.allocated(vmark)) allocate (vmark(nverts), stat = istat) 145 | if ( istat /= 0 ) then 146 | call msgerr ( 4, 'Allocation problem in SwanReadADCGrid: array vmark ' ) 147 | goto 900 148 | endif 149 | vmark = 0 150 | ! 151 | ! read ADCIRC boundary information and store boundary markers 152 | ! 153 | read(ndsd, *, end=950, err=910) nopbc 154 | read(ndsd, *, end=950, err=910) idum 155 | do j = 1, nopbc 156 | !PUN if ( MNPROC==1 ) then 157 | vm = j 158 | read(ndsd, *, end=950, err=910) n2 159 | !PUN else 160 | !PUN read(ndsd, *, end=950, err=910) n2, vm 161 | !PUN endif 162 | do k = 1, n2 163 | read(ndsd, *, end=950, err=910) ivert 164 | vmark(ivert) = vm 165 | enddo 166 | enddo 167 | ! 168 | read(ndsd, *, end=950, err=910) n1 169 | read(ndsd, *, end=950, err=910) idum 170 | do j = 1, n1 171 | !PUN if ( MNPROC==1 ) then 172 | vm = nopbc + j 173 | read(ndsd, *, end=950, err=910) n2, itype 174 | !PUN else 175 | !PUN read(ndsd, *, end=950, err=910) n2, itype, vm 176 | !PUN endif 177 | if ( itype /= 4 .and. itype /= 24 ) then 178 | do k = 1, n2 179 | read(ndsd, *, end=950, err=910) ivert 180 | vmark(ivert) = vm 181 | enddo 182 | else 183 | do k = 1, n2 184 | read(ndsd, *, end=950, err=910) ivert, ivert1 185 | vmark(ivert ) = vm 186 | vmark(ivert1) = vm 187 | enddo 188 | endif 189 | enddo 190 | ! 191 | ! close file fort.14 192 | ! 193 | close(ndsd) 194 | ! 195 | !PUN ! ghost vertices are marked with +999 196 | !PUN ! 197 | !PUN do j = 1, NEIGHPROC 198 | !PUN do k = 1, NNODRECV(j) 199 | !PUN ivert = IRECVLOC(k,j) 200 | !PUN vmark(ivert) = 999 201 | !PUN enddo 202 | !PUN enddo 203 | !PUN ! 204 | 900 return 205 | ! 206 | 910 call msgerr (4, 'error reading data from grid file fort.14' ) 207 | goto 900 208 | 950 call msgerr (4, 'unexpected end of file in grid file fort.14' ) 209 | goto 900 210 | ! 211 | end subroutine SwanReadADCGrid 212 | -------------------------------------------------------------------------------- /src/SwanBndStruc.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanBndStruc ( xcgrid, ycgrid ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmers: The SWAN team | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | ! 32 | ! Authors 33 | ! 34 | ! 41.14: Nico Booij 35 | ! 36 | ! Updates 37 | ! 38 | ! 41.14, Aug. 2010: New subroutine 39 | ! 40 | ! Purpose 41 | ! 42 | ! Generates output curves 'BOUNDARY' and 'BOUND_01' until 'BOUND_04' 43 | ! in the case of a structured grid (both regular and curvilinear). 44 | ! 45 | ! Method 46 | ! 47 | ! The procedure starts at the origin of the grid, and then moves 48 | ! around the grid in counterclockwise order. 49 | ! 50 | ! Modules used 51 | ! 52 | use ocpcomm4 53 | use SWCOMM1 54 | use SWCOMM2 55 | use SWCOMM3 56 | use OUTP_DATA 57 | ! 58 | implicit none 59 | ! 60 | ! Argument variables 61 | ! 62 | real, dimension(MXC,MYC), intent(in) :: xcgrid ! x-coordinate of computational grid 63 | real, dimension(MXC,MYC), intent(in) :: ycgrid ! y-coordinate of computational grid 64 | ! 65 | ! Local variables 66 | ! 67 | integer :: ix, iy ! point index 68 | integer :: ibnd ! number of valid points along boundary 69 | integer :: iside ! side counter (1..4) 70 | integer :: lside ! number of points on one side 71 | integer :: ispt ! number of valid points on one side 72 | integer :: mip ! number of output points 73 | integer :: xstep, ystep 74 | integer :: ix0, ix1, iy0, iy1 75 | integer :: ii, jj ! counters 76 | integer, save :: ient = 0 ! number of entries in this subroutine 77 | ! 78 | logical, save :: done=.false. ! if true procedure has been done 79 | logical :: EQREAL ! function 80 | ! 81 | real :: xp, yp ! one boundary point 82 | real, allocatable, dimension (:) :: xbnd, ybnd ! points of whole boundary 83 | real, allocatable, dimension (:) :: xsid, ysid ! points of one side 84 | ! 85 | character(80) :: msgstr ! string to pass message 86 | character(len=8) :: psname ! name assigned to output curve 87 | ! 88 | TYPE(OPSDAT), POINTER :: OPSTMP, ROPS 89 | ! 90 | ! Structure 91 | ! 92 | ! Description of the pseudo code 93 | ! 94 | ! Source text 95 | ! 96 | if (ltrace) call strace (ient,'SwanBndStruc') 97 | ! 98 | ! if list of boundary vertices is already filled, return 99 | ! 100 | if (done) return 101 | ! 102 | if (.not.allocated(xbnd)) allocate (xbnd(1:2*(mxc+myc-2))) 103 | if (.not.allocated(ybnd)) allocate (ybnd(1:2*(mxc+myc-2))) 104 | ibnd = 0 105 | do iside = 1, 4 106 | if (iside==1) then 107 | ix0 = 1 108 | ix1 = mxc 109 | xstep = 1 110 | iy0 = 1 111 | iy1 = 1 112 | ystep = 0 113 | lside = mxc 114 | elseif (iside==2) then 115 | ix0 = mxc 116 | ix1 = mxc 117 | xstep = 0 118 | iy0 = 1 119 | iy1 = myc 120 | ystep = 1 121 | lside = myc 122 | elseif (iside==3) then 123 | ix0 = mxc 124 | ix1 = 1 125 | xstep = -1 126 | iy0 = myc 127 | iy1 = myc 128 | ystep = 0 129 | lside = mxc 130 | elseif (iside==4) then 131 | ix0 = 1 132 | ix1 = 1 133 | xstep = 0 134 | iy0 = myc 135 | iy1 = 1 136 | ystep = -1 137 | lside = myc 138 | endif 139 | ! 140 | if (.not.allocated(xsid)) allocate (xsid(1:lside)) 141 | if (.not.allocated(ysid)) allocate (ysid(1:lside)) 142 | ix = ix0 143 | iy = iy0 144 | ispt = 0 145 | ! 146 | do ii = 1, lside 147 | ! 148 | ! loop over points of one side of the grid 149 | ! 150 | xp = xcgrid(ix,iy) 151 | yp = ycgrid(ix,iy) 152 | if (.not.(EQREAL(xp,OVEXCV(1)).or.EQREAL(yp,OVEXCV(2)))) then 153 | ! point has valid coordinates 154 | ispt = ispt + 1 155 | xsid(ispt) = xp 156 | ysid(ispt) = yp 157 | if (ii0) then 174 | allocate(OPSTMP) 175 | OPSTMP%PSNAME = psname 176 | OPSTMP%PSTYPE = 'C' 177 | OPSTMP%MIP = mip 178 | allocate(OPSTMP%XP(mip)) 179 | allocate(OPSTMP%YP(mip)) 180 | do jj = 1, mip 181 | OPSTMP%XP(jj) = xsid(jj) 182 | OPSTMP%YP(jj) = ysid(jj) 183 | enddo 184 | deallocate (xsid, ysid) 185 | nullify (OPSTMP%NEXTOPS) 186 | if ( .not.LOPS ) then 187 | FOPS = OPSTMP 188 | COPS => FOPS 189 | LOPS = .TRUE. 190 | else 191 | COPS%NEXTOPS => OPSTMP 192 | COPS => OPSTMP 193 | endif 194 | if (ITEST>=10) write (PRTEST, *) 'Output curve ', psname, & 195 | ' with ', mip, ' points is generated' 196 | else 197 | call MSGERR(1,'No output points found in '//psname) 198 | endif 199 | enddo 200 | ! 201 | psname = 'BOUNDARY' 202 | mip = ibnd 203 | if (mip>0) then 204 | allocate(OPSTMP) 205 | OPSTMP%PSNAME = psname 206 | OPSTMP%PSTYPE = 'C' 207 | OPSTMP%MIP = mip 208 | allocate(OPSTMP%XP(mip)) 209 | allocate(OPSTMP%YP(mip)) 210 | do jj = 1, mip 211 | OPSTMP%XP(jj) = xbnd(jj) 212 | OPSTMP%YP(jj) = ybnd(jj) 213 | enddo 214 | deallocate(xbnd,ybnd) 215 | nullify (OPSTMP%NEXTOPS) 216 | if ( .not.LOPS ) then 217 | FOPS = OPSTMP 218 | COPS => FOPS 219 | LOPS = .TRUE. 220 | else 221 | COPS%NEXTOPS => OPSTMP 222 | COPS => OPSTMP 223 | endif 224 | if (ITEST>=10) write (PRTEST, *) 'Output curve ', psname, & 225 | ' with ', mip, ' points is generated' 226 | else 227 | call MSGERR(1,'No output points found in '//psname) 228 | endif 229 | ! 230 | done = .true. ! prevents second entry into this subroutine 231 | ! 232 | end subroutine SwanBndStruc 233 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------------------ 2 | # Makefile for building SWAN program and documentation 3 | # ------------------------------------------------------------------------------ 4 | # 5 | # Before compilation, type "make config" first! 6 | # 7 | # To compile the serial executable type "make ser" 8 | # To compile the OpenMP executable type "make omp" 9 | # To compile the MPI executable type "make mpi" 10 | # To compile the PunSWAN executable "make punswan" 11 | # 12 | # To remove compiled objects and modules: type "make clean" 13 | # 14 | # To remove compiled objects, modules and executable: type "make clobber" 15 | # 16 | # To compile the SWAN documentation type "make doc" 17 | # 18 | # To remove the PDF and HTML documents type "make cleandoc" 19 | # 20 | # Please do not change anything below, unless you're very sure what you're doing 21 | # ------------------------------------------------------------------------------ 22 | 23 | include macros.inc 24 | 25 | SWAN_EXE = swan.exe 26 | 27 | SWAN_OBJS = \ 28 | swmod1.$(EXTO) \ 29 | swmod2.$(EXTO) \ 30 | SwanSpectPart.$(EXTO) \ 31 | m_constants.$(EXTO) \ 32 | m_fileio.$(EXTO) \ 33 | serv_xnl4v5.$(EXTO) \ 34 | mod_xnl4v5.$(EXTO) \ 35 | SwanGriddata.$(EXTO) \ 36 | SwanGridobjects.$(EXTO) \ 37 | SwanCompdata.$(EXTO) \ 38 | SdsBabanin.$(EXTO) \ 39 | $(NCF_OBJS) \ 40 | swan2coh.$(EXTO) \ 41 | swanmain.$(EXTO) \ 42 | swanpre1.$(EXTO) \ 43 | swanpre2.$(EXTO) \ 44 | swancom1.$(EXTO) \ 45 | swancom2.$(EXTO) \ 46 | swancom3.$(EXTO) \ 47 | swancom4.$(EXTO) \ 48 | swancom5.$(EXTO) \ 49 | swanout1.$(EXTO) \ 50 | swanout2.$(EXTO) \ 51 | swanser.$(EXTO) \ 52 | swanparll.$(EXTO) \ 53 | SwanReadGrid.$(EXTO) \ 54 | SwanReadADCGrid.$(EXTO) \ 55 | SwanReadTriangleGrid.$(EXTO) \ 56 | SwanReadEasymeshGrid.$(EXTO) \ 57 | SwanInitCompGrid.$(EXTO) \ 58 | SwanCheckGrid.$(EXTO) \ 59 | SwanCreateEdges.$(EXTO) \ 60 | SwanGridTopology.$(EXTO) \ 61 | SwanGridVert.$(EXTO) \ 62 | SwanGridCell.$(EXTO) \ 63 | SwanGridFace.$(EXTO) \ 64 | SwanPrintGridInfo.$(EXTO) \ 65 | SwanFindPoint.$(EXTO) \ 66 | SwanPointinMesh.$(EXTO) \ 67 | SwanBpntlist.$(EXTO) \ 68 | SwanPrepComp.$(EXTO) \ 69 | SwanVertlist.$(EXTO) \ 70 | SwanCompUnstruc.$(EXTO) \ 71 | SwanDispParm.$(EXTO) \ 72 | SwanPropvelX.$(EXTO) \ 73 | SwanSweepSel.$(EXTO) \ 74 | SwanPropvelS.$(EXTO) \ 75 | SwanTranspAc.$(EXTO) \ 76 | SwanTranspX.$(EXTO) \ 77 | SwanDiffPar.$(EXTO) \ 78 | SwanGSECorr.$(EXTO) \ 79 | SwanGradDepthorK.$(EXTO) \ 80 | SwanGradVel.$(EXTO) \ 81 | SwanInterpolatePoint.$(EXTO) \ 82 | SwanInterpolateAc.$(EXTO) \ 83 | SwanInterpolateOutput.$(EXTO) \ 84 | SwanConvAccur.$(EXTO) \ 85 | SwanConvStopc.$(EXTO) \ 86 | SwanThreadBounds.$(EXTO) \ 87 | SwanFindObstacles.$(EXTO) \ 88 | SwanCrossObstacle.$(EXTO) \ 89 | SwanComputeForce.$(EXTO) \ 90 | SwanIntgratSpc.$(EXTO) \ 91 | SwanBndStruc.$(EXTO) \ 92 | SwanReadfort18.$(EXTO) \ 93 | SwanPunCollect.$(EXTO) \ 94 | SwanSumOverNodes.$(EXTO) \ 95 | SwanMinOverNodes.$(EXTO) \ 96 | SwanMaxOverNodes.$(EXTO) \ 97 | ocpids.$(EXTO) \ 98 | ocpcre.$(EXTO) \ 99 | ocpmix.$(EXTO) \ 100 | Pincident.$(EXTO) \ 101 | Bivariate_1.$(EXTO) 102 | 103 | SWAN_LIB = libswan.so 104 | 105 | HCAT_EXE = hcat.exe 106 | HCAT_OBJS = swanhcat.$(EXTO) 107 | 108 | MSG_OBJS = \ 109 | $(O_DIR)mkdir.$(EXTO) \ 110 | $(O_DIR)sizes.$(EXTO) \ 111 | $(O_DIR)global.$(EXTO) \ 112 | $(O_DIR)global_3dvs.$(EXTO) \ 113 | $(O_DIR)version.$(EXTO) \ 114 | $(O_DIR)messenger.$(EXTO) 115 | 116 | UNHCAT_EXE = unhcat.exe 117 | UNHCAT_OBJS = HottifySWAN.$(EXTO) 118 | 119 | .SUFFIXES: .f .for .f90 120 | 121 | .PHONY: help clean clobber 122 | 123 | help: 124 | @echo "This Makefile supports the following:" 125 | @echo "make config -- makes machine-dependent macros include file" 126 | @echo "make ser -- makes the serial $(SWAN_EXE) executable" 127 | @echo "make omp -- makes the OpenMP $(SWAN_EXE) executable" 128 | @echo "make mpi -- makes the MPI $(SWAN_EXE) executable" 129 | @echo "make jac -- makes the MPI $(SWAN_EXE) executable" 130 | @echo "make punswan -- makes the parallel un$(SWAN_EXE) executable" 131 | @echo "make coh -- makes the MPI SWAN library for coupling with COHERENS" 132 | @echo "make doc -- makes the SWAN documentation (PDF)" 133 | @echo "make clean -- removes compiled objects and modules" 134 | @echo "make clobber -- removes compiled objects, modules and $(SWAN_EXE)" 135 | @echo "make cleandoc -- removes all SWAN documents" 136 | 137 | config: 138 | @perl platform.pl 139 | 140 | install: 141 | @perl platform.pl 142 | 143 | ser: 144 | @perl switch.pl $(swch) *.ftn *.ftn90 145 | $(MAKE) FOR=$(F90_SER) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_SER)" \ 146 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_SER)" \ 147 | INCS="$(INCS_SER)" LIBS="$(LIBS_SER)" OBJS="$(SWAN_OBJS)" $(SWAN_EXE) 148 | 149 | omp: 150 | @perl switch.pl $(swch) *.ftn *.ftn90 151 | $(MAKE) FOR=$(F90_OMP) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_OMP)" \ 152 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_OMP)" \ 153 | INCS="$(INCS_OMP)" LIBS="$(LIBS_OMP)" OBJS="$(SWAN_OBJS)" $(SWAN_EXE) 154 | 155 | mpi: 156 | @perl switch.pl $(swch) -mpi *.ftn *.ftn90 157 | $(MAKE) FOR=$(F90_MPI) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_MPI)" \ 158 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_MPI)" \ 159 | INCS="$(INCS_MPI)" LIBS="$(LIBS_MPI)" OBJS="$(SWAN_OBJS)" $(SWAN_EXE) 160 | $(MAKE) hcat 161 | 162 | jac: 163 | @perl switch.pl $(swch) -jac -mpi *.ftn *.ftn90 164 | $(MAKE) FOR=$(F90_MPI) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_MPI)" \ 165 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_MPI)" \ 166 | INCS="$(INCS_MPI)" LIBS="$(LIBS_MPI)" OBJS="$(SWAN_OBJS)" $(SWAN_EXE) 167 | $(MAKE) hcat 168 | 169 | punswan: 170 | @perl switch.pl $(swch) -pun *.ftn *.ftn90 171 | $(MAKE) FOR=$(F90_MPI) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_MPI)" \ 172 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_MPI)" \ 173 | INCS="$(INCS_MPI) -I$(O_DIR)" LIBS="$(LIBS_MPI)" \ 174 | OBJS="$(MSG_OBJS) $(SWAN_OBJS)" $(SWAN_EXE) 175 | $(MAKE) unhcat 176 | 177 | coh: 178 | @perl switch.pl $(swch) -mpi -coh *.ftn *.ftn90 179 | $(MAKE) FOR=$(F90_MPI) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_MPI) $(FLAGS_DYN)" \ 180 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_MPI) $(FLAGS_DYN)" \ 181 | INCS="$(INCS_MPI)" LIBS="$(LIBS_MPI)" OBJS="$(SWAN_OBJS)" $(SWAN_LIB) 182 | 183 | hcat: 184 | @perl switch.pl $(swch) swanhcat.ftn 185 | $(MAKE) FOR=$(F90_SER) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_SER)" \ 186 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_SER)" $(HCAT_EXE) 187 | 188 | unhcat: 189 | @perl switch.pl $(swch) HottifySWAN.ftn90 190 | $(MAKE) FOR=$(F90_SER) FFLAGS="$(FLAGS_OPT) $(FLAGS_MSC) $(FLAGS_SER)" \ 191 | FFLAGS90="$(FLAGS_OPT) $(FLAGS90_MSC) $(FLAGS_SER)" $(UNHCAT_EXE) 192 | 193 | doc: 194 | $(MAKE) -f Makefile.latex TARGET=swanuse doc 195 | $(MAKE) -f Makefile.latex TARGET=swantech doc 196 | $(MAKE) -f Makefile.latex TARGET=swanimp doc 197 | $(MAKE) -f Makefile.latex TARGET=swanpgr doc 198 | $(MAKE) -f Makefile.latex TARGET=latexfordummies doc 199 | 200 | $(HCAT_EXE): $(HCAT_OBJS) 201 | $(FOR) $(HCAT_OBJS) $(FFLAGS) $(OUT)$(HCAT_EXE) 202 | 203 | $(UNHCAT_EXE): $(UNHCAT_OBJS) 204 | $(FOR) $(UNHCAT_OBJS) $(FFLAGS) $(OUT)$(UNHCAT_EXE) 205 | 206 | $(SWAN_EXE): $(SWAN_OBJS) 207 | $(FOR) $(OBJS) $(FFLAGS) $(OUT)$(SWAN_EXE) $(INCS) $(LIBS) 208 | 209 | $(SWAN_LIB): $(SWAN_OBJS) 210 | $(FOR) -shared $(OUT)$(SWAN_LIB) $(OBJS) $(FFLAGS) $(INCS) $(LIBS) 211 | 212 | .f.o: 213 | $(FOR) $< -c $(FFLAGS) $(INCS) 214 | 215 | .f90.o: 216 | $(FOR) $< -c $(FFLAGS90) $(INCS) 217 | 218 | .for.o: 219 | $(FOR) $< -c $(FFLAGS) $(INCS) 220 | 221 | .for.obj: 222 | $(FOR) $< -c $(FFLAGS) $(INCS) 223 | 224 | .f90.obj: 225 | $(FOR) $< -c $(FFLAGS90) $(INCS) 226 | 227 | clean: 228 | $(RM) *.$(EXTO) *.mod 229 | 230 | clobber: 231 | $(RM) *.$(EXTO) *.mod *.f *.for *.f90 $(SWAN_EXE) $(HCAT_EXE) $(UNHCAT_EXE) $(SWAN_LIB) 232 | 233 | allclean: 234 | $(RM) *.$(EXTO) *.mod *.f *.for *.f90 $(SWAN_EXE) $(HCAT_EXE) $(UNHCAT_EXE) $(SWAN_LIB) 235 | 236 | cleandoc: 237 | $(MAKE) -f Makefile.latex TARGET=swanuse cleandoc 238 | $(MAKE) -f Makefile.latex TARGET=swantech cleandoc 239 | $(MAKE) -f Makefile.latex TARGET=swanimp cleandoc 240 | $(MAKE) -f Makefile.latex TARGET=swanpgr cleandoc 241 | $(MAKE) -f Makefile.latex TARGET=latexfordummies cleandoc 242 | -------------------------------------------------------------------------------- /src/SwanPunCollect.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanPunCollect ( blkndc ) 2 | ! 3 | ! --|-----------------------------------------------------------|-- 4 | ! | Delft University of Technology | 5 | ! | Faculty of Civil Engineering and Geosciences | 6 | ! | Environmental Fluid Mechanics Section | 7 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 8 | ! | | 9 | ! | Programmer: Marcel Zijlema | 10 | ! --|-----------------------------------------------------------|-- 11 | ! 12 | ! 13 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 14 | ! Copyright (C) 1993-2017 Delft University of Technology 15 | ! 16 | ! This program is free software; you can redistribute it and/or 17 | ! modify it under the terms of the GNU General Public License as 18 | ! published by the Free Software Foundation; either version 2 of 19 | ! the License, or (at your option) any later version. 20 | ! 21 | ! This program is distributed in the hope that it will be useful, 22 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ! GNU General Public License for more details. 25 | ! 26 | ! A copy of the GNU General Public License is available at 27 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 28 | ! or by writing to the Free Software Foundation, Inc., 29 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 30 | ! 31 | !PUN! 32 | !PUN! Authors 33 | !PUN! 34 | !PUN! 41.36: Marcel Zijlema 35 | !PUN! 41.40: Sander Hulst 36 | !PUN! 37 | !PUN! Updates 38 | !PUN! 39 | !PUN! 41.36, July 2012: New subroutine 40 | !PUN! 41.40, November 2012: add global grid coordinates 41 | !PUN! 42 | !PUN! Purpose 43 | !PUN! 44 | !PUN! Determines for each grid vertex in global grid the node number 45 | !PUN! Also determines grid coordinates in global grid 46 | !PUN! 47 | !PUN! Method 48 | !PUN! 49 | !PUN! Collect specific data from all nodes 50 | !PUN! 51 | !PUN! Modules used 52 | !PUN! 53 | !PUN use mpi 54 | !PUN use ocpcomm4 55 | !PUN use swcomm2, only: XOFFS, YOFFS 56 | !PUN use m_parall, only: IAMMASTER 57 | !PUN use SwanGriddata, only: ivertg, nverts, nvertsg, xcugrd, ycugrd, xcugrdgl, ycugrdgl 58 | !PUN use SIZES, only: MYPROC, MNPROC 59 | !PUN use GLOBAL, only: COMM 60 | !PUN! 61 | !PUN implicit none 62 | !PUN! 63 | !PUN! Argument variables 64 | !PUN! 65 | !PUN real, dimension(nvertsg), intent(out) :: blkndc ! array giving node number in each grid vertex in global grid 66 | !PUN! 67 | !PUN! Local variables 68 | !PUN! 69 | !PUN integer, save :: ient = 0 ! number of entries in this subroutine 70 | !PUN integer :: ierr ! error value of MPI call 71 | !PUN integer :: j ! loop counter 72 | !PUN integer :: k ! loop counter 73 | !PUN integer :: nownv ! number of vertices in own subdomain (without ghost vertices) 74 | !PUN ! 75 | !PUN integer, dimension(:), allocatable :: iarr ! auxiliary integer array to gather data 76 | !PUN integer, dimension(:), allocatable :: icount ! array specifying array size of data received from each processor 77 | !PUN integer, dimension(:), allocatable :: idsplc ! array specifying the starting address of the incoming data from each processor, relative to the global array 78 | !PUN integer, dimension(:), allocatable :: ivertp ! vertex index of global grid in own subdomain (without ghost vertices) 79 | !PUN ! 80 | !PUN real , dimension(:), allocatable :: arr ! auxiliary real array to gather data 81 | !PUN real , dimension(:), allocatable :: blknd ! node number per subdomain (without ghost vertices) 82 | !PUN real , dimension(:), allocatable :: xpl ! user coordinates grid points (without ghost vertices) 83 | !PUN real , dimension(:), allocatable :: ypl ! user coordinates grid points (without ghost vertices) 84 | !PUN ! 85 | !PUN character(80) :: msgstr ! string to pass message 86 | !PUN! 87 | !PUN! Structure 88 | !PUN! 89 | !PUN! Description of the pseudo code 90 | !PUN! 91 | !PUN! Source text 92 | !PUN! 93 | !PUN if (ltrace) call strace (ient,'SwanPunCollect') 94 | !PUN ! 95 | !PUN nownv = count(ivertg>0) 96 | !PUN ! 97 | !PUN allocate(ivertp(nownv)) 98 | !PUN allocate( blknd(nownv)) 99 | !PUN allocate( xpl(nownv)) 100 | !PUN allocate( ypl(nownv)) 101 | !PUN ! 102 | !PUN ! determine node number per subdomain 103 | !PUN ! 104 | !PUN k = 0 105 | !PUN do j = 1, nverts 106 | !PUN if ( ivertg(j) > 0 ) then 107 | !PUN k = k + 1 108 | !PUN ivertp(k) = ivertg(j) 109 | !PUN blknd (k) = real(MYPROC+1) 110 | !PUN xpl (k) = xcugrd(j) + XOFFS 111 | !PUN ypl (k) = ycugrd(j) + YOFFS 112 | !PUN endif 113 | !PUN enddo 114 | !PUN ! 115 | !PUN if ( IAMMASTER ) then 116 | !PUN allocate(icount(0:MNPROC-1)) 117 | !PUN allocate(idsplc(0:MNPROC-1)) 118 | !PUN endif 119 | !PUN ! 120 | !PUN ! gather the array sizes to the master 121 | !PUN ! 122 | !PUN call MPI_GATHER( nownv, 1, MPI_INTEGER, icount, 1, MPI_INTEGER, 0, COMM, ierr ) 123 | !PUN if ( ierr /= MPI_SUCCESS ) then 124 | !PUN write (msgstr, '(a,i6)') ' MPI produces some internal error - return code is ',ierr 125 | !PUN call msgerr( 4, trim(msgstr) ) 126 | !PUN return 127 | !PUN endif 128 | !PUN ! 129 | !PUN ! check consistency with respect to size of gathered data 130 | !PUN ! 131 | !PUN if ( IAMMASTER ) then 132 | !PUN if ( sum(icount) /= nvertsg ) then 133 | !PUN call msgerr(4, 'inconsistency found in SwanPunCollect: size of gathered data not correct ') 134 | !PUN return 135 | !PUN endif 136 | !PUN endif 137 | !PUN ! 138 | !PUN ! calculate starting address of each local array with respect to the global array 139 | !PUN ! 140 | !PUN if ( IAMMASTER ) then 141 | !PUN idsplc(0) = 0 142 | !PUN do j = 1, MNPROC-1 143 | !PUN idsplc(j) = icount(j-1) + idsplc(j-1) 144 | !PUN enddo 145 | !PUN endif 146 | !PUN ! 147 | !PUN if ( IAMMASTER ) then 148 | !PUN allocate( iarr(nvertsg)) 149 | !PUN allocate( arr(nvertsg)) 150 | !PUN allocate(xcugrdgl(nvertsg)) 151 | !PUN allocate(ycugrdgl(nvertsg)) 152 | !PUN endif 153 | !PUN ! 154 | !PUN ! gather different amounts of data from each processor to the master 155 | !PUN ! 156 | !PUN call MPI_GATHERV( ivertp, nownv, MPI_INTEGER, iarr, icount, idsplc, MPI_INTEGER, 0, COMM, ierr ) 157 | !PUN if ( ierr == MPI_SUCCESS ) call MPI_GATHERV( blknd, nownv, MPI_REAL, arr, icount, idsplc, MPI_REAL, 0, COMM, ierr ) 158 | !PUN if ( ierr /= MPI_SUCCESS ) then 159 | !PUN write (msgstr, '(a,i6)') ' MPI produces some internal error - return code is ',ierr 160 | !PUN call msgerr( 4, trim(msgstr) ) 161 | !PUN return 162 | !PUN endif 163 | !PUN ! 164 | !PUN if ( IAMMASTER ) then 165 | !PUN do j = 1, nvertsg 166 | !PUN blkndc(iarr(j)) = arr(j) 167 | !PUN enddo 168 | !PUN endif 169 | !PUN ! 170 | !PUN call MPI_GATHERV( xpl, nownv, MPI_REAL, arr, icount, idsplc, MPI_REAL, 0, COMM, ierr ) 171 | !PUN if ( ierr /= MPI_SUCCESS ) then 172 | !PUN write (msgstr, '(a,i6)') ' MPI produces some internal error - return code is ',ierr 173 | !PUN call msgerr( 4, trim(msgstr) ) 174 | !PUN return 175 | !PUN endif 176 | !PUN ! 177 | !PUN if ( IAMMASTER ) then 178 | !PUN do j = 1, nvertsg 179 | !PUN xcugrdgl(iarr(j)) = arr(j) 180 | !PUN enddo 181 | !PUN endif 182 | !PUN ! 183 | !PUN call MPI_GATHERV( ypl, nownv, MPI_REAL, arr, icount, idsplc, MPI_REAL, 0, COMM, ierr ) 184 | !PUN if ( ierr /= MPI_SUCCESS ) then 185 | !PUN write (msgstr, '(a,i6)') ' MPI produces some internal error - return code is ',ierr 186 | !PUN call msgerr( 4, trim(msgstr) ) 187 | !PUN return 188 | !PUN endif 189 | !PUN ! 190 | !PUN if ( IAMMASTER ) then 191 | !PUN do j = 1, nvertsg 192 | !PUN ycugrdgl(iarr(j)) = arr(j) 193 | !PUN enddo 194 | !PUN endif 195 | !PUN ! 196 | !PUN deallocate(ivertp,blknd) 197 | !PUN deallocate(xpl,ypl) 198 | !PUN if ( IAMMASTER ) deallocate(icount,idsplc,iarr,arr) 199 | !PUN ! 200 | end subroutine SwanPunCollect 201 | -------------------------------------------------------------------------------- /tutorial/plot_swan.py: -------------------------------------------------------------------------------- 1 | # Updated to Python 3.7 2 | 3 | from scipy.io import loadmat 4 | import numpy as np 5 | #import pylab as plt 6 | import matplotlib.pyplot as plt 7 | 8 | ########################################################################################### 9 | 10 | def clean_line(line): 11 | line = line.strip() # remove leading and trailing whitespace, carriage returns 12 | line = line.replace(',', ' ') # change commas to spaces 13 | line = line.split() # split on spaces 14 | 15 | return line 16 | 17 | ########################################################################################### 18 | 19 | def GetStruc(InpFile): 20 | ## determine whether run is structured/unstructured 21 | iunst=-1 #0 = structured, 1 = unstructured, -1 = undetermined 22 | with open(inputfile,'r') as fin: 23 | for line in fin: 24 | linein = line.split() 25 | ## read until 'CGRID' colorfound 26 | if len(linein) == 0: 27 | continue # cycle this loop 28 | if linein[0].upper().find('''CGRID''') >= 0: 29 | if linein[1].upper().find('''UNS''') >= 0: 30 | iunst=1 31 | break 32 | if linein[1].upper().find('''REG''') >= 0: 33 | iunst=0 34 | break 35 | 36 | return iunst 37 | 38 | ########################################################################################### 39 | 40 | def GetMat(InpFile): 41 | ## get the matlab output file 42 | with open(InpFile,'r') as fin: 43 | linein = fin.readline() 44 | ## read until 'BLOCK COMPGRID' output line found 45 | ifound=1 46 | while linein.upper().find("""BLOCK 'COMPGRID'""") < 0: 47 | linein = fin.readline() 48 | if linein == '': #EOF 49 | ifound=0 50 | break 51 | if ifound == 0: 52 | matfile = '' 53 | data = '' 54 | else: 55 | matfile = linein.split()[3].replace("'","") 56 | print('Loading ' + matfile) 57 | data = loadmat(matfile, struct_as_record=False, squeeze_me=True) 58 | 59 | return matfile, data 60 | 61 | ########################################################################################### 62 | 63 | def GetNodeEleFile(InpFile): 64 | ## get node and element files 65 | with open(InpFile,'r') as fin: 66 | for line in fin: 67 | linein = line.split() 68 | ## find the line defining the unstructure grid files 69 | if linein[0].upper().find("""READ""") >= 0 and linein[1].upper().find("""UNSTRUC""") >= 0: 70 | casename = linein[3].replace("'","") 71 | break 72 | 73 | return casename+'.node', casename+'.ele' 74 | 75 | ########################################################################################### 76 | 77 | def ReadNodeLocs(NodeFile): 78 | with open(NodeFile,'r') as fin: 79 | nnode = int(float(fin.readline().split()[0])) 80 | # for each line in file, split it and extract x,y, convert to float 81 | # first line is nverts, ndim, nattr (???), nbmark (value of boundary mark) 82 | # other lines are node#, xloc, yloc, vmark (mark value?) 83 | nodelocs = np.asarray( [ [float(val) for val in dataline.split()[1:3]] for dataline in fin.readlines()] ) # just take columns 2 and 3 (x and y) 84 | 85 | return nnode, nodelocs 86 | 87 | ########################################################################################### 88 | 89 | def ReadElems(EleFile): 90 | with open(EleFile,'r') as fin: 91 | nele = int(fin.readline().split()[0]) 92 | # for each line in file, split it and extract x,y, convert to float 93 | # subtract one because python counts from 0 94 | elenodes = np.asarray( [ [int(val)-1 for val in dataline.split()[1:4]] for dataline in fin.readlines()] ) 95 | 96 | return nele, elenodes 97 | 98 | ########################################################################################### 99 | 100 | def GetStrucGrid(InpFile): 101 | ## get the grid coordinates 102 | with open(InpFile,'r') as fin: 103 | linein = fin.readline() 104 | # 105 | # read until 'CGRID REGULAR' found 106 | # 107 | while linein.upper().find('''CGRID REG''') < 0: 108 | linein = fin.readline() 109 | 110 | GridInfo=linein.split()[2:] # chop off keywords in the front 111 | 112 | xo = float(GridInfo[0]) 113 | yo = float(GridInfo[1]) 114 | # rot = float(GridInfo[2]) 115 | xmax = float(GridInfo[3]) 116 | ymax = float(GridInfo[4]) 117 | nx = int(GridInfo[5]) +1 118 | ny = int(GridInfo[6]) +1 119 | 120 | xvalues = np.asarray(np.linspace(xo,xmax,nx)) 121 | yvalues = np.asarray(np.linspace(yo,ymax,ny)) 122 | 123 | # TODO: add rotation functionality 124 | return xvalues, yvalues 125 | 126 | ########################################################################################### 127 | 128 | def GetObs(InpFile): 129 | ## get the obstacle locations 130 | obslist=[] 131 | with open(InpFile,'r') as fin: 132 | for linein in fin: 133 | ## read each 'OBSTACLE' line found 134 | if linein.upper().find('''OBSTACLE''') >= 0: 135 | obsinfo = [float(val) for val in clean_line(linein)[-4:] ] # chop off initial keywords, float the rest 136 | obslist.append(obsinfo) # append the obstacle info to the list 137 | 138 | return obslist 139 | 140 | ########################################################################################### 141 | ## Begin body of the script 142 | ########################################################################################### 143 | 144 | #import sys 145 | ## define input filename 146 | inputfile = 'INPUT' 147 | 148 | ## read in grid structure format 0 = structured, 1 = unstructured 149 | iunst = GetStruc(inputfile) 150 | if iunst == -1: 151 | print('ERROR structure not found') 152 | exit() 153 | 154 | ## get the matlab dataarray 155 | matfile, mat = GetMat(inputfile) 156 | if matfile == '': 157 | print('ERROR matfile not found') 158 | exit() 159 | 160 | ## load mat variables 161 | plot_vars = list(mat.keys()) 162 | plot_vars.remove('__globals__') 163 | plot_vars.remove('__header__') 164 | plot_vars.remove('__version__') 165 | plot_unit = ['[m]', '[s]', '[s]', '[deg]'] 166 | num_vars = len(plot_vars) 167 | len_vars = range(num_vars) 168 | 169 | ## loop through each variable 170 | if num_vars > 1: 171 | for i in len_vars: 172 | num_vars = len_vars[i] 173 | 174 | ## get obstacle locations 175 | obslist = GetObs(inputfile) 176 | 177 | ## set up the plotting 178 | fig, ax=plt.subplots() 179 | fig.set_facecolor("white") 180 | 181 | ## choose color map 182 | # colormap = 'jet' 183 | # colormap = 'copper' 184 | # colormap = 'plasma' 185 | colormap = 'viridis' 186 | 187 | ## plot the data 188 | if iunst == 1: 189 | nodefile, elefile = GetNodeEleFile(inputfile) 190 | nnode, nodelocs = ReadNodeLocs(nodefile) 191 | nele, elenodes = ReadElems(elefile) 192 | 193 | x = nodelocs[:,0] 194 | y = nodelocs[:,1] 195 | z = mat[plot_vars[num_vars]] 196 | 197 | import matplotlib.tri as tri 198 | grid = tri.Triangulation(x, y, triangles=elenodes, mask=None) 199 | 200 | CSF = plt.tricontourf(grid,z,256,cmap=colormap) 201 | #gridlines = plt.triplot(grid,color='k') 202 | else: 203 | x,y = GetStrucGrid(inputfile) 204 | xi, yi = np.meshgrid(x,y) 205 | z = mat[plot_vars[num_vars]] 206 | CSF = plt.contourf(xi,yi,z,256,cmap=colormap) 207 | 208 | ## square axes 209 | plt.axis('equal') 210 | 211 | ## plot axes 212 | plt.xlim(min(x),max(x)) 213 | plt.ylim(min(y),max(y)) 214 | plt.xlabel('Cross-shore [m]') 215 | plt.ylabel('Along-shore [m]') 216 | plt.title(plot_vars[num_vars]) 217 | cbar = plt.colorbar(fraction=0.15, pad=0.05, format = '%0.4f') 218 | cbar.set_label(plot_vars[num_vars] + ' ' + plot_unit[num_vars]) 219 | 220 | ## plot the obstacles 221 | for obs in obslist: 222 | x = [ obs[0], obs[2] ] 223 | y = [ obs[1], obs[3] ] 224 | plt.plot(x,y, color='k', linewidth=2) 225 | #plt.show() 226 | 227 | ## split off the extension 228 | import os.path 229 | pngFile = os.path.splitext(matfile)[0] 230 | ## add variable plotted 231 | pngFile += '_'+plot_vars[num_vars] 232 | ## add png extension 233 | pngFile += '.png' 234 | plt.savefig(pngFile) 235 | 236 | -------------------------------------------------------------------------------- /src/SwanTranspAc.ftn90: -------------------------------------------------------------------------------- 1 | subroutine SwanTranspAc ( amat , rhs , leakcf, ac2 , ac1 , & 2 | cgo , cax , cay , cad , cas , & 3 | anybin, rdx , rdy , spcsig, spcdir, & 4 | obredf, idcmin, idcmax, iscmin, iscmax, & 5 | iddlow, iddtop, isslow, isstop, anyblk, & 6 | trac0 , trac1 ) 7 | ! 8 | ! --|-----------------------------------------------------------|-- 9 | ! | Delft University of Technology | 10 | ! | Faculty of Civil Engineering and Geosciences | 11 | ! | Environmental Fluid Mechanics Section | 12 | ! | P.O. Box 5048, 2600 GA Delft, The Netherlands | 13 | ! | | 14 | ! | Programmer: Marcel Zijlema | 15 | ! --|-----------------------------------------------------------|-- 16 | ! 17 | ! 18 | ! SWAN (Simulating WAves Nearshore); a third generation wave model 19 | ! Copyright (C) 1993-2017 Delft University of Technology 20 | ! 21 | ! This program is free software; you can redistribute it and/or 22 | ! modify it under the terms of the GNU General Public License as 23 | ! published by the Free Software Foundation; either version 2 of 24 | ! the License, or (at your option) any later version. 25 | ! 26 | ! This program is distributed in the hope that it will be useful, 27 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 28 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 29 | ! GNU General Public License for more details. 30 | ! 31 | ! A copy of the GNU General Public License is available at 32 | ! http://www.gnu.org/copyleft/gpl.html#SEC3 33 | ! or by writing to the Free Software Foundation, Inc., 34 | ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 35 | ! 36 | ! 37 | ! Authors 38 | ! 39 | ! 40.80: Marcel Zijlema 40 | ! 41 | ! Updates 42 | ! 43 | ! 40.80, August 2007: New subroutine 44 | ! 40.85, August 2008: add tranport terms for output purposes 45 | ! 41.00, February 2009: add GSE correction 46 | ! 41.07, July 2009: add explicit scheme for sigma space 47 | ! 48 | ! Purpose 49 | ! 50 | ! Computes the transport part of the action balance equation 51 | ! 52 | ! Modules used 53 | ! 54 | use ocpcomm4 55 | use swcomm2 56 | use swcomm3 57 | use swcomm4 58 | use SwanGriddata 59 | ! 60 | implicit none 61 | ! 62 | ! Argument variables 63 | ! 64 | integer, intent(in) :: iddlow ! minimum direction bin that is propagated within a sweep 65 | integer, intent(in) :: iddtop ! maximum direction bin that is propagated within a sweep 66 | integer, intent(in) :: isslow ! minimum frequency that is propagated within a sweep 67 | integer, intent(in) :: isstop ! maximum frequency that is propagated within a sweep 68 | ! 69 | integer, dimension(MSC), intent(in) :: idcmax ! maximum frequency-dependent counter in directional space 70 | integer, dimension(MSC), intent(in) :: idcmin ! minimum frequency-dependent counter in directional space 71 | integer, dimension(MDC), intent(in) :: iscmax ! maximum direction-dependent counter in frequency space 72 | integer, dimension(MDC), intent(in) :: iscmin ! minimum direction-dependent counter in frequency space 73 | ! 74 | real, dimension(MDC,MSC,nverts), intent(in) :: ac1 ! action density at previous time level 75 | real, dimension(MDC,MSC,nverts), intent(in) :: ac2 ! action density at current time level 76 | real, dimension(MDC,MSC,5), intent(out) :: amat ! coefficient matrix of system of equations in (sigma,theta) space 77 | ! 1: correspond to point (l ,m ) 78 | ! 2: correspond to point (l-1,m ) 79 | ! 3: correspond to point (l+1,m ) 80 | ! 4: correspond to point (l ,m-1) 81 | ! 5: correspond to point (l ,m+1) 82 | real, dimension(MDC,MSC), intent(in) :: cad ! wave transport velocity in theta-direction 83 | real, dimension(MDC,MSC), intent(in) :: cas ! wave transport velocity in sigma-direction 84 | real, dimension(MDC,MSC,ICMAX), intent(in) :: cax ! wave transport velocity in x-direction 85 | real, dimension(MDC,MSC,ICMAX), intent(in) :: cay ! wave transport velocity in y-direction 86 | real, dimension(MSC,ICMAX), intent(in) :: cgo ! group velocity 87 | real, dimension(MDC,MSC), intent(out) :: leakcf ! leak coefficient 88 | real, dimension(MDC,MSC,2), intent(in) :: obredf ! action reduction coefficient based on transmission 89 | real, dimension(2), intent(in) :: rdx ! first component of contravariant base vector rdx(b) = a^(b)_1 90 | real, dimension(2), intent(in) :: rdy ! second component of contravariant base vector rdy(b) = a^(b)_2 91 | real, dimension(MDC,MSC), intent(out) :: rhs ! right-hand side of system of equations in (sigma,theta) space 92 | real, dimension(MDC,6), intent(in) :: spcdir ! (*,1): spectral direction bins (radians) 93 | ! (*,2): cosine of spectral directions 94 | ! (*,3): sine of spectral directions 95 | ! (*,4): cosine^2 of spectral directions 96 | ! (*,5): cosine*sine of spectral directions 97 | ! (*,6): sine^2 of spectral directions 98 | real, dimension(MSC), intent(in) :: spcsig ! relative frequency bins 99 | real, dimension(MDC,MSC,MTRNP), intent(out) :: trac0 ! explicit part of propagation in present vertex for output purposes 100 | real, dimension(MDC,MSC,MTRNP), intent(out) :: trac1 ! implicit part of propagation in present vertex for output purposes 101 | ! 102 | logical, dimension(MDC,MSC), intent(in) :: anybin ! true if bin is active in considered sweep 103 | logical, dimension(MDC,MSC), intent(out) :: anyblk ! true if bin is blocked by a counter current based on a CFL criterion 104 | ! 105 | ! Local variables 106 | ! 107 | integer, save :: ient = 0 ! number of entries in this subroutine 108 | ! 109 | ! Structure 110 | ! 111 | ! Description of the pseudo code 112 | ! 113 | ! Source text 114 | ! 115 | if (ltrace) call strace (ient,'SwanTranspAc') 116 | ! 117 | ! set matrix and right-hand side to zero 118 | ! 119 | amat = 0. 120 | rhs = 0. 121 | ! 122 | ! set leak and transport coefficients to zero 123 | ! 124 | leakcf = 0. 125 | trac0 = 0. 126 | trac1 = 0. 127 | ! 128 | ! compute transport in x-y space 129 | ! 130 | !TIMG call SWTSTA(140) 131 | call SwanTranspX ( amat , rhs , ac2 , ac1 , cax , cay , & 132 | rdx , rdy , obredf, idcmin, idcmax, isslow, & 133 | isstop , trac0, trac1 ) 134 | ! 135 | ! add GSE correction, if appropriate 136 | ! 137 | if ( WAVAGE > 0. ) call SwanGSECorr ( rhs, ac2, cgo, spcdir, idcmin, idcmax, isslow, isstop, trac0 ) 138 | !TIMG call SWTSTO(140) 139 | ! 140 | ! compute transport in theta space 141 | ! 142 | !TIMG call SWTSTA(142) 143 | if ( IREFR /= 0 ) then 144 | ! 145 | call STRSD ( DDIR , idcmin , idcmax , cad , & 146 | amat(1,1,4), amat(1,1,1), amat(1,1,5), rhs , & 147 | ac2 , isstop , anybin , leakcf , & 148 | trac0 , trac1 ) 149 | ! 150 | endif 151 | !TIMG call SWTSTO(142) 152 | ! 153 | ! compute transport in sigma space 154 | ! 155 | !TIMG call SWTSTA(141) 156 | if ( (DYNDEP .OR. ICUR /= 0) .and. ITFRE /= 0 ) then 157 | ! 158 | if ( int(PNUMS(8)) == 1 ) then 159 | ! 160 | ! implicit scheme 161 | ! 162 | call STRSSI ( spcsig , cas , amat(1,1,2), amat(1,1,1), & 163 | amat(1,1,3), anybin, rhs , ac2 , & 164 | iscmin , iscmax, iddlow , iddtop , & 165 | trac0 , trac1 ) 166 | ! 167 | elseif ( int(PNUMS(8)) == 2 ) then 168 | ! 169 | ! explicit scheme 170 | ! 171 | call STRSSB ( iddlow, iddtop, idcmin, idcmax, isstop, & 172 | cax , cay , cas , ac2 , spcsig, & 173 | rhs , anyblk, rdx , rdy , trac0 ) 174 | ! 175 | endif 176 | ! 177 | endif 178 | !TIMG call SWTSTO(141) 179 | ! 180 | end subroutine SwanTranspAc 181 | --------------------------------------------------------------------------------