test_record_len.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!#################################################
SUBROUTINE test_record_len (HPROGRAM,HREC,HSELECT,ONOWRITE)
!#################################################
!
!!
!!    MODIFICATIONS
!!    -------------
!!      B. Decharme 07/2013 write 'time' in netcdf output files
!-------------------------------------------------------------------------------
!
USE modi_get_luout
!
USE modd_surfex_mpi, ONLY : nrank,npio
USE modd_xios, ONLY : lxios, lxios_def_closed
#ifdef WXIOS
USE xios, ONLY      : xios_is_valid_field, xios_field_is_active
#endif
!
USE modd_write_surf_atm, ONLY : lfirst_write, lnowrite, ncpt_write
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
 CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM ! calling program
 CHARACTER(LEN=12),  INTENT(IN)  :: HREC     ! name of the article to be written
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
LOGICAL,            INTENT(OUT) :: ONOWRITE ! flag for article to be written
!
 CHARACTER(LEN=12) :: YREC
INTEGER :: IFIELD,JFIELD
INTEGER :: ILUOUT  ! listing logical unit
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('TEST_RECORD_LEN',0,zhook_handle)
!
IF (trim(hrec)=="time".OR.trim(hrec)=="longitude".OR.trim(hrec)=="latitude") THEN
  onowrite = .false.
  IF (lhook) CALL dr_hook('TEST_RECORD_LEN',1,zhook_handle)
  RETURN
ENDIF
!
ncpt_write = ncpt_write + 1
!
IF (lfirst_write) THEN
  !
#ifdef WXIOS
  IF (lxios .AND. (trim(hprogram)=='XIOS' )) THEN
    !
    IF (lxios_def_closed) THEN 
      IF (xios_is_valid_field(hrec)) THEN
        onowrite = .NOT.xios_field_is_active(hrec)
      ELSE
        onowrite = .true.
      ENDIF
    ELSE
      onowrite = .false.
    ENDIF
    !
    IF (onowrite) THEN
      lnowrite(ncpt_write) = onowrite
      IF (lhook) CALL dr_hook('TEST_RECORD_LEN',1,zhook_handle)
      RETURN
    ENDIF
    !
  ENDIF
#endif
  !
  IF (len_trim(hrec)>12) THEN
    CALL get_luout(hprogram,iluout)
    WRITE(iluout,*) '----------------------------------------------'
    WRITE(iluout,*) 'Error occured when writing a field            '
    WRITE(iluout,*) 'The name of the field is too long             '
    WRITE(iluout,*) 'The name must not be longer than 12 characters'
    WRITE(iluout,*) 'Please shorten the name of your field         '
    WRITE(iluout,fmt='(A32,A12,A1)') ' The field name currently is : "',hrec,'"'
    WRITE(iluout,*) '----------------------------------------------'
    CALL abor1_sfx('TEST_RECORD_LEN: FIELD NAME TOO LONG --> '//hrec)
  END IF
  !
  yrec = hrec
  SELECT CASE(hrec(1:4))
    CASE("TEB1","TEB2","TEB3","TEB4","TEB5","TEB6","TEB7","TEB8","TEB9")
      yrec=hrec(6:len(hrec))
  END SELECT
  !
  ! if output fields selection is active, test if this field is to be written
  IF (SIZE(hselect)>0)  THEN
     ifield=count(hselect /= '            ')
     onowrite=.true.
     DO jfield=1,ifield
        IF ( trim(hselect(jfield))==trim(yrec) ) THEN
          onowrite=.false.
        ENDIF
     ENDDO
     !special case for netcdf output
     IF(trim(yrec)=='time')onowrite=.false.
  ELSE
     onowrite=.false.
  ENDIF
  !
  lnowrite(ncpt_write) = onowrite
  !
ELSE
  !
  onowrite = lnowrite(ncpt_write)
  !
ENDIF
!
IF (lhook) CALL dr_hook('TEST_RECORD_LEN',1,zhook_handle)
!
!-------------------------------------------------------------------------------
END SUBROUTINE test_record_len