├── README.md ├── Makefile ├── pointNeighbor.f90 ├── gcl.f90 ├── commonModules.f90 ├── mLaplace.f90 ├── biconjGrad.f90 ├── calcRHS.f90 ├── dataLoader.f90 ├── smoothing.f90 ├── meshMove.f90 ├── ns2DComp.ALE.f90 └── subrutinas.f90 /README.md: -------------------------------------------------------------------------------- 1 | cfd 2 | === 3 | Authors: Shing Chan, Alejandro Agustin Figueroa & German Weht. 4 | 5 | Instituto Universitario Aeronautico, Cordoba - Argentina. 6 | 7 | Solver for Navier Stokes equations with a Streamline Upwind Petrov-Galerkin formulation on a 2D unstructured mesh, 8 | based on Tayfun E. Tezduyar and Masayoshi Senga, "Stabilization and shock-capturing parameters 9 | in SUPG formulation of compressible flows", plus an Arbitrary Lagrangian-Eulerian formulation. 10 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | FC = ifort 2 | OMP = -openmp 3 | FFLAGS = -fast -fpp -mkl $(OMP) #-fpe0 4 | LFLAGS = $(OMP) -mkl 5 | OBJECTS = commonModules.o dataLoader.o pointNeighbor.o \ 6 | mLaplace.o biconjGrad.o smoothing.o calcRHS.o \ 7 | subrutinas.o meshMove.o ns2DComp.ALE.o 8 | 9 | .PHONY: clean 10 | 11 | all: ns 12 | 13 | xhost: FFLAGS += -xHost 14 | xhost: ns 15 | 16 | debug: FFLAGS += -check bounds -traceback -warn 17 | debug: ns 18 | 19 | idb: FFLAGS = -debug -O0 -fpp $(OMP) 20 | idb: LFLAGS = -debug $(OMP) 21 | idb: ns 22 | 23 | profile: FFLAGS += -p 24 | profile: ns 25 | 26 | ns: $(OBJECTS) 27 | $(FC) $(LFLAGS) $(OBJECTS) -o ns 28 | 29 | %.o: %.f90 30 | $(FC) $(FFLAGS) -c $< 31 | 32 | clean: 33 | rm -f $(OBJECTS) ns *.mod 34 | -------------------------------------------------------------------------------- /pointNeighbor.f90: -------------------------------------------------------------------------------- 1 | module PointNeighbor 2 | integer, dimension(:), allocatable :: esup1, esup2 3 | integer, dimension(:), allocatable :: psup1, psup2, lpoin 4 | contains 5 | subroutine getEsup(inpoel,nelem,npoin) 6 | implicit none 7 | integer nelem, npoin 8 | integer inpoel(3,nelem) 9 | integer ielem, ipoi1, ipoin, istor, i 10 | allocate(esup2(npoin+1)) 11 | esup2 = 0 12 | 13 | !contar la cantidad de elementos vecinos de cada nodo (*histogram pattern*) 14 | do ielem=1,nelem 15 | do i=1,3 16 | ipoi1 = inpoel(i,ielem) + 1 17 | esup2(ipoi1) = esup2(ipoi1) + 1 18 | end do 19 | end do 20 | 21 | !reshuffle para obtener esup2 (*scan pattern*) 22 | do ipoin = 2,npoin+1 23 | esup2(ipoin) = esup2(ipoin) + esup2(ipoin-1) 24 | end do 25 | 26 | allocate(esup1(esup2(npoin+1))) 27 | 28 | !obtener el array esup1 de los elementos vecinos 29 | do ielem=1,nelem 30 | do i=1,3 31 | ipoin = inpoel(i,ielem) 32 | istor = esup2(ipoin) + 1 33 | esup2(ipoin) = istor 34 | esup1(istor) = ielem 35 | end do 36 | end do 37 | 38 | !restaurar esup2 39 | do ipoin=npoin+1,2,-1 40 | esup2(ipoin) = esup2(ipoin-1) 41 | end do 42 | esup2(1) = 0 43 | end subroutine getEsup 44 | 45 | subroutine getPsup(inpoel, nelem, npoin) 46 | implicit none 47 | integer nelem, npoin 48 | integer inpoel(3,nelem) 49 | integer ielem, jpoin, ipoin, istor, iesup, i 50 | 51 | if(.not.allocated(esup1)) call getEsup(inpoel, nelem, npoin) 52 | 53 | allocate(psup2(npoin + 1)) 54 | allocate(lpoin(npoin)) 55 | lpoin = 0; psup2(1) = 0; istor = 0 56 | 57 | !calcular total de nodos vecinos 58 | do ipoin=1,npoin 59 | do iesup=esup2(ipoin)+1, esup2(ipoin+1) 60 | ielem=esup1(iesup) 61 | do i=1,3 62 | jpoin=inpoel(i,ielem) 63 | if(jpoin /= ipoin .and. lpoin(jpoin) /= ipoin) then 64 | istor = istor + 1 65 | lpoin(jpoin) = ipoin 66 | end if 67 | enddo 68 | end do 69 | psup2(ipoin+1) = istor 70 | end do 71 | 72 | allocate(psup1(istor)) 73 | 74 | !obtener array psup1 75 | lpoin=0; istor=0 76 | do ipoin=1,npoin 77 | do iesup=esup2(ipoin)+1, esup2(ipoin+1) 78 | ielem=esup1(iesup) 79 | do i=1,3 80 | jpoin=inpoel(i,ielem) 81 | if(jpoin /= ipoin .and. lpoin(jpoin) /= ipoin) then 82 | istor = istor+1 83 | psup1(istor) = jpoin 84 | lpoin(jpoin) = ipoin 85 | end if 86 | enddo 87 | end do 88 | end do 89 | 90 | deallocate(lpoin) 91 | end subroutine getPsup 92 | end module PointNeighbor 93 | -------------------------------------------------------------------------------- /gcl.f90: -------------------------------------------------------------------------------- 1 | module gcl_mod 2 | implicit none 3 | private 4 | real*8, dimension(:), allocatable :: tot1, tot2 5 | real*8, dimension(:), allocatable :: area_old, W_x_old, W_y_old 6 | public :: main, putW, putArea 7 | contains 8 | subroutine main(M, W_x, W_y, dNx, dNy, area, inpoel, dt) 9 | real*8, intent(inout), dimension(:) :: M 10 | real*8, intent(in), dimension(:,:) :: dNx, dNy 11 | real*8, intent(in), dimension(:) :: W_x, W_y, area 12 | integer, intent(in), dimension(:,:) :: inpoel 13 | real*8, intent(in) :: dt 14 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 15 | real*8 :: divW, divW_old 16 | real*8, dimension(3) :: WW_x, WW_y, WW_x_old, WW_y_old 17 | integer :: ielem, nelem, npoin 18 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 19 | nelem = size(inpoel,2) 20 | npoin = size(M) 21 | if(.not.allocated(tot1)) allocate(tot1(npoin)) 22 | if(.not.allocated(tot2)) allocate(tot2(npoin)) 23 | if(.not.allocated(area_old) .or.& 24 | .not.allocated(W_x_old) .or.& 25 | .not.allocated(W_y_old)) stop 'Faltan valores (GCL)' 26 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 27 | tot1 = 0.d0 28 | tot2 = 0.d0 29 | do ielem = 1, nelem 30 | ! v_x(:) = U(2,inpoel(:,ielem))/U(1,inpoel(:,ielem)) 31 | ! v_y(:) = U(3,inpoel(:,ielem))/U(1,inpoel(:,ielem)) 32 | WW_x_old(:) = W_x_old(inpoel(:,ielem)) 33 | WW_y_old(:) = W_y_old(inpoel(:,ielem)) 34 | WW_x(:) = W_x(inpoel(:,ielem)) 35 | WW_y(:) = W_y(inpoel(:,ielem)) 36 | ! divV = dNx(1,ielem)*v_x(1) + dNx(2,ielem)*v_x(2) + dNx(3,ielem)*v_x(3)& 37 | ! + dNy(1,ielem)*v_y(1) + dNy(2,ielem)*v_y(2) + dNy(3,ielem)*v_y(3) 38 | divW = dNx(1,ielem)*WW_x(1) + dNx(2,ielem)*WW_x(2) + dNx(3,ielem)*WW_x(3)& 39 | + dNy(1,ielem)*WW_x(1) + dNy(2,ielem)*WW_x(2) + dNy(3,ielem)*WW_x(3) 40 | divW_old = dNx(1,ielem)*WW_x_old(1) + dNx(2,ielem)*WW_x_old(2) + dNx(3,ielem)*WW_x_old(3)& 41 | + dNy(1,ielem)*WW_x_old(1) + dNy(2,ielem)*WW_x_old(2) + dNy(3,ielem)*WW_x_old(3) 42 | tot1(inpoel(:,ielem)) = tot1(inpoel(:,ielem)) + divW*area(ielem)/3.d0 43 | tot2(inpoel(:,ielem)) = tot2(inpoel(:,ielem)) + divW_old*area_old(ielem)/3.d0 44 | end do 45 | M = M + dt*(tot1 + tot2)/2.d0 46 | end subroutine 47 | subroutine putW(W_x, W_y) 48 | real*8, dimension(:), intent(in) :: W_x, W_y 49 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50 | if(.not.allocated(W_x_old)) allocate(W_x_old(size(W_x))) 51 | if(.not.allocated(W_y_old)) allocate(W_y_old(size(W_y))) 52 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 53 | W_x_old = W_x 54 | W_y_old = W_y 55 | end subroutine 56 | subroutine putArea(area) 57 | real*8, dimension(:), intent(in) :: area 58 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 59 | if(.not.allocated(area_old)) allocate(area_old(size(area))) 60 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 61 | area_old = area 62 | end subroutine 63 | end module 64 | -------------------------------------------------------------------------------- /commonModules.f90: -------------------------------------------------------------------------------- 1 | MODULE MVELOCIDADES 2 | REAL(8), DIMENSION(:), ALLOCATABLE:: VEL_X, VEL_Y, W_X, W_Y 3 | END MODULE MVELOCIDADES 4 | 5 | MODULE MVARIABGEN 6 | REAL(8), DIMENSION(:, :), ALLOCATABLE:: U, U1, U2, RHS, RHS1, RHS2, RHS3, UN 7 | END MODULE MVARIABGEN 8 | 9 | MODULE MVARIABLES 10 | REAL(8), DIMENSION(:), ALLOCATABLE:: P, T, RHO, E, RMACH 11 | END MODULE MVARIABLES 12 | 13 | MODULE MESTABILIZACION 14 | !REAL(8) CTE 15 | REAL(8) , DIMENSION(:), ALLOCATABLE:: SHOC, T_SUGN1, T_SUGN2, T_SUGN3 16 | END MODULE MESTABILIZACION 17 | 18 | !MODULE MNEWMARK 19 | !REAL(8), DIMENSION(:), ALLOCATABLE:: DXPOS, DYPOS 20 | !END MODULE MNEWMARK 21 | 22 | !MODULE MATRICES 23 | !INTEGER NDIM 24 | !REAL(8), DIMENSION(:, :), ALLOCATABLE:: MASA, C, K 25 | !END MODULE MATRICES 26 | 27 | !MODULE MAT2 28 | !REAL(8), DIMENSION(:), ALLOCATABLE:: DISN, DISS, VELN, VELS, ACCN, ACCS, R, G, G1, F, CTEN 29 | !END MODULE MAT2 30 | 31 | MODULE TIMERS 32 | integer rate, start_t, end_t, sub_start, sub_end, sub_rate, m_start, m_end, m_rate 33 | real calcrhs_t, cuarto_t, output_t, masas_t, deriv_t, laplace_t, normales_t, forces_t, newmark_t, grad_t, transf_t, estab_t 34 | real spmv_t, residuo_t, fuente_t, total_t 35 | END MODULE TIMERS 36 | 37 | !MODULE DATOS_REFINAMIENTO 38 | ! REAL(8)ETA_REFIN, HHMAX_REFIN, HHMIN_REFIN 39 | !END MODULE DATOS_REFINAMIENTO 40 | ! 41 | !MODULE DATOS_ENTRADA 42 | ! INTEGER NGAS 43 | ! REAL(8) GAMA, UINF, VINF, TINF, RHOINF, MACHINF, PINF, CINF 44 | ! REAL(8) FR, FMU, FGX, FGY, QH, FK, FCv 45 | !END MODULE DATOS_ENTRADA 46 | ! 47 | !MODULE MNORMALES 48 | ! INTEGER NNORMV 49 | ! INTEGER , DIMENSION(:, :), ALLOCATABLE:: IVN 50 | ! INTEGER , DIMENSION(:), ALLOCATABLE:: INORMV_NODE 51 | ! REAL(8) , DIMENSION(:), ALLOCATABLE:: RNORMV_VALUEX, RNORMV_VALUEY, RNX, RNY, BAUX 52 | !END MODULE MNORMALES 53 | ! 54 | !MODULE MALLOCAR 55 | ! INTEGER NNOD, NELEM, NFIXRHO, NFIXVI, NFIXV, NELNORM, NFIXT, NSETS, NMASTER 56 | ! INTEGER NSLAVE, NFIX_MOVE, NMOVE 57 | !END MODULE MALLOCAR 58 | 59 | !MODULE MVARIABFIX 60 | ! INTEGER , DIMENSION(:), ALLOCATABLE:: IFIXRHO_NODE, IFIXV_NODE, IFIXT_NODE 61 | ! REAL(8) , DIMENSION(:), ALLOCATABLE:: RFIXRHO_VALUE, RFIXV_VALUEX 62 | ! REAL(8) , DIMENSION(:), ALLOCATABLE:: RFIXV_VALUEY, RFIXT_VALUE 63 | !END MODULE MVARIABFIX 64 | ! 65 | !MODULE MGEOMETRIA 66 | ! INTEGER , DIMENSION(:, :), ALLOCATABLE:: N 67 | ! REAL(8) , DIMENSION(:, :), ALLOCATABLE:: DNX, DNY 68 | ! REAL(8) , DIMENSION(:), ALLOCATABLE:: X, Y, HHX, HHY, AREA, HH, M 69 | !END MODULE MGEOMETRIA 70 | 71 | !MODULE MFUERZAS 72 | ! INTEGER , DIMENSION(:, :, :), ALLOCATABLE:: ISET 73 | ! INTEGER , DIMENSION(:), ALLOCATABLE:: IPER_MASTER, IPER_SLAVE, IPER_AUX 74 | ! integer ielem_sets(10) 75 | !END MODULE MFUERZAS 76 | 77 | !MODULE MMOVIMIENTO 78 | ! INTEGER , DIMENSION(:), ALLOCATABLE:: IFM, I_M, ILAUX 79 | !END MODULE MMOVIMIENTO 80 | 81 | !MODULE MLAPLACE 82 | ! INTEGER , DIMENSION(:, :), ALLOCATABLE:: INDEL 83 | ! INTEGER , DIMENSION(:), ALLOCATABLE:: IND, NN1, NN2 84 | ! REAL(8) , DIMENSION(:), ALLOCATABLE:: ADIAG, RAUX, S 85 | !END MODULE MLAPLACE 86 | 87 | !MODULE MPRINTRES 88 | ! CHARACTER*4 RHOCHAR, VEL2CHAR, MACHCHAR, PRESCHAR, TEMPCHAR, ENERCHAR, POSCHAR 89 | !END MODULE MPRINTRES 90 | -------------------------------------------------------------------------------- /mLaplace.f90: -------------------------------------------------------------------------------- 1 | module Mlaplace 2 | integer, dimension(:), allocatable :: lap_idx, lap_rowptr 3 | real(8), dimension(:), allocatable :: lap_sparse, lap_diag 4 | real*8, parameter :: TWOSQRT3 = 3.46410161513775d0 5 | private initialize, mu 6 | contains 7 | subroutine laplace(inpoel, area, dNx, dNy, nelem, npoin) 8 | !------------------------------------------------------ 9 | ! Ensambla el vector sparse del laplaciano, lap_sparse 10 | !------------------------------------------------------ 11 | use PointNeighbor, only: esup1, esup2 12 | use MeshData, only: X, Y 13 | implicit none 14 | integer, intent(in) :: nelem, npoin 15 | integer, intent(in) :: inpoel(3,nelem) 16 | real*8, intent(in) :: dNx(3,nelem), dNy(3,nelem), area(nelem) 17 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 18 | real*8 :: a, q, X3(3), Y3(3) 19 | integer :: ipoin, jpoin, kpoin, i, j, k, iesup, ielem 20 | logical, save :: isFirstCall = .true. 21 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 22 | if(isFirstCall) then 23 | call initialize(inpoel, nelem, npoin) 24 | isFirstCall = .false. 25 | end if 26 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 27 | 28 | !$OMP PARALLEL DO PRIVATE(ipoin) 29 | do ipoin = 1, lap_rowptr(npoin + 1) 30 | lap_sparse(ipoin) = 0.d0 31 | end do 32 | !$OMP END PARALLEL DO 33 | 34 | !$OMP PARALLEL DO PRIVATE(ipoin, iesup, ielem, a, i, jpoin, j, kpoin, k) 35 | do ipoin = 1, npoin 36 | do iesup = esup2(ipoin) + 1, esup2(ipoin + 1) 37 | ielem = esup1(iesup); a = area(ielem) 38 | X3 = X(inpoel(:,ielem)) 39 | Y3 = Y(inpoel(:,ielem)) 40 | q = 1/(mu(X3,Y3)**2) 41 | do i = 1, 3 42 | jpoin = inpoel(i, ielem) 43 | if (jpoin == ipoin) then !Encuentra el nodo en cuestion 44 | do j = 1, 3 45 | kpoin = inpoel(j, ielem) 46 | do k = lap_rowptr(ipoin) + 1, lap_rowptr(ipoin + 1) 47 | if (lap_idx(k) == kpoin) then !Encuentra la ubicacion donde guardar 48 | lap_sparse(k) = lap_sparse(k) + (dNx(i, ielem)*dNx(j, ielem) + dNy(i, ielem)*dNy(j, ielem))*q 49 | end if 50 | end do 51 | end do 52 | end if 53 | end do 54 | end do 55 | lap_diag(ipoin) = lap_sparse(lap_rowptr(ipoin) + 1) 56 | end do 57 | !$OMP END PARALLEL DO 58 | end subroutine laplace 59 | 60 | subroutine initialize(inpoel, nelem, npoin) 61 | !---------------------------------------------------------------- 62 | ! Inicializa variables necesarias. Arma lap_rowptr & lap_idx 63 | !---------------------------------------------------------------- 64 | use PointNeighbor, only: psup1, psup2, getPsup 65 | implicit none 66 | integer, intent(in) :: nelem, npoin 67 | integer, intent(in) :: inpoel(3, nelem) 68 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 69 | integer :: i, ipoin, ipsup 70 | 71 | if(.not.allocated(psup1).or..not.allocated(psup2)) & 72 | call getPsup(inpoel, nelem, npoin) 73 | 74 | allocate(lap_sparse(size(psup1)+npoin)) 75 | allocate(lap_idx(size(psup1)+npoin)) 76 | allocate(lap_rowptr(npoin+1)) 77 | allocate(lap_diag(npoin)) 78 | 79 | lap_sparse = 0.d0 80 | lap_rowptr(1) = 0 81 | 82 | do i = 2, npoin+1 83 | lap_rowptr(i) = psup2(i) + i - 1 84 | end do 85 | 86 | do ipoin = 1, npoin 87 | lap_idx(lap_rowptr(ipoin)+1) = ipoin 88 | ipsup = psup2(ipoin)+1 89 | do i = lap_rowptr(ipoin)+2,lap_rowptr(ipoin+1) 90 | lap_idx(i) = psup1(ipsup) 91 | ipsup = ipsup + 1 92 | end do 93 | end do 94 | end subroutine initialize 95 | 96 | pure real*8 function mu(X3, Y3) 97 | real*8, intent(in) :: X3(:), Y3(:) 98 | !%%%%%%%%%%%%%%%%%%%% 99 | real*8 :: l1, l2, l3, l, area 100 | !%%%%%%%%%%%%%%%%%%%% 101 | area = X3(2)*Y3(3)+X3(3)*Y3(1)+X3(1)*Y3(2) & 102 | -(X3(2)*Y3(1)+X3(3)*Y3(2)+X3(1)*Y3(3)) 103 | l1 = (X3(3)-X3(2))**2 + (Y3(3)-Y3(2))**2 104 | l2 = (X3(1)-X3(3))**2 + (Y3(1)-Y3(3))**2 105 | l3 = (X3(2)-X3(1))**2 + (Y3(2)-Y3(1))**2 106 | l = l1 + l2 + l3 107 | mu = TWOSQRT3*area/l 108 | end function mu 109 | end module Mlaplace 110 | -------------------------------------------------------------------------------- /biconjGrad.f90: -------------------------------------------------------------------------------- 1 | module BiconjGrad 2 | real(8), allocatable, dimension(:) :: y, p, r, z 3 | 4 | private 5 | 6 | public biCG 7 | contains 8 | subroutine biCG(spMtx, spIdx, spRowptr, diagMtx, x, b, x_fix, x_fixIdx, npoin, nfix) 9 | !-------------------------------------------------------------------------------------------------- 10 | ! Calcula x dado A.x = b, mediante gradiente biconjugado 11 | !-------------------------------------------------------------------------------------------------- 12 | implicit none 13 | integer npoin, nfix, k 14 | integer spRowptr(npoin + 1), spIdx(spRowptr(npoin + 1)) 15 | integer x_fixIdx(nfix) 16 | real(8) spMtx(spRowptr(npoin + 1)), x(npoin), b(npoin), diagMtx(npoin) 17 | real(8) x_fix(nfix) 18 | real(8) tol, err_old, err_new, alfa, beta, py 19 | 20 | if(.not.allocated(y)) allocate(y(npoin)) 21 | if(.not.allocated(p)) allocate(p(npoin)) 22 | if(.not.allocated(r)) allocate(r(npoin)) 23 | if(.not.allocated(z)) allocate(z(npoin)) 24 | 25 | k = 0 26 | tol = 1.d-10 27 | 28 | call copy1(nfix, 1.d0, x_fix, x_fixIdx, npoin, x) 29 | call SpMV(spMtx, spIdx, spRowptr, x, y, npoin, spRowptr(npoin+1)) 30 | ! call mkl_dcsrgemv('n', npoin, spMtx, spRowptr, spIdx, x, y) 31 | call copy2(npoin, 1.d30, x, nfix, x_fixIdx, y) 32 | call vecsum(npoin, -1.d0, y, b, r) 33 | call assign2(npoin, r, nfix, x_fixIdx, 0.d0) 34 | 35 | if(vecdot(npoin, r, r) < tol) return 36 | 37 | call vecdiv(npoin, r, diagMtx, p) 38 | err_new = vecdot(npoin, r, p) 39 | call SpMV(spMtx, spIdx, spRowptr, p, y, npoin, spRowptr(npoin+1)) 40 | ! call mkl_dcsrgemv('n', npoin, spMtx, spRowptr, spIdx, p, y) 41 | call copy2(npoin, 1.d30, p, nfix, x_fixIdx, y) 42 | py = vecdot(npoin, p, y) 43 | alfa = err_new/py 44 | call vecsum(npoin, alfa, p, x, x) 45 | err_old = err_new 46 | 47 | do while(dabs(err_old) > tol .and. k < 1000) 48 | k = k + 1 49 | call vecsum(npoin, -alfa, y, r, r) 50 | call vecdiv(npoin, r, diagMtx, z) 51 | err_new = vecdot(npoin, r, z) 52 | beta = err_new/err_old 53 | call vecsum(npoin, beta, p, z, p) 54 | call SpMV(spMtx, spIdx, spRowptr, p, y, npoin, spRowptr(npoin+1)) 55 | ! call mkl_dcsrgemv('n', npoin, spMtx, spRowptr, spIdx, p, y) 56 | call copy2(npoin, 1.d30, p, nfix, x_fixIdx, y) 57 | py = vecdot(npoin, p, y) 58 | alfa = err_new/py 59 | call vecsum(npoin, alfa, p, x, x) 60 | err_old = err_new 61 | end do 62 | end subroutine biCG 63 | 64 | subroutine vecdiv(n, x, y, z) 65 | !--------------------------------- 66 | ! Calcula z = x/y 67 | !--------------------------------- 68 | implicit none 69 | integer n, i 70 | real(8) x(n), y(n), z(n) 71 | 72 | !$OMP PARALLEL DO 73 | do i = 1, n 74 | z(i) = x(i)/y(i) 75 | end do 76 | !$OMP END PARALLEL DO 77 | end subroutine vecdiv 78 | 79 | subroutine vecsum(n, alfa, x, y, z) 80 | !----------------------------------- 81 | ! Calcula z = alfa*x + y 82 | !----------------------------------- 83 | implicit none 84 | integer n, i 85 | real(8) x(n), y(n), z(n), alfa 86 | 87 | !$OMP PARALLEL DO 88 | do i = 1, n 89 | z(i) = alfa*x(i) + y(i) 90 | end do 91 | !$OMP END PARALLEL DO 92 | end subroutine vecsum 93 | 94 | subroutine assign(n, y, scal) 95 | !----------------------------- 96 | ! y(:) = scal 97 | !----------------------------- 98 | implicit none 99 | integer n, i 100 | real(8) scal, y(n) 101 | 102 | !$OMP PARALLEL DO PRIVATE(i) 103 | do i = 1, n 104 | y(i) = scal 105 | end do 106 | !$OMP END PARALLEL DO 107 | end subroutine 108 | 109 | subroutine assign2(n, y, m, idx, scal) 110 | implicit none 111 | integer n, m, i 112 | real(8) y(n), scal 113 | integer idx(m) 114 | 115 | !$OMP PARALLEL DO PRIVATE(i) 116 | do i = 1, m 117 | y(idx(i)) = scal 118 | end do 119 | !$OMP END PARALLEL DO 120 | end subroutine 121 | 122 | subroutine copy1(m, alfa, x, idx, n, y) 123 | !----------------------------------------- 124 | ! y(idx(:)) = alfa*x 125 | !----------------------------------------- 126 | implicit none 127 | integer n, m, i 128 | real(8) x(m), y(n), alfa 129 | integer idx(m) 130 | !$OMP PARALLEL DO PRIVATE(i) 131 | do i=1, m 132 | y(idx(i)) = alfa*x(i) 133 | end do 134 | !$OMP END PARALLEL DO 135 | end subroutine 136 | 137 | subroutine copy2(n, alfa, x, m, idx, y) 138 | !----------------------------------------- 139 | ! y(idx(:)) = alfa*x(idx(:)) 140 | !----------------------------------------- 141 | implicit none 142 | integer n, m, i 143 | real(8) x(n), y(n), alfa 144 | integer idx(m) 145 | 146 | !$OMP PARALLEL DO PRIVATE(i) 147 | do i=1, m 148 | y(idx(i)) = alfa*x(idx(i)) 149 | end do 150 | !$OMP END PARALLEL DO 151 | end subroutine copy2 152 | 153 | real(8) function vecdot(n, x, y) 154 | !----------------------------------- 155 | ! Devuelve producto punto 156 | !----------------------------------- 157 | implicit none 158 | integer n, i 159 | real(8) x(n), y(n), res 160 | res = 0.d0 161 | 162 | !$OMP PARALLEL DO REDUCTION(+:res) 163 | do i = 1, n 164 | res = res + x(i)*y(i) 165 | end do 166 | !$OMP END PARALLEL DO 167 | 168 | vecdot = res 169 | end function vecdot 170 | 171 | subroutine SpMV(spMtx, spIdx, spRowptr, v, y, npoin, npos) 172 | !--------------------------------------------------------- 173 | ! Multiplicacion sparse y = M.v 174 | !--------------------------------------------------------- 175 | implicit none 176 | integer npoin, npos 177 | integer i, j 178 | real(8) spMtx(npos), v(npoin), y(npoin), dot 179 | integer spIdx(npos), spRowptr(npoin+1) 180 | 181 | !$OMP PARALLEL DO PRIVATE(i, j, dot) 182 | do i = 1, npoin 183 | dot = 0.d0 184 | do j = spRowptr(i)+1, spRowptr(i+1) 185 | dot = dot + spMtx(j)*v(spIdx(j)) 186 | end do 187 | y(i) = dot 188 | end do 189 | !$OMP END PARALLEL DO 190 | end subroutine 191 | end module BiconjGrad 192 | -------------------------------------------------------------------------------- /calcRHS.f90: -------------------------------------------------------------------------------- 1 | module calcRHS_mod 2 | implicit none 3 | contains 4 | subroutine calcRHS(rhs, U, theta, dNx, dNy, area, shoc, dtl, t_sugn1, t_sugn2, t_sugn3, inpoel, nelem, npoin) 5 | use InputData, only: Cv => FCV, lambda_ref => FK, mu_ref => FMU, gamma0 => gama, T_inf, cte 6 | use Mvariables, only: T 7 | integer, intent(in) :: npoin, nelem, inpoel(3,nelem) 8 | real*8, intent(inout) :: rhs(4,npoin) 9 | real*8, intent(in) :: U(4,npoin), theta(4,npoin), dNx(3,nelem), dNy(3,nelem) 10 | real*8, intent(in), dimension(nelem) :: area, dtl, shoc, t_sugn1, t_sugn2, t_sugn3 11 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 12 | integer :: ielem, ipoi1, ipoi2, ipoi3, i, k 13 | real*8 :: rho, v1, v2, e, V_sq 14 | real*8 :: tau1, tau2, tau3, nu 15 | real*8, dimension(4) :: U_k, theta_k, Ux, Uy 16 | real*8, dimension(3) :: Nx, Ny 17 | real*8, dimension(4,3) :: rhs_tmp 18 | real*8, parameter, dimension(3,3) :: N = & 19 | reshape((/& 20 | 0.d0, .5d0, .5d0, & 21 | .5d0, 0.d0, .5d0, & 22 | .5d0, .5d0, 0.d0 & 23 | /), (/3,3/)) 24 | REAL*8, dimension(1:4) :: AiUi 25 | REAL*8, dimension(1:4) :: AiUi_theta 26 | REAL*8, dimension(1:4) :: A1AiUi_theta 27 | REAL*8, dimension(1:4) :: A2AiUi_theta 28 | REAL*8 :: lambda, mu, T_avg 29 | REAL*8, dimension(2:4) :: K1jUj 30 | REAL*8, dimension(2:4) :: K2jUj 31 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 32 | !$OMP PARALLEL DO DEFAULT(PRIVATE) & 33 | !$OMP SHARED(rhs, U, theta, dNx, dNy, area, shoc, dtl, & 34 | !$OMP t_sugn1, t_sugn2, t_sugn3, inpoel, nelem, npoin, & 35 | !$OMP T, Cv, lambda_ref, mu_ref, gamma0, T_inf, cte, N) 36 | do ielem = 1, nelem 37 | rhs_tmp(:,:) = 0.d0 38 | ipoi1 = inpoel(1,ielem) 39 | ipoi2 = inpoel(2,ielem) 40 | ipoi3 = inpoel(3,ielem) 41 | Nx(1:3) = dNx(1:3,ielem) 42 | Ny(1:3) = dNy(1:3,ielem) 43 | Ux(1:4) = U(1:4,ipoi1)*Nx(1) + U(1:4,ipoi2)*Nx(2) + U(1:4,ipoi3)*Nx(3) 44 | Uy(1:4) = U(1:4,ipoi1)*Ny(1) + U(1:4,ipoi2)*Ny(2) + U(1:4,ipoi3)*Ny(3) 45 | tau1 = t_sugn1(ielem) 46 | tau2 = t_sugn2(ielem) 47 | tau3 = t_sugn3(ielem) 48 | nu = shoc(ielem)*cte 49 | T_avg = (T(ipoi1) + T(ipoi2) + T(ipoi3))/3.d0 50 | mu = mu_ref*(T_avg/T_inf)**1.5d0*(T_inf + 110)/(T_avg + 110) 51 | lambda = lambda_ref*(T_avg/T_inf)**1.5d0*(T_inf + 194)/(T_avg + 194) 52 | do k = 1, 3 53 | U_k(1:4) = & 54 | N(1,k)*U(1:4,ipoi1) +& 55 | N(2,k)*U(1:4,ipoi2) +& 56 | N(3,k)*U(1:4,ipoi3) 57 | theta_k(1:4) = & 58 | N(1,k)*theta(1:4,ipoi1) +& 59 | N(2,k)*theta(1:4,ipoi2) +& 60 | N(3,k)*theta(1:4,ipoi3) 61 | rho = U_k(1) 62 | v1 = U_k(2)/rho 63 | v2 = U_k(3)/rho 64 | e = U_k(4)/rho 65 | V_sq = v1**2 + v2**2 66 | !****************************************************************************** 67 | !* Code generated with sympy 0.7.5-git * 68 | !* * 69 | !* See http://www.sympy.org/ for more information. * 70 | !* * 71 | !* This file is part of 'ns2DComp' * 72 | !****************************************************************************** 73 | AiUi(1) = Ux(2) + Uy(3) 74 | AiUi(2) = (1.0d0/2.0d0)*Ux(1)*(V_sq*(gamma0 - 1) - 2*v1**2) - Ux(2)*v1*( & 75 | gamma0 - 3) - Ux(3)*v2*(gamma0 - 1) + Ux(4)*(gamma0 - 1) - Uy(1)*v1*v2 + & 76 | Uy(2)*v2 + Uy(3)*v1 77 | AiUi(3) = -Ux(1)*v1*v2 + Ux(2)*v2 + Ux(3)*v1 + (1.0d0/2.0d0)*Uy(1)*(V_sq*( & 78 | gamma0 - 1) - 2*v2**2) - Uy(2)*v1*(gamma0 - 1) - Uy(3)*v2*(gamma0 - 3) + & 79 | Uy(4)*(gamma0 - 1) 80 | AiUi(4) = Ux(1)*v1*(V_sq*(gamma0 - 1) - e*gamma0) - 1.0d0/2.0d0*Ux(2)*(V_sq & 81 | *(gamma0 - 1) - 2*e*gamma0 + 2*v1**2*(gamma0 - 1)) - Ux(3)*v1*v2*( & 82 | gamma0 - 1) + Ux(4)*gamma0*v1 + Uy(1)*v2*(V_sq*(gamma0 - 1) - e*gamma0) - & 83 | Uy(2)*v1*v2*(gamma0 - 1) - 1.0d0/2.0d0*Uy(3)*(V_sq*(gamma0 - 1) - 2*e* & 84 | gamma0 + 2*v2**2*(gamma0 - 1)) + Uy(4)*gamma0*v2 85 | 86 | AiUi_theta(1:4) = +theta_k(1:4) + AiUi(1:4) 87 | 88 | A1AiUi_theta(1) = AiUi_theta(2) 89 | A1AiUi_theta(2) = v1*(-gamma0 + 3)*AiUi_theta(2) - v2*(gamma0 - 1)* & 90 | AiUi_theta(3) + (gamma0 - 1)*AiUi_theta(4) + ((1.0d0/2.0d0)* & 91 | V_sq*(gamma0 - 1) - v1**2)*AiUi_theta(1) 92 | A1AiUi_theta(3) = -v1*v2*AiUi_theta(1) + v1*AiUi_theta(3) + v2* & 93 | AiUi_theta(2) 94 | A1AiUi_theta(4) = gamma0*v1*AiUi_theta(4) - v1*v2*(gamma0 - 1)* & 95 | AiUi_theta(3) + v1*(V_sq*(gamma0 - 1) - e*gamma0)*AiUi_theta(1) & 96 | + (-1.0d0/2.0d0*V_sq*(gamma0 - 1) + e*gamma0 - v1**2*(gamma0 - 1 & 97 | ))*AiUi_theta(2) 98 | A2AiUi_theta(1) = AiUi_theta(3) 99 | A2AiUi_theta(2) = -v1*v2*AiUi_theta(1) + v1*AiUi_theta(3) + v2* & 100 | AiUi_theta(2) 101 | A2AiUi_theta(3) = -v1*(gamma0 - 1)*AiUi_theta(2) + v2*(-gamma0 + 3)* & 102 | AiUi_theta(3) + (gamma0 - 1)*AiUi_theta(4) + ((1.0d0/2.0d0)* & 103 | V_sq*(gamma0 - 1) - v2**2)*AiUi_theta(1) 104 | A2AiUi_theta(4) = gamma0*v2*AiUi_theta(4) - v1*v2*(gamma0 - 1)* & 105 | AiUi_theta(2) + v2*(V_sq*(gamma0 - 1) - e*gamma0)*AiUi_theta(1) & 106 | + (-1.0d0/2.0d0*V_sq*(gamma0 - 1) + e*gamma0 - v2**2*(gamma0 - 1 & 107 | ))*AiUi_theta(3) 108 | 109 | rhs_tmp(1:4,1) = rhs_tmp(1:4,1) + N(1,k)*AiUi(1:4) + & 110 | tau1*(Nx(1)*A1AiUi_theta(1:4) + Ny(1)*A2AiUi_theta(1:4)) + & 111 | nu*(Nx(1)*Ux(1:4) + Ny(1)*Uy(1:4)) 112 | rhs_tmp(1:4,2) = rhs_tmp(1:4,2) + N(2,k)*AiUi(1:4) + & 113 | tau2*(Nx(2)*A1AiUi_theta(1:4) + Ny(2)*A2AiUi_theta(1:4)) + & 114 | nu*(Nx(2)*Ux(1:4) + Ny(2)*Uy(1:4)) 115 | rhs_tmp(1:4,3) = rhs_tmp(1:4,3) + N(3,k)*AiUi(1:4) + & 116 | tau3*(Nx(3)*A1AiUi_theta(1:4) + Ny(3)*A2AiUi_theta(1:4)) + & 117 | nu*(Nx(3)*Ux(1:4) + Ny(3)*Uy(1:4)) 118 | 119 | if(mu_ref > tiny(0d0)) then 120 | ! K1jUj(1) = 0 121 | K1jUj(2) = (2.0d0/3.0d0)*mu*(-2*Ux(1)*v1 + 2*Ux(2) + Uy(1)*v2 - Uy(3))/rho 122 | K1jUj(3) = mu*(-Ux(1)*v2 + Ux(3) - Uy(1)*v1 + Uy(2))/rho 123 | K1jUj(4) = (1.0d0/3.0d0)*(Cv*mu*(-Uy(1)*v1*v2 + 3*Uy(2)*v2 - 2*Uy(3)*v1) & 124 | - Ux(1)*(Cv*mu*(3*V_sq + v1**2) - 3*lambda*(V_sq - e)) + Ux(2)*v1*(4*Cv*mu & 125 | - 3*lambda) + 3*Ux(3)*v2*(Cv*mu - lambda) + 3*Ux(4)*lambda)/(Cv*rho) 126 | 127 | ! K2jUj(1) = 0 128 | K2jUj(2) = mu*(-Ux(1)*v2 + Ux(3) - Uy(1)*v1 + Uy(2))/rho 129 | K2jUj(3) = (2.0d0/3.0d0)*mu*(Ux(1)*v1 - Ux(2) - 2*Uy(1)*v2 + 2*Uy(3))/rho 130 | K2jUj(4) = (1.0d0/3.0d0)*(Cv*mu*(-Ux(1)*v1*v2 - 2*Ux(2)*v2 + 3*Ux(3)*v1) & 131 | - Uy(1)*(Cv*mu*(3*V_sq + v2**2) - 3*lambda*(V_sq - e)) + 3*Uy(2)*v1*(Cv*mu & 132 | - lambda) + Uy(3)*v2*(4*Cv*mu - 3*lambda) + 3*Uy(4)*lambda)/(Cv*rho) 133 | 134 | rhs_tmp(2:4,1) = rhs_tmp(2:4,1) + (Nx(1)*K1jUj(2:4) + Ny(1)*K2jUj(2:4)) 135 | rhs_tmp(2:4,2) = rhs_tmp(2:4,2) + (Nx(2)*K1jUj(2:4) + Ny(2)*K2jUj(2:4)) 136 | rhs_tmp(2:4,3) = rhs_tmp(2:4,3) + (Nx(3)*K1jUj(2:4) + Ny(3)*K2jUj(2:4)) 137 | end if 138 | !****************************************************************************** 139 | end do 140 | 141 | rhs_tmp(:,:) = rhs_tmp(:,:)*area(ielem)*dtl(ielem)/3.d0 142 | 143 | do i = 1, 4 144 | !$OMP ATOMIC 145 | RHS(i,ipoi1) = RHS(i,ipoi1) + rhs_tmp(i,1) 146 | !$OMP ATOMIC 147 | RHS(i,ipoi2) = RHS(i,ipoi2) + rhs_tmp(i,2) 148 | !$OMP ATOMIC 149 | RHS(i,ipoi3) = RHS(i,ipoi3) + rhs_tmp(i,3) 150 | end do 151 | end do 152 | !$OMP END PARALLEL DO 153 | 154 | end subroutine calcRHS 155 | 156 | end module calcRHS_mod 157 | -------------------------------------------------------------------------------- /dataLoader.f90: -------------------------------------------------------------------------------- 1 | module InputData 2 | !------------------------------------------------ 3 | ! Modulo para leer los datos de filename-1.dat 4 | !------------------------------------------------ 5 | real(8) U_inf, V_inf, T_inf, RHO_inf, MACH_inf, P_inf, C_inf 6 | real(8) FR, FMU, FGX, FGY, QH, FK, FCv, GAMA 7 | real(8) XREF(10), YREF(10) 8 | real(8) FSAFE, CTE 9 | real(8) ETA_REFIN, HHMAX_REFIN, HHMIN_REFIN 10 | integer IRESTART, MAXITER, IPRINT, MOVIE, ITLOCAL, MOVING 11 | integer NGAS 12 | integer NDIM !<=== 13 | character(4) RHOCHAR, VEL2CHAR, MACHCHAR, PRESCHAR, TEMPCHAR, ENERCHAR, POSCHAR 14 | character(80) FILENAME 15 | integer printFlag 16 | contains 17 | subroutine readInputData 18 | implicit none 19 | !PRINTFLAG 20 | printFlag = 0 21 | 22 | open (1, FILE = 'EULER.DAT', STATUS = 'OLD') 23 | read (1, '(A)') FILENAME 24 | CLOSE(1) 25 | 26 | open(1, FILE = trim(FILENAME)//'-1.dat', STATUS = 'OLD') 27 | !CCCC -----> 28 | read(1, *) 29 | read(1, *) IRESTART, MAXITER, IPRINT, MOVIE, ITLOCAL 30 | !CCCC -----> 31 | read(1, *) 32 | read(1, *) FSAFE, U_inf, V_inf, MACH_inf, T_inf, RHO_inf, P_inf 33 | !CCCC -----> 34 | read(1, *) 35 | read(1, *) FMU, FGX, FGY, QH 36 | !CCCC -----> 37 | read(1, *) 38 | read(1, *) FK, FR, FCv, GAMA, NGAS 39 | !CCCC -----> CTE DE SHOCK-CAPTURING 40 | read(1, *) 41 | read(1, *) CTE 42 | !CCCC -----> ALE 43 | read(1, *) 44 | read(1, *) 45 | read(1, *) MOVING, XREF(1), YREF(1) 46 | !CCCC -----> IMPRESION DE RESULTADOS SEGUN AGUSTIN 47 | read(1, *) 48 | read(1, *) 49 | read(1, *) RHOCHAR, VEL2CHAR, MACHCHAR, PRESCHAR, TEMPCHAR, ENERCHAR, POSCHAR 50 | !CCCC -----> REFINANMIENTO 51 | read(1, *) 52 | read(1, *) 53 | read(1, *) 54 | read(1, *) 55 | read(1, *) ETA_REFIN, HHMAX_REFIN, HHMIN_REFIN 56 | CLOSE(1) 57 | 58 | NDIM = 2 !<=== 59 | CTE = 1.d0/CTE 60 | if(T_inf.EQ.0.d0) T_inf = P_inf/(FR*RHO_inf) 61 | if(P_inf.EQ.0.d0) P_inf = RHO_inf*FR*T_inf 62 | if(RHO_inf.EQ.0.d0) RHO_inf = P_inf/(FR*T_inf) 63 | C_inf = dsqrt(GAMA*FR*T_inf) 64 | if(dsqrt(U_inf**2+ V_inf**2) .EQ. 0.d0) U_inf = C_inf*MACH_inf 65 | end subroutine readInputData 66 | end module InputData 67 | 68 | module MeshData !Contiene mvariabfix, mgeometria, mallocar, mfuerzas, mmovimiento & mnormales 69 | !---------------------------------------------- 70 | ! Modulo para cargar los datos de la malla 71 | !---------------------------------------------- 72 | ! =============== Geometria =============== 73 | integer, dimension(:, :), allocatable :: inpoel 74 | real(8), dimension(:, :), allocatable :: dNx, dNy 75 | real(8), dimension(:), allocatable :: X, Y, HHX, HHY, HH, M, area 76 | integer npoin, nelem, nFixRho, nFixVi, nFixV, nwall, nFixT, nsets, nFix_move, nmove 77 | integer NSLAVE, NMASTER 78 | ! =============== Fix =============== 79 | integer, dimension(:), allocatable :: IFIXRHO_NODE, IFIXV_NODE, IFIXT_NODE 80 | real(8), dimension(:), allocatable :: RFIXRHO_VALUE, RFIXV_VALUEX 81 | real(8), dimension(:), allocatable :: RFIXV_VALUEY, RFIXT_VALUE 82 | ! =============== Normales ================ 83 | integer, dimension(:, :), allocatable :: wall 84 | ! =============== Set fuerzas =============== 85 | integer, dimension(:, :, :), allocatable :: ISET 86 | ! =============== Periodical =============== 87 | integer, dimension(:), allocatable :: iper_master, iper_slave, iper_aux 88 | ! =============== Movimiento =============== 89 | integer ielem_sets(10) 90 | integer nele_set, nset_numb, nnmove 91 | integer, dimension(:), allocatable :: ifm, i_m, ilaux 92 | ! =============== Subrutinas =============== 93 | private :: handleError, allocateMeshData 94 | contains 95 | subroutine loadMeshData 96 | use InputData 97 | 98 | open(1, FILE = trim(FILENAME)//'.dat', STATUS = 'OLD') 99 | 100 | read(1, *) !NUMERO DE NODOS !NUMERO DE ELEMENTOS 101 | read(1, *) npoin , nelem 102 | read(1, *) 103 | read(1, *) nfixrho, nfixvi, nfixv, nwall, nfixt, nsets, nmaster, nslave, nfix_move, nmove 104 | 105 | call allocateMeshData 106 | 107 | read(1, *) 108 | read(1, *) 109 | read(1, *) 110 | read(1, *) 111 | !CCCC-----> COORDENADAS DE LOS NODOS 112 | write(*, *) ' reading coordinates....' 113 | IERROR = 1 114 | do ipoin = 1, npoin 115 | read(1, *, ERR = 27) i, X(i), Y(i) 116 | end do 117 | write(*, *) ' ready ' 118 | write(*, '(A, I5//)') ' TOTAL NODOS LEIDOS:', i 119 | 120 | !CCCC----> CONECTIVIDADES DE LOS ELEMENTOS 121 | write(*, *) ' reading elements....' 122 | IERROR = 2 123 | read(1, *) 124 | do ielem = 1, nelem 125 | read(1, *, ERR = 27) i, inpoel(1, i), inpoel(2, i), inpoel(3, i) 126 | end do 127 | write(*, *) ' ready ' 128 | write(*, '(A, I6//)') ' TOTAL ELEMENTOS LEIDOS:', i 129 | 130 | !CCCC----> PUNTOS CON DENSIDAD PRESCRITA 131 | write(*, *) 'reading fix density points....' 132 | IERROR = 3 133 | read(1, *) 134 | do IFIXRHO = 1, NFIXRHO 135 | read(1, *, ERR = 27) IFIXRHO_NODE(IFIXRHO), RFIXRHO_VALUE(IFIXRHO) 136 | if (RFIXRHO_VALUE(IFIXRHO).LT.0) THEN 137 | RFIXRHO_VALUE(IFIXRHO) = 1.225d0 138 | ELSE 139 | RFIXRHO_VALUE(IFIXRHO) = RFIXRHO_VALUE(IFIXRHO)*RHO_inf 140 | end if 141 | end do 142 | write(*, *) ' ready ' 143 | write(*, '(A, I5//)') ' TOTAL NODOS CON DENSIDAD IMPUESTA:', NFIXRHO 144 | 145 | !CCCC----> NODOS CON VELOCIDAD FIJA 146 | write(*, *) ' reading fix velocities (INFLOW)....' 147 | IERROR = 4 148 | read(1, *) 149 | do IFIXV = 1, NFIXVI 150 | read(1, *, ERR = 27) IFIXV_NODE(IFIXV), RFIXV_VALUEX(IFIXV) & 151 | , RFIXV_VALUEY(IFIXV) 152 | RFIXV_VALUEX(IFIXV) = RFIXV_VALUEX(IFIXV)*U_inf 153 | RFIXV_VALUEY(IFIXV) = RFIXV_VALUEY(IFIXV)*V_inf 154 | end do 155 | write(*, *) ' ready ' 156 | write(*, '(A, I5//)') ' TOTAL ELEMENTOS CON VELOCIDAD IMPUESTA:', NFIXVI 157 | 158 | !CCCC----> NODOS CON VELOCIDAD FIJA (NO SLIP) 159 | !CCCC----> CALCULA LA TEMPERATURA DE ESTANCAMIENTO PARA IMPONERLA EN LAS 160 | !CCCC----> PAREDES DONDE SE PRESCRIBE LA CONDICION DE "NO SLIP" 161 | TWALL = T_inf*(1.d0 + (GAMA-1)/2.d0*MACH_inf*MACH_inf) 162 | IFIXT_A = 0 163 | write(*, *) ' reading fix velocities (NO SLIP)....' 164 | IERROR = 4 165 | read(1, *) 166 | do IFIXV = NFIXVI + 1, NFIXVI + NFIXV 167 | read(1, *, ERR = 27) IFIXV_NODE(IFIXV), RFIXV_VALUEX(IFIXV) & 168 | , RFIXV_VALUEY(IFIXV) 169 | RFIXV_VALUEX(IFIXV) = 0.d0 170 | RFIXV_VALUEY(IFIXV) = 0.d0 171 | IFIXT_A = IFIXT_A + 1 172 | IFIXT_NODE(IFIXT_A) = IFIXV_NODE(IFIXV) 173 | RFIXT_VALUE(IFIXT_A) = TWALL 174 | end do 175 | write(*, *) ' ready ' 176 | NFIXV = NFIXV + NFIXVI 177 | write(*, '(A, I5//)') ' TOTAL ELEMENTOS CON VELOCIDAD NO SLIP:', NFIXV 178 | 179 | !CCCC----> VELOCIDAD NORMAL NULA 180 | write(*, *) ' reading elements with normal velocity prescribe....' 181 | IERROR = 5 182 | read(1, *) 183 | do INEL = 1, nwall 184 | read(1, *, ERR = 27) wall(1, INEL), wall(2, INEL) 185 | end do 186 | write(*, *) ' ready ' 187 | write(*, '(A, I6/)')' TOTAL ELEMENTOS CON VELOCIDAD NORMAL IMPUESTA:', nwall 188 | 189 | !CCCC----> TEMPERATURA PRESCRITA 190 | write(*, *) ' reading fix temperature nodes....' 191 | IERROR = 8 192 | read(1, *) 193 | do IFIXT = 1, NFIXT 194 | read(1, *, ERR = 27) IFIXT_NODE(IFIXT + IFIXT_A), RFIXT_VALUE(IFIXT + IFIXT_A) 195 | RFIXT_VALUE(IFIXT + IFIXT_A) = RFIXT_VALUE(IFIXT + IFIXT_A)*T_inf 196 | end do 197 | write(*, *) ' ready ' 198 | NFIXT = NFIXT + IFIXT_A 199 | write(*, '(A, I6/)') ' TOTAL NODOS COM TEMPERATURA IMPUESTA:', NFIXT 200 | 201 | !CCCC----> LECTURA DE LOS SETS PARA EL 202 | !CCCC----> CALCULO DE LAS FUERZAS 203 | write(*, *) ' reading sets nodes....' 204 | IERROR = 9 205 | IELEM_SETS = 0 206 | NSET_NUMB = 0 207 | read(1, *) 208 | do ISETS = 1, NSETS 209 | read(1, *, ERR = 27) NELE_SET, ISET1, ISET2, ISETNUMB 210 | if (ISETNUMB.GT.NSET_NUMB) NSET_NUMB = ISETNUMB 211 | IELEM_SETS(ISETNUMB) = IELEM_SETS(ISETNUMB) + 1 212 | ISET(1, ISETNUMB, IELEM_SETS(ISETNUMB)) = ISET1 213 | ISET(2, ISETNUMB, IELEM_SETS(ISETNUMB)) = ISET2 214 | ISET(3, ISETNUMB, IELEM_SETS(ISETNUMB)) = NELE_SET 215 | end do 216 | write(*, *) ' ready ' 217 | write(*, '(A, I6)') ' NUMERO DE SETS:', NSET_NUMB 218 | write(*, '(A, I6//)') ' NUMERO DE ELEMENTOS DE LOS SETS:', NSETS 219 | 220 | !CCCC----> PERIODICAL MASTER 221 | write(*, *) ' reading nodes with periodical master and slave condition....' 222 | IERROR = 10 223 | if(NMASTER.NE.NSLAVE)THEN 224 | write(*, *)'ERROR NODOS MASTER DISTINTO NODOS SLAVE' 225 | stop 226 | end if 227 | read(1, *) 228 | do IMASTER = 1, NMASTER 229 | read(1, *, ERR = 27)IPER_MASTER(IMASTER) 230 | end do 231 | read(1, *) 232 | do IMASTER = 1, NMASTER 233 | read(1, *, ERR = 27)IPER_SLAVE(IMASTER) 234 | end do 235 | write(*, *) ' ready ' 236 | write(*, '(A, I6/)')' TOTAL NODOS CON CONDICION PERIODICA:', NMASTER + NSLAVE 237 | 238 | !CCCC----> NODOS CON MOVIMIENTO FIJO 239 | write(*, *) ' reading fix movement ....' 240 | read(1, *) 241 | do IM = 1, NFIX_MOVE 242 | read(1, *, ERR = 27) IFM(IM), dummy 243 | end do 244 | write(*, *) ' ready ' 245 | write(*, '(A, I5//)') ' TOTAL NODOS CON MOVIMIENTO FIJO:', NFIX_MOVE 246 | 247 | !CCCC----> NODOS CON MOVIMIENTO 248 | !CCCC-------------------------- 249 | write(*, *) ' reading movement ....' 250 | read(1, *) 251 | do IM = 1, NMOVE 252 | read(1, *, ERR = 27) I_M(IM), dummy 253 | end do 254 | write(*, *) ' ready ' 255 | write(*, '(A, I5//)') ' TOTAL NODOS CON MOVIMIENTO FIJO:', NMOVE 256 | 257 | !Fijo que nodos se mueven y cuales no 258 | NNMOVE = NFIX_MOVE + NMOVE 259 | j = 0 260 | do i = 1, nmove 261 | j = j + 1 262 | ilaux(j) = i_m(i) 263 | end do 264 | 265 | do i = 1, nfix_move 266 | j = j + 1 267 | ilaux(j) = ifm(i) 268 | end do 269 | 270 | close(1) 271 | IERROR = 0 272 | 27 if (IERROR.NE.0) then 273 | call handleError(IERROR) 274 | end if 275 | end subroutine loadMeshData 276 | 277 | subroutine handleError(IERROR) 278 | implicit real(8) (a-h, o-z) 279 | character(10) errType(5) 280 | 281 | data errType /'NODOS', 'ELEMENTOS', 'NO_TRAC', 'FIX_VEL', 'NORM_VEL'/ 282 | if (IERROR.ne.0) then 283 | write(*, '(A)') 'ERROR EN LA LECTURA DE ', errType(IERROR) 284 | stop 285 | end if 286 | end subroutine handleError 287 | 288 | subroutine allocateMeshData 289 | !use DATOS_REFINAMIENTO 290 | !use DATOS_ENTRADA 291 | !use MNORMALES 292 | !use MALLOCAR 293 | !use MVARIABFIX 294 | !use MGEOMETRIA 295 | !use MeshData 296 | !use MFUERZAS 297 | !use MMOVIMIENTO 298 | !use InputData 299 | use MVELOCIDADES 300 | use MVARIABGEN 301 | use MVARIABLES 302 | use MESTABILIZACION 303 | !use MNEWMARK 304 | ALLOCATE(VEL_X(npoin), VEL_Y(npoin), W_X(npoin), W_Y(npoin)) 305 | ALLOCATE(U(4, npoin), U1(4, npoin), U2(4, npoin), RHS(4, npoin), RHS1(4, npoin), UN(4, npoin)) 306 | ALLOCATE(RHS2(4, npoin), RHS3(4, npoin)) 307 | !ALLOCATE(RNORMV_VALUEX(npoin), RNORMV_VALUEY(npoin), wall(2, nwall)) 308 | allocate(wall(2, nwall)) 309 | !ALLOCATE(INORMV_NODE(npoin), RNX(npoin), RNY(npoin), BAUX(npoin)) 310 | ALLOCATE(IFIXRHO_NODE(NFIXRHO), RFIXRHO_VALUE(NFIXRHO), RFIXV_VALUEX(NFIXVI + NFIXV)) 311 | ALLOCATE(RFIXV_VALUEY(NFIXVI + NFIXV), IFIXV_NODE(NFIXVI + NFIXV)) 312 | ALLOCATE(RFIXT_VALUE(NFIXV + NFIXT), IFIXT_NODE(NFIXT + NFIXV)) 313 | ALLOCATE(X(npoin), Y(npoin), inpoel(3, NELEM), HHX(NELEM), HHY(NELEM), DNX(3, NELEM)) 314 | ALLOCATE(DNY(3, NELEM), AREA(NELEM), HH(NELEM), M(npoin)) 315 | ALLOCATE(P(npoin), T(npoin), RHO(npoin), E(npoin), RMACH(npoin)) 316 | !ALLOCATE(S(npoin*15), NN1(npoin*15), NN2(npoin*15), IND(npoin), INDEL(10, npoin)) 317 | !ALLOCATE(ADIAG(npoin), RAUX(npoin)) 318 | ALLOCATE(ISET(3, 10, NSETS), IPER_MASTER(NMASTER), IPER_SLAVE(NMASTER)) 319 | ALLOCATE(IPER_AUX(NMASTER), IFM(NFIX_MOVE), I_M(NMOVE), ILAUX(npoin)) 320 | ALLOCATE(SHOC(NELEM), T_SUGN1(NELEM), T_SUGN2(NELEM), T_SUGN3(NELEM)) 321 | end subroutine allocateMeshData 322 | end module MeshData 323 | -------------------------------------------------------------------------------- /smoothing.f90: -------------------------------------------------------------------------------- 1 | module smoothing_mod 2 | implicit none 3 | save 4 | private 5 | real*8, parameter :: TWOSQRT3 = 3.46410161513775d0 6 | integer, parameter :: MAX_ELEM_PER_NODE = 20 7 | integer, parameter :: NITER = 100, MITER = 2, NTRY = 8 8 | real*8, parameter :: TOL_METRIC = .85D0 9 | real*8, parameter :: FACTOR_TOL_DIST = 1d-2 10 | real*8, parameter :: FACTOR_DELTA = 1d-2 11 | real*8, parameter :: FACTOR_PLUS = 1.d0 12 | real*8, parameter :: FACTOR_STEP = 3.d0 13 | !%%%%%%%%%%%%%%% 14 | integer :: NELEM, NPOIN 15 | real*8 :: H_MIN_GLOBAL 16 | logical, dimension(:), allocatable :: smoothable 17 | real*8, dimension(:), allocatable :: tol_move 18 | logical, save :: SWITCH_TOL_MOVE = .false. 19 | public :: smoothing, setTol_move 20 | contains 21 | subroutine smoothing(X, Y, inpoel, fixed, npoin0, nelem0, dX, dY) 22 | integer, intent(in) :: npoin0, nelem0, inpoel(3,nelem0) 23 | real*8, intent(inout) :: X(npoin0), Y(npoin0) 24 | logical, intent(in) :: fixed(npoin0) 25 | real*8, intent(in), optional :: dX(npoin), dY(npoin) 26 | !%%%%%%%%%%%%%%% 27 | integer :: iter, ipoin, min_idx 28 | real*8 :: d_max, TOL_DIST 29 | real*8, allocatable, dimension(:), save :: mu_vec 30 | logical, save :: isFirstCall = .true. 31 | integer, save :: counter = 0 32 | integer, parameter :: PRINT_INTERVAL = 500 33 | !%%%%%%%%%%%%%%% 34 | counter = counter + 1 35 | if(isFirstCall) then 36 | NELEM = nelem0 37 | NPOIN = npoin0 38 | allocate(mu_vec(MAX_ELEM_PER_NODE)) 39 | allocate(smoothable(NPOIN)) 40 | counter = PRINT_INTERVAL 41 | isFirstCall = .false. 42 | end if 43 | !%%%%%%%%%%%%%%% 44 | call checkMesh(inpoel, X, Y) 45 | if(.not. any(smoothable == .true.)) return 46 | if(present(dX).and.present(dY)) call setTol_move(dX, dY) 47 | do iter = 1, 2 48 | call laplacianSmoothing(X, Y, fixed, inpoel) 49 | end do 50 | TOL_DIST = FACTOR_TOL_DIST*H_MIN_GLOBAL 51 | do iter = 1, NITER 52 | d_max = 0.d0 53 | do ipoin = 1, NPOIN 54 | if(smoothable(ipoin) .and. .not. fixed(ipoin)) then 55 | smoothable(ipoin) = .false. 56 | call getMu_vec(mu_vec, ipoin, inpoel, X, Y, min_idx) 57 | if(mu_vec(min_idx) < TOL_METRIC) then 58 | call moveIpoin(X, Y, ipoin, inpoel, mu_vec, min_idx, d_max) 59 | end if 60 | end if 61 | end do 62 | if(d_max < TOL_DIST) exit 63 | end do 64 | if(counter == PRINT_INTERVAL) then 65 | counter = 0 66 | print*, '=============SMOOTHING=============' 67 | print*, '# iteraciones:', iter 68 | print*, 'Min Distortion Metric:', getMeshQuality(X, Y, inpoel) 69 | print*, 'H_MIN_GLOBAL:', H_MIN_GLOBAL 70 | print*, '===================================' 71 | end if 72 | end subroutine smoothing 73 | 74 | subroutine laplacianSmoothing(X, Y, fixed, inpoel) 75 | use PointNeighbor!, only: psup1, psup2 76 | integer, intent(in) :: inpoel(3,NELEM) 77 | real*8, intent(inout) :: X(NPOIN), Y(NPOIN) 78 | logical, intent(in) :: fixed(NPOIN) 79 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80 | integer :: ipoin, ipsup, n 81 | real*8 :: X_new, Y_new, X_old, Y_old, dX, dY, mu_old 82 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 83 | if(.not.allocated(psup1).or..not.allocated(psup2)) call getPsup(inpoel, NELEM, NPOIN) 84 | do ipoin = 1, NPOIN 85 | if(smoothable(ipoin).and..not.fixed(ipoin)) then 86 | X_new = 0 87 | Y_new = 0 88 | mu_old = getMu_min(X, Y, ipoin, inpoel) 89 | X_old = X(ipoin) 90 | Y_old = Y(ipoin) 91 | n = psup2(ipoin + 1) - psup2(ipoin) 92 | do ipsup = psup2(ipoin) + 1, psup2(ipoin + 1) 93 | X_new = X_new + X(psup1(ipsup)) 94 | Y_new = Y_new + Y(psup1(ipsup)) 95 | end do 96 | X_new = X_new/n 97 | Y_new = Y_new/n 98 | if(SWITCH_TOL_MOVE) then 99 | dX = X_new - X(ipoin) 100 | dY = Y_new - Y(ipoin) 101 | X(ipoin) = X(ipoin) + dX/(dabs(dX) + dabs(dY))*tol_move(ipoin)/2*FACTOR_STEP 102 | Y(ipoin) = Y(ipoin) + dY/(dabs(dX) + dabs(dY))*tol_move(ipoin)/2*FACTOR_STEP 103 | else 104 | X(ipoin) = X_new 105 | Y(ipoin) = Y_new 106 | end if 107 | !IF WORSE, RESTORE 108 | if(getMu_min(X, Y, ipoin, inpoel) < mu_old) then 109 | X(ipoin) = X_old 110 | Y(ipoin) = Y_old 111 | end if 112 | end if 113 | end do 114 | end subroutine laplacianSmoothing 115 | 116 | subroutine moveIpoin(X, Y, ipoin, inpoel, mu_vec, min_idx, d_max) 117 | integer, intent(in) :: ipoin, inpoel(3,NELEM) 118 | integer, intent(inout) :: min_idx 119 | real*8, intent(inout) :: mu_vec(MAX_ELEM_PER_NODE) 120 | real*8, intent(inout) :: X(NPOIN), Y(NPOIN) 121 | real*8, intent(inout) :: d_max 122 | !%%%%%%%%%%%%%%%%%%%% 123 | real*8, allocatable, dimension(:), save :: gx, gy 124 | real*8 :: x_old, y_old, x0, y0, mu_min 125 | real*8 :: dx, dy, step, d_move 126 | integer :: i, j, min_idx_new 127 | logical :: accepted 128 | logical, save :: isFirstCall = .true. 129 | !%%%%%%%%%%%%%%%%%%%% 130 | if(isFirstCall) then 131 | allocate(gx(MAX_ELEM_PER_NODE), gy(MAX_ELEM_PER_NODE)) 132 | isFirstCall = .false. 133 | end if 134 | !%%%%%%%%%%%%%%%%%%%% 135 | x0 = X(ipoin) 136 | y0 = Y(ipoin) 137 | do i = 1, MITER 138 | mu_min = mu_vec(min_idx) 139 | x_old = X(ipoin) 140 | y_old = Y(ipoin) 141 | call getG(gx, gy, ipoin, inpoel, X, Y, mu_vec) 142 | step = getStep(gx, gy, mu_vec, min_idx, ipoin, X, Y, inpoel) 143 | !TRY NEW POSITION 144 | accepted = .false. 145 | do j = 1, NTRY 146 | dx = step*gx(min_idx) 147 | dy = step*gy(min_idx) 148 | X(ipoin) = X(ipoin) + dx 149 | Y(ipoin) = Y(ipoin) + dy 150 | call getMu_vec(mu_vec, ipoin, inpoel, X, Y, min_idx_new) 151 | if(mu_vec(min_idx_new) > mu_min*FACTOR_PLUS) then 152 | min_idx = min_idx_new 153 | accepted = .true. 154 | exit 155 | else 156 | step = .5d0*step 157 | end if 158 | end do 159 | !IF FAILED, RESTORE & EXIT 160 | if(.not.accepted) then 161 | X(ipoin) = x_old 162 | Y(ipoin) = y_old 163 | exit 164 | end if 165 | end do 166 | d_move = (X(ipoin) - x0)**2 + (Y(ipoin) - y0)**2 167 | !TRACK LARGEST DISTANCE MOVED 168 | if(d_move > d_max) d_max = d_move 169 | !IF MOVED, UPDATE LIST 170 | if(d_move > tiny(1.d0)) call update_list(ipoin, inpoel) 171 | end subroutine moveIpoin 172 | 173 | subroutine getMu_vec(mu_vec, ipoin, inpoel, X, Y, min_idx) 174 | use PointNeighbor!, only: esup1, esup2 175 | integer, intent(in) :: ipoin, inpoel(3,NELEM) 176 | real*8, intent(in) :: X(NPOIN), Y(NPOIN) 177 | real*8, intent(out) :: mu_vec(MAX_ELEM_PER_NODE) 178 | integer, optional, intent(out) :: min_idx 179 | !%%%%%%%%%%%%%%%%%%%% 180 | integer :: iesup 181 | real*8 :: X_loc(3), Y_loc(3) 182 | real*8 :: mu_min, mu1 183 | !%%%%%%%%%%%%%%%%%%%% 184 | if(.not.allocated(esup1) .or. .not.allocated(esup2)) call getEsup(inpoel, NELEM, NPOIN) 185 | if(present(min_idx)) min_idx = 1 186 | mu_min = 1 187 | do iesup = esup2(ipoin) + 1, esup2(ipoin + 1) 188 | X_loc(:) = X(inpoel(:, esup1(iesup))) 189 | Y_loc(:) = Y(inpoel(:, esup1(iesup))) 190 | mu1 = mu(X_loc, Y_loc) 191 | mu_vec(iesup - esup2(ipoin)) = mu1 192 | if(present(min_idx)) then 193 | if(mu1 < mu_min) then 194 | mu_min = mu1 195 | min_idx = iesup - esup2(ipoin) 196 | end if 197 | end if 198 | end do 199 | end subroutine getMu_vec 200 | 201 | real*8 function getMu_min(X, Y, ipoin, inpoel) 202 | use PointNeighbor 203 | integer, intent(in) :: ipoin 204 | real*8, intent(in) :: X(NPOIN), Y(NPOIN) 205 | integer, intent(in) :: inpoel(3,NELEM) 206 | !%%%%%%%%%%%%%%%%%%%% 207 | integer :: iesup 208 | real*8 :: X_loc(3), Y_loc(3) 209 | real*8 :: mu1 210 | !%%%%%%%%%%%%%%%%%%%% 211 | if(.not.allocated(esup1) .or. .not.allocated(esup2)) call getEsup(inpoel, NELEM, NPOIN) 212 | getMu_min = 1 213 | do iesup = esup2(ipoin) + 1, esup2(ipoin + 1) 214 | X_loc(:) = X(inpoel(:, esup1(iesup))) 215 | Y_loc(:) = Y(inpoel(:, esup1(iesup))) 216 | mu1 = mu(X_loc, Y_loc) 217 | if(mu1 <= getMu_min) getMu_min = mu1 218 | end do 219 | end function 220 | 221 | subroutine getG(gx, gy, ipoin, inpoel, X, Y, mu_vec) 222 | integer, intent(in) :: ipoin, inpoel(3,NELEM) 223 | real*8, intent(in) :: mu_vec(MAX_ELEM_PER_NODE) 224 | real*8, intent(inout) :: X(NPOIN), Y(NPOIN) 225 | real*8, intent(out) :: gx(:), gy(:) 226 | !%%%%%%%%%%%%%%%%%%%% 227 | real*8 :: x_old, y_old 228 | real*8 :: DELTA 229 | !%%%%%%%%%%%%%%%%%%%% 230 | DELTA = H_MIN_GLOBAL*FACTOR_DELTA 231 | !--- GX --- 232 | x_old = X(ipoin) 233 | X(ipoin) = X(ipoin) + DELTA 234 | call getMu_vec(gx, ipoin, inpoel, X, Y) 235 | gx = (gx - mu_vec)/DELTA 236 | X(ipoin) = x_old 237 | !--- GY --- 238 | y_old = Y(ipoin) 239 | Y(ipoin) = Y(ipoin) + DELTA 240 | call getMu_vec(gy, ipoin, inpoel, X, Y) 241 | gy = (gy - mu_vec)/DELTA 242 | Y(ipoin) = y_old 243 | end subroutine getG 244 | 245 | real*8 function getStep(gx, gy, mu_vec, min_idx, ipoin, X, Y, inpoel) 246 | use PointNeighbor!, only: esup1, esup2 247 | real*8, intent(in) :: gx(:), gy(:), mu_vec(MAX_ELEM_PER_NODE) 248 | integer, intent(in) :: min_idx, ipoin, inpoel(3,NELEM) 249 | real*8, intent(in) :: X(NPOIN), Y(NPOIN) 250 | !%%%%%%%%%%%%%%%%%%%% 251 | real*8 :: g2, gg, step1 252 | real*8 :: gx_min, gy_min, mu_min 253 | integer :: i 254 | !%%%%%%%%%%%%%%%%%%%% 255 | if(.not.allocated(esup1) .or. .not.allocated(esup2)) call getEsup(inpoel, NELEM, NPOIN) 256 | gx_min = gx(min_idx) 257 | gy_min = gy(min_idx) 258 | mu_min = mu_vec(min_idx) 259 | g2 = gx_min**2 + gy_min**2 260 | if(SWITCH_TOL_MOVE) then 261 | getStep = tol_move(ipoin)/((dabs(gx_min) + dabs(gy_min))*NITER) 262 | else 263 | getStep = getH_min(ipoin, X, Y, inpoel)*FACTOR_STEP/(dabs(gx_min) + dabs(gy_min)) 264 | end if 265 | do i = 1, esup2(ipoin + 1) - esup2(ipoin) 266 | gg = gx_min*gx(i) + gy_min*gy(i) 267 | if(gg < 0) then 268 | step1 = (mu_vec(i) - mu_min)/(g2 - gg) 269 | if(step1 < getStep) getStep = step1 270 | end if 271 | end do 272 | end function getStep 273 | 274 | real*8 function getH_min(ipoin, X, Y, inpoel) 275 | use PointNeighbor!, only: esup1, esup2 276 | integer, intent(in) :: ipoin, inpoel(3,NELEM) 277 | real*8, intent(in) :: X(NPOIN), Y(NPOIN) 278 | !%%%%%%%%%%%%%%%%%%%% 279 | integer :: iesup 280 | real*8 :: X_loc(3), Y_loc(3) 281 | real*8 :: h1 282 | !%%%%%%%%%%%%%%%%%%%% 283 | if(.not.allocated(esup1) .or. .not.allocated(esup2)) call getEsup(inpoel, NELEM, NPOIN) 284 | getH_min = 1 285 | do iesup = esup2(ipoin) + 1, esup2(ipoin + 1) 286 | X_loc(:) = X(inpoel(:,esup1(iesup))) 287 | Y_loc(:) = Y(inpoel(:,esup1(iesup))) 288 | h1 = h(X_loc, Y_loc) 289 | if(h1 < getH_min) getH_min = h1 290 | end do 291 | end function getH_min 292 | 293 | subroutine update_list(ipoin, inpoel) 294 | use PointNeighbor!, only: psup1, psup2 295 | integer, intent(in) :: ipoin, inpoel(3,NELEM) 296 | !%%%%%%%%%%%%%%%%%%%% 297 | integer :: ipsup 298 | !%%%%%%%%%%%%%%%%%%%% 299 | if(.not.allocated(psup1) .or. .not.allocated(psup2)) call getPsup(inpoel, NELEM, NPOIN) 300 | forall (ipsup = psup2(ipoin) + 1 : psup2(ipoin + 1)) 301 | smoothable(psup1(ipsup)) = .true. 302 | end forall 303 | end subroutine update_list 304 | 305 | pure real*8 function mu(X_loc, Y_loc) 306 | real*8, intent(in) :: X_loc(:), Y_loc(:) 307 | !%%%%%%%%%%%%%%%%%%%% 308 | real*8 :: l1, l2, l3, l, area 309 | !%%%%%%%%%%%%%%%%%%%% 310 | area = X_loc(2)*Y_loc(3)+X_loc(3)*Y_loc(1)+X_loc(1)*Y_loc(2) & 311 | -(X_loc(2)*Y_loc(1)+X_loc(3)*Y_loc(2)+X_loc(1)*Y_loc(3)) 312 | l1 = (X_loc(3)-X_loc(2))**2 + (Y_loc(3)-Y_loc(2))**2 313 | l2 = (X_loc(1)-X_loc(3))**2 + (Y_loc(1)-Y_loc(3))**2 314 | l3 = (X_loc(2)-X_loc(1))**2 + (Y_loc(2)-Y_loc(1))**2 315 | l = l1 + l2 + l3 316 | mu = TWOSQRT3*area/l 317 | end function mu 318 | 319 | pure real*8 function h(X_loc, Y_loc) 320 | real*8, intent(in) :: X_loc(:), Y_loc(:) 321 | !%%%%%%%%%%%%%%%%%%%% 322 | real*8 :: d1, d2, d3, d, area 323 | !%%%%%%%%%%%%%%%%%%%% 324 | area = X_loc(2)*Y_loc(3) + X_loc(3)*Y_loc(1) + X_loc(1)*Y_loc(2) & 325 | -(X_loc(2)*Y_loc(1) + X_loc(3)*Y_loc(2) + X_loc(1)*Y_loc(3)) 326 | d1 = dabs(X_loc(3)-X_loc(2)) + dabs(Y_loc(3)-Y_loc(2)) 327 | d2 = dabs(X_loc(1)-X_loc(3)) + dabs(Y_loc(1)-Y_loc(3)) 328 | d3 = dabs(X_loc(2)-X_loc(1)) + dabs(Y_loc(2)-Y_loc(1)) 329 | d = d1 + d2 + d3 330 | !H ES MENOR O IGUAL A 1/4 LA ALTURA MINIMA 331 | h = dabs(area)/d 332 | end function h 333 | 334 | pure real*8 function getMeshQuality(X, Y, inpoel) 335 | integer, intent(in) :: inpoel(3,NELEM) 336 | real*8, intent(in) :: X(NPOIN), Y(NPOIN) 337 | !%%%%%%%%%%%%%%%%%%%% 338 | integer :: ielem 339 | real*8 :: X_loc(3), Y_loc(3) 340 | real*8 :: mu1 341 | !%%%%%%%%%%%%%%%%%%%% 342 | getMeshQuality = 1 343 | do ielem = 1, nelem 344 | X_loc(:) = X(inpoel(:,ielem)) 345 | Y_loc(:) = Y(inpoel(:,ielem)) 346 | mu1 = mu(X_loc, Y_loc) 347 | if(mu1 < getMeshQuality) getMeshQuality = mu1 348 | end do 349 | end function getMeshQuality 350 | 351 | subroutine checkMesh(inpoel, X, Y) 352 | integer, intent(in) :: inpoel(3,NELEM) 353 | real*8, intent(in) :: X(NPOIN), Y(NPOIN) 354 | !%%%%%%%%%%%%%%%%%%%%%%%%% 355 | integer :: ielem 356 | real*8 :: X_loc(3), Y_loc(3) 357 | real*8 :: h1 358 | !%%%%%%%%%%%%%%%%%%%%%%%%% 359 | H_MIN_GLOBAL = 1 360 | smoothable(:) = .false. 361 | do ielem = 1, NELEM 362 | X_loc(:) = X(inpoel(:,ielem)) 363 | Y_loc(:) = Y(inpoel(:,ielem)) 364 | if(mu(X_loc, Y_loc) < TOL_METRIC) then 365 | smoothable(inpoel(:,ielem)) = .true. 366 | end if 367 | h1 = h(X_loc, Y_loc) 368 | if(h1 < H_MIN_GLOBAL) H_MIN_GLOBAL = h1 369 | end do 370 | end subroutine checkMesh 371 | 372 | subroutine setTol_move(dX, dY) 373 | real*8, dimension(:), intent(in) :: dX, dY 374 | !%%%%%%%%%%%%%%%%%%%%%%%%% 375 | integer :: ipoin, npoin 376 | !%%%%%%%%%%%%%%%%%%%%%%%%% 377 | npoin = size(dX) 378 | if(.not.allocated(tol_move)) allocate(tol_move(npoin)) 379 | !%%%%%%%%%%%%%%%%%%%%%%%%% 380 | SWITCH_TOL_MOVE = .true. 381 | !$OMP PARALLEL DO PRIVATE(ipoin) 382 | do ipoin = 1, npoin 383 | tol_move(ipoin) = dabs(dX(ipoin)) + dabs(dY(ipoin)) 384 | end do 385 | !$OMP END PARALLEL DO 386 | end subroutine setTol_move 387 | end module smoothing_mod 388 | -------------------------------------------------------------------------------- /meshMove.f90: -------------------------------------------------------------------------------- 1 | #define timer(func, store) call system_clock(start_t, rate); call func; call system_clock(end_t); store = store + real(end_t - start_t)/real(rate); 2 | module MeshMove 3 | real(8), dimension(:), allocatable :: b, pos_aux 4 | real(8), dimension(:), allocatable :: dxpos, dypos 5 | real(8) yposr, alpha 6 | real(8), dimension(:, :), allocatable :: masa, c, k 7 | real(8), dimension(:), allocatable :: disn, diss, veln, vels, accn, accs, r, g, g1, f, cten 8 | real(8) fx(10), fy(10), rm(10), f_vx(10), f_vy(10) 9 | real(8), dimension(:), allocatable :: xpos, ypos 10 | 11 | private 12 | public :: setNewmarkCondition, fluidStructure 13 | public :: fx, fy, rm, f_vx, f_vy, xpos, ypos 14 | contains 15 | subroutine setNewmarkCondition 16 | implicit none 17 | call allocateNewmark 18 | !CONDICIONES INICIALES NEWMARK 19 | DISN(1) = 0.d0; DISN(2) = 0.D0 20 | VELN(1) = 0.d0; VELN(2) = 0.d0 21 | ACCN = 0.d0 22 | F(1) = 0.d0 23 | F(2) = 0.d0 24 | YPOSR = DISN(1) 25 | ALPHA = DISN(2) 26 | end subroutine setNewmarkCondition 27 | 28 | subroutine fluidStructure(dtmin, time, SMOOTH_FIX, x1, y1) 29 | use MeshData 30 | use Mlaplace 31 | use mvelocidades 32 | use BiconjGrad 33 | use mvariables 34 | use mvariabgen 35 | use InputData, only: XREF, YREF, NDIM, IPRINT 36 | use timers 37 | implicit none 38 | integer :: ipoin 39 | real*8 :: dtmin, alphav, yposrv, pi, fre, ampli, time, alpha, yposr 40 | real*8 :: x1(npoin), y1(npoin) 41 | integer :: SMOOTH_SIM(2,npoin) 42 | logical :: SMOOTH_FIX(npoin) 43 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 44 | if(.not. allocated(xpos)) allocate(xpos(npoin)) 45 | if(.not. allocated(ypos)) allocate(ypos(npoin)) 46 | if(.not. allocated(pos_aux)) allocate(pos_aux(npoin)) 47 | if(.not. allocated(dxpos)) allocate(dxpos(npoin)) 48 | if(.not. allocated(dypos)) allocate(dypos(npoin)) 49 | if(.not. allocated(b)) allocate(b(npoin)) 50 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 51 | 52 | DXPOS = 0.d0 53 | DYPOS = 0.d0 54 | 55 | PI=DACOS(-1.d0) 56 | FRE=0.5D0 57 | AMPLI=PI/8.D0 58 | XREF(2)=1.4d0 ; YREF(2)=0.d0 59 | timer(FORCES(NSETS, NSET_NUMB, IELEM_SETS, npoin, X, Y, P, FX, FY, RM, XREF, YREF), forces_t) 60 | 61 | !F(1) = dcos(DISN(2))*FY(1) - dsin(DISN(2))*FX(1) 62 | !F(2) = RM(1) + 0.1d0*dsin(DISN(2))*FX(1) - dcos(DISN(2))*0.1d0*FY(1) 63 | 64 | ALPHAV = DISN(2) 65 | YPOSRV = DISN(1) 66 | 67 | !timer(NEWMARK_METHOD(DTMIN), newmark_t) 68 | 69 | !DISN(2)=AMPLI*DSIN(-2.d0*PI*FRE*TIME) 70 | DISN(2)=AMPLI*DSIN(10.d0*TIME) 71 | ALPHA=DISN(2)-ALPHAV; YPOSR=DISN(1) -YPOSRV 72 | 73 | !ALPHA = DISN(2) - ALPHAV 74 | !YPOSR = DISN(1) - YPOSRV 75 | 76 | timer(TRANSF(ALPHA, YPOSR, XREF, YREF), transf_t) 77 | 78 | !NODOS SIN MOVIMIENTO 79 | !$OMP PARALLEL DO PRIVATE(IPOIN) 80 | do ipoin = 1 + NMOVE, NFIX_MOVE + NMOVE 81 | POS_AUX(ipoin) = 0.d0 82 | end do 83 | !$OMP END PARALLEL DO 84 | 85 | !$OMP PARALLEL DO PRIVATE(IPOIN) 86 | do ipoin = 1, NMOVE 87 | POS_AUX(ipoin) = DXPOS(ilaux(ipoin)) 88 | end do 89 | !$OMP END PARALLEL DO 90 | 91 | !$OMP PARALLEL DO PRIVATE(IPOIN) 92 | do ipoin = 1, npoin 93 | B(ipoin) = 0.d0 94 | end do 95 | !$OMP END PARALLEL DO 96 | 97 | timer(biCG(lap_sparse, lap_idx, lap_rowptr, lap_diag, xpos, b, pos_aux(1:nnmove), ilaux(1:nnmove), npoin, nnmove), grad_t) 98 | 99 | !$OMP PARALLEL DO PRIVATE(IPOIN) 100 | do ipoin = 1, npoin 101 | X(ipoin) = X(ipoin) + XPOS(ipoin) 102 | X1(ipoin) = X1(ipoin) + XPOS(ipoin) 103 | W_X(ipoin) = XPOS(ipoin)/DTMIN 104 | end do 105 | !$OMP END PARALLEL DO 106 | 107 | !$OMP PARALLEL DO PRIVATE(IPOIN) 108 | do ipoin = 1, NMOVE 109 | POS_AUX(ipoin) = DYPOS(ilaux(ipoin)) 110 | end do 111 | !$OMP END PARALLEL DO 112 | 113 | !$OMP PARALLEL DO PRIVATE(IPOIN) 114 | do ipoin = 1, npoin 115 | B(ipoin) = 0.d0 116 | end do 117 | !$OMP END PARALLEL DO 118 | 119 | timer(biCG(lap_sparse, lap_idx, lap_rowptr, lap_diag, ypos, b, pos_aux(1:nnmove), ilaux(1:nnmove), npoin, nnmove), grad_t) 120 | 121 | !$OMP PARALLEL DO PRIVATE(IPOIN) 122 | do ipoin = 1, npoin 123 | Y(ipoin) = Y(ipoin) + YPOS(ipoin) 124 | Y1(ipoin) = Y1(ipoin) + YPOS(ipoin) 125 | W_Y(ipoin) = YPOS(ipoin)/DTMIN 126 | end do 127 | !$OMP END PARALLEL DO 128 | 129 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 130 | ! XPOS=X ; YPOS=Y 131 | ! if(counter.EQ.1000)THEN 132 | ! counter = 0 133 | ! call SMOOTH_MESH(npoin,nelem,inpoel,XPOS,YPOS,SMOOTH_FIX,SMOOTH_SIM) 134 | ! W_X = (X - X_aux)/DTMIN 135 | ! W_Y = (Y - Y_aux)/DTMIN 136 | ! X1 = X-xpos 137 | ! Y1 = Y-ypos 138 | ! X = XPOS 139 | ! Y = YPOS 140 | ! end if 141 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 142 | end subroutine 143 | 144 | subroutine allocateNewmark 145 | !use MATRICES 146 | !use MAT2 147 | use InputData, only: NDIM 148 | ALLOCATE(MASA(NDIM, NDIM), C(NDIM, NDIM), K(NDIM, NDIM)) 149 | ALLOCATE(DISN(NDIM), DISS(NDIM), VELN(NDIM), VELS(NDIM), ACCN(NDIM), ACCS(NDIM)) 150 | ALLOCATE(R(NDIM), G(NDIM), G1(NDIM), F(NDIM), CTEN(NDIM)) 151 | end subroutine allocateNewmark 152 | 153 | subroutine FORCES(NSETS, NSET_NUMB, IELEM_SETS, npoin & 154 | , X, Y, P , FX, FY, RM, X_ROT, Y_ROT) 155 | !cccc calculo de las fuerzas en cccc 156 | !cccc cada uno de los sets cccc 157 | !use MFUERZAS 158 | use MeshData, only: ISET, IPER_MASTER, IPER_SLAVE, IPER_AUX 159 | implicit real(8) (A-H, O-Z) 160 | 161 | INTEGER IELEM_SETS(10) 162 | 163 | real(8) X(npoin), Y(npoin) 164 | real(8) P(npoin) 165 | real(8) FX(10), FY(10), RM(10),X_ROT(10),Y_ROT(10) 166 | 167 | FX(1:NSET_NUMB)=0.d0 168 | FY(1:NSET_NUMB)=0.d0 169 | RM(1:NSET_NUMB)=0.d0 170 | 171 | do ISET_NUMB=1, NSET_NUMB 172 | do II=1, IELEM_SETS(ISET_NUMB) 173 | N1=ISET(1, ISET_NUMB, II) 174 | N2=ISET(2, ISET_NUMB, II) 175 | 176 | D_PRESS=(P(N1)+P(N2))/2.d0 177 | RLX=X(N1)-X(N2) 178 | RLY=Y(N2)-Y(N1) 179 | 180 | DFX=D_PRESS*RLY 181 | DFY=D_PRESS*RLX 182 | 183 | FX(ISET_NUMB)=FX(ISET_NUMB)+DFX 184 | FY(ISET_NUMB)=FY(ISET_NUMB)+DFY 185 | 186 | XC=(X(N1)+X(N2))/2.d0 187 | YC=(Y(N2)+Y(N1))/2.d0 188 | 189 | RM(ISET_NUMB)=RM(ISET_NUMB)+DFY*(XC-X_ROT(ISET_NUMB))-DFX*(YC-Y_ROT(ISET_NUMB)) 190 | 191 | end do 192 | end do 193 | return 194 | end subroutine FORCES 195 | 196 | subroutine NEWMARK_METHOD(H) 197 | !-------------------------------------------------------------------------- 198 | ! Newmark's Direct Integration Method 199 | !-------------------------------------------------------------------------- 200 | ! Code written by : - Ing. German Weht 201 | ! Researcher & PhD Student 202 | ! Departamento de Mecanica Aeronautica 203 | ! Instituto Universitario Aeronautico 204 | ! Cordoba, Argentina 205 | ! E-mail : gerweht@gmail.com 206 | !------------------------------------------------------------------------- 207 | ! PURPOSE 208 | ! Solve linear structural differential equations 209 | ! *** Newmark time integration *** 210 | ! The system of ordinary differential equations 211 | ! [M]{ACC}+[C]{VEL}+[K]{DIS}={F} 212 | ! 213 | ! 214 | ! INPUT 215 | ! [M] : System Mass [inpoel, inpoel] 216 | ! [C] : System Damping [inpoel, inpoel] 217 | ! [K] : System Stiffness [inpoel, inpoel] 218 | ! [F] : Externally Applied Load [inpoel] 219 | ! [DISS] : Initial Position [inpoel] 220 | ! [VELS] : Initial Velocity [inpoel] 221 | ! [ACCS] : Initial Aceleration [inpoel] 222 | ! [T] : Initial Time 223 | ! [TMAX] : Finish Time 224 | ! [H] : Time step 225 | ! [G] : Auxiliaries [inpoel] 226 | ! [G1] : Auxiliaries [inpoel] 227 | ! OUTPUT 228 | ! [DIS]: Displacemente [inpoel] 229 | ! [VEL]: Velocity [inpoel] 230 | ! [ACC]: Acceleration [inpoel] 231 | ! 232 | ! The options include changing the value of the "gamma" and "beta" 233 | ! coefficient which appear in the formulation of the method. By default 234 | ! these values are set to gamma = 1/2 and beta = 1/4. 235 | ! 236 | ! 237 | !------------------------------------------------------------------------- 238 | !use MATRICES 239 | !use MAT2 240 | use InputData, only: NDIM 241 | implicit real(8)(A-H, O-Z) 242 | !real(8), ALLOCATABLE:: M(:, :), C(:, :), K(:, :) 243 | !real(8), ALLOCATABLE:: DIS(:), DISS(:), VEL(:), VELS(:), ACC(:), ACCS(:), R(:), G(:), G1(:), F(:), CTE(:) 244 | PI=DACOS(-1.d0) 245 | GR=1.d0!9.81D0 ! gravedad 246 | 247 | 248 | 249 | 250 | 251 | ! **** DEFINICION DE CONSTANTES DEL METODO POR DEFAULT GAMA=1/2 BETA=1/4 **** 252 | GAMA=.5D0 ; BETA=.25D0 253 | 254 | A1 = 1.d0/(BETA*H*H) ; A2 = 1.d0/(BETA*H) ; A3 = 1.d0/(2.d0*BETA) - 1.d0 ; A4 = (1.d0 - GAMA)*H ; A5 = GAMA*H 255 | A1D = GAMA/(BETA*H) ; A2D = GAMA/BETA - 1.d0 ; A3D = 0.5D0*H*(GAMA/BETA - 2.d0) 256 | 257 | 258 | 259 | !ALLOCATE(M(NDIM, NDIM), C(NDIM, NDIM), K(NDIM, NDIM)) 260 | !ALLOCATE(DIS(NDIM), DISS(NDIM), VEL(NDIM), VELS(NDIM), ACC(NDIM), ACCS(NDIM)) 261 | !ALLOCATE(R(NDIM), G(NDIM), G1(NDIM), F(NDIM), CTE(NDIM)) 262 | 263 | 264 | !***** MATRICES ***** 265 | ! MATRIZ DE MASA 266 | MASA(1, 1)=51.5d0 ; MASA(1, 2)=-51.5d0*.0429d0 267 | MASA(2, 1)=-51.5d0*.0429d0 ; MASA(2, 2)=2.275d0 268 | 269 | ! MATRIZ DE AMORTIGUAMIENTO 270 | C(1, 1)=32.358D0/GR ; C(1, 2)=0.d0 271 | C(2, 1)=0.d0 ; C(2, 2)=5.718D0/GR 272 | 273 | ! MATRIZ DE RIGUIDEZ 274 | K(1, 1)=50828.463D0/GR ; K(1, 2)=0.d0 275 | K(2, 1)=0.d0 ; K(2, 2)=35923.241D0/GR 276 | 277 | ! VECTOR DE FUERZAS EXTERNAS 278 | 279 | 280 | ! CONDICIONES INICIALES 281 | !DIS(1)=0.05D0; DIS(2)=PI/8.d0 282 | !VEL=0.d0 283 | !ACC=0.d0 284 | 285 | ! Matrix with [Keff]=[K]+a1[M]+a1D[C] 286 | K=K+A1*MASA+A1D*C 287 | 288 | !CCCC -----> TRIANGULAR SUPERIOR DE LA MATRIZ K, SI ES CONSTANTE 289 | do I=1, NDIM-1 290 | do J=I+1, NDIM 291 | CTEN(J)=K(J, I)/K(I, I) 292 | do l=I+1, NDIM 293 | K(J, l)=K(J, l)-CTEN(J)*K(I, l) 294 | end do 295 | end do 296 | end do 297 | 298 | !do WHILE(T.LT.TMAX) 299 | !Guardo el resultado del paso anterior 300 | DISS = DISN 301 | VELS = VELN 302 | ACCS = ACCN 303 | R=0.d0 304 | ! Vector of effective loading forces at time t+dt 305 | ! R = F + [M]*(a1*dis + a2*vel + a3*acc) + [C]*(a1d*dis + a2d*vel + a3d*acc) 306 | ! Sumo ambos vectores, todas operaciones vectoriales 307 | 308 | ! Primera parte [M]*(a1*dis + a2*vel + a3*acc) 309 | G= A1*DISN+A2*VELN+A3*ACCN 310 | call MATVEC(MASA, G, G1, NDIM) 311 | R=F+G1 312 | 313 | ! Segunda parte [C]*(a1d*dis + a2d*vel + a3d*acc) 314 | G=A1D*DISN+A2D*VELN+A3D*ACCN 315 | call MATVEC(C, G, G1, NDIM) 316 | R=R+G1 317 | 318 | ! Resuelvo el sistema [Keff]q=Feff y obtengo los desplazamientos en t+dt 319 | call GAUSS(K, R, DISN, CTEN, NDIM) 320 | 321 | ! Aceleraciones el t+dt 322 | ACCN = A1*(DISN - DISS) - A2*VELS - A3*ACCS 323 | ! Velocidad a t+dt 324 | VELN = VELS + A4*ACCS + A5*ACCN 325 | TIEMPO=TIEMPO+H 326 | !write(1, *) T, DIS, VEL 327 | ! end do 328 | 329 | end subroutine NEWMARK_METHOD 330 | 331 | subroutine MATVEC(A, X, AUX, NDIM) 332 | ! SUBRUTINA PRODUCTO MATRIZ VECTOR 333 | implicit real(8)(A-H, O-Z) 334 | real(8)A(NDIM, NDIM), X(NDIM), AUX(NDIM) 335 | 336 | AUX=0.d0 337 | do I=1, NDIM 338 | do J=1, NDIM 339 | AUX(I)=AUX(I)+A(I, J)*X(J) 340 | end do 341 | end do 342 | 343 | return 344 | end subroutine MATVEC 345 | 346 | subroutine GAUSS(A, B, X, CTE, NDIM) 347 | ! METODO DE GAUSS JORDAN PARA SISTEMAS LINEALES 348 | implicit real(8) (A-H, O-Z) 349 | real(8) B(NDIM), X(NDIM), A(NDIM, NDIM), CTE(NDIM) 350 | 351 | !CCCC -----> TRIANGULAR SUPERIOR AL VECTOR TERMINO INDEPENDIENTE 352 | do I=1, NDIM-1 353 | do J=I+1, NDIM 354 | B(J)=B(J)-CTE(J)*B(I) 355 | end do 356 | end do 357 | 358 | !CCCC -----> RETORSUSTITUCION 359 | do I=NDIM, 1, -1 360 | S=0.d0 361 | do J=I+1, NDIM 362 | S=S+A(I, J)*X(J) 363 | end do 364 | X(I)=(B(I)-S)/A(I, I) 365 | end do 366 | 367 | end subroutine GAUSS 368 | 369 | subroutine TRANSF(ALPHA, YPOSR, XREF, YREF) 370 | !use MGEOMETRIA 371 | !use MALLOCAR 372 | !use MMOVIMIENTO 373 | use MeshData 374 | !use MNEWMARK 375 | 376 | implicit real(8) (A-H, O-Z) 377 | REAL(8) XREF(10),YREF(10) 378 | DO ISET_NUMB=1,NSET_NUMB 379 | DO II=1,IELEM_SETS(ISET_NUMB) 380 | DO JJ=1,2 381 | 382 | DISTX = X(ISET(JJ,ISET_NUMB,II)) - XREF(ISET_NUMB) 383 | DISTY = Y(ISET(JJ,ISET_NUMB,II)) - YREF(ISET_NUMB)+YPOSR 384 | 385 | DXPOS(ISET(JJ,ISET_NUMB,II)) = dcos(ALPHA)*DISTX + dsin(ALPHA)*DISTY - DISTX 386 | DYPOS(ISET(JJ,ISET_NUMB,II)) = -dsin(ALPHA)*DISTX + dcos(ALPHA)*DISTY - DISTY+YPOSR 387 | end do 388 | end do 389 | end do 390 | 391 | 392 | end subroutine 393 | end module MeshMove 394 | 395 | !CCCC---- SMOOTHING DE LOS ELEMENTOS 396 | !CCCC------------------------------- 397 | subroutine SMOOTH_MESH(npoin, NELEM, inpoel, X, Y & 398 | , SMOOTH_FIX, SMOOTH_SIM) 399 | 400 | implicit real(8) (A-H, O-Z) 401 | 402 | INTEGER inpoel(3, NELEM), SMOOTH_SIM(2, npoin) 403 | INTEGER NELINOD(npoin), NE(20, npoin) 404 | 405 | real(8) X(npoin), Y(npoin) 406 | real(8) MU_0, MU_X, MU_Y, MU_Z, RMU1, RMUMIN, GG, GGI, GAM1, GAMMIN 407 | real(8) MU(100), GX(100), GY(100), XX(4), YY(4) 408 | 409 | LOGICAL SMOOTH_FIX(npoin) 410 | 411 | write(*, *) 'suavizado inicial 1' 412 | 413 | do INOD=1, npoin 414 | NELINOD(INOD)=0 415 | end do 416 | 417 | do IELEM=1, NELEM 418 | do IN=1, 3 419 | INOD=inpoel(IN, IELEM) 420 | NELINOD(INOD)=NELINOD(INOD)+1 421 | NE(NELINOD(INOD), INOD)=IELEM 422 | end do 423 | end do 424 | 425 | DELTA=1.D-4 426 | !CCCC COMIENZO DE ITERACIONES DE OPTIMIZACION 427 | 428 | do IT=1, 1000 429 | 430 | 431 | RMM=1.D10 432 | ERR=0.d0; xmax=0 433 | NUMEL=0 434 | do INOD=1, npoin 435 | 436 | if (SMOOTH_FIX(INOD)) THEN 437 | 438 | RMUMIN=1.D10 439 | do IEL=1, NELINOD(INOD) 440 | IELEM=NE(IEL, INOD) 441 | 442 | do IN=1, 3 443 | N1=inpoel(IN, IELEM) 444 | XX(IN)=X(N1) 445 | YY(IN)=Y(N1) 446 | if (N1.EQ.INOD) IN_P=IN 447 | end do 448 | 449 | MU_0=RMU1(XX, YY) 450 | 451 | if (RMM.GT.MU_0) THEN 452 | RMM=MU_0 453 | IELMIN=IELEM 454 | end if 455 | 456 | MU(IEL)=MU_0 457 | if (MU_0.LT.RMUMIN) THEN 458 | RMUMIN=MU_0 459 | IELM=IEL 460 | end if 461 | 462 | XX(IN_P)=X(INOD)+DELTA 463 | MU_X=RMU1(XX, YY) 464 | XX(IN_P)=X(INOD) 465 | GX(IEL)=(MU_X-MU_0)/DELTA 466 | 467 | YY(IN_P)=Y(INOD)+DELTA 468 | MU_Y=RMU1(XX, YY) 469 | YY(IN_P)=Y(INOD) 470 | GY(IEL)=(MU_Y-MU_0)/DELTA 471 | end do 472 | 473 | if (RMUMIN.GT.0.8D0) CYCLE 474 | NUMEL=NUMEL+1 475 | 476 | GMX=GX(IELM) 477 | GMY=GY(IELM) 478 | 479 | GAM1=0.d0 480 | GAMMIN=1.D10 481 | do IEL=1, NELINOD(INOD) 482 | GG=GMX*GMX+GMY*GMY 483 | if (IEL.NE.IELM) THEN 484 | GGI=GX(IEL)*GMX+GY(IEL)*GMY 485 | if (GGI.LT.0) THEN 486 | GAM1=(MU(IEL)-RMUMIN)/(GG-GGI) 487 | if (GAMMIN.GT.GAM1.AND.GAM1.NE.0.) GAMMIN=GAM1 488 | end if 489 | end if 490 | end do 491 | 492 | GAMMIN=GAMMIN/8 493 | if (GAMMIN.GT.100) GAMMIN=1.D-6 494 | 495 | X1=X(INOD)+GMX*GAMMIN*SMOOTH_SIM(1, INOD) 496 | Y1=Y(INOD)+GMY*GAMMIN*SMOOTH_SIM(2, INOD) 497 | 498 | ERR=ERR+(X(INOD)-X1)**2+(Y(INOD)-Y1)**2 499 | 500 | X(INOD)=X1 501 | Y(INOD)=Y1 502 | 503 | end if 504 | end do 505 | 506 | if (NUMEL.EQ.0) EXIT 507 | 508 | end do 509 | 510 | write(*, *) 'ERROR FINAL:', ERR, ' PASOS:', IT-1, NUMEL 511 | 512 | return 513 | end subroutine SMOOTH_MESH 514 | 515 | FUNCTION RMU1(XX, YY) 516 | implicit real(8) (A-H, O-Z) 517 | real(8) XX(4), YY(4) 518 | 519 | AREA=XX(2)*YY(3)+XX(3)*YY(1)+XX(1)*YY(2) & 520 | -(XX(2)*YY(1)+XX(3)*YY(2)+XX(1)*YY(3)) 521 | 522 | RL21=(XX(2)-XX(1))**2.d0+(YY(2)-YY(1))**2.d0 523 | RL32=(XX(3)-XX(2))**2.d0+(YY(3)-YY(2))**2.d0 524 | RL13=(XX(1)-XX(3))**2.d0+(YY(1)-YY(3))**2.d0 525 | 526 | RL=RL21+RL32+RL13 527 | 528 | RMU1=2.d0*DSQRT(3.d0)*AREA/RL 529 | 530 | return 531 | end FUNCTION RMU1 532 | -------------------------------------------------------------------------------- /ns2DComp.ALE.f90: -------------------------------------------------------------------------------- 1 | #define timer(func, store) call system_clock(start_t, rate); call func; call system_clock(end_t); store = store + real(end_t - start_t)/real(rate); 2 | 3 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4 | !CCC CCC 5 | !CCC NAVIER-STOKES 2D CCC 6 | !CCC CCC 7 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 8 | PROGRAM NSComp2D 9 | 10 | use MESTABILIZACION 11 | use MVARIABLES 12 | use Mnormales 13 | use MVELOCIDADES 14 | use MVARIABGEN 15 | use TIMERS 16 | use Mlaplace 17 | use InputData 18 | use MeshData 19 | use MeshMove 20 | use smoothing_mod 21 | implicit real(8) (A-H, O-Z) 22 | 23 | integer BANDERA, NESTAB 24 | ! CCCC SUAVIZADO DE LOS ELEMENTOS 25 | integer, dimension(:, :), allocatable:: SMOOTH_SIM 26 | real(8), dimension(:), allocatable:: GAMM 27 | real(8) ER(4), ERR(4) 28 | ! CCCC LOCAL TIME STEP 29 | real(8), dimension(:), allocatable:: DTL, DT 30 | ! CCCC REFINAMIENTO 31 | real(8), dimension(:), allocatable:: HH_NEW,x1,y1 32 | ! CCCC SUAVIZADO SMOOTHING 33 | logical, dimension(:), allocatable:: SMOOTH_FIX 34 | 35 | cuarto_t=0; calcrhs_t = 0; masas_t=0; deriv_t=0; laplace_t=0; normales_t=0; fuente_t=0 36 | forces_t=0; newmark_t=0; transf_t=0; grad_t=0; residuo_t=0; spmv_t=0 37 | 38 | !CCCC----> TIEMPO DE CPU 39 | call system_clock(m_start, m_rate) 40 | 41 | open(22, FILE='FORCES_HISTORY', STATUS='UNKNOWN') 42 | 43 | !Lee archivo filename-1.dat 44 | call readInputData 45 | !Lee archivo filename.dat 46 | call loadMeshData 47 | 48 | ALLOCATE(SMOOTH_SIM(2, npoin)) 49 | ALLOCATE(GAMM(npoin), DTL(NELEM), DT(NELEM)) 50 | ALLOCATE(HH_NEW(npoin), SMOOTH_FIX(npoin),x1(npoin),y1(npoin)) 51 | 52 | !CCCC------------------------------------!CCCC 53 | !CCCC-----> COMIENZO DEL CALCULO <-----!CCCC 54 | !CCCC------------------------------------!CCCC 55 | !CCCC----> ASIGNA VALOR A LAS VARIABLES PRIMITIVAS Y REALIZA UN RESTART 56 | !CCCC----> SI IRESTART.EQ.1 57 | !CCCC------------------------------------------------------------ 58 | 59 | GAMM = GAMA 60 | call RESTART(GAMM) 61 | 62 | !!$ ! NODOS QUE NO SON SUAVIZADOS 63 | SMOOTH_FIX(1:npoin)=.false. 64 | SMOOTH_SIM(1:2, 1:npoin)=1 65 | do I=1, NMOVE 66 | N1=I_M(I) 67 | SMOOTH_FIX(N1)=.true. 68 | end do 69 | 70 | do I=1, NFIX_MOVE 71 | N1=IFM(I) 72 | SMOOTH_FIX(N1)=.true. 73 | end do 74 | x1=0.d0 ; y1=0.d0 75 | 76 | call smoothing(X, Y, inpoel, smooth_fix, npoin, nelem) 77 | 78 | if(NGAS.NE.1) GAMM = GAMA 79 | 80 | !CCCC-----> CALCULO DE LOS NODOS CON PERIODICIDAD 81 | !CCCC--------------------------------------------------------- 82 | if(NMASTER.NE.0.AND.NSLAVE.NE.0)THEN 83 | call PERIODIC 84 | end if 85 | 86 | !CCCC-----> CALCULO DE LAS NORMALES 87 | !CCCC--------------------------------------------------------- 88 | call NORMALES 89 | 90 | !CCCC----> CALCULO DE LAS DERIVADAS, EL AREA Y LA LONGITUD CARAC. 91 | !CCCC------------------------------------------------------------ 92 | call DERIV(HMIN) 93 | 94 | !CCCC----> CALCULO DE LAS MATRICES DE MASAS LUMPED 95 | !CCCC ---------------------------------------------------------- 96 | call MASAS(.false.) 97 | 98 | !CCCC----> CALCULO DE LOS NODOS VECINOS Y EL LAPLACIANO 99 | !CCCC ------------------------------------------------------ 100 | call laplace(inpoel, area, dNx, dNy, nelem, npoin) 101 | 102 | !CCCC----> ABRE EL ARCHIVO DE CONVERGENCIA 103 | !CCCC---------------------------------------------- 104 | open(7, FILE=trim(filename)//'.cnv', STATUS='UNKNOWN') 105 | 106 | !CCCC -----------------------------------------CCCC 107 | !CCCC ----> COMIENZO DE LAS ITERACIONES <---- CCCC 108 | !CCCC -----------------------------------------CCCC 109 | TIME = 0.d0 110 | ISAL = 0 111 | ITER = 0 112 | DTMIN = 0.d0 113 | ITERPRINT = 0 114 | FLUX1 = DABS(FGX + FGY + QH) !VARIABLE PARA CALCULAR LOS TERMINOS FUENTES 115 | RMACH = (U_inf**2 + V_inf**2)/DSQRT(GAMA*FR*T_inf) 116 | 117 | !CCCC----> ORDEN DE INTEGRACION DE RUNGE-KUTTA 118 | NRK = 4 119 | 120 | !CCCC----> DEFINO VELOCIDAD DE LA MALLA 121 | W_X = -0.d0 122 | W_Y = 0.d0 123 | !YPOS = 0.d0 124 | !XPOS = 0.d0; 125 | IMOOTH = 0 126 | 127 | write(*, '(A, I3, A)') '****-------> RUNGE-KUTTA DE', NRK, ' ORDEN <-------****' 128 | write(*, *)'' 129 | 130 | !CCCC----> ABRE EL ARCHIVO DONDE SE IMPRIMEN LOS RESULTADOS 131 | if (MOVIE.EQ.1) open(2, FILE=trim(filename)//'.flavia.res', STATUS='UNKNOWN') 132 | 133 | BANDERA = 1 134 | NESTAB = 1 135 | 136 | call setNewmarkCondition 137 | OPEN(17,FILE='DESPLAZAMIENTO',STATUS='UNKNOWN') 138 | do WHILE (ITER.LT.MAXITER.AND.ISAL.EQ.0) 139 | 140 | ITER = ITER + 1 141 | 142 | !CCCC ----> CALCULO DEL dT 143 | !CCCC -------------------- 144 | call DELTAT(DTMIN, DT) 145 | 146 | if (BANDERA.EQ.1) THEN 147 | DTMIN1 = DTMIN 148 | BANDERA = 2 149 | end if 150 | PORC = DABS((DTMIN-DTMIN1)/DTMIN) 151 | if (100.d0*PORC.LE.1.d0) THEN 152 | DTMIN = DTMIN1 153 | else 154 | DTMIN1 = DTMIN 155 | BANDERA = 2 156 | end if 157 | 158 | !CCCC----> FUNCION PARA ESTABLECER LOCAL-TIME-STEP 159 | if (ITLOCAL.NE.0) THEN 160 | DTFACT = 1.d0 - DEXP(-ITER*4.6D0/ITLOCAL) 161 | DTL = DTMIN*DTFACT + DT*(1.d0 - DTFACT) 162 | else 163 | DTL = DTMIN 164 | end if 165 | 166 | TIME = TIME + DTMIN 167 | 168 | !$omp parallel do private(ipoin) 169 | do ipoin = 1, npoin 170 | U1(:, ipoin) = U(:, ipoin) 171 | end do 172 | !$omp end parallel do 173 | 174 | ! if (BANDERA.LE.4) THEN 175 | call RK(DTMIN, NRK, BANDERA, GAMM, dtl) 176 | ! else 177 | ! call ADAMSB(DTMIN, NESTAB, GAMM, dtl) 178 | ! end if 179 | 180 | call fluidStructure(dtmin,time,SMOOTH_FIX,x1,y1) 181 | 182 | !CCCC--------------------------CCCC 183 | !CCCC ----> IMPRESION <---- CCCC 184 | !CCCC--------------------------CCCC 185 | ITERPRINT = ITERPRINT + 1 186 | if (ITERPRINT.EQ.IPRINT.OR.ITER.EQ.MAXITER) THEN 187 | !CCCC-------------------------------------------------CCCC 188 | !CCCC ----> CALCULO DE LOS ERRORES (RESIDUOS) <---- CCCC 189 | !CCCC ----> PARA CONTROLAR LA CONVERGENCIA <---- CCCC 190 | !CCCC-------------------------------------------------CCCC 191 | ER = 0.d0; ERR = 0.d0 192 | !$omp parallel do reduction(+:ER, ERR) 193 | do ipoin = 1, npoin 194 | ER(:) = ER(:) + (U(:, ipoin) - U1(:, ipoin))**2 195 | ERR(:) = ERR(:) + U1(:, ipoin)**2 196 | end do 197 | !$omp end parallel do 198 | 199 | write(7, '(I7, 4E14.6)') ITER, TIME, DSQRT(ER(1)/ERR(1)), DSQRT(ER(2)/ERR(2)), DSQRT(ER(3)/ERR(3)), DSQRT(ER(4)/ERR(4)) 200 | 201 | !CCCC----> Fusible para que corte si error>1.d2 202 | FUSIBLE = MAXVAL(DSQRT(ER/ERR)) 203 | 204 | if(FUSIBLE.GT.1.D2)THEN 205 | print*, ' ERROR CONVERGENCIA' 206 | print*, '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' 207 | print*, ' ***** OVERFLOW *****' 208 | print*, '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' 209 | STOP 210 | end if 211 | 212 | write(*, '(A, 3X)')'CCCC-----------------------------------------CCCC ' 213 | write(*, '(A, 3X)')'CCCC ----> INFORMACION DE LA CORRIDA <---- CCCC ' 214 | write(*, '(A, 3X/)')'CCCC-----------------------------------------CCCC ' 215 | write(*, '(A, I6/)')'PASOS EJECUTADOS:', ITER 216 | write(*, '(A, E12.4)')'TIEMPO ACUMULADO:', TIME 217 | write(*, '(A, E12.4)')'PASO DE TIEMPO:', DTMIN 218 | write(*, '(A, F7.2/)')'NUMERO DE MACH MAXIMO:', MAXVAL(RMACH) 219 | 220 | write(*, '(5X, A)')'****** ERRORES *******' 221 | write(*, '(A, X, E12.4)')'Continuidad', DSQRT(ER(1)/ERR(1)) 222 | write(*, '(A, X, E12.4)')'Momento u ', DSQRT(ER(2)/ERR(2)) 223 | write(*, '(A, X, E12.4)')'Momento v ', DSQRT(ER(3)/ERR(3)) 224 | write(*, '(A, X, E12.4, /)')'Energia ', DSQRT(ER(4)/ERR(4)) 225 | 226 | call PRINTFLAVIA(GAMM, RHO, VEL_X - W_X, VEL_Y - W_Y, P, T, E, RMACH, X1, Y1 & 227 | , npoin, ITER) 228 | 229 | ITERPRINT = 0 230 | 231 | if(FMU.NE.0.d0)THEN 232 | call FORCE_VISC(NELEM, npoin, nsets & 233 | , IELEM_SETS, ISET, inpoel, NSET_NUMB, U_inf, V_inf, RHO_inf, T_inf & 234 | , X, Y, P, T, VEL_X, VEL_Y, DNX, DNY, FMU, RHO & 235 | , F_VX, F_VY) 236 | end if 237 | WRITE(17,'(7E13.5)')TIME,F_VX(1),F_VY(1),RM(1),F_VX(2),F_VY(2),RM(2) 238 | open(33, FILE='FORCES', STATUS='UNKNOWN') 239 | 240 | do ISET_NUMB=1, NSET_NUMB 241 | write(33, '(A, I2)') 'SET NUMERO', ISET_NUMB 242 | write(33, '(A, E14.5)') 'FUERZA EN X:', FX(ISET_NUMB) 243 | write(33, '(A, E14.5/)') 'FUERZA EN Y:', FY(ISET_NUMB) 244 | !write(33, '(A, E14.5/)') 'MOMENTO:', RM(ISET_NUMB) 245 | write(33, '(A, E14.5)') 'FUERZA VISCOSA EN X:', F_VX(ISET_NUMB) 246 | write(33, '(A, E14.5/)') 'FUERZA VISCOSA EN Y:', F_VY(ISET_NUMB) 247 | write(33, '(A, E14.5)') 'FUERZA TOTAL EN X:', FX(ISET_NUMB)+F_VX(ISET_NUMB) 248 | write(33, '(A, E14.5/)') 'FUERZA TOTAL EN Y:', FY(ISET_NUMB)+F_VY(ISET_NUMB) 249 | end do 250 | close(33) 251 | 252 | call PRINTREST(ITER, npoin, U, T, GAMM, TIME, filename) 253 | 254 | end if 255 | 256 | BANDERA = BANDERA + 1 257 | 258 | !CCCC ----> CALCULOS DE LOS TERMINOS PARA CADA ITERACION 259 | if(MOVING.EQ.1)THEN 260 | !CCCC-----> CALCULO DE LAS NORMALES 261 | !CCCC--------------------------------------------------------- 262 | timer(NORMALES, normales_t) 263 | 264 | !CCCC----> CALCULO DE LAS DERIVADAS, EL AREA Y LA LONGITUD CARAC. 265 | !CCCC------------------------------------------------------------ 266 | timer(DERIV(HMIN), deriv_t) 267 | 268 | !CCCC----> CALCULO DE LAS MATRICES DE MASAS LUMPED 269 | !CCCC ---------------------------------------------------------- 270 | timer(MASAS(.false., dtmin), masas_t) 271 | 272 | !CCCC----> CALCULO DE LOS NODOS VECINOS Y EL LAPLACIANO 273 | !CCCC ------------------------------------------------------ 274 | timer(laplace(inpoel, area, dNx, dNy, nelem, npoin), laplace_t) 275 | end if 276 | 277 | !$omp parallel do private(ipoin) 278 | do ipoin = 1, npoin 279 | U(:, ipoin) = U1(:, ipoin) 280 | end do 281 | !$omp end parallel do 282 | end do 283 | 284 | !CCCC -----> CIERRA EL ARCHIVO DE RESULTADOS.. 285 | if (MOVIE.EQ.1)THEN 286 | close(2) 287 | end if 288 | !CCCC-----------------------------------CCCC 289 | !CCCC -----> FIN DEL LOOP <----- CCCC 290 | !CCCC-----------------------------------CCCC 291 | 292 | !CCCC----> CIERRA EL ARCHIVO DE LA CONVERGENCIA 293 | !CCCC------------------------------------------ 294 | write(*, *)'****---------------------****' 295 | write(*, *)'****----> REFINANDO <----****' 296 | write(*, *)'****---------------------****' 297 | 298 | print *, "normales_t: ", normales_t 299 | print *, "deriv_t: ", deriv_t 300 | print *, "masas_t: ", masas_t 301 | print *, "laplace_t: ", laplace_t 302 | print *, "estab_t: ", estab_t 303 | print *, "cuarto_t: ", cuarto_t 304 | print *, "calcrhs_t : ", calcrhs_t 305 | print *, "fuente_t: ", fuente_t 306 | print *, "forces_t: ", forces_t 307 | print *, "transf_t: ", transf_t 308 | print *, "newmark_t: ", newmark_t 309 | print *, "grad_t: ", grad_t 310 | 311 | !!$ !call NEW_SIZE(npoin, NELEM, inpoel, DNX, DNY, AREA, M, HH, U & 312 | !!$ ! , HH_NEW) 313 | !do I=1, npoin 314 | ! RMACH(I)=DSQRT(VEL_X(I)**2+VEL_Y(I)**2)/DSQRT(GAMA*FR*T(I)) 315 | !end do 316 | !hh_new=hhmax_refin 317 | 318 | 319 | !call ESTIMADOR_ERR(npoin, NELEM, inpoel, DNX, DNY, HH, M, AREA, 3.5D0, RMACH, P) 320 | !do I=1, npoin 321 | ! if(HH_NEW(I).GT.P(I))HH_NEW(I)=P(I) 322 | !end do 323 | 324 | !call ESTIMADOR_ERR(npoin, NELEM, inpoel, DNX, DNY, HH, M, AREA, 4.d0, RHO, P) 325 | !do I=1, npoin 326 | ! if(HH_NEW(I).GT.P(I))HH_NEW(I)=P(I) 327 | !end do 328 | 329 | !HHMIN_REFIN=0.01D0 330 | !call ESTIMADOR_ERR(npoin, NELEM, inpoel, DNX, DNY, HH, M, AREA, 6.d0, RMACH, P) 331 | !do I=1, npoin 332 | ! if(HH_NEW(I).GT.P(I))HH_NEW(I)=P(I) 333 | !end do 334 | 335 | ! ACOMODO LOS TAMANOS SOBRE EL/LOS CUERPOS 336 | !do ISET_NUMB=1, NSET_NUMB 337 | ! do II=1, IELEM_SETS(ISET_NUMB) 338 | 339 | ! N1=ISET(1, ISET_NUMB, II) 340 | ! N2=ISET(2, ISET_NUMB, II) 341 | ! IELEM=ISET(3, ISET_NUMB, II) 342 | ! HH_NEW(N1)=.01D0 !hhmin_refin!DSQRT(2.d0*AREA(IELEM)) 343 | ! HH_NEW(N2)=.01D0 !hhmin_refin!DSQRT(2.d0*AREA(IELEM)) 344 | ! end do 345 | !end do 346 | 347 | !do I=1, NELEM 348 | ! AR=AREA(I) 349 | ! CC=DSQRT(1.5*2.d0*AR) 350 | ! do J=1, 3 351 | ! N1=inpoel(J, I) 352 | ! if(HH_NEW(N1).GT.CC) HH_NEW(N1)=HHMIN_REFIN 353 | ! end do 354 | !end do 355 | 356 | 357 | !open(12, FILE='remeshing.msh', STATUS='UNKNOWN') 358 | 359 | !write(12, '(A)') 'BackgroundMesh V 1.0' 360 | !write(12, '(A)') 'MESH dimension 2 ElemType Triangle Nnode 3' 361 | !write(12, '(A)') 'Coordinates' 362 | !do INOD=1, npoin 363 | ! write(12, '(I7, 3E14.6)') INOD, X(INOD), Y(INOD) 364 | !end do 365 | !write(12, '(A)') 'end Coordinates' 366 | 367 | !write(12, '(A)') 'Elements' 368 | !do IELEM=1, NELEM 369 | ! write(12, '(5I7)') IELEM, inpoel(1, IELEM), inpoel(2, IELEM), inpoel(3, IELEM) 370 | !end do 371 | !write(12, '(A)') 'end Elements' 372 | 373 | !write(12, '(A)') 'DesiredSize Nodes' 374 | 375 | !do I=1, npoin 376 | ! write(12, '(I7, E14.6)') I, HH_NEW(I) 377 | !end do 378 | !write(12, '(A)') 'end DesiredSize Nodes' 379 | 380 | !close(12) 381 | 382 | !CCCC ----> TIEMPO DE CPU 383 | call system_clock(m_end) 384 | print *, "TIEMPO TOTAL: ", real(m_end - m_start)/real(m_rate) 385 | close(7) 386 | write(*, *) 387 | write(*, *)'****-------> FIN DEL CALCULO <-------****' 388 | write(*, *) 389 | end PROGRAM NSComp2D 390 | 391 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 392 | !CCCC----> RESTART <----CCCC 393 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 394 | subroutine RESTART(GAMM) 395 | !use DATOS_ENTRADA 396 | use InputData 397 | use MeshData 398 | use MVARIABGEN 399 | use MVELOCIDADES 400 | use MVARIABLES 401 | implicit real(8) (A-H, O-Z) 402 | real(8) GAMM(npoin) 403 | 404 | if (IRESTART.NE.1) THEN 405 | !CCCC----> SI IOLDSOL .NE. 1 INICIALIZA LAS VARIABLES 406 | !CCCC----> CON LOS VALORES DEL INFINITO 407 | !CCCC------------------------------------------------ 408 | RHOAMB=RHO_INF ; TAMB=T_INF ;UAMB=U_inf ; VAMB=V_inf ; PAMB=RHO_INF*FR*T_INF 409 | do INOD=1, npoin 410 | 411 | !CCCC---> VARIABLES CONSERVATIVAS 412 | U(1, INOD)=RHOAMB 413 | U(2, INOD)=RHOAMB*UAMB 414 | U(3, INOD)=RHOAMB*VAMB 415 | ENERGIA=PAMB/((GAMM(INOD)-1.d0)*RHOAMB)+.5d0*(UAMB**2.d0+VAMB**2.d0) 416 | U(4, INOD)=ENERGIA*RHOAMB 417 | VEL_X(INOD)=UAMB 418 | VEL_Y(INOD)=VAMB 419 | T(INOD)=TAMB 420 | end do 421 | else 422 | 423 | !CCCC----> SI IOLDSOL .EQ. 1 HACE UN RESTART 424 | !CCCC--------------------------------------- 425 | open(1, FILE=trim(filename)//'.RST', FORM='UNFORMATTED', STATUS='UNKNOWN') 426 | read(1) ITER_OLD, TIME 427 | do INOD=1, npoin 428 | read(1) (U(J, INOD), J=1, 4), T(INOD), GAMM(INOD) 429 | end do 430 | 431 | close(1) 432 | 433 | end if 434 | return 435 | end subroutine RESTART 436 | 437 | subroutine PERIODIC 438 | !use MGEOMETRIA 439 | use MeshData 440 | implicit real(8) (A-H, O-Z) 441 | 442 | do I=1, NMASTER 443 | N1=IPER_MASTER(I) 444 | do J=1, NMASTER 445 | N2=IPER_SLAVE(J) 446 | XX=DABS(X(N1)-X(N2)) 447 | if(XX.LT.1.D-6)THEN 448 | IPER_AUX(I)=N2 449 | end if 450 | end do 451 | end do 452 | return 453 | end subroutine PERIODIC 454 | 455 | !CCCC ----> RUTINA DE INTERPOLACION PARA GAS EN EQUILIBRIO TERMOQUIMICO 456 | subroutine TGAS(E, RHO, P, A, T, GAMM) 457 | implicit real(8) (A-H, O-Z) 458 | 459 | Y2=DLOG10(RHO/1.292D0) 460 | Z2=DLOG10(E/78408.4D0) 461 | if(Y2.GT.-.50D0) GO TO 11 462 | if(Y2.GT.-4.50D0)GO TO 6 463 | if(Z2.GT..65D0) GO TO 1 464 | GAMM=1.4D0 465 | SNDSQ=E*.560D0 466 | GO TO 18 467 | 1 if(Z2.GT.1.50D0) GO TO 2 468 | GAMM=1.46543D0+(.007625D0+.000292D0*Y2)*Y2-(.254500D0+.017244D0*Y2)*Z2 & 469 | +(.355907D0+.015422D0*Y2-.163235D0*Z2)*Z2*Z2 470 | GAME=2.304D0*(-.25450D0-.017244D0*Y2+(.711814D0+.030844D0*Y2-.489705D0*Z2)*Z2) 471 | GAMR=2.304D0*(.007625D0+(-.017244D0+.015422D0*Z2)*Z2+.000584D0*Y2) 472 | A1=-.000954D0 473 | A2=.171187D0 474 | A3=.004567D0 475 | GO TO 17 476 | 2 if(Z2.GT.2.20D0) GO TO 3 477 | GAS1=2.02636D0+.0584931D0*Y2 478 | GAS2=.454886D0+.027433D0*Y2 479 | GAS3=.165265D0+.014275D0*Y2 480 | GAS4=.136685D0+.010071D0*Y2 481 | GAS5=.058493D0-.027433D0*Z2 482 | GAS6=-.014275D0+.010071D0*Z2 483 | GAS7=DEXP((-10.d0+3.d0*Y2)*(Z2-.023D0*Y2-2.025D0)) 484 | DERE=-30.0D0 485 | DERR=0.285D0 486 | A1=.008737D0 487 | A2=.184842D0 488 | A3=-.302441D0 489 | GO TO 15 490 | 3 if(Z2.GT.3.05D0) GO TO 4 491 | GAS1=1.60804D0+.034791D0*Y2 492 | GAS2=.188906D0+.010927D0*Y2 493 | GAS3=.124117D0+.007277D0*Y2 494 | GAS4=.069839D0+.003985D0*Y2 495 | GAS5=.034791D0-.010927D0*Z2 496 | GAS6=-.07277D0+.03985D0*Z2 497 | GAS7=DEXP(-30.0D0*(Z2+.007D0*Y2-2.691D0)) 498 | DERE=-30.0D0 499 | DERR=0.21D0 500 | A1=.017884D0 501 | A2=.153672D0 502 | A3=-.930224D0 503 | GO TO 15 504 | 4 if(Z2.GT.3.38D0) GO TO 5 505 | GAS1=1.25672D0+.007073D0*Y2 506 | GAS2=.039228D0-.000491D0*Y2 507 | GAS3=-.721798D0-.073753D0*Y2 508 | GAS4=-.198942D0-.021539D0*Y2 509 | GAS5=.007073D0+.000491D0*Z2 510 | GAS6=.073753D0-.021539D0*Z2 511 | GAS7=DEXP(0.425D0*Y2-50.0D0*Z2+166.7D0) 512 | DERE=-50.d0 513 | DERR=0.325D0 514 | A1=.002379D0 515 | A2=.217959D0 516 | A3=.005943D0 517 | GO TO 15 518 | 5 GAMM=-84.0327D0+(-.331761D0+.001153D0*Y2)*Y2+(72.2066D0+.491914D0*Y2)*Z2 & 519 | +(-20.3559D0-.070617D0*Y2+1.90979D0*Z2)*Z2*Z2 520 | GAME=2.304D0*( 72.2066D0+.491914D0*Y2+(-40.7118D0-.141234D0*Y2+5.72937D0*Z2)*Z2) 521 | GAMR=2.304D0*(-.831761D0+.002306D0*Y2+(.491914D0-.070617D0*Z2)*Z2) 522 | A1=.006572D0 523 | A2=.183396D0 524 | A3=-.135960D0 525 | GO TO 17 526 | 6 if(Z2.GT..65D0) GO TO 7 527 | GAMM=1.4D0 528 | SNDSQ=E*.560D0 529 | GO TO 18 530 | 7 if(Z2.GT.1.54D0) GO TO 8 531 | GAS1=1.44813D0+.001292D0*Y2 532 | GAS2=.073510D0+.001948D0*Y2 533 | GAS3=-.054745D0+.013705D0*Y2 534 | GAS4=-.055473D0+.021874D0*Y2 535 | GAS5=.001292D0-.001948D0*Z2 536 | GAS6=-.013705D0+.021874D0*Z2 537 | GAS7=DEXP(-10.0D0*(Z2-1.42D0)) 538 | DERE=-1.d0 539 | DERR=0.d0 540 | A1=-.001973D0 541 | A2=.185233D0 542 | A3=-.059952D0 543 | GO TO 15 544 | 8 if(Z2.GT.2.22D0) GO TO 9 545 | GAS1=1.73158D0+.003902D0*Y2 546 | GAS2=.272846D0-.006237D0*Y2 547 | GAS3=-.041419D0-.037475D0*Y2 548 | GAS4=.016984D0-.018038D0*Y2 549 | GAS5=.003902D0+.006237D0*Z2 550 | GAS6=.037475D0-.018038D0*Z2 551 | GAS7=DEXP((-10.0D0+3.0D0*Y2)*(Z2-.023D0*Y2-2.025D0)) 552 | DERE=3.d0*Y2-10.d0 553 | DERR=3.d0*Z2+12.15D0*Y2-20.325D0 554 | A1=-.013027D0 555 | A2=.07427D0 556 | A3=.012889D0 557 | GO TO 15 558 | 9 if(Z2.GT.2.90D0) GO TO 10 559 | GAS1=1.59350D0+.075324D0*Y2 560 | GAS2=.176186D0+.026072D0*Y2 561 | GAS3=.200838D0+.058536D0*Y2 562 | GAS6=.099687D0+.025287D0*Y2 !VIENE POR ACA 563 | GAS5=.075324D0-.026072D0*Z2 564 | GAS6=-.058536D0+.025287D0*Z2 565 | GAS7=DEXP((-10.d0+5.d0*Y2)*(Z2-2.7D0)) 566 | DERE=5.d0*Y2-10.d0 567 | DERR=5.d0*Z2-13.5D0 568 | A1=.004342D0 569 | A2=.212192D0 570 | A3=-.001293D0 571 | GO TO 15 572 | 10 GAS1=1.12688D0-.025957D0*Y2 573 | GAS2=-.013602D0-.013772D0*Y2 574 | GAS3=.127737D0+.087942D0*Y2 575 | GAS4=.043104D0+.023547D0*Y2 576 | GAS5=-.025957D0+.013772D0*Z2 577 | GAS6=-.087942D0+.023547D0*Z2 578 | !C GAS7=EXP(-20.0D0*Z2+(4.0D0*Z2-13.2D0)*Y2+66.d0) 579 | GAS7=DEXP((-20.d0+4.d0*Y2)*(Z2-3.3D0)) 580 | DERE=-20.d0+4.d0*Y2 581 | DERR=4.d0*Z2-13.2D0 582 | A1=.006348D0 583 | A2=.209716D0 584 | A3=-.006001D0 585 | GO TO 15 586 | 11 if(Z2.GT..65D0) GO TO 12 587 | GAMM=1.4D0 588 | SNDSQ=E*.560D0 589 | GO TO 18 590 | 12 if(Z2.GT.1.68D0) GO TO 13 591 | GAS1=1.45510D0-.000102D0*Y2 592 | GAS2=.081537D0-.000166D0*Y2 593 | GAS3=-.128647D0+.049454D0*Y2 594 | GAS4=-.101036D0+.033518D0*Y2 595 | GAS5=-.000102D0+.000166D0*Z2 596 | GAS6=-.049454D0+.033518D0*Z2 597 | GAS7=DEXP(-15.d0*(Z2-1.420D0)) 598 | DERE=-15.d0 599 | DERR=0.d0 600 | A1=.00045D0 601 | A2=.203892D0 602 | A3=.101797D0 603 | GO TO 15 604 | 13 if(Z2.GT.2.46D0) GO TO 14 605 | GAS1=1.59608D0-.042426D0*Y2 606 | GAS2=.192840D0-.029353D0*Y2 607 | GAS3=.019430D0-.005954D0*Y2 608 | GAS4=.026097D0-.006164D0*Y2 609 | GAS5=-.042426D0+.029353D0*Z2 610 | GAS6=.005954D0-.006164D0*Z2 611 | GAS7=DEXP(-15.d0*(Z2-2.050D0)) 612 | DERE=-15.d0 613 | DERR=0.d0 614 | A1=-.006609D0 615 | A2=.127637D0 616 | A3=.297037D0 617 | GO TO 15 618 | 14 GAS1=1.54363D0-.049071D0*Y2 619 | GAS2=.153562D0-.029209D0*Y2 620 | GAS3=.324907D0+.077599D0*Y2 621 | GAS4=.142408D0+.022071D0*Y2 622 | GAS5=-.049071D0+.029209D0*Z2 623 | GAS6=-.077599D0+.022071D0*Z2 624 | GAS7=DEXP(-10.0D0*(Z2-2.708D0)) 625 | DERE=-10.d0 626 | DERR=0.d0 627 | A1=-.000081D0 628 | A2=.226601D0 629 | A3=.170922D0 630 | 15 GAS10=1.d0/(1.+GAS7) 631 | 16 GAS8=GAS3-GAS4*Z2 632 | GAS8=GAS3-GAS4*Z2 633 | GAS9=GAS8*GAS7*GAS10*GAS10 634 | GAMM=GAS1-GAS2*Z2-GAS8*GAS10 635 | GAME=2.304D0*(-GAS2+GAS4*GAS10+GAS9*DERE) 636 | GAMR=2.304D0*(GAS5+GAS6*GAS10+GAS9*DERR) 637 | 17 SNDSQ=E*(A1+(GAMM-1.d0)*(GAMM+A2*GAME)+A3*GAMR) 638 | 18 A=DSQRT(SNDSQ) 639 | P=RHO*E*(GAMM-1.d0) 640 | X2=DLOG10(P/1.0134D5) 641 | Y2=Y2+.0231264D0 642 | Z3=X2-Y2 643 | if(Y2.GT.-.50D0) GO TO 29 644 | if(Y2.GT.-4.50D0)GO TO 24 645 | if(Z3.GT..30D0) GO TO 19 646 | T=P/(287.d0*RHO) 647 | return 648 | 19 if(Z3.GT.1.0D0) GO TO 20 649 | T=10.d0**(.2718D0+.00074D0*Y2+(.990136D0-.004947D0*Y2)*Z3+(.990717D0 & 650 | +.175194D0*Y2-(.982407D0+.159233D0*Y2)*Z3)/(1.d0+DEXP(-20.d0*(Z3-.88D0)))) 651 | GO TO 32 652 | 20 if(Z3.GT.1.35D0) GO TO 21 653 | T=10.d0**(1.39925D0+.167780D0*Y2+(-.143168D0-.159234D0*Y2)*Z3+(-.027614D0 & 654 | -.090761D0*Y2+(.307036D0+.121621D0*Y2)*Z3)/(1.d0+DEXP(-20.d0*(Z3-1.17D0)))) 655 | GO TO 32 656 | 21 if(Z3.GT.1.79D0) GO TO 22 657 | T=10.d0**(1.11401D0+.002221D0*Y2+(.351875D0+.017246D0*Y2)*Z3+(-1.15099D0 & 658 | -.173555D0*Y2+(.673342D0-.088399D0*Y2)*Z3)/(1.d0+DEXP(-20.d0*(Z3-1.56D0)))) 659 | GO TO 32 660 | 661 | 22 if(Z3.GT.2.47D0) GO TO 23 662 | T=10.d0**(1.01722D0-.017918D0*Y2+(.473523D0+.025456D0*Y2)*Z3+(-2.17978D0 & 663 | -.334716D0*Y2+(.898619D0+.127386D0*Y2)*Z3)/(1.d0+DEXP(-20.d0*(Z3-2.22D0)))) 664 | GO TO 32 665 | 23 T=10.d0**(-45.0871D0-9.00504D0*Y2+(35.8685D0+6.79222D0*Y2)*Z3-(6.77699D0 & 666 | +1.2737D0*Y2)*Z3*Z3+(-.064705D0+.025325D0*Z3)*Y2*Y2) 667 | GO TO 32 668 | 24 if(Z3.GT..48D0) GO TO 25 669 | T=P/(287.d0*RHO) 670 | return 671 | 25 if(Z3.GT..9165D0) GO TO 26 672 | T=10.d0**(.284312D0+.987912D0*Z3+.001644D0*Y2) 673 | GO TO 32 674 | 26 if(Z3.GT.1.478D0) GO TO 27 675 | T=10.d0**(.502071D0-.01299D0*Y2+(.774818D0+.025397D0*Y2)*Z3+(.009912D0 & 676 | -.150527D0*Y2+(-.000385D0+.105734D0*Y2)*Z3)/(1.d0+DEXP(-15.d0*(Z3-1.28D0)))) 677 | GO TO 32 678 | 27 if(Z3.GT.2.176D0) GO TO 28 679 | T=10.d0**(1.02294D0+.021535D0*Y2+(.427212D0+.0069D0*Y2)*Z3+(-.427823D0 & 680 | -.211991D0*Y2+(.257096D0+.101192D0*Y2)*Z3)/(1.d0+DEXP(-12.d0*(Z3-1.778D0)))) 681 | GO TO 32 682 | 28 T=10.d0**(1.47540D0+.12962D0*Y2+(.254154D0-.046411D0*Y2)*Z3+(-.221229D0 & 683 | -.057077D0*Y2+(.158116D0+.03043D0*Y2)*Z3)/(1.d0+DEXP(5.d0*Y2*(Z3-2.40D0)))) 684 | GO TO 32 685 | 29 if(Z3.GT..48D0) GO TO 30 686 | T=P/(287.d0*RHO) 687 | return 688 | 30 if(Z3.GT.1.07D0) GO TO 31 689 | T=10.d0**(.279268D0+.992172D0*Z3) 690 | GO TO 32 691 | 31 T=10.d0**(.233261D0-.056383D0*Y2+(1.19783D0+.063121D0*Y2-.165985D0*Z3)*Z3+ & 692 | (-.814535D0+.099233D0*Y2+(.602385D0-.067428D0*Y2-.093991D0*Z3)*Z3)/(1.d0+DEXP(( & 693 | 5.d0*Y2-20.d0)*(Z3-1.78D0)))) 694 | 32 T=T*151.777778D0 695 | return 696 | end 697 | 698 | !CCCC----------------------------------------------------!CCCC 699 | !CCCC ----> Imprime resultados en formato FLAVIA <---- !CCCC 700 | !CCCC----------------------------------------------------!CCCC 701 | subroutine PRINTFLAVIA(GAMM, RHO, VEL_X, VEL_Y, P, T, E, RMACH, XPOS, YPOS & 702 | , npoin, ITER) 703 | 704 | !use MPRINTRES 705 | use InputData 706 | implicit real(8) (A-H, O-Z) 707 | 708 | INTEGER npoin 709 | 710 | real(8) RHO(npoin), VEL_X(npoin), VEL_Y(npoin) 711 | real(8) P(npoin), T(npoin), E(npoin), GAMM(npoin), RMACH(npoin) 712 | real(8) XPOS(npoin), YPOS(npoin), U(4, npoin) 713 | 714 | !CCCC----> IMPRESION DE RESULTADOS 715 | !CCCC----------------------------- 716 | if (MOVIE.EQ.0)THEN 717 | open(2, FILE=trim(filename)//'.flavia.res', STATUS='UNKNOWN') 718 | end if 719 | 720 | !CCCC----> ESCRITURA DE VELOCIDADES 721 | !CCCC------------------------------ 722 | if(VEL2CHAR.EQ.'.si.')THEN 723 | write(2, '(A15, 5(I8, 2X))') 'VELOCITY', 2, ITER, 2, 1, 1 724 | write(2, '(A)') 'VEL_X' 725 | write(2, '(A)') 'VEL_Y' 726 | 727 | do INOD=1, npoin 728 | write(2, '(I8, 3E13.4)') INOD, VEL_X(INOD), VEL_Y(INOD) 729 | end do 730 | end if 731 | 732 | !CCCC----> ESCRITURA DE POSICIONES 733 | !CCCC------------------------------ 734 | if(POSCHAR.EQ.'.si.')THEN 735 | write(2, '(A15, 5(I8, 2X))') 'POSITION', 2, ITER, 2, 1, 1 736 | write(2, '(A)') 'X' 737 | write(2, '(A)') 'Y' 738 | 739 | do INOD=1, npoin 740 | write(2, '(I8, 3E16.6)') INOD, XPOS(INOD), YPOS(INOD) 741 | end do 742 | end if 743 | 744 | !CCCC----> ESCRITURA DE LAS DENSIDADES 745 | !CCCC--------------------------------- 746 | if(RHOCHAR.EQ.'.si.')THEN 747 | write(2, '(A15, 5(I8, 2X))') 'DENSITY', 2, ITER, 1, 1, 1 748 | write(2, '(A)') 'DENSITY' 749 | 750 | do INOD=1, npoin 751 | write(2, '(I8, 1E13.4)') INOD, RHO(INOD) 752 | end do 753 | end if 754 | 755 | !CCCC----> ESCRITURA DE LAS PRESIONES 756 | !CCCC-------------------------------- 757 | if(PRESCHAR.EQ.'.si.')THEN 758 | write(2, '(A15, 5(I8, 2X))') 'PRESSURE', 2, ITER, 1, 1, 1 759 | write(2, '(A)') 'PRESSURE' 760 | 761 | do INOD=1, npoin 762 | write(2, '(I8, 1E16.3)') INOD, P(INOD) 763 | end do 764 | end if 765 | 766 | !CCCC -----> ESCRITURA DE LAS TEMPERATURAS 767 | !CCCC ------------------------------------ 768 | if(TEMPCHAR.EQ.'.si.')THEN 769 | write(2, '(A15, 5(I8, 2X))') 'TEMPERATURE', 2, ITER, 1, 1, 1 770 | write(2, '(A)') 'TEMPERATURE' 771 | 772 | do INOD=1, npoin 773 | write(2, '(I8, 1E13.3)') INOD, T(INOD) 774 | end do 775 | end if 776 | 777 | !CCCC----> ESCRITURA DEL NUMERO DE MACH 778 | !CCCC----------------------------------- 779 | if(MACHCHAR.EQ.'.si.')THEN 780 | write(2, '(A15, 5(I8, 2X))') 'Mach_Number', 2, ITER, 1, 1, 1 781 | write(2, '(A)') 'Mach_Number' 782 | !write(2, '(A)') 'Mach_Number_Tgas' 783 | 784 | do INOD=1, npoin 785 | VEL=DSQRT(VEL_X(INOD)*VEL_X(INOD)+VEL_Y(INOD)*VEL_Y(INOD)) 786 | VC=DSQRT(GAMM(INOD)*FR*T(INOD)) 787 | write(2, '(I8, 2F11.2)') INOD, VEL/VC!, RMACH(INOD) 788 | 789 | end do 790 | end if 791 | 792 | !CCCC----> ESCRITURA DE LA ENERGIA INTERNA 793 | !CCCC----------------------------------- 794 | if(ENERCHAR.EQ.'.si.')THEN 795 | write(2, '(A15, 5(I8, 2X))') 'Internal_Energy', 2, ITER, 1, 1, 1 796 | write(2, '(A)') 'Internal_Energy' 797 | 798 | do INOD=1, npoin 799 | write(2, '(I8, 1E16.8)') INOD, E(INOD) 800 | end do 801 | end if 802 | 803 | !CCCC----> ESCRITURA DE GAMA 804 | !CCCC----------------------------------- 805 | !write(2, '(A15, 5I6)') 'GAMA', 2, ITER, 1, 1, 1 806 | !write(2, '(A)') 'GAMA' 807 | 808 | !do INOD=1, npoin 809 | ! write(2, '(I6, 1E16.8)') INOD, GAMM(INOD) 810 | !end do 811 | 812 | if (MOVIE.EQ.0)THEN 813 | close(2) 814 | end if 815 | 816 | return 817 | end subroutine PRINTFLAVIA 818 | 819 | subroutine FORCE_VISC(NELEM, npoin, nsets & 820 | , IELEM_SETS, ISET, inpoel, NSET_NUMB, U_inf, V_inf, RHO_inf, T_inf & 821 | , X, Y, P, T, VEL_X, VEL_Y, DNX, DNY, RMU, RHO & 822 | , F_VX, F_VY) 823 | !CCCC-----------------------------------!CCCC 824 | !CCCC CALCULO DE LAS FUERZAS VISCOSAS !CCCC 825 | !CCCC-----------------------------------!CCCC 826 | implicit real(8) (A-H, O-Z) 827 | INTEGER IELEM_SETS(10), ISET(3, 10, nsets), inpoel(3, NELEM) 828 | real(8) X(npoin), Y(npoin), P(npoin), VEL_X(npoin), VEL_Y(npoin), RHO(npoin) 829 | real(8) DNX(3, NELEM), DNY(3, NELEM), T(npoin) 830 | real(8) F_VX(10), F_VY(10) 831 | 832 | F_VX=0.d0 ; F_VY=0.d0 833 | open(1, FILE='SKIN.DAT', STATUS='UNKNOWN') 834 | do ISET_NUMB=1, NSET_NUMB 835 | 836 | do II=1, IELEM_SETS(ISET_NUMB) 837 | 838 | NN1=ISET(1, ISET_NUMB, II) 839 | NN2=ISET(2, ISET_NUMB, II) 840 | IELEM=ISET(3, ISET_NUMB, II) 841 | 842 | TEMP=(T(NN1)+T(NN2))/2.d0 843 | !FMU= 1.716d-5*162.6/(TEMP-110.55)*(TEMP/273.15)**.75D0 !SUTHERLAND 844 | smu=110.d0 845 | fmu=0.017d0*(temp/t_inf)**1.5d0*(t_inf+smu)/(temp+smu) 846 | RLY=-(X(NN2)-X(NN1)) 847 | RLX=Y(NN2)-Y(NN1) 848 | RMOD=DSQRT(RLX*RLX+RLY*RLY) 849 | 850 | DY=RLY 851 | DX=RLX 852 | 853 | RLX=RLX/RMOD 854 | RLY=RLY/RMOD 855 | 856 | DUX=0.d0 ; DUY=0.d0 ; DVX=0.d0 ; DVY=0.d0 857 | PRESS=0.d0 858 | do JJ=1, 3 859 | NN=inpoel(JJ, IELEM) 860 | !CCCC ----> DERIVADA DE VEL_X 861 | DUX=DUX+DNX(JJ, IELEM)*VEL_X(NN) 862 | DUY=DUY+DNY(JJ, IELEM)*VEL_X(NN) 863 | !CCCC ----> DERIVADA DE VEL_Y 864 | DVX=DVX+DNX(JJ, IELEM)*VEL_Y(NN) 865 | DVY=DVY+DNY(JJ, IELEM)*VEL_Y(NN) 866 | PRESS=PRESS+P(NN) 867 | end do 868 | 869 | PRESS=PRESS/3.d0 870 | !CCCC ----> TENSOR 2D 871 | TXX=-PRESS-FMU*(2.d0/3.d0*(DUX+DVY)-2.d0*DUX) 872 | TXY=FMU*(DUY+DVX) 873 | 874 | TYX=TXY 875 | TYY=-PRESS-FMU*(2.d0/3.d0*(DUX+DVY)-2.d0*DVY) 876 | 877 | !CCCC ----> CALCULO PARA SACAR EL SKIN FRICTION 878 | TTX=TXX*RLX+TXY*RLY 879 | TTY=TYX*RLX+TYY*RLY 880 | 881 | TMOD=-TTX*RLY+TTY*RLX 882 | UU=U_inf*U_inf+V_inf*V_inf 883 | SKIN=TMOD/(.5d0*RHO_inf*UU) 884 | 885 | F_VX(ISET_NUMB)=F_VX(ISET_NUMB) +TTX*RMOD 886 | F_VY(ISET_NUMB)=F_VY(ISET_NUMB) +TTY*RMOD 887 | 888 | write(1, *)SKIN, (X(NN2)+X(NN1))/2.d0, (press/82713.27d0) 889 | end do 890 | end do 891 | close(1) 892 | return 893 | end 894 | 895 | !CCCC-----------------------------------------------!CCCC 896 | !CCCC ----> Imprime resultados para RESTART <---- !CCCC 897 | !CCCC-----------------------------------------------!CCCC 898 | subroutine PRINTREST(ITER, npoin, U, T, GAMM, TIME, filename) 899 | 900 | implicit real(8) (A-H, O-Z) 901 | 902 | real(8) U(4, npoin), T(npoin), GAMM(npoin) 903 | 904 | character(80) filename 905 | 906 | open(1, FILE=trim(filename)//'.RST', FORM='UNFORMATTED', STATUS='UNKNOWN') 907 | 908 | write(1) ITER, TIME 909 | 910 | do INOD=1, npoin 911 | write(1) (U(J, INOD), J=1, 4), T(INOD), GAMM(INOD) 912 | end do 913 | 914 | close(1) 915 | 916 | return 917 | end 918 | 919 | !CCCC---------------------------CCCC 920 | !CCCC----> PRESSURE SWITCH <----CCCC 921 | !CCCC---------------------------CCCC 922 | subroutine NEWPRES(npoin, NPOS, NN1, NN2, P, PS) 923 | 924 | implicit real(8) (A-H, O-Z) 925 | INTEGER(4) NN1(NPOS), NN2(NPOS) 926 | real(8)S1(npoin), S2(npoin), PS(npoin), P(npoin) 927 | 928 | S1=0.d0 929 | S2=0.d0 930 | 931 | do IPOS=1, NPOS 932 | N1=NN1(IPOS) 933 | N2=NN2(IPOS) 934 | AUX=P(N1)-P(N2) 935 | S1(N1)=S1(N1)+AUX 936 | S2(N1)=S2(N1)+DABS(AUX) 937 | end do 938 | 939 | do I=1, npoin 940 | PS(I)=DABS(S1(I))/(S2(I)) 941 | if(S2(I).LT.5.D-2)PS(I)=0.d0 942 | if(PS(I).LT..2D0)PS(I)=0.d0 !MODIFICAR SI ES NECESARIO 943 | end do 944 | return 945 | end subroutine NEWPRES 946 | 947 | !CCCC-----> CALCULA EL TAMA\D1O OPTIMO PARA REFINAMIENTO ADAPTATIVO 948 | !CCCC------------------------------------------------------------ 949 | subroutine NEW_SIZE(npoin, NELEM, inpoel, DNX, DNY, AREA, M, HH, U & 950 | , AUX) 951 | !use DATOS_REFINAMIENTO 952 | use InputData 953 | implicit real*8 (A-H, O-Z) 954 | 955 | INTEGER inpoel(3, NELEM) 956 | real(8) DNX(3, NELEM), DNY(3, NELEM), AREA(NELEM), HH(NELEM), U(4, npoin) 957 | real(8) HH_NEW(NELEM) 958 | real(8) SXX(npoin), SXY(npoin), SYY(npoin), AUX(npoin), M(npoin) 959 | 960 | SXX=0.d0; SYY=0.d0; SXY=0.d0; AUX=0.d0 961 | 962 | do IELEM=1, NELEM 963 | N1=inpoel(1, IELEM) ; N2=inpoel(2, IELEM) ; N3=inpoel(3, IELEM) 964 | 965 | RNX1=DNX(1, IELEM) ; RNX2=DNX(2, IELEM) ; RNX3=DNX(3, IELEM) 966 | RNY1=DNY(1, IELEM) ; RNY2=DNY(2, IELEM) ; RNY3=DNY(3, IELEM) 967 | 968 | !CCCC ----> DERIVADA DE RHO.VEL_X 969 | DUX= RNX1*U(2, N1)+RNX2*U(2, N2)+RNX3*U(2, N3) 970 | DUY= RNY1*U(2, N1)+RNY2*U(2, N2)+RNY3*U(2, N3) 971 | !CCCC ----> DERIVADA DE RHO.VEL_Y 972 | DVX= RNX1*U(3, N1)+RNX2*U(3, N2)+RNX3*U(3, N3) 973 | DVY= RNY1*U(3, N1)+RNY2*U(3, N2)+RNY3*U(3, N3) 974 | 975 | SIGMXX=2*DUX; SIGMYY=2*DVY; SIGMXY=DUY+DVX 976 | 977 | do I=1, 3 978 | N1=inpoel(I, IELEM) 979 | SXX(N1)=SXX(N1)+SIGMXX*AREA(IELEM) 980 | SYY(N1)=SYY(N1)+SIGMYY*AREA(IELEM) 981 | SXY(N1)=SXY(N1)+SIGMXY*AREA(IELEM) 982 | AUX(N1)=AUX(N1)+AREA(IELEM) 983 | end do 984 | end do 985 | 986 | do INOD=1, npoin 987 | SXX(INOD)=SXX(INOD)/AUX(INOD) 988 | SYY(INOD)=SYY(INOD)/AUX(INOD) 989 | SXY(INOD)=SXY(INOD)/AUX(INOD) 990 | end do 991 | 992 | 993 | ESIG=0.d0; SIG=0.d0 994 | do IELEM=1, NELEM 995 | N1=inpoel(1, IELEM) ; N2=inpoel(2, IELEM) ; N3=inpoel(3, IELEM) 996 | 997 | RNX1=DNX(1, IELEM) ; RNX2=DNX(2, IELEM) ; RNX3=DNX(3, IELEM) 998 | RNY1=DNY(1, IELEM) ; RNY2=DNY(2, IELEM) ; RNY3=DNY(3, IELEM) 999 | 1000 | !CCCC ----> DERIVADA DE RHO.VEL_X 1001 | DUX= RNX1*U(2, N1)+RNX2*U(2, N2)+RNX3*U(2, N3) 1002 | DUY= RNY1*U(2, N1)+RNY2*U(2, N2)+RNY3*U(2, N3) 1003 | !CCCC ----> DERIVADA DE RHO.VEL_Y 1004 | DVX= RNX1*U(3, N1)+RNX2*U(3, N2)+RNX3*U(3, N3) 1005 | DVY= RNY1*U(3, N1)+RNY2*U(3, N2)+RNY3*U(3, N3) 1006 | 1007 | SIGMXX=2*DUX; SIGMYY=2*DVY; SIGMXY=DUY+DVX 1008 | 1009 | ESIGXX=SIGMXX-(SXX(N1)+SXX(N2)+SXX(N3))/3.d0 1010 | SIGXX=(SXX(N1)+SXX(N2)+SXX(N3))/3.d0 1011 | 1012 | ESIGYY=SIGMYY-(SYY(N1)+SYY(N2)+SYY(N3))/3.d0 1013 | SIGYY=(SYY(N1)+SYY(N2)+SYY(N3))/3.d0 1014 | 1015 | ESIGXY=SIGMXY-(SXY(N1)+SXY(N2)+SXY(N3))/3.d0 1016 | SIGXY=(SXY(N1)+SXY(N2)+SXY(N3))/3.d0 1017 | 1018 | ESIG=ESIG+(ESIGXX*ESIGXX+ESIGYY*ESIGYY+ESIGXY*ESIGXY)*AREA(IELEM) 1019 | SIG=SIG+(SIGXX*SIGXX+SIGYY*SIGYY+SIGXY*SIGXY)*AREA(IELEM) 1020 | end do 1021 | 1022 | ERR_AVERAGE=ETA_REFIN*DSQRT((SIG+ESIG)/DFLOAT(NELEM)) 1023 | 1024 | do IELEM=1, NELEM 1025 | 1026 | N1=inpoel(1, IELEM) ; N2=inpoel(2, IELEM) ; N3=inpoel(3, IELEM) 1027 | 1028 | RNX1=DNX(1, IELEM) ; RNX2=DNX(2, IELEM) ; RNX3=DNX(3, IELEM) 1029 | RNY1=DNY(1, IELEM) ; RNY2=DNY(2, IELEM) ; RNY3=DNY(3, IELEM) 1030 | 1031 | !CCCC ----> DERIVADA DE RHO.VEL_X 1032 | DUX= RNX1*U(2, N1)+RNX2*U(2, N2)+RNX3*U(2, N3) 1033 | DUY= RNY1*U(2, N1)+RNY2*U(2, N2)+RNY3*U(2, N3) 1034 | !CCCC ----> DERIVADA DE RHO.VEL_Y 1035 | DVX= RNX1*U(3, N1)+RNX2*U(3, N2)+RNX3*U(3, N3) 1036 | DVY= RNY1*U(3, N1)+RNY2*U(3, N2)+RNY3*U(3, N3) 1037 | 1038 | SIGMXX=2*DUX; SIGMYY=2*DVY; SIGMXY=DUY+DVX 1039 | 1040 | ESIGXX=SIGMXX-(SXX(N1)+SXX(N2)+SXX(N3))/3.d0 1041 | 1042 | ESIGYY=SIGMYY-(SYY(N1)+SYY(N2)+SYY(N3))/3.d0 1043 | 1044 | ESIGXY=SIGMXY-(SXY(N1)+SXY(N2)+SXY(N3))/3.d0 1045 | 1046 | ESIG=(ESIGXX*ESIGXX+ESIGYY*ESIGYY+ESIGXY*ESIGXY)*AREA(IELEM) 1047 | 1048 | EPS_I=ESIG/ERR_AVERAGE 1049 | HH_NEW(IELEM)=HH(IELEM)/EPS_I 1050 | 1051 | end do 1052 | 1053 | AUX=0.d0 1054 | do I=1, NELEM 1055 | AR=AREA(I) 1056 | do J=1, 3 1057 | N1=inpoel(J, I) 1058 | AUX(N1)=AUX(N1)+HH_NEW(I)*AR 1059 | end do 1060 | end do 1061 | do I=1, npoin 1062 | AUX(I)=AUX(I)/M(I) 1063 | if(AUX(I).GT.HHMAX_REFIN) AUX(I)=HHMAX_REFIN 1064 | if(AUX(I).LT.HHMIN_REFIN) AUX(I)=HHMIN_REFIN 1065 | end do 1066 | 1067 | return 1068 | end subroutine NEW_SIZE 1069 | 1070 | !CCCC-----> ESTIMADOR DE ERROR 1071 | !CCCC------------------------------- 1072 | ! INPUT: VAR= VARIABLE DE ENTRADA A LA CUAL CALCULALOS EL ERROR 1073 | ! OUTPUT: AUX= ERROR ESTIMADO SUAVIZADO A LOS NODOS 1074 | subroutine ESTIMADOR_ERR(npoin, NELEM, inpoel, DNX, DNY, HH, M, AREA, BETA, VAR, AUX) 1075 | !use DATOS_REFINAMIENTO 1076 | use InputData 1077 | implicit real(8) (A-H, O-Z) 1078 | INTEGER inpoel(3, NELEM) 1079 | real(8)DNX(3, NELEM), DNY(3, NELEM), HH(NELEM), VAR(npoin) 1080 | real(8) TITA(NELEM), AUX(npoin), AREA(NELEM), M(npoin) 1081 | TITA=0.d0 ; TITA_PROM=0.d0 1082 | do IELEM=1, NELEM 1083 | N1=inpoel(1, IELEM) ; N2=inpoel(2, IELEM) ; N3=inpoel(3, IELEM) 1084 | 1085 | RNX1=DNX(1, IELEM) ; RNX2=DNX(2, IELEM) ; RNX3=DNX(3, IELEM) 1086 | RNY1=DNY(1, IELEM) ; RNY2=DNY(2, IELEM) ; RNY3=DNY(3, IELEM) 1087 | 1088 | !CCCC ----> DERIVADA DE LA VARIABLE 1089 | DUX= RNX1*VAR(N1)+RNX2*VAR(N2)+RNX3*VAR(N3) 1090 | DUY= RNY1*VAR(N1)+RNY2*VAR(N2)+RNY3*VAR(N3) 1091 | 1092 | TITA(IELEM)=DSQRT((DABS(DUX)+DABS(DUY))*.5D0)*HH(IELEM) 1093 | TITA_PROM=TITA_PROM+TITA(IELEM) 1094 | end do 1095 | TITA_PROM=TITA_PROM/NELEM 1096 | 1097 | TITA_SD=0.d0 1098 | do I=1, NELEM 1099 | TITA_SD=TITA_SD+(TITA(I)-TITA_PROM)**2 1100 | end do 1101 | TITA_SD=DSQRT(TITA_SD/NELEM) 1102 | 1103 | !CCCC----> SUAVIZO EN A LOS NODOS 1104 | AUX=0.d0 1105 | do I=1, NELEM 1106 | AR=AREA(I) 1107 | do J=1, 3 1108 | N1=inpoel(J, I) 1109 | AUX(N1)=AUX(N1)+TITA(I)*AR 1110 | end do 1111 | end do 1112 | do I=1, npoin 1113 | AUX(I)=AUX(I)/M(I) 1114 | end do 1115 | 1116 | !CCCC----> APLICO FILTRO PASA ALTO 1117 | !BETA=3.5D0 ! MODIFICO A OJO 1118 | COMPARADOR=TITA_PROM+BETA*TITA_SD 1119 | do I=1, npoin 1120 | if(AUX(I).GT.COMPARADOR)THEN 1121 | AUX(I)=HHMIN_REFIN 1122 | else 1123 | AUX(I)=HHMAX_REFIN 1124 | end if 1125 | end do 1126 | 1127 | return 1128 | end subroutine ESTIMADOR_ERR 1129 | -------------------------------------------------------------------------------- /subrutinas.f90: -------------------------------------------------------------------------------- 1 | #define timer(func, store) call system_clock(start_t, rate); call func; call system_clock(end_t); store = store + real(end_t - start_t)/real(rate); 2 | module Mnormales 3 | integer, private :: m 4 | integer, dimension(:), allocatable, private :: n_ipoin 5 | real(8), dimension(:), allocatable, private :: n_x, n_y, num_l_x, num_l_y, den_l 6 | contains 7 | subroutine normales 8 | !use mgeometria 9 | use meshdata, only: wall, nwall, x, y, npoin 10 | implicit none 11 | real(8) l_edge_x, l_edge_y, l_edge, l_x, l_y, l_nrm 12 | integer ielem, ipoin 13 | 14 | if(.not.allocated(n_ipoin)) allocate(n_ipoin(npoin)) 15 | if(.not.allocated(n_x)) allocate(n_x(npoin)) 16 | if(.not.allocated(n_y)) allocate(n_y(npoin)) 17 | if(.not.allocated(num_l_x)) allocate(num_l_x(npoin)) 18 | if(.not.allocated(num_l_y)) allocate(num_l_y(npoin)) 19 | if(.not.allocated(den_l)) allocate(den_l(npoin)) 20 | 21 | num_l_x = 0.d0 22 | num_l_y = 0.d0 23 | den_l = 0.d0 24 | m = 0 25 | 26 | !$omp parallel 27 | !$omp do private(l_edge_x, l_edge_y, l_edge, ielem) 28 | do ielem = 1, nwall 29 | l_edge_x = y(wall(2, ielem)) - y(wall(1, ielem)) 30 | l_edge_y = -(x(wall(2, ielem)) - x(wall(1, ielem))) 31 | l_edge = dsqrt(l_edge_x*l_edge_x + l_edge_y*l_edge_y) 32 | 33 | !$omp atomic 34 | num_l_x(wall(1, ielem)) = num_l_x(wall(1, ielem)) + l_edge_x 35 | !$omp atomic 36 | num_l_y(wall(1, ielem)) = num_l_y(wall(1, ielem)) + l_edge_y 37 | !$omp atomic 38 | den_l(wall(1, ielem)) = den_l(wall(1, ielem)) + l_edge 39 | !$omp atomic 40 | num_l_x(wall(2, ielem)) = num_l_x(wall(2, ielem)) + l_edge_x 41 | !$omp atomic 42 | num_l_y(wall(2, ielem)) = num_l_y(wall(2, ielem)) + l_edge_y 43 | !$omp atomic 44 | den_l(wall(2, ielem)) = den_l(wall(2, ielem)) + l_edge 45 | end do 46 | !$omp end do 47 | !$omp end parallel 48 | 49 | !paralelizacion de esta parte requiere omp critical en el nested if, 50 | !en la implementacion demostro que no rinde 51 | do ipoin = 1, npoin 52 | if (den_l(ipoin) > 1.d-6) then 53 | l_x = num_l_x(ipoin)/den_l(ipoin) 54 | l_y = num_l_y(ipoin)/den_l(ipoin) 55 | l_nrm = dsqrt(l_x*l_x + l_y*l_y) 56 | if (l_nrm > 0.2d0) then 57 | m = m + 1 58 | n_ipoin(m) = ipoin 59 | n_x(m) = l_x/l_nrm 60 | n_y(m) = l_y/l_nrm 61 | end if 62 | end if 63 | end do 64 | end subroutine normales 65 | 66 | subroutine normalvel 67 | !use mallocar 68 | !use mnormales 69 | !use meshdata 70 | use mvelocidades 71 | implicit none 72 | integer i, ipoin 73 | real(8) vx, vy, wx, wy, p 74 | 75 | !$omp parallel do private(vx, vy, wx, wy, p, i, ipoin) 76 | do i = 1, m 77 | ipoin = n_ipoin(i) 78 | vx = vel_x(ipoin); vy = vel_y(ipoin) 79 | wx = w_x(ipoin); wy = w_y(ipoin) 80 | p = -n_y(i)*(vx - wx) + n_x(i)*(vy - wy) 81 | vel_x(ipoin) = -n_y(i)*p + wx 82 | vel_y(ipoin) = n_x(i)*p + wy 83 | end do 84 | !$omp end parallel do 85 | end subroutine normalvel 86 | end module Mnormales 87 | 88 | subroutine deriv(hmin) !<----- PARA QUE SE USA HMIN? 89 | !------------------------------------------ 90 | ! Calcula dNx, dNy y area de cada elemento 91 | !------------------------------------------ 92 | !use MGEOMETRIA 93 | use MeshData, only: X, Y, inpoel, area, HH, HHX, HHY, dNx, dNy, nelem 94 | implicit none 95 | integer ielem 96 | real(8) hmin 97 | real(8) X_loc(3), Y_loc(3), a 98 | 99 | !$OMP PARALLEL & 100 | !$OMP PRIVATE(X_loc, Y_loc, ielem, a) 101 | !$OMP DO 102 | do ielem = 1,nelem 103 | X_loc(:) = X(inpoel(:, ielem)) 104 | Y_loc(:) = Y(inpoel(:, ielem)) 105 | 106 | area(ielem) = (X_loc(2)*Y_loc(3) + X_loc(3)*Y_loc(1) + X_loc(1)*Y_loc(2)& 107 | - (X_loc(2)*Y_loc(1) + X_loc(3)*Y_loc(2) + X_loc(1)*Y_loc(3)))/2.d0 108 | a = area(ielem) 109 | 110 | dNx(1, ielem) = (Y_loc(2) - Y_loc(3))/(2.d0*a) 111 | dNx(2, ielem) = (Y_loc(3) - Y_loc(1))/(2.d0*a) 112 | dNx(3, ielem) = (Y_loc(1) - Y_loc(2))/(2.d0*a) 113 | dNy(1, ielem) = (X_loc(3) - X_loc(2))/(2.d0*a) 114 | dNy(2, ielem) = (X_loc(1) - X_loc(3))/(2.d0*a) 115 | dNy(3, ielem) = (X_loc(2) - X_loc(1))/(2.d0*a) 116 | 117 | HH(ielem) = dsqrt(area(ielem)) 118 | HHX(ielem) = abs(min( X_loc(3) - X_loc(2), X_loc(1) - X_loc(3), X_loc(2) - X_loc(1) )) 119 | HHY(ielem) = abs(min( Y_loc(3) - Y_loc(2), Y_loc(1) - Y_loc(3), Y_loc(2) - Y_loc(1) )) 120 | end do 121 | !$OMP END DO 122 | !$OMP END PARALLEL 123 | 124 | hmin = minval(hh) 125 | if(hmin > 1.d10) hmin = 1.d10 126 | end subroutine deriv 127 | 128 | subroutine MASAS() 129 | !---------------------------------------- 130 | ! Ensambla la matriz de masas condensada 131 | !---------------------------------------- 132 | !use MGEOMETRIA 133 | use MeshData, only: M, inpoel, area, nelem, npoin, dNx, dNy 134 | implicit none 135 | integer ipoin, ielem 136 | 137 | !$OMP PARALLEL DO PRIVATE(ipoin) 138 | do ipoin = 1, npoin 139 | M(ipoin) = 0.d0 140 | end do 141 | !$OMP END PARALLEL DO 142 | 143 | !$OMP PARALLEL DO PRIVATE(ielem) 144 | do ielem = 1, nelem 145 | !$OMP ATOMIC 146 | M(inpoel(1, ielem)) = M(inpoel(1, ielem)) + area(ielem)/3.d0 147 | !$OMP ATOMIC 148 | M(inpoel(2, ielem)) = M(inpoel(2, ielem)) + area(ielem)/3.d0 149 | !$OMP ATOMIC 150 | M(inpoel(3, ielem)) = M(inpoel(3, ielem)) + area(ielem)/3.d0 151 | end do 152 | !$OMP END PARALLEL DO 153 | end subroutine MASAS 154 | 155 | subroutine deltat(dtmin, dt) 156 | !------------------------------- 157 | ! Calcula delta t 158 | !------------------------------- 159 | !use MALLOCAR 160 | !use DATOS_ENTRADA 161 | use MeshData, only: inpoel, nelem, area 162 | use InputData, only: FSAFE, fr, gama, t_inf 163 | use MVELOCIDADES 164 | use MVARIABLES 165 | implicit real(8) (A-H,O-Z) 166 | real(8) DT(nelem), dtmin 167 | integer ielem, i, ipoin 168 | real(8) T_iel, vumax, vvmax, vu, vv, vel, dtelem, cota, vc 169 | 170 | DTMIN = 1.D20 171 | 172 | do ielem = 1, nelem 173 | VUMAX = 0.d0 174 | VVMAX = 0.d0 175 | 176 | T_iel = (T(inpoel(1, ielem)) + T(inpoel(2, ielem)) + T(inpoel(3, ielem)))/3.d0 177 | 178 | !GM = GAMA-1.d0 !(GAMM(inpoel(1, ielem))+GAMM(inpoel(2, ielem))+GAMM(inpoel(3, ielem)))/3.d0 179 | VC = DSQRT(GAMA*FR*T_iel) 180 | 181 | !CCCC ----> CALCULO DE LA MAXIMA VELOCIDAD ELEMENTAL 182 | do i = 1, 3 183 | ipoin = inpoel(i, ielem) 184 | VU = dabs(VEL_X(ipoin) - W_X(ipoin)) 185 | VV = dabs(VEL_Y(ipoin) - W_Y(ipoin)) 186 | 187 | if (VU.GT.VUMAX) VUMAX = VU 188 | if (VV.GT.VVMAX) VVMAX = VV 189 | end do 190 | 191 | 192 | 193 | HH=dsqrt(2.d0*AREA(IELEM)) 194 | VEL=(VUMAX**2+VVMAX**2)**.5D0 195 | smu=110.d0 196 | fmu=0.017d0*(t_iel/t_inf)**1.5d0*(t_inf+smu)/(t_iel+smu) 197 | ET=fmu 198 | 199 | Pe=(VEL*HH)/(2.D0*ET) 200 | 201 | ALPHA=MIN(Pe/3.d0,1.D0) 202 | 203 | DELTATU=1.D0/(4.D0*ET/HH**2.D0+ALPHA*VEL/HH) 204 | DELTATC=1.D0/(4.D0*ET/HH**2.D0) 205 | 206 | DTELEM= FSAFE/(1.D0/DELTATC+1.D0/DELTATU) 207 | DT(IELEM)=DTELEM 208 | 209 | IF (DTELEM.LT.DTMIN) DTMIN=DTELEM 210 | END DO 211 | COTA = 10.d0*DTMIN !EL VALOR 10 ESTA PUESTO A OJO #MODIFICAR SI ES NECESARIO# 212 | do ielem = 1, nelem 213 | 214 | if(DT(ielem) > COTA) DT(ielem) = COTA 215 | end do 216 | 217 | return 218 | end subroutine deltat 219 | 220 | subroutine CUARTO_ORDEN(U, U_n, FR, gamm) 221 | !--------------------------------------------- 222 | ! Calculo de la proyeccion U_n 223 | !--------------------------------------------- 224 | !use MALLOCAR 225 | !use MGEOMETRIA 226 | use MeshData 227 | implicit real(8) (A-H,O-Z) 228 | real(8) U(4,npoin), U_n(4,npoin), GAMM(npoin) 229 | 230 | real(8) A1(3,4,3), A2(3,4,3), Adv(4,3), U_loc(4,3), Ux(4), Uy(4), Nx(3), Ny(3), U_n_tmp(4,3) 231 | real(8) sp(3,3) !Funciones de forma 232 | real(8) c(3), vx(3), vy(3), V_sq(3), TEMP(3), e(3) 233 | INTEGER ipoin(3) 234 | 235 | U_n = 0.d0 236 | sp(:,1) = (/ .5d0, .5d0, 0.d0 /) 237 | sp(:,2) = (/ 0.d0, .5d0, .5d0 /) 238 | sp(:,3) = (/ .5d0, 0.d0, .5d0 /) 239 | 240 | !$omp parallel 241 | !$omp do private(ielem, ipoin, gama, temp, fmu, Nx, Ny, Ux, Uy, ar,& 242 | !$omp U_loc, vx, vy, v_sq, e, c, A1, A2, Adv, U_n_tmp, i) 243 | do ielem = 1,nelem 244 | U_n_tmp = 0.d0 245 | ipoin = inpoel(:, ielem) 246 | 247 | gama = (GAMM(ipoin(1))+GAMM(ipoin(2))+GAMM(ipoin(3)))/3.d0 248 | 249 | Nx = dNx(:, ielem) 250 | Ny = dNy(:, ielem) 251 | 252 | Ux(:) = U(:,ipoin(1))*Nx(1) + U(:,ipoin(2))*Nx(2) + U(:,ipoin(3))*Nx(3) 253 | Uy(:) = U(:,ipoin(1))*Ny(1) + U(:,ipoin(2))*Ny(2) + U(:,ipoin(3))*Ny(3) 254 | 255 | AR = area(ielem)/3.d0 256 | 257 | !CCCC ----> INTEGRO LAS VARIABLES EN LOS PUNTOS DE GAUSS 258 | U_loc(:,1) = sp(1,1)*U(:,ipoin(1)) + sp(2,1)*U(:,ipoin(2)) + sp(3,1)*U(:,ipoin(3)) 259 | U_loc(:,2) = sp(1,2)*U(:,ipoin(1)) + sp(2,2)*U(:,ipoin(2)) + sp(3,2)*U(:,ipoin(3)) 260 | U_loc(:,3) = sp(1,3)*U(:,ipoin(1)) + sp(2,3)*U(:,ipoin(2)) + sp(3,3)*U(:,ipoin(3)) 261 | 262 | !CCCC ----> DEFINO VARIABLES PRIMITIVAS 263 | vx(:) = U_loc(2,:)/U_loc(1,:) 264 | vy(:) = U_loc(3,:)/U_loc(1,:) 265 | e(:) = U_loc(4,:)/U_loc(1,:) 266 | V_sq(:) = vx*vx+vy*vy 267 | temp(:) = (gama-1.d0)/FR*(e-.5d0*V_sq) !FR = CTE. UNIVERSAL DE LOS GASES 268 | c(:) = dsqrt(gama*fr*temp(:)) 269 | 270 | ! = = = GAUSS QUAD = == 271 | do i = 1,3 272 | !A1(0,:,i) = (/ 0.d0, 1.d0, 0.d0, 0.d0 /) 273 | A1(1,:,i) = (/ (gama-1.d0)/2.d0*V_sq(i)-vx(i)*vx(i),& 274 | (3.d0-gama)*vx(i),& 275 | -(gama-1.d0)*vy(i),& 276 | (gama-1.d0) /) 277 | A1(2,:,i) = (/ -vx(i)*vy(i),& 278 | vy(i),& 279 | vx(i),& 280 | 0.d0 /) 281 | A1(3,:,i) = (/ ((gama-1.d0)*V_sq(i)-gama*e(i))*vx(i),& 282 | gama*e(i)-(gama-1.d0)/2.d0*V_sq(i)-(gama-1.d0)*vx(i)*vx(i),& 283 | -(gama-1.d0)*vx(i)*vy(i),& 284 | gama*vx(i) /) 285 | !A2(0,:,i) = (/ 0.d0, 0.d0, 1.d0, 0.d0 /) 286 | A2(1,:,i) = (/ -vx(i)*vy(i),& 287 | vy(i),& 288 | vx(i),& 289 | 0.d0 /) 290 | A2(2,:,i) = (/ (gama-1.d0)/2.d0*V_sq(i)-vy(i)*vy(i),& 291 | -(gama-1.d0)*vx(i),& 292 | (3.d0-gama)*vy(i),& 293 | (gama-1.d0) /) 294 | A2(3,:,i) = (/ ((gama-1.d0)*V_sq(i)-gama*e(i))*vy(i),& 295 | -(gama-1.d0)*vx(i)*vy(i),& 296 | gama*e(i)-(gama-1.d0)/2.d0*V_sq(i)-(gama-1.d0)*vy(i)*vy(i),& 297 | gama*vy(i) /) 298 | 299 | Adv(1,i) = Ux(2) + Uy(3) 300 | Adv(2:4,i) = A1(:,1,i)*Ux(1) + A1(:,2,i)*Ux(2) + A1(:,3,i)*Ux(3) + A1(:,4,i)*Ux(4)& 301 | +A2(:,1,i)*Uy(1) + A2(:,2,i)*Uy(2) + A2(:,3,i)*Uy(3) + A2(:,4,i)*Uy(4) 302 | end do 303 | ! = = = end GAUSS QUAD = == 304 | 305 | U_n_tmp(:,1) = Adv(:,1)*sp(1,1)*AR + Adv(:,2)*sp(1,2)*AR + Adv(:,3)*sp(1,3)*AR 306 | U_n_tmp(:,2) = Adv(:,1)*sp(2,1)*AR + Adv(:,2)*sp(2,2)*AR + Adv(:,3)*sp(2,3)*AR 307 | U_n_tmp(:,3) = Adv(:,1)*sp(3,1)*AR + Adv(:,2)*sp(3,2)*AR + Adv(:,3)*sp(3,3)*AR 308 | 309 | do i = 1,3 310 | !$omp atomic 311 | U_n(1,ipoin(i)) = U_n(1,ipoin(i)) + U_n_tmp(1,i) 312 | !$omp atomic 313 | U_n(2,ipoin(i)) = U_n(2,ipoin(i)) + U_n_tmp(2,i) 314 | !$omp atomic 315 | U_n(3,ipoin(i)) = U_n(3,ipoin(i)) + U_n_tmp(3,i) 316 | !$omp atomic 317 | U_n(4,ipoin(i)) = U_n(4,ipoin(i)) + U_n_tmp(4,i) 318 | end do 319 | 320 | end do 321 | !$omp end do 322 | 323 | !$omp do private(i) 324 | do i= 1, npoin 325 | U_n(:, i) = -U_n(:, i)/M(i) 326 | end do 327 | !$omp end do 328 | !$omp end parallel 329 | end subroutine CUARTO_ORDEN 330 | 331 | 332 | SUBROUTINE ESTAB(U,T,GAMA,FR,RMU & 333 | ,DTMIN,RHOINF,TINF,UINF,VINF,GAMM) 334 | 335 | use MeshData 336 | use MVELOCIDADES 337 | use MESTABILIZACION 338 | use InputData, only: cte 339 | implicit real(8) (A-H,O-Z) 340 | 341 | 342 | REAL(8) U(4,npoin),T(npoin),GAMM(npoin) 343 | 344 | 345 | !CCCC ----> CTES DE CALCULO PARA SHOCK-CAPTURING 346 | CC=DSQRT(GAMA*FR*TINF) 347 | VEL2=DSQRT(UINF*UINF+VINF*VINF) 348 | 349 | DO IELEM=1,NELEM 350 | 351 | N1=inpoel(1,IELEM) 352 | N2=inpoel(2,IELEM) 353 | N3=inpoel(3,IELEM) 354 | GM=(GAMM(N1)+GAMM(N2)+GAMM(N3))/3.D0 355 | TAU=0.D0 356 | H_RGNE=0.D0 357 | H_RGN=0.D0 358 | H_JGN=0.D0 359 | 360 | !CCCC ----> VARIABLES ELEMENTALES 361 | RHO_ELEM=(U(1,N1)+U(1,N2)+U(1,N3))/3.D0 362 | VX=(VEL_X(N1)+VEL_X(N2)+VEL_X(N3))/3.D0 363 | VY=(VEL_Y(N1)+VEL_Y(N2)+VEL_Y(N3))/3.D0 364 | 365 | !PARTES NUEVAS 366 | WX=(W_X(N1)+W_X(N2)+W_X(N3))/3.D0 367 | WY=(W_Y(N1)+W_Y(N2)+W_Y(N3))/3.D0 368 | VX=VX-WX ; VY=VY-WY 369 | VEL2=DSQRT(VX*VX+VY*VY) 370 | 371 | !CCCC ----> DERIVADA DE RHO 372 | DRX= U(1,N1)*DNX(1,IELEM)+U(1,N2)*DNX(2,IELEM)+U(1,N3)*DNX(3,IELEM) 373 | DRY= U(1,N1)*DNY(1,IELEM)+U(1,N2)*DNY(2,IELEM)+U(1,N3)*DNY(3,IELEM) 374 | DR2=DSQRT(DRX*DRX+DRY*DRY)+1.D-20 375 | !CCCC ----> DERIVADA DE TEMPERATURA 376 | DTX= T(N1)*DNX(1,IELEM)+T(N2)*DNX(2,IELEM)+T(N3)*DNX(3,IELEM) 377 | DTY= T(N1)*DNY(1,IELEM)+T(N2)*DNY(2,IELEM)+T(N3)*DNY(3,IELEM) 378 | DT2=DSQRT(DTX*DTX+DTY*DTY)+1.D-20 379 | !CCCC ----> DERIVADA DE LA VELOCIDAD 380 | DUX= VEL2*DNX(1,IELEM)+VEL2*DNX(2,IELEM)+VEL2*DNX(3,IELEM) 381 | DUY= VEL2*DNY(1,IELEM)+VEL2*DNY(2,IELEM)+VEL2*DNY(3,IELEM) 382 | 383 | DU2=DSQRT(DUX*DUX+DUY*DUY)+1.D-20 384 | 385 | !CCCC ----> VECTOR UNIDAD THETA 386 | RTX=DTX/DT2 387 | RTY=DTY/DT2 388 | !CCCC ----> VECTOR UNIDAD J 389 | RJX=DRX/DR2 390 | RJY=DRY/DR2 391 | !CCCC ----> VECTOR UNIDAD VELOCIDAD 392 | RUX=DUX/DU2 393 | RUY=DUY/DU2 394 | 395 | TEMP=(T(N1)+T(N2)+T(N3))/3.D0 396 | C=DSQRT(GM*FR*TEMP) 397 | 398 | !FMU= RMU*162.6/(TEMP-110.55)*(TEMP/273.15)**.75D0 !SUTHERLAND 399 | smu=110.d0 400 | fmu=0.017d0*(temp/tinf)**1.5d0*(tinf+smu)/(temp+smu) 401 | DO I=1,3 402 | 403 | TERM_1=DABS(VX*DNX(I,IELEM)+VY*DNY(I,IELEM)) 404 | TERM_2=DABS(RJX*DNX(I,IELEM)+RJY*DNY(I,IELEM)) 405 | 406 | H_RGN1=DABS(RTX*DNX(I,IELEM)+RTY*DNY(I,IELEM)) !CALCULO PARA ECU. ENERGIA 407 | H_RGN2=DABS(RUX*DNX(I,IELEM)+RUY*DNY(I,IELEM)) !CALCULO PARA ECU. MOMENTO 408 | 409 | TAU=TAU+TERM_1+TERM_2*C 410 | 411 | H_RGNE=H_RGNE+H_RGN1 412 | H_RGN=H_RGN+H_RGN2 413 | H_JGN=H_JGN+TERM_2 414 | END DO 415 | 416 | TAU=1.D0/TAU 417 | H_RGNE=2.D0/H_RGNE 418 | 419 | H_RGN=2.D0/H_RGN 420 | IF(H_RGN.GT.1.D1)H_RGN=0.D0 421 | H_JGN=2.D0/H_JGN 422 | IF(H_JGN.GT.1.D1)H_JGN=0.D0 423 | 424 | TR1=DR2*H_JGN/RHO_ELEM 425 | ZZZ=H_JGN/(2.D0*C) 426 | SHOC(IELEM)=(TR1+TR1**2)*.5D0*C**2*ZZZ 427 | 428 | RESUMEN=1.D0/TAU**2.D0 +(2.D0/DTMIN)**2.D0 429 | RRR=RESUMEN**(-.5D0) 430 | T_SUGN1(IELEM)=RRR 431 | T_SUGN2(IELEM)=RRR 432 | T_SUGN3(IELEM)=RRR 433 | 434 | IF(FMU.NE.0.D0)THEN 435 | TAU_SUNG3= H_RGN**2.D0/(4.D0*FMU/RHOINF) 436 | TAU_SUNG3_E= H_RGNE**2.D0/(4.D0*FMU/RHOINF) 437 | 438 | T_SUGN2(IELEM)=(RESUMEN+1.D0/TAU_SUNG3**2.D0)**(-.5D0) 439 | T_SUGN3(IELEM)=(RESUMEN+1.D0/TAU_SUNG3_E**2.D0)**(-.5D0) 440 | 441 | END IF 442 | 443 | END DO 444 | 445 | RETURN 446 | END SUBROUTINE ESTAB 447 | 448 | 449 | ! subroutine calcRHS(U, U_n, rhs, P, RMU, dtl, gamm) 450 | ! !RMU, FK, P, T_inf, FCV al pedos en Euler 451 | ! !use MALLOCAR 452 | ! !use MGEOMETRIA 453 | ! use Mvelocidades, only: W_x, W_y 454 | ! use MeshData 455 | ! use MESTABILIZACION 456 | ! use InputData, only: cte, T_inf, FK, FCv, FR, printFlag 457 | ! implicit real(8) (A-H,O-Z) 458 | ! real(8) U(4,npoin),P(npoin),U_n(4,npoin),T(npoin), dtl(nelem), gamm(npoin) 459 | ! real(8) rhs(4,npoin) 460 | ! real(8) A1(3,4,3), A2(3,4,3), Adv(4,3), AA1(4), AA2(4), Adv_phi(4,3), U_loc(4,3), Ux(4), Uy(4), Nx(3), Ny(3) 461 | ! real(8) tau(4), choq(3), phi_loc(4,3), rhs_tmp(4,3) 462 | ! real(8) sp(3,3) !Funciones de forma 463 | ! real(8) c(3), vx(3), vy(3), V_sq(3), temp(3), e(3) 464 | ! real*8 W_xp(3), W_yp(3) 465 | ! INTEGER ipoin(3) 466 | 467 | ! sp(:,1) = (/ .5d0, .5d0, 0.d0 /) 468 | ! sp(:,2) = (/ 0.d0, .5d0, .5d0 /) 469 | ! sp(:,3) = (/ .5d0, 0.d0, .5d0 /) 470 | 471 | ! !$omp parallel & 472 | ! !$omp private(ielem,ipoin,gama,temp,FMU,Nx,Ny,Ux,Uy,AR,HLONG,HLONGX,HLONGY,tau,ALFA_MU,i,& 473 | ! !$omp U_loc,phi_loc,vx,vy,V_sq,e,C,A1,A2,Adv,AA1,AA2,Adv_phi,choq,rhs_tmp) 474 | 475 | ! !$omp do 476 | ! do ielem = 1,nelem 477 | ! rhs_tmp = 0.d0 478 | ! ipoin = inpoel(:, ielem) 479 | 480 | ! gama = (GAMM(ipoin(1))+GAMM(ipoin(2))+GAMM(ipoin(3)))/3.d0 481 | ! !temp = (T(ipoin(1))+T(ipoin(2))+T(ipoin(3)))/3.d0 482 | ! !FMU= 1.716D-5*162.6/(temp-110.55)*(temp/273.15)**.75D0 !SUTHERLAND 483 | 484 | ! Nx = dNx(:, ielem) 485 | ! Ny = dNy(:, ielem) 486 | 487 | ! Ux(:) = U(:,ipoin(1))*Nx(1) + U(:,ipoin(2))*Nx(2) + U(:,ipoin(3))*Nx(3) 488 | ! Uy(:) = U(:,ipoin(1))*Ny(1) + U(:,ipoin(2))*Ny(2) + U(:,ipoin(3))*Ny(3) 489 | 490 | ! AR = area(ielem)*dtl(ielem)/3.d0 491 | ! !CCCC ----> LONG. CARACTERISTICA 492 | ! HLONGX = HHX(ielem) 493 | ! HLONGY = HHY(ielem) 494 | ! HLONG = DSQRT(area(ielem)) 495 | ! !CCCC ----> ESTAB. TEZDUyAR 496 | ! tau(1) = T_SUGN1(ielem) 497 | ! tau(2) = T_SUGN2(ielem) 498 | ! tau(3) = T_SUGN2(ielem) 499 | ! tau(4) = T_SUGN3(ielem) 500 | ! ALFA_MU = SHOC(ielem) 501 | ! choq(1) = ALFA_MU*AR*CTE 502 | ! choq(2) = ALFA_MU*AR*CTE 503 | ! choq(3) = ALFA_MU*AR*CTE 504 | 505 | ! !CCCC ----> INTEGRO LAS VARIABLES EN LOS PUNTOS DE GAUSS 506 | ! U_loc(:,1) = sp(1,1)*U(:,ipoin(1)) + sp(2,1)*U(:,ipoin(2)) + sp(3,1)*U(:,ipoin(3)) 507 | ! U_loc(:,2) = sp(1,2)*U(:,ipoin(1)) + sp(2,2)*U(:,ipoin(2)) + sp(3,2)*U(:,ipoin(3)) 508 | ! U_loc(:,3) = sp(1,3)*U(:,ipoin(1)) + sp(2,3)*U(:,ipoin(2)) + sp(3,3)*U(:,ipoin(3)) 509 | 510 | ! phi_loc(:,1) = sp(1,1)*U_n(:,ipoin(1)) + sp(2,1)*U_n(:,ipoin(2)) + sp(3,1)*U_n(:,ipoin(3)) 511 | ! phi_loc(:,2) = sp(1,2)*U_n(:,ipoin(1)) + sp(2,2)*U_n(:,ipoin(2)) + sp(3,2)*U_n(:,ipoin(3)) 512 | ! phi_loc(:,3) = sp(1,3)*U_n(:,ipoin(1)) + sp(2,3)*U_n(:,ipoin(2)) + sp(3,3)*U_n(:,ipoin(3)) 513 | 514 | ! W_xp(:) = 0.0 515 | ! W_yp(:) = 0.0 516 | ! ! W_xp(1) = sp(1,1)*W_x(ipoin(1)) + sp(2,1)*W_x(ipoin(2)) + sp(3,1)*W_x(ipoin(3)) 517 | ! ! W_xp(2) = sp(1,2)*W_x(ipoin(1)) + sp(2,2)*W_x(ipoin(2)) + sp(3,2)*W_x(ipoin(3)) 518 | ! ! W_xp(3) = sp(1,3)*W_x(ipoin(1)) + sp(2,3)*W_x(ipoin(2)) + sp(3,3)*W_x(ipoin(3)) 519 | ! ! W_yp(1) = sp(1,1)*W_y(ipoin(1)) + sp(2,1)*W_y(ipoin(2)) + sp(3,1)*W_y(ipoin(3)) 520 | ! ! W_yp(2) = sp(1,2)*W_y(ipoin(1)) + sp(2,2)*W_y(ipoin(2)) + sp(3,2)*W_y(ipoin(3)) 521 | ! ! W_yp(3) = sp(1,3)*W_y(ipoin(1)) + sp(2,3)*W_y(ipoin(2)) + sp(3,3)*W_y(ipoin(3)) 522 | 523 | ! !CCCC ----> DEFINO VARIABLES PRIMITIVAS 524 | ! vx(:) = U_loc(2,:)/U_loc(1,:) 525 | ! vy(:) = U_loc(3,:)/U_loc(1,:) 526 | ! e(:) = U_loc(4,:)/U_loc(1,:) 527 | ! V_sq(:) = vx*vx+vy*vy 528 | ! temp(:) = (gama-1.d0)/FR*(e-.5d0*V_sq) !FR = CTE. UNIVERSAL DE LOS GASES 529 | ! c(:) = DSQRT(gama*FR*temp(:)) 530 | 531 | ! ! = = = GAUSS QUAD = == 532 | ! do i = 1,3 533 | ! !A1(0,:,i) = (/ 0.d0, 1.d0, 0.d0, 0.d0 /) 534 | ! A1(1,:,i) = (/ (gama-1.d0)/2.d0*V_sq(i)-vx(i)*vx(i),& 535 | ! (3.d0-gama)*vx(i) - W_xp(i),& 536 | ! -(gama-1.d0)*vy(i),& 537 | ! (gama-1.d0) /) 538 | ! A1(2,:,i) = (/ -vx(i)*vy(i),& 539 | ! vy(i),& 540 | ! vx(i) - W_xp(i),& 541 | ! 0.d0 /) 542 | ! A1(3,:,i) = (/ ((gama-1.d0)*V_sq(i)-gama*e(i))*vx(i),& 543 | ! gama*e(i)-(gama-1.d0)/2.d0*V_sq(i)-(gama-1.d0)*vx(i)*vx(i),& 544 | ! -(gama-1.d0)*vx(i)*vy(i),& 545 | ! gama*vx(i) - W_xp(i)/) 546 | ! !A2(0,:,i) = (/ 0.d0, 0.d0, 1.d0, 0.d0 /) 547 | ! A2(1,:,i) = (/ -vx(i)*vy(i),& 548 | ! vy(i) - W_yp(i),& 549 | ! vx(i),& 550 | ! 0.d0 /) 551 | ! A2(2,:,i) = (/ (gama-1.d0)/2.d0*V_sq(i)-vy(i)*vy(i),& 552 | ! -(gama-1.d0)*vx(i),& 553 | ! (3.d0-gama)*vy(i) - W_yp(i),& 554 | ! (gama-1.d0) /) 555 | ! A2(3,:,i) = (/ ((gama-1.d0)*V_sq(i)-gama*e(i))*vy(i),& 556 | ! -(gama-1.d0)*vx(i)*vy(i),& 557 | ! gama*e(i)-(gama-1.d0)/2.d0*V_sq(i)-(gama-1.d0)*vy(i)*vy(i),& 558 | ! gama*vy(i) - W_yp(i) /) 559 | 560 | ! Adv(1,i) = -W_xp(i)*Ux(1) + Ux(2) + -W_yp(i)*Uy(1) + Uy(3) 561 | ! Adv(2:4,i) = A1(:,1,i)*Ux(1) + A1(:,2,i)*Ux(2) + A1(:,3,i)*Ux(3) + A1(:,4,i)*Ux(4)& 562 | ! +A2(:,1,i)*Uy(1) + A2(:,2,i)*Uy(2) + A2(:,3,i)*Uy(3) + A2(:,4,i)*Uy(4) 563 | ! end do 564 | ! ! = = = end GAUSS QUAD = == 565 | 566 | ! Adv_phi = Adv + phi_loc 567 | 568 | ! AA1(1) = (-W_xp(1)*Adv_phi(1,1) + Adv_phi(2,1) -W_xp(2)*Adv_phi(1,2) + Adv_phi(2,2) -W_xp(3)*Adv_phi(1,3) + Adv_phi(2,3))*AR 569 | ! AA1(2:4) = (A1(:,1,1)*Adv_phi(1,1) + A1(:,2,1)*Adv_phi(2,1) + A1(:,3,1)*Adv_phi(3,1) + A1(:,4,1)*Adv_phi(4,1) + & 570 | ! A1(:,1,2)*Adv_phi(1,2) + A1(:,2,2)*Adv_phi(2,2) + A1(:,3,2)*Adv_phi(3,2) + A1(:,4,2)*Adv_phi(4,2) + & 571 | ! A1(:,1,3)*Adv_phi(1,3) + A1(:,2,3)*Adv_phi(2,3) + A1(:,3,3)*Adv_phi(3,3) + A1(:,4,3)*Adv_phi(4,3))*AR 572 | ! AA2(1) = (-W_yp(1)*Adv_phi(1,1) + Adv_phi(3,1) -W_yp(2)*Adv_phi(1,2) + Adv_phi(3,2) -W_yp(3)*Adv_phi(1,3) + Adv_phi(3,3))*AR 573 | ! AA2(2:4) = (A2(:,1,1)*Adv_phi(1,1) + A2(:,2,1)*Adv_phi(2,1) + A2(:,3,1)*Adv_phi(3,1) + A2(:,4,1)*Adv_phi(4,1) + & 574 | ! A2(:,1,2)*Adv_phi(1,2) + A2(:,2,2)*Adv_phi(2,2) + A2(:,3,2)*Adv_phi(3,2) + A2(:,4,2)*Adv_phi(4,2) + & 575 | ! A2(:,1,3)*Adv_phi(1,3) + A2(:,2,3)*Adv_phi(2,3) + A2(:,3,3)*Adv_phi(3,3) + A2(:,4,3)*Adv_phi(4,3))*AR 576 | 577 | ! rhs_tmp(:,1) = (Nx(1)*AA1 + Ny(1)*AA2)*tau + & 578 | ! (Adv(:,1)*sp(1,1) + Adv(:,2)*sp(1,2) + Adv(:,3)*sp(1,3))*AR + 3*(Nx(1)*Ux + Ny(1)*Uy)*choq(1) 579 | ! rhs_tmp(:,2) = (Nx(2)*AA1 + Ny(2)*AA2)*tau + & 580 | ! (Adv(:,1)*sp(2,1) + Adv(:,2)*sp(2,2) + Adv(:,3)*sp(2,3))*AR + 3*(Nx(2)*Ux + Ny(2)*Uy)*choq(2) 581 | ! rhs_tmp(:,3) = (Nx(3)*AA1 + Ny(3)*AA2)*tau + & 582 | ! (Adv(:,1)*sp(3,1) + Adv(:,2)*sp(3,2) + Adv(:,3)*sp(3,3))*AR + 3*(Nx(3)*Ux + Ny(3)*Uy)*choq(3) 583 | 584 | ! do i = 1,3 585 | ! !$omp atomic 586 | ! rhs(1,ipoin(i)) = rhs(1,ipoin(i)) + rhs_tmp(1,i) 587 | ! !$omp atomic 588 | ! rhs(2,ipoin(i)) = rhs(2,ipoin(i)) + rhs_tmp(2,i) 589 | ! !$omp atomic 590 | ! rhs(3,ipoin(i)) = rhs(3,ipoin(i)) + rhs_tmp(3,i) 591 | ! !$omp atomic 592 | ! rhs(4,ipoin(i)) = rhs(4,ipoin(i)) + rhs_tmp(4,i) 593 | ! end do 594 | 595 | ! end do 596 | ! !$omp end do 597 | ! !$omp end parallel 598 | ! return 599 | ! end subroutine calcRHS 600 | 601 | subroutine fixvel 602 | !use mallocar 603 | !use mvariabfix 604 | use mvelocidades 605 | use meshdata 606 | implicit none 607 | integer i, j 608 | 609 | !$omp parallel do private(i, j) 610 | do i = 1, nfixv 611 | j = ifixv_node(i) 612 | vel_x(j) = rfixv_valuex(i) 613 | vel_y(j) = rfixv_valuey(i) 614 | end do 615 | !$omp end parallel do 616 | end subroutine FIXVEL 617 | 618 | subroutine FIX(FR,GAMM) 619 | !use MALLOCAR 620 | !use MVARIABFIX 621 | use MVELOCIDADES 622 | use MVARIABLES 623 | use MeshData 624 | implicit real(8) (A-H,O-Z) 625 | real(8) GAMM(npoin) 626 | 627 | !$omp parallel 628 | !$omp do private(i) 629 | do i = 1, nfixrho 630 | rho(ifixrho_node(i)) = rfixrho_value(i) 631 | end do 632 | !$omp end do 633 | 634 | !$omp do private(i, j, gm) 635 | do i = 1, NFIXT 636 | j = IFIXT_NODE(i) 637 | GM = GAMM(j) - 1.d0 638 | T(j) = RFIXT_VALUE(i) 639 | E(j) = T(j)*FR/GM + .5d0*(VEL_X(j)**2 + VEL_Y(j)**2) 640 | end do 641 | !$omp end do 642 | !$omp end parallel 643 | end subroutine FIX 644 | 645 | subroutine RK(DTMIN, NRK, BANDERA, GAMM, dtl) 646 | !use DATOS_REFINAMIENTO 647 | !use DATOS_ENTRADA 648 | !use MALLOCAR 649 | !use MVARIABFIX 650 | !use MGEOMETRIA 651 | !use MFUERZAS 652 | !use MMOVIMIENTO 653 | use calcRHS_mod 654 | use InputData 655 | use MNORMALES 656 | use MVELOCIDADES 657 | use MVARIABGEN 658 | use MeshData 659 | use MVARIABLES 660 | use MESTABILIZACION 661 | use TIMERS 662 | implicit real(8)(A-H,O-Z) 663 | integer BANDERA 664 | real(8) GAMM(npoin) 665 | real(8) dtl(nelem) 666 | 667 | do IRK = 1,NRK 668 | RK_FACT = 1.d0/(NRK + 1 - IRK) 669 | 670 | !CCCC ----> SOLO CALCULO UNA VEZ EL TERMINO DE ESTABILIZACION 671 | if(IRK.EQ.1)THEN 672 | !DEBUGGG 673 | timer(cuarto_orden(U1,UN,FR,gamm), cuarto_t) 674 | UN = 0.0 675 | 676 | timer(estab(U,T,GAMA,FR,RMU,DTMIN,RHO_inf,T_inf,U_inf,V_inf,GAMM), estab_t) 677 | end if 678 | 679 | !$omp parallel do private(ipoin) 680 | do ipoin = 1, npoin 681 | RHS(:, ipoin) = 0.d0 682 | end do 683 | !$omp end parallel do 684 | 685 | timer( calcRHS(rhs, U, UN, dNx, dNy, area, shoc, dtl, t_sugn1, t_sugn2, t_sugn3, inpoel, nelem, npoin), calcrhs_t) 686 | ! timer(calcRHS(U, UN, RHS, P, RMU, dtl, gamm), calcrhs_t) 687 | ! call rhs_diffusive& 688 | ! (rhs, U, dnx, dny, area, dtl, T, gamm, fr, fmu, fk, fcv, T_inf, inpoel, npoin, nelem) 689 | 690 | !CCCC ----> CALCULO DE LOS TERMINOS FUENTES 691 | !DEBUGGG 692 | timer(FUENTE(dtl), fuente_t) 693 | 694 | !CCCC ----> INTEGRADOR TEMPORAL 695 | !$OMP PARALLEL DO PRIVATE(IPOIN) 696 | do ipoin = 1, npoin 697 | U1(:, ipoin) = U(:, ipoin) - rk_fact/M(ipoin)*RHS(:, ipoin) 698 | end do 699 | !$OMP END PARALLEL DO 700 | 701 | !CCCC---------------------------------------------- 702 | !CCCC----> PASA A LA VARIABLE PRIMARIA PARA APLICAR 703 | !CCCC----> LAS CONDICIONES DE CONTORNO 704 | !CCCC---------------------------------------------- 705 | 706 | if(NGAS.EQ.1) GO TO 112 707 | !$OMP PARALLEL DO PRIVATE(IPOIN, VEL2) 708 | do ipoin = 1, npoin 709 | RHO(ipoin) = U1(1,ipoin) 710 | VEL_X(ipoin) = U1(2,ipoin)/RHO(ipoin) 711 | VEL_Y(ipoin) = U1(3,ipoin)/RHO(ipoin) 712 | E(ipoin) = U1(4,ipoin)/RHO(ipoin) 713 | VEL2 = (VEL_X(ipoin)**2 + VEL_Y(ipoin)**2) 714 | P(ipoin) = RHO(ipoin)*(GAMM(ipoin)-1.d0)*(E(ipoin)-.5d0*VEL2) 715 | T(ipoin) = P(ipoin)/(RHO(ipoin)*FR) 716 | RMACH(ipoin) = DSQRT(VEL2/(T(ipoin)*GAMM(ipoin)*FR)) 717 | end do 718 | !$OMP END PARALLEL DO 719 | 720 | 112 CONTINUE 721 | 722 | !CCCC----> CASO PARA AIRE EN EQUILIBRIO 723 | !CCCC---------------------------------------------- 724 | if(NGAS.NE.0)THEN 725 | do ipoin = 1, npoin 726 | RHO(ipoin) = U1(1,ipoin) 727 | E(ipoin) = U1(4,ipoin)/RHO(ipoin) 728 | VEL_X(ipoin) = U1(2,ipoin)/RHO(ipoin) 729 | VEL_Y(ipoin) = U1(3,ipoin)/RHO(ipoin) 730 | VEL2 = VEL_X(ipoin)**2.d0+VEL_Y(ipoin)**2.d0 731 | P(ipoin) = RHO(ipoin)*(GAMM(ipoin)-1.d0)*(E(ipoin)-.5d0*VEL2) 732 | T(ipoin) = P(ipoin)/(RHO(ipoin)*FR) 733 | if(IRK.EQ.NRK)THEN 734 | call TGAS(E(ipoin)-.5d0*VEL2,RHO(ipoin),PGAS,AGAS,TGASi,GAMI) 735 | GAMM(ipoin) = GAMI 736 | P(ipoin) = PGAS 737 | T(ipoin) = TGASi 738 | RMACH(ipoin) = DSQRT(VEL2)/AGAS 739 | end if 740 | end do 741 | end if 742 | 743 | !!$ !CCCC---------------------------------------------- 744 | !!$ !CCCC----> PASA INFORMACION DE PERIODICIDAD 745 | !!$ 746 | !!$ if(NMASTER.NE.0)THEN 747 | !!$ do IMASTER = 1,NMASTER 748 | !!$ N1 = IPER_MASTER(IMASTER) 749 | !!$ N2 = IPER_AUX(IMASTER) 750 | !!$ 751 | !!$ RRHO = (RHO(N1)+RHO(N2))/2.d0 752 | !!$ RHO(N1) = RRHO ; RHO(N2) = RRHO 753 | !!$ 754 | !!$ RVELX = (VEL_X(N1)+VEL_X(N2))/2.d0 755 | !!$ VEL_X(N1) = RVELX ; VEL_X(N2) = RVELX 756 | !!$ 757 | !!$ RVELY = (VEL_Y(N1)+VEL_Y(N2))/2.d0 758 | !!$ VEL_Y(N1) = RVELY ; VEL_Y(N2) = RVELY 759 | !!$ 760 | !!$ RE = (E(N1)+E(N2))/2.d0 761 | !!$ E(N1) = RE ; E(N2) = RE 762 | !!$ 763 | !!$ RP = (P(N1)+P(N2))/2.d0 764 | !!$ P(N1) = RP ; P(N2) = RP 765 | !!$ 766 | !!$ RT = (T(N1)+T(N2))/2.d0 767 | !!$ T(N1) = RT ; T(N2) = RT 768 | !!$ end do 769 | !!$ end if 770 | 771 | !CCCC---------------------------------------CCCC 772 | !CCCC ----> MOVIMIENTO DE MALLA <---- CCCC 773 | !CCCC---------------------------------------CCCC 774 | 775 | !DELTAX = -dtmin*500.d0 776 | !do i = 1,NMOVE 777 | ! POS_AUX(i) = DELTAX 778 | !end do 779 | ! !NODOS SIN MOVIMIENTO 780 | !do i = NMOVE+1,NFIX_MOVE+NMOVE 781 | ! POS_AUX(i) = 0.d0 782 | !end do 783 | 784 | !B = 0.d0 785 | !call GRADCONJ2(S,XPOS,B,NN1,NN2,npoin,NPOS & 786 | ! ,ILAUX,POS_AUX,NNMOVE,RAUX,ADIAG & 787 | ! ,PK,APK,Z) 788 | 789 | !W_X = XPOS/DTMIN 790 | !X = X+XPOS 791 | !YPOS = Y 792 | !!$ IMOOTH = IMOOTH+1 793 | !!$ if(IMOOTH.EQ.IPRINT)THEN 794 | !!$ IMOOTH = 0 795 | !!$ call SMOOTH_MESH(npoin,nelem,inpoel,XPOS,YPOS & 796 | !!$ ,SMOOTH_FIX,SMOOTH_SIM) 797 | !!$ W_X = (X-XPOS)/DTMIN 798 | !!$ W_Y = (Y-YPOS)/DTMIN 799 | !!$ end if 800 | ! X = XPOS 801 | ! Y = YPOS 802 | 803 | !CCCC---------------------------------------CCCC 804 | !CCCC ----> CONDICIONES DE CONTORNO <---- CCCC 805 | !CCCC---------------------------------------CCCC 806 | 807 | !CCCC----> VELOCIDADES IMPUESTAS 808 | !CCCC--------------------------- 809 | call FIXVEL 810 | 811 | !CCCC----> CORRECCION DE LAS VELOCIDADES NORMALES 812 | !CCCC-------------------------------------------- 813 | call NORMALVEL 814 | 815 | !CCCC----> VALORES IMPUESTOS 816 | !CCCC----------------------- 817 | call FIX(FR,GAMM) 818 | 819 | !$omp parallel do private(ipoin) 820 | do ipoin = 1, npoin 821 | U1(1,ipoin) = RHO(ipoin) 822 | U1(2,ipoin) = VEL_X(ipoin)*RHO(ipoin) 823 | U1(3,ipoin) = VEL_Y(ipoin)*RHO(ipoin) 824 | U1(4,ipoin) = E(ipoin)*RHO(ipoin) 825 | end do 826 | !$omp end parallel do 827 | 828 | end do 829 | 830 | if (BANDERA.EQ.2) THEN 831 | !$omp parallel do private(ipoin) 832 | do ipoin = 1, npoin 833 | RHS3(:, ipoin) = RHS(:, ipoin) 834 | end do 835 | !$omp end parallel do 836 | else if(BANDERA.EQ.3) THEN 837 | !$omp parallel do private(ipoin) 838 | do ipoin = 1, npoin 839 | RHS2(:, ipoin) = RHS(:, ipoin) 840 | end do 841 | !$omp end parallel do 842 | else if(BANDERA.EQ.4) THEN 843 | !$omp parallel do private(ipoin) 844 | do ipoin = 1, npoin 845 | RHS1(:, ipoin) = RHS(:, ipoin) 846 | end do 847 | !$omp end parallel do 848 | end if 849 | end subroutine RK 850 | 851 | subroutine ADAMSB(DTMIN, NESTAB, GAMM, dtl) 852 | !use DATOS_REFINAMIENTO 853 | !use DATOS_ENTRADA 854 | !use MGEOMETRIA 855 | use calcRHS_mod 856 | use InputData 857 | use MVELOCIDADES 858 | use MVARIABGEN 859 | use MeshData 860 | use MVARIABLES 861 | use MESTABILIZACION 862 | use TIMERS 863 | use Mnormales 864 | implicit real(8) (A-H,O-Z) 865 | integer NESTAB 866 | real(8) GAMM(npoin) 867 | real(8) dtl(nelem) 868 | 869 | !CCCC ----> SOLO CALCULO UNA VEZ EL TERMINO DE ESTABILIZACION 870 | if (NESTAB.EQ.4) NESTAB = 1 871 | if (NESTAB.EQ.2) THEN 872 | timer(CUARTO_ORDEN(U1,UN,FR,gamm), cuarto_t) 873 | timer(ESTAB(U,T,GAMA,FR,RMU,DTMIN,RHO_inf,T_inf,U_inf,V_inf, GAMM), estab_t) 874 | ! call cuarto_orden(U1,UN,FR,gamm) 875 | ! call estab(U,T,GAMA,FR,RMU,DTMIN,RHO_inf,T_inf,U_inf,V_inf,GAMM) 876 | end if 877 | NESTAB = NESTAB + 1 878 | 879 | !$omp parallel do private(ipoin) 880 | do ipoin = 1, npoin 881 | RHS(:, ipoin) = 0.d0 882 | end do 883 | !$omp end parallel do 884 | 885 | timer( calcRHS(rhs, U, UN, dNx, dNy, area, shoc, dtl, t_sugn1, t_sugn2, t_sugn3, inpoel, nelem, npoin), calcrhs_t) 886 | ! timer(calcRHS(U, UN, RHS, P, RMU, dtl, gamm), calcrhs_t) 887 | ! call rhs_diffusive& 888 | ! (rhs, U, dnx, dny, area, dtl, T, gamm, fr, fmu, fk, fcv, T_inf, inpoel, npoin, nelem) 889 | !CCCC ----> CALCULO DE LOS TERMINOS FUENTES 890 | timer(FUENTE(dtl), fuente_t) 891 | ! call FUENTE(dtl) 892 | 893 | !CCCC ----> INTEGRADOR TEMPORAL 894 | !$omp parallel do private(ipoin, RL) 895 | do ipoin = 1, npoin 896 | RL = 24.d0*M(ipoin) 897 | U1(:, ipoin) = U(:, ipoin) - (55.d0*RHS(:, ipoin) - 59.d0*RHS1(:, ipoin) + 37.d0*RHS2(:, ipoin) - 9.d0*RHS3(:, ipoin))/RL 898 | end do 899 | !$omp end parallel do 900 | 901 | !$omp parallel do private(ipoin) 902 | do ipoin = 1, npoin 903 | RHS3(:, ipoin) = RHS2(:, ipoin) 904 | RHS2(:, ipoin) = RHS1(:, ipoin) 905 | RHS1(:, ipoin) = RHS(:, ipoin) 906 | end do 907 | !$omp end parallel do 908 | 909 | !CCCC---------------------------------------------- 910 | !CCCC----> PASA A LA VARIABLE PRIMARIA PARA APLICAR 911 | !CCCC----> LAS CONDICIONES DE CONTORNO 912 | !CCCC---------------------------------------------- 913 | if(NGAS.EQ.1) GO TO 111 914 | !$omp parallel do private(ipoin, vel2) 915 | do ipoin = 1, npoin 916 | RHO(ipoin) = U1(1,ipoin) 917 | VEL_X(ipoin) = U1(2,ipoin)/RHO(ipoin) 918 | VEL_Y(ipoin) = U1(3,ipoin)/RHO(ipoin) 919 | E(ipoin) = U1(4,ipoin)/RHO(ipoin) 920 | VEL2 = (VEL_X(ipoin)**2.d0+VEL_Y(ipoin)**2.d0) 921 | P(ipoin) = RHO(ipoin)*(GAMM(ipoin)-1.d0)*(E(ipoin)-.5d0*VEL2) 922 | T(ipoin) = P(ipoin)/(RHO(ipoin)*FR) 923 | RMACH(ipoin) = DSQRT(VEL2/(T(ipoin)*GAMM(ipoin)*FR)) 924 | end do 925 | !$omp end parallel do 926 | 111 CONTINUE 927 | 928 | !CCCC----> CASO PARA AIRE EN EQUILIBRIO 929 | !CCCC---------------------------------------------- 930 | if(NGAS.NE.0)THEN 931 | do ipoin = 1, npoin 932 | RHO(ipoin) = U1(1,ipoin) 933 | E(ipoin) = U1(4,ipoin)/RHO(ipoin) 934 | VEL_X(ipoin) = U1(2,ipoin)/RHO(ipoin) 935 | VEL_Y(ipoin) = U1(3,ipoin)/RHO(ipoin) 936 | VEL2 = VEL_X(ipoin)**2.d0+VEL_Y(ipoin)**2.d0 937 | P(ipoin) = RHO(ipoin)*(GAMM(ipoin)-1.d0)*(E(ipoin)-.5d0*VEL2) 938 | T(ipoin) = P(ipoin)/(RHO(ipoin)*FR) 939 | 940 | call TGAS(E(ipoin)-.5d0*VEL2,RHO(ipoin),PGAS,AGAS,TGASi,GAMI) 941 | GAMM(ipoin) = GAMI 942 | P(ipoin) = PGAS 943 | T(ipoin) = TGASi 944 | RMACH(ipoin) = DSQRT(VEL2)/AGAS 945 | 946 | end do 947 | end if 948 | 949 | !!$ !CCCC---------------------------------------------- 950 | !!$ !CCCC----> PASA INFORMACION DE PERIODICIDAD 951 | !!$ 952 | !!$ if(NMASTER.NE.0)THEN 953 | !!$ do IMASTER = 1,NMASTER 954 | !!$ N1 = IPER_MASTER(IMASTER) 955 | !!$ N2 = IPER_AUX(IMASTER) 956 | !!$ 957 | !!$ RRHO = (RHO(N1)+RHO(N2))/2.d0 958 | !!$ RHO(N1) = RRHO ; RHO(N2) = RRHO 959 | !!$ 960 | !!$ RVELX = (VEL_X(N1)+VEL_X(N2))/2.d0 961 | !!$ VEL_X(N1) = RVELX ; VEL_X(N2) = RVELX 962 | !!$ 963 | !!$ RVELY = (VEL_Y(N1)+VEL_Y(N2))/2.d0 964 | !!$ VEL_Y(N1) = RVELY ; VEL_Y(N2) = RVELY 965 | !!$ 966 | !!$ RE = (E(N1)+E(N2))/2.d0 967 | !!$ E(N1) = RE ; E(N2) = RE 968 | !!$ 969 | !!$ RP = (P(N1)+P(N2))/2.d0 970 | !!$ P(N1) = RP ; P(N2) = RP 971 | !!$ 972 | !!$ RT = (T(N1)+T(N2))/2.d0 973 | !!$ T(N1) = RT ; T(N2) = RT 974 | !!$ end do 975 | !!$ end if 976 | 977 | !CCCC---------------------------------------CCCC 978 | !CCCC ----> MOVIMIENTO DE MALLA <---- CCCC 979 | !CCCC---------------------------------------CCCC 980 | 981 | !DELTAX = -dtmin*500.d0 982 | !do i = 1,NMOVE 983 | ! POS_AUX(i) = DELTAX 984 | !end do 985 | ! 986 | !NODOS SIN MOVIMIENTO 987 | ! do i = NMOVE+1,NFIX_MOVE+NMOVE 988 | ! POS_AUX(i) = 0.d0 989 | ! end do 990 | ! B = 0.d0 991 | 992 | !call GRADCONJ2(S,XPOS,B,NN1,NN2,npoin,NPOS & 993 | ! ,ILAUX,POS_AUX,NNMOVE,RAUX,ADIAG & 994 | ! ,PK,APK,Z) 995 | 996 | !W_X = XPOS/DTMIN 997 | !X = X+XPOS 998 | !YPOS = Y 999 | ! IMOOTH = IMOOTH+1 1000 | ! if(IMOOTH.EQ.IPRINT)THEN 1001 | ! IMOOTH = 0 1002 | ! call SMOOTH_MESH(npoin,nelem,inpoel,XPOS,YPOS & 1003 | ! ,SMOOTH_FIX,SMOOTH_SIM) 1004 | ! W_X = (X-XPOS)/DTMIN 1005 | ! W_Y = (Y-YPOS)/DTMIN 1006 | ! end if 1007 | !X = XPOS 1008 | !Y = YPOS 1009 | 1010 | !CCCC---------------------------------------CCCC 1011 | !CCCC ----> CONDICIONES DE CONTORNO <---- CCCC 1012 | !CCCC---------------------------------------CCCC 1013 | 1014 | !CCCC----> VELOCIDADES IMPUESTAS 1015 | !CCCC--------------------------- 1016 | call FIXVEL 1017 | 1018 | !CCCC----> CORRECCION DE LAS VELOCIDADES NORMALES 1019 | !CCCC-------------------------------------------- 1020 | call NORMALVEL 1021 | 1022 | !CCCC----> VALORES IMPUESTOS 1023 | !CCCC----------------------- 1024 | call FIX(FR,GAMM) 1025 | 1026 | !$omp parallel do 1027 | do ipoin = 1,npoin 1028 | U1(1,ipoin) = RHO(ipoin) 1029 | U1(2,ipoin) = VEL_X(ipoin)*RHO(ipoin) 1030 | U1(3,ipoin) = VEL_Y(ipoin)*RHO(ipoin) 1031 | U1(4,ipoin) = E(ipoin)*RHO(ipoin) 1032 | end do 1033 | !omp end parallel 1034 | end subroutine ADAMSB 1035 | 1036 | subroutine FUENTE(dtl) 1037 | !use MALLOCAR 1038 | !use MGEOMETRIA 1039 | !use DATOS_ENTRADA 1040 | use MeshData 1041 | use MVELOCIDADES 1042 | use MVARIABGEN 1043 | use InputData 1044 | 1045 | implicit real(8) (A-H, O-Z) 1046 | 1047 | real(8) rhs_tmp(4, 3), Ux(4), Uy(4), Nx(3), Ny(3), dtl(nelem) 1048 | real(8) sp(3, 3) 1049 | real(8) wx(3), wy(3) 1050 | integer ipoin(3) 1051 | 1052 | sp(:, 1) = (/ .5d0, .5d0, 0.d0 /) 1053 | sp(:, 2) = (/ 0.d0, .5d0, .5d0 /) 1054 | sp(:, 3) = (/ .5d0, 0.d0, .5d0 /) 1055 | 1056 | !$omp parallel & 1057 | !$omp private(ielem, Ux, Uy, AR, wx, wy, rhs_tmp, ipoin, i) 1058 | 1059 | !$omp do 1060 | do ielem = 1, nelem 1061 | rhs_tmp = 0.d0 1062 | ipoin = inpoel(:, ielem) 1063 | 1064 | Ux = U(:, ipoin(1))*dNx(1, ielem) + U(:, ipoin(2))*dNx(2, ielem) + U(:, ipoin(3))*dNx(3, ielem) 1065 | Uy = U(:, ipoin(1))*dNy(1, ielem) + U(:, ipoin(2))*dNy(2, ielem) + U(:, ipoin(3))*dNy(3, ielem) 1066 | 1067 | AR = AREA(ielem)*dtl(ielem)/3.d0 1068 | 1069 | wx(1) = sum(sp(:,1)*w_x(ipoin(:))) 1070 | wx(2) = sum(sp(:,2)*w_x(ipoin(:))) 1071 | wx(3) = sum(sp(:,3)*w_x(ipoin(:))) 1072 | wy(1) = sum(sp(:,1)*w_y(ipoin(:))) 1073 | wy(2) = sum(sp(:,2)*w_y(ipoin(:))) 1074 | wy(3) = sum(sp(:,3)*w_y(ipoin(:))) 1075 | 1076 | rhs_tmp(:, 1) = -AR*(sp(1, 1)*(Ux*wx(1) + Uy*wy(1)) + sp(1, 2)*(Ux*wx(2) + Uy*wy(2)) + sp(1, 3)*(Ux*wx(3) + Uy*wy(3))) 1077 | rhs_tmp(:, 2) = -AR*(sp(2, 1)*(Ux*wx(1) + Uy*wy(1)) + sp(2, 2)*(Ux*wx(2) + Uy*wy(2)) + sp(2, 3)*(Ux*wx(3) + Uy*wy(3))) 1078 | rhs_tmp(:, 3) = -AR*(sp(3, 1)*(Ux*wx(1) + Uy*wy(1)) + sp(3, 2)*(Ux*wx(2) + Uy*wy(2)) + sp(3, 3)*(Ux*wx(3) + Uy*wy(3))) 1079 | 1080 | do i = 1, 3 1081 | !$omp atomic 1082 | rhs(1, ipoin(i)) = rhs(1, ipoin(i)) + rhs_tmp(1, i) 1083 | !$omp atomic 1084 | rhs(2, ipoin(i)) = rhs(2, ipoin(i)) + rhs_tmp(2, i) 1085 | !$omp atomic 1086 | rhs(3, ipoin(i)) = rhs(3, ipoin(i)) + rhs_tmp(3, i) 1087 | !$omp atomic 1088 | rhs(4, ipoin(i)) = rhs(4, ipoin(i)) + rhs_tmp(4, i) 1089 | end do 1090 | 1091 | end do 1092 | !$omp end do 1093 | !$omp end parallel 1094 | end subroutine FUENTE 1095 | 1096 | real*8 function cmpMtx(m, n, a, b) 1097 | implicit none 1098 | integer m, n, i, j 1099 | real*8 a(m,n), b(m,n) 1100 | real*8, allocatable, dimension(:,:) :: c 1101 | real*8 res 1102 | 1103 | allocate(c(m,n)) 1104 | c = a - b 1105 | res = 0.d0 1106 | do i = 1, m 1107 | do j = 1, n 1108 | res = res + c(i,j)**2 1109 | end do 1110 | end do 1111 | cmpMtx = res 1112 | deallocate(c) 1113 | end function cmpMtx 1114 | --------------------------------------------------------------------------------