TABLE OF CONTENTS
NUM/save_calc [ Modules ]
NOM
save_calc (calc)
DESCRIPTION
Sauvegarde binaire du domaine en cours
Binary backup of the current domain
!
ENTREES / INPUT
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_typ IMPLICIT NONE #ifdef _MPI include 'mpif.h' #endif !.2----- Declaration type(calcul),intent(in) :: calc!! Objet calcul / Calcul object character :: fsol*11,cn*10 integer :: i,ic,id,iu,jc,jd,ju,is,ios character(len=256) :: iomsg !=========================== DEBUT DU CODE EXECUTABLE ================== cn='0123456789' ic=int(calc%msh%numdom/100.) id=int((calc%msh%numdom-ic*100.)/10.) iu=calc%msh%numdom-id*10-ic*100 jc=int(calc%ipas/100.) jd=int((calc%ipas-jc*100.)/10.) ju=calc%ipas-jd*10-jc*100 IF (calc%msh%numdom.gt.999)then call print_err('save_calc','Domain index > 999 is not supported') stop end if 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,form='unformatted',iostat=ios,iomsg=iomsg) if (ios /= 0) call print_err('save_calc','Cannot open '//trim(fsol)//' : '//trim(iomsg)) rewind(11) write(11,iostat=ios,iomsg=iomsg) calc%nb_bloc,calc%nbds if (ios /= 0) call print_err('save_calc','Error writing header (nb_bloc,nbds): '//trim(iomsg)) ! Ecriture des parametres numeriques write(11,iostat=ios,iomsg=iomsg) nvar if (ios /= 0) call print_err('save_calc','Error writing nvar: '//trim(iomsg)) write(11,iostat=ios,iomsg=iomsg) calc%tmax,2*calc%tmax-calc%tmin, calc%cfl if (ios /= 0) call print_err('save_calc','Error writing time/cfl: '//trim(iomsg)) write(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('save_calc','Error writing numerics: '//trim(iomsg)) write(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('save_calc','Error writing mesh dimensions: '//trim(iomsg)) write(11,iostat=ios,iomsg=iomsg) calc%msh%small, calc%msh%big if (ios /= 0) call print_err('save_calc','Error writing mesh scales: '//trim(iomsg)) write(11,iostat=ios,iomsg=iomsg) calc%pdtp,calc%nb_sondes ,calc%point_sondes, calc%num_point_min if (ios /= 0) call print_err('save_calc','Error writing probes: '//trim(iomsg)) ! ecriture des parametres physiques write(11,iostat=ios,iomsg=iomsg) gpes_phy,imodel_phy,pes_xyz if (ios /= 0) call print_err('save_calc','Error writing physical params #1: '//trim(iomsg)) !diphasique write(11,iostat=ios,iomsg=iomsg) rho0A_phy,c_phy, rho0W_phy, p0_phy, sharp_phy if (ios /= 0) call print_err('save_calc','Error writing physical params #2: '//trim(iomsg)) !SV write(11,iostat=ios,iomsg=iomsg) hzero_phy,ibathy,num_bathy,ngrad_bathy,ifrict if (ios /= 0) call print_err('save_calc','Error writing physical params #3: '//trim(iomsg)) write(11,iostat=ios,iomsg=iomsg) fich_bathy if (ios /= 0) call print_err('save_calc','Error writing bathy filename: '//trim(iomsg)) ! Ecriture des sommets, des faces, des cellules if(calc%msh%nb_vertex.ne.0) then write(11,iostat=ios,iomsg=iomsg) calc%msh%list_vertex if (ios /= 0) call print_err('save_calc','Error writing vertices: '//trim(iomsg)) end if if(calc%msh%nb_face.ne.0) then write(11,iostat=ios,iomsg=iomsg) calc%msh%list_face if (ios /= 0) call print_err('save_calc','Error writing faces: '//trim(iomsg)) end if if(calc%msh%nb_cell.ne.0) then write(11,iostat=ios,iomsg=iomsg) calc%msh%list_cell if (ios /= 0) call print_err('save_calc','Error writing cells: '//trim(iomsg)) end if ! ecriture des conditions aux limites imposees write(11,iostat=ios,iomsg=iomsg) phy_state if (ios /= 0) call print_err('save_calc','Error writing boundary states: '//trim(iomsg)) ! ecriture des blocs write(11,iostat=ios,iomsg=iomsg) calc%nrma if (ios /= 0) call print_err('save_calc','Error writing nrma: '//trim(iomsg)) write(11,iostat=ios,iomsg=iomsg) calc%vcde,calc%vcra if (ios /= 0) call print_err('save_calc','Error writing vcde/vcra: '//trim(iomsg)) IF (calc%nb_bloc.ne.0) then write(11,iostat=ios,iomsg=iomsg) calc%list_bloc if (ios /= 0) call print_err('save_calc','Error writing block list: '//trim(iomsg)) end if write(11,iostat=ios,iomsg=iomsg) calc%nb_sol ! Nombre de solides <5 if (ios /= 0) call print_err('save_calc','Error writing number of solids: '//trim(iomsg)) ! ecriture des solides !IF (calc%nb_sol .NE. 0 .AND. iu.NE.0) THEN IF (calc%nb_sol .NE. 0 ) THEN DO i=1,calc%nb_sol !Identifiant du solide, Nbre de sommets, facettes, Nbre de cellules write(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('save_calc','Error writing solid header: '//trim(iomsg)) ! Bounding Box du solide et rho write(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('save_calc','Error writing solid bounds/rho: '//trim(iomsg)) ! Postion du centre de gravite du solide, angle de rotation par rapport au referentiel global write(11,iostat=ios,iomsg=iomsg) calc%list_sol(i)%xg,calc%list_sol(i)%theta if (ios /= 0) call print_err('save_calc','Error writing solid state: '//trim(iomsg)) ! Liste des facettes constituant l enveloppe du solide write(11,iostat=ios,iomsg=iomsg) calc%list_sol(i)%list_facette if (ios /= 0) call print_err('save_calc','Error writing solid facets: '//trim(iomsg)) ! Liste des vertex sur l enveloppe du solide write(11,iostat=ios,iomsg=iomsg) calc%list_sol(i)%list_vertex if (ios /= 0) call print_err('save_calc','Error writing solid vertices: '//trim(iomsg)) ! Nbre de cellules contenues dans le solide !IF (calc%list_sol(i)%nb_cell.ne.0) write(11) calc%list_sol(i)%list_cells write(16,1000) calc%msh%numdom,calc%list_sol(i)%id, calc%list_sol(i)%nb_vert,& calc%list_sol(i)%nb_face,calc%list_sol(i)%nb_cell 1000 format(' Domaine:',i7,/, & ' Solide :',i7,/,& ' nb vert:',i7,/,& ' nb face:',i7,/,& ' nb cell:',i7,/) END DO END IF ! Ecriture de la liste des cellules a echanger/recevoir DO i=1,calc%msh%nb_dom is=0 IF (associated(calc%msh%list_send(i)%L)) THEN is=size(calc%msh%list_send(i)%L) END IF write(11,iostat=ios,iomsg=iomsg) is if (ios /= 0) call print_err('save_calc','Error writing send size: '//trim(iomsg)) IF (is.ne.0) then write(11,iostat=ios,iomsg=iomsg) calc%msh%list_send(i)%L if (ios /= 0) call print_err('save_calc','Error writing send list: '//trim(iomsg)) end if END DO DO i=1,calc%msh%nb_dom is=0 IF (associated(calc%msh%list_recv(i)%L)) THEN is=size(calc%msh%list_recv(i)%L) END IF write(11,iostat=ios,iomsg=iomsg) is if (ios /= 0) call print_err('save_calc','Error writing recv size: '//trim(iomsg)) IF (is.ne.0) then write(11,iostat=ios,iomsg=iomsg) calc%msh%list_recv(i)%L if (ios /= 0) call print_err('save_calc','Error writing recv list: '//trim(iomsg)) end if END DO close(11) !=========================== FIN DE LA ROUTINE ==================== END SUBROUTINE save_calc