Philippe 07/03/2019: IO bugfix: io_set_mnhversion must be called by all the processes
[MNH-git_open_source-lfs.git] / src / SURFEX / test_record_len.F90
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !SFX_LIC for details. version 1.
5 !#################################################
6 SUBROUTINE TEST_RECORD_LEN (HPROGRAM,HREC,HSELECT,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 !
17 USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
18 USE MODD_XIOS, ONLY : LXIOS, LXIOS_DEF_CLOSED
19 #ifdef WXIOS
20 USE XIOS, ONLY      : XIOS_IS_VALID_FIELD, XIOS_FIELD_IS_ACTIVE
21 #endif
22 !
23 USE MODD_WRITE_SURF_ATM, ONLY : LFIRST_WRITE, LNOWRITE, NCPT_WRITE
24 !
25 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
26 USE PARKIND1  ,ONLY : JPRB
27 !
28 USE MODI_ABOR1_SFX
29 !
30 IMPLICIT NONE
31 !
32  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM ! calling program
33  CHARACTER(LEN=LEN_HREC),  INTENT(IN)  :: HREC     ! name of the article to be written
34  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
35 LOGICAL,            INTENT(OUT) :: ONOWRITE ! flag for article to be written
36 !
37  CHARACTER(LEN=LEN_HREC) :: YREC
38 INTEGER :: IFIELD,JFIELD
39 INTEGER :: ILUOUT  ! listing logical unit
40 REAL(KIND=JPRB) :: ZHOOK_HANDLE
41 !-------------------------------------------------------------------------------
42 IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',0,ZHOOK_HANDLE)
43 !
44 IF (TRIM(HREC)=="time".OR.TRIM(HREC)=="longitude".OR.TRIM(HREC)=="latitude") THEN
45   ONOWRITE = .FALSE.
46   IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',1,ZHOOK_HANDLE)
47   RETURN
48 ENDIF
49 !
50 NCPT_WRITE = NCPT_WRITE + 1
51 !
52 IF (LFIRST_WRITE) THEN
53   !
54 #ifdef WXIOS
55   IF (LXIOS .AND. (TRIM(HPROGRAM)=='XIOS' )) THEN
56     !
57     IF (LXIOS_DEF_CLOSED) THEN 
58       IF (XIOS_IS_VALID_FIELD(HREC)) THEN
59         ONOWRITE = .NOT.XIOS_FIELD_IS_ACTIVE(HREC)
60       ELSE
61         ONOWRITE = .TRUE.
62       ENDIF
63     ELSE
64       ONOWRITE = .FALSE.
65     ENDIF
66     !
67     IF (ONOWRITE) THEN
68       LNOWRITE(NCPT_WRITE) = ONOWRITE
69       IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',1,ZHOOK_HANDLE)
70       RETURN
71     ENDIF
72     !
73   ENDIF
74 #endif
75   !
76   IF (LEN_TRIM(HREC)>LEN_HREC) THEN
77     CALL GET_LUOUT(HPROGRAM,ILUOUT)
78     WRITE(ILUOUT,*) '----------------------------------------------'
79     WRITE(ILUOUT,*) 'Error occured when writing a field            '
80     WRITE(ILUOUT,*) 'The name of the field is too long             '
81     WRITE(ILUOUT,*) 'The name must not be longer than',LEN_HREC,' characters'
82     WRITE(ILUOUT,*) 'Please shorten the name of your field         '
83     WRITE(ILUOUT,FMT='(A32,A12,A1)') ' The field name currently is : "',HREC,'"'
84     WRITE(ILUOUT,*) '----------------------------------------------'
85     CALL ABOR1_SFX('TEST_RECORD_LEN: FIELD NAME TOO LONG --> '//HREC)
86   END IF
87   !
88   YREC = HREC
89   SELECT CASE(HREC(1:4))
90     CASE("TEB1","TEB2","TEB3","TEB4","TEB5","TEB6","TEB7","TEB8","TEB9")
91       YREC=HREC(6:LEN(HREC))
92   END SELECT
93   !
94   ! if output fields selection is active, test if this field is to be written
95   IF (SIZE(HSELECT)>0)  THEN
96      IFIELD=COUNT(HSELECT /= '            ')
97      ONOWRITE=.TRUE.
98      DO JFIELD=1,IFIELD
99         IF ( TRIM(HSELECT(JFIELD))==TRIM(YREC) ) THEN
100           ONOWRITE=.FALSE.
101         ENDIF
102      ENDDO
103      !special case for netcdf output
104      IF(TRIM(YREC)=='time')ONOWRITE=.FALSE.
105   ELSE
106      ONOWRITE=.FALSE.
107   ENDIF
108   !
109   LNOWRITE(NCPT_WRITE) = ONOWRITE
110   !
111 ELSE
112   !
113   ONOWRITE = LNOWRITE(NCPT_WRITE)
114   !
115 ENDIF
116 !
117 IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',1,ZHOOK_HANDLE)
118 !
119 !-------------------------------------------------------------------------------
120 END SUBROUTINE TEST_RECORD_LEN