TABLE OF CONTENTS
UTI/PRE/calc_bathy [ Modules ]
NOM
calc_bathy(calc)
DESCRIPTION
* calcul de la bathy sur chaque cellule a partir des bathy aux sommet de la base des blocs On utlise les fonction d interpolation du Q4 Computation of the bathymetry on each cell from the vertex on the bottom of the blocks. Q4 Interpolation s functions are used ENTREES / INPUT calc : objet calcul / calculation object SORTIES / OUTPUT calc : objet calcul / calculation object
SOURCE
! Ce logiciel est regi par la licence [CeCILL-B] ! This software is governed by the [CeCILL-B] license !=========================== DEBUT DES DECLARATIONS ==================== !.1----- Implicit, Use USE num IMPLICIT NONE !.2----- Declaration type(calcul),intent(inout) :: calc integer :: ib,i real(kind=kind(0.d0)) :: coef,x,y,z,c real(kind=kind(0.d0)) :: x1,x2,x3,x4 real(kind=kind(0.d0)) :: y1,y2,y3,y4 real(kind=kind(0.d0)) :: z1,z2,z3,z4 real(kind=kind(0.d0)) :: c1,c2,c3,c4 real(kind=kind(0.d0)),dimension(4,4) :: a !=========================== DEBUT DU CODE EXECUTABLE ================== DO ib=1,calc%nb_bloc x1=calc%list_bloc(ib)%s(1)%x y1=calc%list_bloc(ib)%s(1)%y z1=calc%list_bloc(ib)%vb(1) c1=calc%list_bloc(ib)%vb(5) x2=calc%list_bloc(ib)%s(2)%x y2=calc%list_bloc(ib)%s(2)%y z2=calc%list_bloc(ib)%vb(2) c2=calc%list_bloc(ib)%vb(6) x3=calc%list_bloc(ib)%s(3)%x y3=calc%list_bloc(ib)%s(3)%y z3=calc%list_bloc(ib)%vb(3) c3=calc%list_bloc(ib)%vb(7) x4=calc%list_bloc(ib)%s(4)%x y4=calc%list_bloc(ib)%s(4)%y z4=calc%list_bloc(ib)%vb(4) c4=calc%list_bloc(ib)%vb(8) coef=x1*x2*(y1-y2)*(y3-y4)-x1*x3*(y1-y3)*(y2-y4)+x1*x4*(y1-y4)*(y2-y3)+ & x2*x3*(y1-y4)*(y2-y3)-x2*x4*(y1-y3)*(y2-y4)+x3*x4*(y1-y2)*(y3-y4) a(1,1) = -x2*x3*y2*y4 + x2*x3*y3*y4 + x2*x4*y2*y3 - x2*x4*y3*y4 - x3*x4*y2*y3 + x3*x4*y2*y4 a(1,2) = x1*x3*y1*y4 - x1*x3*y3*y4 - x1*x4*y1*y3 + x1*x4*y3*y4 + x3*x4*y1*y3 - x3*x4*y1*y4 a(1,3) = -x1*x2*y1*y4 + x1*x2*y2*y4 + x1*x4*y1*y2 - x1*x4*y2*y4 - x2*x4*y1*y2 + x2*x4*y1*y4 a(1,4) = x1*x2*y1*y3 - x1*x2*y2*y3 - x1*x3*y1*y2 + x1*x3*y2*y3 + x2*x3*y1*y2 - x2*x3*y1*y3 a(2,1) = -x2*y2*y3 + x2*y2*y4 + x3*y2*y3 - x3*y3*y4 - x4*y2*y4 + x4*y3*y4 a(2,2) = x1*y1*y3 - x1*y1*y4 - x3*y1*y3 + x3*y3*y4 + x4*y1*y4 - x4*y3*y4 a(2,3) = -x1*y1*y2 + x1*y1*y4 + x2*y1*y2 - x2*y2*y4 - x4*y1*y4 + x4*y2*y4 a(2,4) = x1*y1*y2 - x1*y1*y3 - x2*y1*y2 + x2*y2*y3 + x3*y1*y3 - x3*y2*y3 a(3,1) = x2*x3*y2 - x2*x3*y3 - x2*x4*y2 + x2*x4*y4 + x3*x4*y3 - x3*x4*y4 a(3,2) = -x1*x3*y1 + x1*x3*y3 + x1*x4*y1 - x1*x4*y4 - x3*x4*y3 + x3*x4*y4 a(3,3) = x1*x2*y1 - x1*x2*y2 - x1*x4*y1 + x1*x4*y4 + x2*x4*y2 - x2*x4*y4 a(3,4) = -x1*x2*y1 + x1*x2*y2 + x1*x3*y1 - x1*x3*y3 - x2*x3*y2 + x2*x3*y3 a(4,1) = x2*y3 - x2*y4 - x3*y2 + x3*y4 + x4*y2 - x4*y3 a(4,2) = -x1*y3 + x1*y4 + x3*y1 - x3*y4 - x4*y1 + x4*y3 a(4,3) = x1*y2 - x1*y4 - x2*y1 + x2*y4 + x4*y1 - x4*y2 a(4,4) = -x1*y2 + x1*y3 + x2*y1 - x2*y3 - x3*y1 + x3*y2 a=a/coef !write(*,'(4e12.5)')coef !write(*,'(4e12.5)')transpose(a) do i=1,calc%list_bloc(ib)%nb_cell x=calc%msh%list_cell(calc%list_bloc(ib)%first_cell+i)%center%x y=calc%msh%list_cell(calc%list_bloc(ib)%first_cell+i)%center%y z= a(1,1)*z1+a(1,2)*z2+a(1,3)*z3+a(1,4)*z4 + & (a(2,1)*z1+a(2,2)*z2+a(2,3)*z3+a(2,4)*z4)*x + & (a(3,1)*z1+a(3,2)*z2+a(3,3)*z3+a(3,4)*z4)*y + & (a(4,1)*z1+a(4,2)*z2+a(4,3)*z3+a(4,4)*z4)*x*y c= a(1,1)*c1+a(1,2)*c2+a(1,3)*c3+a(1,4)*c4 + & (a(2,1)*c1+a(2,2)*c2+a(2,3)*c3+a(2,4)*c4)*x + & (a(3,1)*c1+a(3,2)*c2+a(3,3)*c3+a(3,4)*c4)*y + & (a(4,1)*c1+a(4,2)*c2+a(4,3)*c3+a(4,4)*c4)*x*y calc%msh%list_cell(calc%list_bloc(ib)%first_cell+i)%w%vprim%v(5)=z calc%msh%list_cell(calc%list_bloc(ib)%first_cell+i)%w%vprim%v(6)=c !write(*,'(10e13.5)')x,x1,x2,x3,x4,z,z1,z2,z3,z4 !write(*,'(10e13.5)')x1,y1,z1 !write(*,'(10e13.5)')x2,y2,z2 !write(*,'(10e13.5)')x3,y3,z3 !write(*,'(10e13.5)')x4,y4,z4 !write(*,*)'------------------------------' !write(*,'(10e13.5)')x,y,z !write(*,*)'------------------------------' enddo END DO !=========================== FIN DE LA ROUTINE ==================== END SUBROUTINE calc_bathy