TABLE OF CONTENTS
- 1. UTI/proddl
UTI/proddl [ Modules ]
NOM
proddl(w,bli,blo,co,ndim)
DESCRIPTION
Initialise les ddls d un bloc du calcul co a partir des ddls du bloc du calcul ci
les maillages des calculs sont eventuellement (de)raffine par 2.
Initialise the dof of a co calculation block from the dof of the ci calculation block
calculation meshes are eventually refined or coarsen
ENTREES / INPUT
w variable primitives du bloc initial / primitive variable of the initial block
bli objet bloc initial / initial block object
blo objet bloc final / final block object
ndim dimension du maillage 1,2 ou3 / mesh dimension 1,2 or 3
SORTIES / OUTPUT
co objet calcul de sortie (out) / output calcul 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(bloc), intent(in) :: bli,blo !! Bloc initial et final / Initial and final block type(list_vec), intent(inout) :: w !! Variables primitives du bloc initial / Primitive variables of the initial block integer,intent(in) :: ndim !! dimension du probleme / Problem dimension type(calcul), intent(inout) :: co !! Objet calcul modifie / Modified calcul object integer :: i,j,k,nxi,nyi,nzi,nxo,nyo,nzo,nci,nco,ici,ico,ierr !=========================== DEBUT DU CODE EXECUTABLE ================== nxi=1;nyi=1;nzi=1;nxo=1;nyo=1;nzo=1 SELECT CASE (ndim) CASE (1) ! Cas 1D nxi=bli%nx*2**(bli%nrb) nyi=1 nzi=1 nxo=blo%nx*2**(blo%nrb) nyo=1 nzo=1 CASE (2) ! Cas 2D nxi=bli%nx*2**(bli%nrb) nyi=bli%ny*2**(bli%nrb) nzi=1 nxo=blo%nx*2**(blo%nrb) nyo=blo%ny*2**(blo%nrb) nzo=1 CASE (3) ! Cas 3D nxi=bli%nx*2**(bli%nrb) nyi=bli%ny*2**(bli%nrb) nzi=bli%nz*2**(bli%nrb) nxo=blo%nx*2**(blo%nrb) nyo=blo%ny*2**(blo%nrb) nzo=blo%nz*2**(blo%nrb) END SELECT nci=nxi*nyi*nzi nco=nxo*nyo*nzo ierr=0 DO i=1,nco co%msh%list_cell(i+blo%first_cell)%w%chi =0.d0 co%msh%list_cell(i+blo%first_cell)%w%vprim%v=0.d0 co%msh%list_cell(i+blo%first_cell)%w%vbal%v =0.d0 co%msh%list_cell(i+blo%first_cell)%w%gprim(1)%v=0.d0 co%msh%list_cell(i+blo%first_cell)%w%gprim(2)%v=0.d0 co%msh%list_cell(i+blo%first_cell)%w%gprim(3)%v=0.d0 END DO !====================================================================== ! projection des ddl dans le bloc !====================================================================== IF (nci.eq.nco) THEN ! le maillage interieur est identique ierr=1 DO i=1,nco co%msh%list_cell(i+blo%first_cell)%w%vprim%v= w%vec(i)%v if(imodel_phy.eq.1.and. ngrad_bathy.eq.0)then ! on recupere le gradient de bathy si besoin SELECT CASE (ibathy) CASE(0) CASE(1) ! Initialisation de la bathymetrie par fonction utilisateur CALL fct_bathy(co%msh%list_cell(i+blo%first_cell)%center%x, & co%msh%list_cell(i+blo%first_cell)%center%y, & co%msh%list_cell(i+blo%first_cell)%center%z, & co%msh%list_cell(i+blo%first_cell)%w%vprim%v(5), & co%msh%list_cell(i+blo%first_cell)%w%gprim(1)%v(5),& co%msh%list_cell(i+blo%first_cell)%w%gprim(2)%v(5), & co%msh%list_cell(i+blo%first_cell)%w%vprim%v(6)) !~CASE (2) ! Initialisation de la bathymetrie par interpolation lineaire par bloc !~CASE (3) ! Initialisation de la bathymetrie par bloc sur le raffinement max CASE DEFAULT call print_err('proddl','Unforeseen case') END SELECT endif END DO END IF !---------------------- IF (nci.eq.(nco*(2**ndim)))then ! le maillage est plus grossier ierr=1 if(imodel_phy.eq.1)then !methode qui conserve eta et pas h !! do i=1,nxi do j=1,nyi do k=1,nzi ici=i+(j-1)*nxi+(k-1)*nxi*nyi ico=int((i+1)/2)+(int((j+1)/2)-1)*nxo+(int((k+1)/2)-1)*nxo*nyo+blo%first_cell !changement de repere h=eta if(w%vec(ici)%v(1)>hzero_phy)then w%vec(ici)%v(1)=w%vec(ici)%v(1)+w%vec(ici)%v(5) else w%vec(ici)%v(1:3)=0.d0 endif co%msh%list_cell(ico)%w%vprim%v=co%msh%list_cell(ico)%w%vprim%v+w%vec(ici)%v enddo enddo enddo do i=1,nxo*nyo*nzo co%msh%list_cell(i+blo%first_cell)%w%vprim%v=co%msh%list_cell(i+blo%first_cell)%w%vprim%v/(2.d0**ndim) !changement de repere h=h ! on met a jour la bathymetrie SELECT CASE (ibathy) CASE(0) CASE(1) ! Initialisation de la bathymetrie par fonction utilisateur CALL fct_bathy(co%msh%list_cell(i+blo%first_cell)%center%x, & co%msh%list_cell(i+blo%first_cell)%center%y, & co%msh%list_cell(i+blo%first_cell)%center%z, & co%msh%list_cell(i+blo%first_cell)%w%vprim%v(5), & co%msh%list_cell(i+blo%first_cell)%w%gprim(1)%v(5),& co%msh%list_cell(i+blo%first_cell)%w%gprim(2)%v(5), & co%msh%list_cell(i+blo%first_cell)%w%vprim%v(6)) !~CASE (2) ! Initialisation de la bathymetrie par interpolation lineaire par bloc !~CASE (3) ! Initialisation de la bathymetrie par bloc sur le raffinement max CASE DEFAULT call print_err('proddl','Unforeseen case') END SELECT co%msh%list_cell(i+blo%first_cell)%w%vprim%v(1)=max(0.d0,& co%msh%list_cell(i+blo%first_cell)%w%vprim%v(1)-co%msh%list_cell(i+blo%first_cell)%w%vprim%v(5)) call prim2bal(co%msh%list_cell(i+blo%first_cell)%w) enddo else DO i=1,nxi DO j=1,nyi DO k=1,nzi ici=i+(j-1)*nxi+(k-1)*nxi*nyi ico=int((i+1)/2)+(int((j+1)/2)-1)*nxo+(int((k+1)/2)-1)*nxo*nyo+blo%first_cell co%msh%list_cell(ico)%w%vprim%v=co%msh%list_cell(ico)%w%vprim%v+w%vec(ici)%v END DO END DO END DO DO i=1,nxo*nyo*nzo co%msh%list_cell(i+blo%first_cell)%w%vprim%v=co%msh%list_cell(i+blo%first_cell)%w%vprim%v/(2.d0**ndim) CALL prim2bal(co%msh%list_cell(i+blo%first_cell)%w) END DO endif END IF !---------------------- IF (nci.eq.(nco/(2**ndim))) THEN ! le maillage est plus fin ierr=1 if(imodel_phy.eq.1)then !methode qui conserve eta et pas h !! DO i=1,nxo DO j=1,nyo DO k=1,nzo ico=i+(j-1)*nxo+(k-1)*nxo*nyo+blo%first_cell ici=int((i+1)/2)+(int((j+1)/2)-1)*nxi+(int((k+1)/2)-1)*nxi*nyi co%msh%list_cell(ico)%w%vprim%v=w%vec(ici)%v ! on met a jour la bathymetrie SELECT CASE (ibathy) CASE(0) CASE(1) ! Initialisation de la bathymetrie par fonction utilisateur CALL fct_bathy(co%msh%list_cell(ico)%center%x, & co%msh%list_cell(ico)%center%y, & co%msh%list_cell(ico)%center%z, & co%msh%list_cell(ico)%w%vprim%v(5), & co%msh%list_cell(ico)%w%gprim(1)%v(5),& co%msh%list_cell(ico)%w%gprim(2)%v(5), & co%msh%list_cell(ico)%w%vprim%v(6)) !~CASE (2) ! Initialisation de la bathymetrie par interpolation lineaire par bloc !~CASE (3) ! Initialisation de la bathymetrie par bloc sur le raffinement max CASE DEFAULT call print_err('proddl','Unforeseen case') END SELECT co%msh%list_cell(ico)%w%vprim%v(1)=max(0.d0,w%vec(ici)%v(1)+& w%vec(ici)%v(5)-co%msh%list_cell(ico)%w%vprim%v(5)) END DO END DO END DO else DO i=1,nxo DO j=1,nyo DO k=1,nzo ico=i+(j-1)*nxo+(k-1)*nxo*nyo+blo%first_cell ici=int((i+1)/2)+(int((j+1)/2)-1)*nxi+(int((k+1)/2)-1)*nxi*nyi co%msh%list_cell(ico)%w%vprim%v=w%vec(ici)%v END DO END DO END DO endif END IF !---------------------- IF (ierr.eq.0) THEN ! Impossible write(*,*)nci,nco call print_err('proddl',' ERROR : Incompatible cell numbers') END IF !=========================== FIN DE LA ROUTINE ==================== END SUBROUTINE proddl