TABLE OF CONTENTS
- 1. NUM/get_calc
NUM/get_calc [ Modules ]
NOM
get_calc (calc)
DESCRIPTION
Recuperation binaire du domaine en cours
Binary recovery of the current domain
ENTREES / INPUT
calc : objet calcul / calcul object
SORTIES / OUTPUT
calc : objet calcul / 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_typ IMPLICIT NONE !.2----- Declaration type(calcul),intent(inout) :: calc !! Objet calcul / Calcul object character :: fsol*11,cn*10 integer :: i,ic,id,iu,is,ios character(len=256) :: iomsg !type(param_ini_s) :: param !=========================== DEBUT DU CODE EXECUTABLE ================== ! !------- Initialisations ! cn='0123456789' ic=int(calc%msh%numdom/100.) id=int((calc%msh%numdom-ic*100.)/10.) iu=calc%msh%numdom-id*10-ic*100 if (calc%msh%numdom.gt.999) call print_err('get_calc','Domain index > 999 is not supported') fsol( 1: 7)='cerfbin' fsol( 8: 8)='_' fsol( 9: 9)=cn(ic+1:ic+1) fsol(10:10)=cn(id+1:id+1) fsol(11:11)=cn(iu+1:iu+1) open(11,file=fsol,status='old',form='unformatted',iostat=ios,iomsg=iomsg) if (ios /= 0) call print_err('get_calc','Cannot open '//trim(fsol)//' : '//trim(iomsg)) !write(*,*)'Reading File ',fsol read(11,iostat=ios,iomsg=iomsg) calc%nb_bloc,calc%nbds if (ios /= 0) call print_err('get_calc','Error reading header (nb_bloc,nbds): '//trim(iomsg)) ! Lecture des parametres numeriques read(11,iostat=ios,iomsg=iomsg) nvar if (ios /= 0) call print_err('get_calc','Error reading nvar: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) calc%tmin, calc%tmax, calc%cfl if (ios /= 0) call print_err('get_calc','Error reading time/cfl: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) calc%isauv, calc%istart, calc%ipas, & calc%ityp_flux, calc%iordre_t, calc%iordre_e, calc%imeth_int_temps, calc%ilimiteur if (ios /= 0) call print_err('get_calc','Error reading numerics: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) calc%msh%numdom, calc%msh%nb_cell, & calc%msh%nb_face, calc%msh%nb_dom, calc%msh%nb_vertex, calc%msh%ndim, & calc%msh%nb_level_face,calc%msh%nb_level_cell if (ios /= 0) call print_err('get_calc','Error reading mesh dimensions: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) calc%msh%small, calc%msh%big if (ios /= 0) call print_err('get_calc','Error reading mesh scales: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) calc%pdtp, calc%nb_sondes, calc%point_sondes, calc%num_point_min if (ios /= 0) call print_err('get_calc','Error reading probes: '//trim(iomsg)) ! Lecture des parametres physiques read(11,iostat=ios,iomsg=iomsg) gpes_phy , imodel_phy,pes_xyz if (ios /= 0) call print_err('get_calc','Error reading physical params #1: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) rho0A_phy,c_phy, rho0W_phy, p0_phy, sharp_phy if (ios /= 0) call print_err('get_calc','Error reading physical params #2: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) hzero_phy,ibathy,num_bathy,ngrad_bathy,ifrict if (ios /= 0) call print_err('get_calc','Error reading physical params #3: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) fich_bathy if (ios /= 0) call print_err('get_calc','Error reading bathy filename: '//trim(iomsg)) ! ! Lecture des sommets, des faces, des cellules if(calc%msh%nb_vertex.ne.0)allocate(calc%msh%list_vertex(calc%msh%nb_vertex)) if(calc%msh%nb_face.ne.0) allocate(calc%msh%list_face(calc%msh%nb_face)) if(calc%msh%nb_cell.ne.0) allocate(calc%msh%list_cell(calc%msh%nb_cell)) if(calc%msh%nb_vertex.ne.0) then read(11,iostat=ios,iomsg=iomsg) (calc%msh%list_vertex(i),i=1,calc%msh%nb_vertex) if (ios /= 0) call print_err('get_calc','Error reading vertices: '//trim(iomsg)) end if if(calc%msh%nb_face.ne.0) then read(11,iostat=ios,iomsg=iomsg) (calc%msh%list_face(i) ,i=1,calc%msh%nb_face) if (ios /= 0) call print_err('get_calc','Error reading faces: '//trim(iomsg)) end if if(calc%msh%nb_cell.ne.0) then read(11,iostat=ios,iomsg=iomsg) (calc%msh%list_cell(i) ,i=1,calc%msh%nb_cell) if (ios /= 0) call print_err('get_calc','Error reading cells: '//trim(iomsg)) end if !~! ! Lecture des conditions aux limites imposees read(11,iostat=ios,iomsg=iomsg) phy_state if (ios /= 0) call print_err('get_calc','Error reading boundary states: '//trim(iomsg)) ! Lecture des blocs read(11,iostat=ios,iomsg=iomsg) calc%nrma if (ios /= 0) call print_err('get_calc','Error reading nrma: '//trim(iomsg)) read(11,iostat=ios,iomsg=iomsg) calc%vcde,calc%vcra if (ios /= 0) call print_err('get_calc','Error reading vcde/vcra: '//trim(iomsg)) if(calc%nb_bloc.ne.0)allocate(calc%list_bloc(calc%nb_bloc)) if(calc%nb_bloc.ne.0) then read(11,iostat=ios,iomsg=iomsg) calc%list_bloc if (ios /= 0) call print_err('get_calc','Error reading block list: '//trim(iomsg)) end if ! Lecture des solides read(11,iostat=ios,iomsg=iomsg)calc%nb_sol ! Nombre de solides <5 if (ios /= 0) call print_err('get_calc','Error reading number of solids: '//trim(iomsg)) IF (calc%nb_sol .NE. 0 ) THEN do i=1,calc%nb_sol !Identifiant du solide, Nbre de sommets, facettes, Nbre de cellules read(11,iostat=ios,iomsg=iomsg)calc%list_sol(i)%id,calc%list_sol(i)%imv, & calc%list_sol(i)%nb_vert,calc%list_sol(i)%nb_face, calc%list_sol(i)%nb_cell if (ios /= 0) call print_err('get_calc','Error reading solid header: '//trim(iomsg)) ! Bounding Box du solide et rho read(11,iostat=ios,iomsg=iomsg) calc%list_sol(i)%xmin_s,calc%list_sol(i)%xmax_s,& calc%list_sol(i)%ymin_s,calc%list_sol(i)%ymax_s,& calc%list_sol(i)%zmin_s,calc%list_sol(i)%zmax_s,calc%list_sol(i)%rho if (ios /= 0) call print_err('get_calc','Error reading solid bounds/rho: '//trim(iomsg)) ! Postion du centre de gravite du solide, angle de rotation par rapport au referentiel global read(11,iostat=ios,iomsg=iomsg) calc%list_sol(i)%xg,calc%list_sol(i)%theta if (ios /= 0) call print_err('get_calc','Error reading solid state: '//trim(iomsg)) ! Liste des facettes constituant l enveloppe du solide allocate(calc%list_sol(i)%list_facette(calc%list_sol(i)%nb_face)) read(11,iostat=ios,iomsg=iomsg) calc%list_sol(i)%list_facette if (ios /= 0) call print_err('get_calc','Error reading solid facets: '//trim(iomsg)) ! Liste des vertex sur l enveloppe du solide allocate(calc%list_sol(i)%list_vertex(calc%list_sol(i)%nb_vert)) read(11,iostat=ios,iomsg=iomsg) calc%list_sol(i)%list_vertex if (ios /= 0) call print_err('get_calc','Error reading solid vertices: '//trim(iomsg)) ! Nbre de cellules contenues dans le solide ! if(calc%list_sol(i)%nb_cell.ne.0)allocate(calc%list_sol(i)%list_cells(calc%list_sol(i)%nb_cell)) ! if(calc%list_sol(i)%nb_cell.ne.0)read(11) calc%list_sol(i)%list_cells enddo endif ! ! Lecture de la liste des cellules a echanger/recevoir allocate(calc%msh%list_send(calc%msh%nb_dom)) do i=1,calc%msh%nb_dom nullify(calc%msh%list_send(i)%L) read(11,iostat=ios,iomsg=iomsg)is if (ios /= 0) call print_err('get_calc','Error reading send size: '//trim(iomsg)) if(is.ne.0)then allocate(calc%msh%list_send(i)%L(is)) read(11,iostat=ios,iomsg=iomsg)calc%msh%list_send(i)%L if (ios /= 0) call print_err('get_calc','Error reading send list: '//trim(iomsg)) endif end do allocate(calc%msh%list_recv(calc%msh%nb_dom)) do i=1,calc%msh%nb_dom nullify(calc%msh%list_recv(i)%L) read(11,iostat=ios,iomsg=iomsg)is if (ios /= 0) call print_err('get_calc','Error reading recv size: '//trim(iomsg)) if(is.ne.0)then allocate(calc%msh%list_recv(i)%L(is)) read(11,iostat=ios,iomsg=iomsg)calc%msh%list_recv(i)%L if (ios /= 0) call print_err('get_calc','Error reading recv list: '//trim(iomsg)) endif end do close(11) ! !=========================== FIN DE LA ROUTINE ==================== END SUBROUTINE get_calc