source: LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90 @ 5113

module write_field
  USE netcdf, ONLY: nf90_sync, nf90_put_var, nf90_enddef, nf90_def_dim, nf90_unlimited, &
          nf90_clobber, nf90_create, nf90_def_var
  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
  USE strings_mod, ONLY: int2str

  IMPLICIT NONE; PRIVATE
  PUBLIC WriteField

  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
    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 = nf90_put_var(FieldId(Index), FieldVarId(Index), Field, start, count)
    status = nf90_sync(FieldId(Index))

  end subroutine WriteField_gen

  subroutine CreateNewField(name, dimx, dimy, dimz)
    IMPLICIT NONE
    character(len = *) :: name
    integer :: dimx, dimy, dimz
    integer :: TabDim(4)
    integer :: status

    NbField = NbField + 1
    FieldName(NbField) = TRIM(ADJUSTL(name))
    FieldIndex(NbField) = 1

    status = nf90_create(TRIM(ADJUSTL(name)) // '.nc', nf90_clobber, FieldId(NbField))
    status = nf90_def_dim(FieldId(NbField), 'X', dimx, TabDim(1))
    status = nf90_def_dim(FieldId(NbField), 'Y', dimy, TabDim(2))
    status = nf90_def_dim(FieldId(NbField), 'Z', dimz, TabDim(3))
    status = nf90_def_dim(FieldId(NbField), 'iter', nf90_unlimited, TabDim(4))
    status = nf90_def_var(FieldId(NbField), FieldName(NbField), nf90_format, TabDim, FieldVarId(NbField))
    status = nf90_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épend 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

end module write_field