write_field.F90

Go to the documentation of this file.

!
! $Id: write_field.F90 2342 2015-08-19 13:21:38Z emillour $
!
module write_field
implicit none

  integer, parameter :: maxwritefield = 100
  integer, dimension(MaxWriteField),save :: fieldid
  integer, dimension(MaxWriteField),save :: fieldvarid
  integer, dimension(MaxWriteField),save :: fieldindex
  character(len=255), dimension(MaxWriteField) ::  fieldname 
   
  integer,save :: nbfield = 0
  
  interface writefield
    module procedure writefield3d,writefield2d,writefield1d
  end interface writefield
  contains
  
    function getfieldindex(name)
    implicit none
      integer          :: GetFieldindex
      character(len=*) :: name
    
      character(len=255) :: TrueName
      integer            :: i
       
      
      truename=trim(adjustl(name))
    
      getfieldindex=-1
      do i=1,nbfield
        if (truename==fieldname(i)) then
          getfieldindex=i
          exit
        endif
      enddo
    end function getfieldindex
 
    subroutine writefield3d(name,Field)
    implicit none
      character(len=*) :: name
      real, dimension(:,:,:) :: Field 
      integer, dimension(3) :: Dim
      
      dim=shape(field)
      call writefield_gen(name,field,dim(1),dim(2),dim(3))  
  
    end subroutine writefield3d
    
    subroutine writefield2d(name,Field)
    implicit none
      character(len=*) :: name
      real, dimension(:,:) :: Field 
      integer, dimension(2) :: Dim
      
      dim=shape(field)
      call writefield_gen(name,field,dim(1),dim(2),1)  
  
    end subroutine writefield2d
    
    subroutine writefield1d(name,Field)
    implicit none
      character(len=*) :: name
      real, dimension(:) :: Field 
      integer, dimension(1) :: Dim
      
      dim=shape(field)
      call writefield_gen(name,field,dim(1),1,1)  
  
    end subroutine writefield1d
        
    subroutine writefield_gen(name,Field,dimx,dimy,dimz)
    implicit none
    include 'netcdf.inc'
      character(len=*) :: name
      integer :: dimx,dimy,dimz
      real,dimension(dimx,dimy,dimz) :: Field
      integer,dimension(dimx*dimy*dimz) :: ndex
      integer :: status
      integer :: index
      integer :: start(4)
      integer :: count(4)
      
           
      index=getfieldindex(name)
      if (index==-1) then
        call createnewfield(name,dimx,dimy,dimz)
                index=getfieldindex(name)
      else
        fieldindex(index)=fieldindex(index)+1.
      endif
      
      start(1)=1
      start(2)=1
      start(3)=1
      start(4)=fieldindex(index)

      count(1)=dimx
      count(2)=dimy
      count(3)=dimz
      count(4)=1

      status = nf_put_vara_double(fieldid(index),fieldvarid(index),start,count,field)
      status = nf_sync(fieldid(index))
      
    end subroutine writefield_gen
       
    subroutine createnewfield(name,dimx,dimy,dimz)
    implicit none
    include 'netcdf.inc'  
      character(len=*) :: name
      integer :: dimx,dimy,dimz
      integer :: TabDim(4)
      integer :: status
      
      
      nbfield=nbfield+1
      fieldname(nbfield)=trim(adjustl(name))
      fieldindex(nbfield)=1
      
      
      status = nf_create(trim(adjustl(name))//'.nc', nf_clobber, fieldid(nbfield))
      status = nf_def_dim(fieldid(nbfield),'X',dimx,tabdim(1))
      status = nf_def_dim(fieldid(nbfield),'Y',dimy,tabdim(2))
      status = nf_def_dim(fieldid(nbfield),'Z',dimz,tabdim(3))
      status = nf_def_dim(fieldid(nbfield),'iter',nf_unlimited,tabdim(4))
      status = nf_def_var(fieldid(nbfield),fieldname(nbfield),nf_double,4,tabdim,fieldvarid(nbfield))
      status = nf_enddef(fieldid(nbfield))

    end subroutine createnewfield
    
    
    
  subroutine write_field1d(name,Field)
    implicit none
  
    integer, parameter :: MaxDim=1
    character(len=*)   :: name
    real, dimension(:) :: Field
    real, dimension(:),allocatable :: New_Field
    character(len=20) :: str
    integer, dimension(MaxDim) :: Dim
    integer :: i,nb
    integer, parameter :: id=10
    integer, parameter :: NbCol=4
    integer :: ColumnSize 
    integer :: pos
    character(len=255) :: form
    character(len=255) :: MaxLen
    
    
    open(unit=id,file=name//'.field',form='formatted',status='replace')
    write (id,'("----- Field '//name//'",//)')
    dim=shape(field)
    maxlen=int2str(len(trim(int2str(dim(1)))))
    columnsize=20+6+3+len(trim(int2str(dim(1))))
    nb=0
    pos=2
    do i=1,dim(1)
      nb=nb+1
      
      if (mod(nb,nbcol)==0) then
        form='(t'//trim(int2str(pos))// ',i'//trim(maxlen) //'," ---> ",g22.16,/)'
        pos=2
      else
        form='(t'//trim(int2str(pos))// ',i'//trim(maxlen) //'," ---> ",g22.16," | ",)'
        pos=pos+columnsize
      endif
      write (id,form,advance='no') i,field(i)
    enddo
     
    close(id)

  end subroutine write_field1d

  subroutine write_field2d(name,Field)
    implicit none
  
    integer, parameter :: MaxDim=2
    character(len=*)   :: name
    real, dimension(:,:) :: Field
    real, dimension(:,:),allocatable :: New_Field
    character(len=20) :: str
    integer, dimension(MaxDim) :: Dim
    integer :: i,j,nb
    integer, parameter :: id=10
    integer, parameter :: NbCol=4
    integer :: ColumnSize 
    integer :: pos,offset
    character(len=255) :: form
    character(len=255) :: spacing
    
    open(unit=id,file=name//'.field',form='formatted',status='replace')
    write (id,'("----- Field '//name//'",//)')
    
    dim=shape(field)
    offset=len(trim(int2str(dim(1))))+len(trim(int2str(dim(2))))+3
    columnsize=20+6+3+offset

    spacing='(t2,"'//repeat('-',columnsize*nbcol)//'")'
    
    do i=1,dim(2)
      nb=0
      pos=2
      do j=1,dim(1)
        nb=nb+1
      
        if (mod(nb,nbcol)==0) then
          form='(t'//trim(int2str(pos))//            &
               ',"('//trim(int2str(j))//','          &
                    //trim(int2str(i))//')",t'       & 
                    //trim(int2str(pos+offset))     &    
                    //'," ---> ",g22.16,/)'
          pos=2
        else
          form='(t'//trim(int2str(pos))//            &
               ',"('//trim(int2str(j))//','          &
                    //trim(int2str(i))//')",t'       & 
                    //trim(int2str(pos+offset))     &    
                    //'," ---> ",g22.16," | ")'
          pos=pos+columnsize
        endif
        write (id,form,advance='no') field(j,i)
      enddo
      if (mod(nb,nbcol)==0) then
        write (id,spacing)
      else
        write (id,'("")')
        write (id,spacing)
      endif
    enddo
     
  end subroutine write_field2d
  
  subroutine write_field3d(name,Field)
    implicit none
  
    integer, parameter :: MaxDim=3
    character(len=*)   :: name
    real, dimension(:,:,:) :: Field
    real, dimension(:,:,:),allocatable :: New_Field
    integer, dimension(MaxDim) :: Dim
    integer :: i,j,k,nb
    integer, parameter :: id=10
    integer, parameter :: NbCol=4
    integer :: ColumnSize 
    integer :: pos,offset
    character(len=255) :: form
    character(len=255) :: spacing

    open(unit=id,file=name//'.field',form='formatted',status='replace')
    write (id,'("----- Field '//name//'"//)')
    
    dim=shape(field)
    offset=len(trim(int2str(dim(1))))+len(trim(int2str(dim(2))))+len(trim(int2str(dim(3))))+4
    columnsize=22+6+3+offset

!    open(unit=id,file=name,form=formatted
   
    spacing='(t2,"'//repeat('-',columnsize*nbcol)//'")'
    
    do i=1,dim(3)
    
      do j=1,dim(2)
        nb=0
        pos=2
        
        do k=1,dim(1)
        nb=nb+1
      
          if (mod(nb,nbcol)==0) then
            form='(t'//trim(int2str(pos))//            &
                 ',"('//trim(int2str(k))//','          &
                      //trim(int2str(j))//','          &
                      //trim(int2str(i))//')",t'       & 
                      //trim(int2str(pos+offset))      &    
                      //'," ---> ",g22.16,/)'
           pos=2
          else
            form='(t'//trim(int2str(pos))//            &
                 ',"('//trim(int2str(k))//','          &
                      //trim(int2str(j))//','          &
                      //trim(int2str(i))//')",t'       & 
                      //trim(int2str(pos+offset))      &    
                      //'," ---> ",g22.16," | ")'
! dépent de l'implémention, sur compaq, c'est necessaire
!            Pos=Pos+ColumnSize
          endif
          write (id,form,advance='no') field(k,j,i)
        enddo
        if (mod(nb,nbcol)==0) then
          write (id,spacing)
        else
          write (id,'("")')
          write (id,spacing)
        endif
      enddo
      write (id,spacing)
    enddo
    
    close(id)
  
  end subroutine write_field3d  
  
  function int2str(int)
    implicit none
    integer, parameter :: MaxLen=10
    integer,intent(in) :: int
    character(len=MaxLen) :: int2str
    logical :: flag
    integer :: i
    flag=.true.
    
    i=int
    
    int2str=''
    do while (flag)
      int2str=char(mod(i,10)+48)//int2str
      i=i/10
      if (i==0) flag=.false.
    enddo
  end function int2str

end module write_field