TABLE OF CONTENTS
- 1. UTI/cerf2tec
UTI/cerf2tec [ Modules ]
NOM
cerf2tec
DESCRIPTION
Programme permettant la lecture de fichiers binaires au format CERF puis de les transformer en un fichier au format tecplot en version multibloc Program for reading binary files in CERF format then transform them into a file in tecplot format in a multiblock version
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 uti IMPLICIT NONE !.2----- Declaration type(calcul) :: calc type(point) :: p integer :: idom,i,j,k,ii,ib,nx,ny,nz,ivar,np,i2d,icell integer :: ibloc,ifc,nb_bloc,nbdom,is,nxtot real(kind=kind(0.d0)) ,allocatable,dimension(:) :: x,y,z !=========================== DEBUT DU CODE EXECUTABLE ================== write(*,*)achar(27)//'[34m**********************************************************' write(*,*) fdate() write(*,*)'CERF 2 Tecplot format output ' write(*,*)'**********************************************************' //achar(27)//'[0m' nx=1;ny=1;nz=1;nxtot=0 ! lecture des informations necessaires a la transformation OPEN(11,file='cerfbin_000',status='old',form='unformatted') read(11) nb_bloc,nbdom CLOSE(11) ! Boucle sur les domaines et les blocs OPEN(12,file='cerfout.dat',status='unknown') !~OPEN(13,file='blocamr.dat',status='unknown') !~write(13,*)'Number of blocks',nb_bloc DO idom=1,nbdom CALL empty_mesh(calc%msh,nbdom,idom) CALL empty_sol(calc%list_sol) ! Recuperation du calcul CALL get_calc(calc) IF (idom.eq.1) THEN write(12,*)' TITLE="',calc%tmin,'"' if(imodel_phy.ne.1)then write(12,*)' VARIABLES="X","Y","Z","R","U","V","W","P","Prod"' else !Cas particulier du modele de SaintVenant write(12,*)' VARIABLES="X","Y","Z","eta","U","V","P_S","Zbottom"' endif endif if(imodel_phy.eq.1)then do i=1,calc%msh%nb_cell if(calc%msh%list_cell(i)%w%vprim%v(1)<hzero_phy)then calc%msh%list_cell(i)%w%vprim%v(1)=0.d0 else calc%msh%list_cell(i)%w%vprim%v(1)=calc%msh%list_cell(i)%w%vprim%v(1)+& calc%msh%list_cell(i)%w%vprim%v(5) endif enddo endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG SOLIDE !!!!!!!!!!!!!!!!!!! !~do i=1,calc%msh%nb_cell !~ calc%msh%list_cell(i)%w%vprim%v(4)=calc%msh%list_cell(i)%w%chi !~ enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG SOLIDE !!!!!!!!!!!!!!!!!!! DO ib=1,calc%nb_bloc !~CALL ecrit_bloc(calc%list_bloc(ib)) ibloc=calc%list_bloc(ib)%numbl SELECT CASE (calc%msh%ndim) CASE (1) ! Cas 1D nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb) ny=1 nz=1 i2d=-1 nxtot=nxtot+nx CASE (2) ! Cas 2D nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb) ny=calc%list_bloc(ib)%ny*2**(calc%list_bloc(ib)%nrb) nz=1 i2d=1 CASE (3) ! Cas 3D nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb) ny=calc%list_bloc(ib)%ny*2**(calc%list_bloc(ib)%nrb) nz=calc%list_bloc(ib)%nz*2**(calc%list_bloc(ib)%nrb) i2d=0 END SELECT write(12,1000)nx+1,ny+1,nz+1 1000 format('ZONE I=',i5,' J=',i5,' K=',i5,& ', DATAPACKING=BLOCK, VARLOCATION=([4,5,6,7,8,9]=CELLCENTERED)') ii=0 np=(nx+1)*(ny+1)*(nz+1) allocate(x(np)) allocate(y(np)) allocate(z(np)) ! construction de la liste des sommets DO i=1,nx+1 DO j=1,ny+1 DO k=1,nz+1 is=i+(nx+1)*(j-1)+(nx+1)*(ny+1)*(k-1) p=pni(calc%list_bloc(ib),i*1.d0,j*1.d0,k*1.d0,i2d) x(is)=p%x y(is)=p%y z(is)=p%z END DO END DO END DO ! Cas particulier du modele de SaintVenant if(imodel_phy.eq.1)then do i=1,nx do j=1,ny icell=calc%list_bloc(ib)%first_cell+i+(j-1)*nx z(i+(j-1)*(nx+1)) =calc%msh%list_cell(icell)%w%vprim%v(1) z(i+1+(j-1)*(nx+1))=calc%msh%list_cell(icell)%w%vprim%v(1) z(i+(j)*(nx+1)) =calc%msh%list_cell(icell)%w%vprim%v(1) z(i+1+(j)*(nx+1)) =calc%msh%list_cell(icell)%w%vprim%v(1) z(i+(j-1)*(nx+1)+(nx+1)*(ny+1)) =calc%msh%list_cell(icell)%w%vprim%v(5) z(i+1+(j-1)*(nx+1)+(nx+1)*(ny+1))=calc%msh%list_cell(icell)%w%vprim%v(5) z(i+(j)*(nx+1)+(nx+1)*(ny+1)) =calc%msh%list_cell(icell)%w%vprim%v(5) z(i+1+(j)*(nx+1)+(nx+1)*(ny+1)) =calc%msh%list_cell(icell)%w%vprim%v(5) enddo enddo endif write(12,'(10e13.5)')x write(12,'(10e13.5)')y write(12,'(10e13.5)')z deallocate(x) deallocate(y) deallocate(z) ifc=calc%list_bloc(ib)%first_cell DO ivar=1,nvar write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(ivar),ii=ifc+1,ifc+nx*ny*nz) END DO if(imodel_phy.eq.1)write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(4),ii=ifc+1,ifc+nx*ny*nz) ! production entropie if(imodel_phy.eq.1)write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(5),ii=ifc+1,ifc+nx*ny*nz) ! bathy if(imodel_phy.eq.2)write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(6),ii=ifc+1,ifc+nx*ny*nz) ! production entropie END DO END DO close(12) if(calc%msh%ndim.ne.1) return !=========================== SAUVEGARDE EN 1D SI NECESSAIRE ====================================== ! Boucle sur les domaines et les blocs OPEN(12,file='cerfout1d.dat',status='unknown') DO idom=1,nbdom CALL empty_mesh(calc%msh,nbdom,idom) CALL empty_sol(calc%list_sol) ! Recuperation du calcul CALL get_calc(calc) IF (idom.eq.1) THEN write(12,*)' TITLE="',calc%tmin,'"' if(imodel_phy.ne.1)then write(12,*)' VARIABLES="X","R","U","P"' else !Cas particulier du modele de SaintVenant write(12,*)' VARIABLES="X","h","U","eta","q","Zbottom"' endif write(12,1001)nxtot 1001 format('ZONE T="", I=',i9,' F=POINT') endif DO ib=1,calc%nb_bloc ibloc=calc%list_bloc(ib)%numbl nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb) ! Cas du modele de SaintVenant if(imodel_phy.eq.1)then do i=1,nx icell=calc%list_bloc(ib)%first_cell+i write(12,'(6e14.6)')calc%msh%list_cell(icell)%center%x, & calc%msh%list_cell(icell)%w%vprim%v(1), & calc%msh%list_cell(icell)%w%vprim%v(2), & calc%msh%list_cell(icell)%w%vprim%v(1)+calc%msh%list_cell(icell)%w%vprim%v(5), & calc%msh%list_cell(icell)%w%vprim%v(1)*calc%msh%list_cell(icell)%w%vprim%v(2), & calc%msh%list_cell(icell)%w%vprim%v(5) enddo endif if(imodel_phy.eq.2)then do i=1,nx icell=calc%list_bloc(ib)%first_cell+i write(12,'(6e14.6)')calc%msh%list_cell(icell)%center%x, & calc%msh%list_cell(icell)%w%vprim%v(1), & calc%msh%list_cell(icell)%w%vprim%v(2), & calc%msh%list_cell(icell)%w%vprim%v(5) enddo endif END DO END DO close(12) !=========================== FIN DE LA ROUTINE ==================== CONTAINS SUBROUTINE ecrit_bloc(b) use geo IMPLICIT NONE type(bloc),intent(in) :: b integer in !=========================== DEBUT DU CODE EXECUTABLE ================== write(13,'(6i10)')b%numbl, b%idom,b%nx,b%ny,b%nz,b%nrb DO in=1,8 write(13,'(3e16.8)') b%s(in)%x,b%s(in)%y,b%s(in)%z END DO write(13,'(6i10)') b%cl write(13,'(6i10)') b%nrf write(13,'(6i10)') b%dom write(13,'(6i10)') b%first_cell, b%nb_cell, b%first_face, b%nb_face, b%first_vertex, b%nb_vertex END SUBROUTINE ecrit_bloc END PROGRAM cerf2tec