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 (DGU, &
                            hprogram,hrec,onowrite)
!#################################################
!
!!
!!    MODIFICATIONS
!!    -------------
!!      B. Decharme 07/2013 write 'time' in netcdf output files
!-------------------------------------------------------------------------------
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modi_get_luout
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=12),  INTENT(IN)  :: hrec     ! name of the article to be written
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('MODI_WRITE_SURF:TEST_RECORD_LEN',0,zhook_handle)
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 (dgu%LSELECT)  THEN
   ifield=count(dgu%CSELECT /= '            ')
   onowrite=.true.
   DO jfield=1,ifield
      IF ( trim(dgu%CSELECT(jfield))==trim(yrec) ) THEN
         onowrite=.false.
      ENDIF
   ENDDO
   !special case for netcdf output
   IF(trim(yrec)=='time')onowrite=.false.
ELSE
   onowrite=.false.
ENDIF
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:TEST_RECORD_LEN',1,zhook_handle)
!
!-------------------------------------------------------------------------------
END SUBROUTINE test_record_len