source: LMDZ5/trunk/libf/misc/write_field.F90 @ 2830

!
! $Id: write_field.F90 2342 2015-08-19 13:21:38Z acozic $
!
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