source: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_write_field.f90 @ 5159

module lmdz_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 lmdz_strings, 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 lmdz_write_field