src/SURFEX/test_record_len.F90

   1 !SURFEX_LIC Copyright 1994-2014 Meteo-France
   2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
   3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
   4 !SURFEX_LIC for details. version 1.
   5 !#################################################
   6 SUBROUTINE TEST_RECORD_LEN(HPROGRAM,HREC,ONOWRITE)
   7 !#################################################
   8 !
   9 !!
  10 !!    MODIFICATIONS
  11 !!    -------------
  12 !!      B. Decharme 07/2013 write 'time' in netcdf output files
  13 !-------------------------------------------------------------------------------
  14 !
  15 USE MODI_GET_LUOUT
  16 USE MODD_DIAG_SURF_ATM_n,  ONLY : LSELECT, CSELECT
  17 !
  18 !
  19 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  20 USE PARKIND1  ,ONLY : JPRB
  21 !
  22 USE MODI_ABOR1_SFX
  23 !
  24 IMPLICIT NONE
  25 !
  26  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM ! calling program
  27  CHARACTER(LEN=12),  INTENT(IN)  :: HREC     ! name of the article to be written
  28 LOGICAL,            INTENT(OUT) :: ONOWRITE ! flag for article to be written
  29 !
  30  CHARACTER(LEN=12) :: YREC
  31 INTEGER :: IFIELD,JFIELD
  32 INTEGER :: ILUOUT  ! listing logical unit
  33 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  34 !-------------------------------------------------------------------------------
  35 IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',0,ZHOOK_HANDLE)
  36 IF (LEN_TRIM(HREC)>12) THEN
  37   CALL GET_LUOUT(HPROGRAM,ILUOUT)
  38   WRITE(ILUOUT,*) '----------------------------------------------'
  39   WRITE(ILUOUT,*) 'Error occured when writing a field            '
  40   WRITE(ILUOUT,*) 'The name of the field is too long             '
  41   WRITE(ILUOUT,*) 'The name must not be longer than 12 characters'
  42   WRITE(ILUOUT,*) 'Please shorten the name of your field         '
  43   WRITE(ILUOUT,FMT='(A32,A12,A1)') ' The field name currently is : "',HREC,'"'
  44   WRITE(ILUOUT,*) '----------------------------------------------'
  45   CALL ABOR1_SFX('TEST_RECORD_LEN: FIELD NAME TOO LONG --> '//HREC)
  46 END IF
  47 !
  48 YREC = HREC
  49 SELECT CASE(HREC(1:4))
  50 CASE("TEB1","TEB2","TEB3","TEB4","TEB5","TEB6","TEB7","TEB8","TEB9")
  51         YREC=HREC(6:LEN(HREC))
  52 END SELECT
  53 ! if output fields selection is active, test if this field is to be written
  54 IF (LSELECT)  THEN
  55    IFIELD=COUNT(CSELECT /= '            ')
  56    ONOWRITE=.TRUE.
  57    DO JFIELD=1,IFIELD
  58       IF ( TRIM(CSELECT(JFIELD))==TRIM(YREC) ) THEN
  59          ONOWRITE=.FALSE.
  60       ENDIF
  61    ENDDO
  62    !special case for netcdf output
  63    IF(TRIM(YREC)=='time')ONOWRITE=.FALSE.
  64 ELSE
  65    ONOWRITE=.FALSE.
  66 ENDIF
  67 IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',1,ZHOOK_HANDLE)
  68 !
  69 !-------------------------------------------------------------------------------
  70 END SUBROUTINE TEST_RECORD_LEN