1d6e5dfc60642e0c5f43bc18666d9ee15cd48529
[MNH-git_open_source-lfs.git] / 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