Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[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=LEN_HREC),  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=LEN_HREC) :: YREC
31 INTEGER :: IFIELD,JFIELD
32 INTEGER :: ILUOUT  ! listing logical unit
33 REAL(KIND=JPRB) :: ZHOOK_HANDLE
34
35 CHARACTER(LEN=LEN_HREC) :: YFMT
36
37 !-------------------------------------------------------------------------------
38 IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',0,ZHOOK_HANDLE)
39 IF (LEN_TRIM(HREC)>LEN_HREC) THEN
40   CALL GET_LUOUT(HPROGRAM,ILUOUT)
41   WRITE(ILUOUT,*) '----------------------------------------------'
42   WRITE(ILUOUT,*) 'Error occured when writing a field            '
43   WRITE(ILUOUT,*) 'The name of the field is too long             '
44   WRITE(ILUOUT,*) 'The name must not be longer than',LEN_HREC,' characters'
45   WRITE(ILUOUT,*) 'Please shorten the name of your field         '
46   WRITE(YFMT,FMT='("(A32,A",I2.2,",A1)")') LEN_HREC
47   WRITE(ILUOUT,FMT=YFMT) ' The field name currently is : "',HREC,'"'
48   WRITE(ILUOUT,*) '----------------------------------------------'
49   CALL ABOR1_SFX('TEST_RECORD_LEN: FIELD NAME TOO LONG --> '//HREC)
50 END IF
51 !
52 YREC = HREC
53 SELECT CASE(HREC(1:4))
54 CASE("TEB1","TEB2","TEB3","TEB4","TEB5","TEB6","TEB7","TEB8","TEB9")
55         YREC=HREC(6:LEN(HREC))
56 END SELECT
57 ! if output fields selection is active, test if this field is to be written
58 IF (LSELECT)  THEN
59    IFIELD=COUNT(CSELECT /= '            ')
60    ONOWRITE=.TRUE.
61    DO JFIELD=1,IFIELD
62       IF ( TRIM(CSELECT(JFIELD))==TRIM(YREC) ) THEN
63          ONOWRITE=.FALSE.
64       ENDIF
65    ENDDO
66    !special case for netcdf output
67    IF(TRIM(YREC)=='time')ONOWRITE=.FALSE.
68 ELSE
69    ONOWRITE=.FALSE.
70 ENDIF
71 IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',1,ZHOOK_HANDLE)
72 !
73 !-------------------------------------------------------------------------------
74 END SUBROUTINE TEST_RECORD_LEN