write_header.f

Go to the documentation of this file.

!                   *************************
                    SUBROUTINE write_header
!                   *************************
!
     &(fformat,nres,title,nvar,nomvar,outvar)
!
!***********************************************************************
! HERMES   V6P2                                   21/08/2010
!***********************************************************************
!
!brief    Write the header of the result file
!
!history  Y.audouin (LNHE)
!+        05/02/04
!+        V7P0
!+        Creation of the file
!
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FFORMAT        |-->| FILE FORMAT
!| NRES           |-->| LOGICAL UNIT OF FILE
!| TITLE          |-->| TITLE OF FILE
!| NVAR           |-->| TOTAL NUMBER OF VARIABLES
!| NOMVAR         |-->| NAME OF VARIABLES
!| OUTVAR         |-->| VARIABLES TO BE PUT IN THE FILE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_hermes
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      CHARACTER(LEN=8)                 , INTENT(IN) :: FFORMAT
      INTEGER                          , INTENT(IN) :: NRES
      CHARACTER(LEN=72)                , INTENT(IN) :: TITLE
      INTEGER                          , INTENT(IN) :: NVAR
      CHARACTER(LEN=32),DIMENSION(NVAR), INTENT(IN) :: NOMVAR
      LOGICAL          ,DIMENSION(NVAR), INTENT(IN) :: OUTVAR
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      CHARACTER(LEN=80) :: F_TITLE
      CHARACTER(LEN=32), ALLOCATABLE :: VAR_NAME(:)
      INTEGER F_NVAR, IERR, I
!
      ! COUTING THE REAL NUMBER OF VARIABLE
      f_nvar = 0
      DO i=1,nvar
        IF(outvar(i)) f_nvar = f_nvar + 1
      ENDDO
      ! BUILD THE ARRAY CONTAING ONLY THE OUTPUT VARIABLE
      ALLOCATE(var_name(f_nvar),stat=ierr)
      CALL check_allocate(ierr,'VAR_NAME')
      f_nvar = 0
      DO i=1,nvar
        IF(outvar(i)) THEN
          f_nvar = f_nvar + 1
          var_name(f_nvar)(1:32) = nomvar(i)(1:32)
        ENDIF
      ENDDO
!
      ! ADD THE FORMAT TO THE TITLE
      f_title = title(1:72)//fformat
      CALL set_header(fformat,nres,f_title,f_nvar,var_name,ierr)
      CALL check_call(ierr,'WRITE_HEADER:SET_HEADER')
!
      DEALLOCATE(var_name)
!
      RETURN
      END