save_calc.f90

### TABLE OF CONTENTS

- 1. NUM/save_calc

## NUM/save_calc [ Modules ]

[ Top ] [ 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