Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / lfi2cdf / src / fieldtype.f90
1 MODULE MODE_FIELDTYPE
2   USE MODD_PARAM
3   
4   IMPLICIT NONE 
5
6   PRIVATE
7
8   
9   TYPE field
10      CHARACTER(LEN=FM_FIELD_SIZE) :: name ! Le nom de l'article LFI
11      INTEGER                      :: TYPE ! Type :entier(INT) ou reel(FLOAT)
12      INTEGER                      :: dim  ! Dimension de l'article  
13   END TYPE field
14   
15   TYPE(field), DIMENSION(:), ALLOCATABLE :: userfield
16
17   ! Les champs contenant %TDATE et %TIME sont traites en dur
18   ! dans la routine de recherche de type
19   TYPE(field), DIMENSION(2),   PARAMETER  :: datefield = (/&
20                field('%TDA', INT, D0), &
21                field('%TIM', FLOAT, D0) &
22              /)
23
24   TYPE(field), DIMENSION(219), SAVE  :: sysfield
25
26   PUBLIC :: get_ftype, init_sysfield
27
28 CONTAINS 
29 SUBROUTINE init_sysfield()
30 sysfield(1) =  field('LBXSVMxxx', FLOAT , D0)
31 sysfield(2) =  field('LBYSVMxxx', FLOAT , D0)
32 sysfield(3) =  field('LBXUM', FLOAT, D0)
33 sysfield(4) =  field('LBYUM', FLOAT, D0)
34 sysfield(5) =  field('LBXVM', FLOAT, D0)
35 sysfield(6) =  field('LBYVM', FLOAT, D0)
36 sysfield(7) =  field('LBXWM', FLOAT, D0)
37 sysfield(8) =  field('LBYWM', FLOAT, D0)
38 sysfield(9) =  field('LBXTHM', FLOAT, D0)
39 sysfield(10) =  field('LBYTHM', FLOAT, D0)
40 sysfield(11) =  field('LBXRVM', FLOAT, D0)
41 sysfield(12) =  field('LBYRVM', FLOAT, D0)
42 sysfield(13) =  field('AVG_ZS', FLOAT, D0)
43 sysfield(14) =  field('SIL_ZS', FLOAT, D0)
44 sysfield(15) =  field('AOSIP', FLOAT, D0)
45 sysfield(16) =  field('AOSIM', FLOAT, D0)
46 sysfield(17) =  field('AOSJP', FLOAT, D0)
47 sysfield(18) =  field('AOSJM', FLOAT, D0)
48 sysfield(19) =  field('HO2IP', FLOAT, D0)
49 sysfield(20) =  field('HO2IM', FLOAT, D0)
50 sysfield(21) =  field('HO2JP', FLOAT, D0)
51 sysfield(22) =  field('HO2JM', FLOAT, D0)
52 sysfield(23) =  field('RIMX',INT, D0)
53 sysfield(24) =  field('RIMY',INT, D0)
54 sysfield(25) =  field('HORELAX_UVWTH',BOOL, D0)
55 sysfield(26) =  field('HORELAX_R',BOOL, D0)
56 sysfield(27) =  field('I2D_XY', INT, D0)
57 sysfield(28) =  field('MENU_BUDGET',TEXT, D0)
58 sysfield(29) =  field('IE', INT, D0)
59 sysfield(30) =  field('ZR', FLOAT, D0)
60 sysfield(31) =  field('GOK', BOOL, D0)
61 sysfield(32) =  field('YTEXT', TEXT, D0)
62 sysfield(33) =  field('X1D', FLOAT, D0)
63 sysfield(34) =  field('I1D', INT, D0)
64 sysfield(35) =  field('DEB', INT, D0)
65 sysfield(36) =  field('3D1', FLOAT, D0)
66 sysfield(37) =  field('3D2', FLOAT, D0)
67 sysfield(38) =  field('3D3', FLOAT, D0)
68 sysfield(39) =  field('3D4', FLOAT, D0)
69 sysfield(40) =  field('3D5', FLOAT, D0)
70 sysfield(41) =  field('RHODREFZ', FLOAT, D0)
71 sysfield(42) =  field('RSVS', FLOAT, D0)
72 sysfield(43) =  field('RUS', FLOAT, D0)
73 sysfield(44) =  field('MY_NAME', TEXT, D0)
74 sysfield(45) =  field('DAD_NAME', TEXT, D0)
75 sysfield(46) =  field('STORAGE_TYPE', TEXT, D0)
76 sysfield(47) =  field('IMAX', INT, D0)
77 sysfield(48) =  field('JMAX', INT, D0)
78 sysfield(49) =  field('KMAX', INT, D0)
79 sysfield(50) =  field('RPK', FLOAT, D0)
80 sysfield(51) =  field('NEB', FLOAT , D0)
81 sysfield(52) =  field('LONOR', FLOAT, D0)
82 sysfield(53) =  field('LATOR', FLOAT, D0)
83 sysfield(54) =  field('THINSHELL', BOOL, D0)
84 sysfield(55) =  field('LAT0', FLOAT, D0)
85 sysfield(56) =  field('LON0', FLOAT, D0)
86 sysfield(57) =  field('BETA', FLOAT, D0)
87 sysfield(58) =  field('XHAT', FLOAT, D0)
88 sysfield(59) =  field('YHAT', FLOAT, D0)
89 sysfield(60) =  field('ZHAT', FLOAT, D0)
90 sysfield(61) =  field('ZS', FLOAT, D0)
91 sysfield(62) =  field('CARTESIAN', BOOL, D0)
92 sysfield(63) =  field('UM', FLOAT, D0)
93 sysfield(64) =  field('VM', FLOAT, D0)
94 sysfield(65) =  field('WM', FLOAT, D0)
95 sysfield(66) =  field('THM', FLOAT, D0)
96 sysfield(67) =  field('TKEM', FLOAT, D0)
97 sysfield(68) =  field('EPSM', FLOAT, D0)
98 sysfield(69) =  field('PABSM',FLOAT, D0)
99 sysfield(70) =  field('RVM', FLOAT, D0)
100 sysfield(71) =  field('RCM', FLOAT, D0)
101 sysfield(72) =  field('RRM', FLOAT, D0)
102 sysfield(73) =  field('RIM', FLOAT, D0)
103 sysfield(74) =  field('RSM', FLOAT, D0)
104 sysfield(75) =  field('RGM', FLOAT, D0)
105 sysfield(76) =  field('RHM', FLOAT, D0)
106 sysfield(77) =  field('SVMxxx', FLOAT, D0)
107 sysfield(78) =  field('LSUM', FLOAT, D0)
108 sysfield(79) =  field('LSVM', FLOAT, D0)
109 sysfield(80) =  field('LSWM',FLOAT , D0)
110 sysfield(81) =  field('LSTHM',FLOAT, D0)
111 sysfield(82) =  field('LSRVM',FLOAT, D0)
112 sysfield(83) =  field('LSXTKEM',FLOAT, D0)
113 sysfield(84) =  field('LSYTKEM',FLOAT, D0)
114 sysfield(85) =  field('LSXEPSM',FLOAT, D0)
115 sysfield(86) =  field('LSYEPSM',FLOAT, D0)
116 sysfield(87) =  field('LSXRCM',FLOAT , D0)
117 sysfield(88) =  field('LSYRCM', FLOAT, D0)
118 sysfield(89) =  field('LSXRRM', FLOAT, D0)
119 sysfield(90) =  field('LSYRRM', FLOAT, D0)
120 sysfield(91) =  field('LSXRIM', FLOAT, D0)
121 sysfield(92) =  field('LSYRIM', FLOAT, D0)
122 sysfield(93) =  field('LSXRSM', FLOAT, D0)
123 sysfield(94) =  field('LSYRSM', FLOAT, D0)
124 sysfield(95) =  field('LSXRGM', FLOAT, D0)
125 sysfield(96) =  field('LSYRGM', FLOAT, D0)
126 sysfield(97) =  field('LSXRHM', FLOAT, D0)
127 sysfield(98) =  field('LSYRHM', FLOAT, D0)
128 sysfield(99) =  field('LSXSVMxxx', FLOAT, D0)
129 sysfield(100) =  field('LSYSVMxxx', FLOAT, D0)
130 sysfield(101) =  field('UT',FLOAT, D0)
131 sysfield(102) =  field('VT',FLOAT, D0)
132 sysfield(103) =  field('WT',FLOAT, D0)
133 sysfield(104) =  field('THT',FLOAT, D0)
134 sysfield(105) =  field('TKET',FLOAT, D0)
135 sysfield(106) =  field('EPST',FLOAT, D0)
136 sysfield(107) =  field('PABST',FLOAT, D0)
137 sysfield(108) =  field('RVT',FLOAT, D0)
138 sysfield(109) =  field('RCT',FLOAT, D0)
139 sysfield(110) =  field('RRT',FLOAT, D0)
140 sysfield(111) =  field('RIT',FLOAT, D0)
141 sysfield(112) =  field('CIT',FLOAT, D0)
142 sysfield(113) =  field('RST',FLOAT, D0)
143 sysfield(114) =  field('RGT',FLOAT, D0)
144 sysfield(115) =  field('RHT',FLOAT, D0)
145 sysfield(116) =  field('SVTxxx',FLOAT, D0)
146 sysfield(117) =  field('DRYMASST',FLOAT, D0)
147 sysfield(118) =  field('SRCM',FLOAT, D0)
148 sysfield(119) =  field('SRCT',FLOAT, D0)
149 sysfield(120) =  field('SIGS',FLOAT, D0)
150 sysfield(121) =  field('RHOREFZ',FLOAT, D0)
151 sysfield(122) =  field('THVREFZ',FLOAT, D0)
152 sysfield(123) =  field('EXNTOP',FLOAT, D0)
153 sysfield(124) =  field('RESA', FLOAT , D0)
154 sysfield(125) =  field('Z0SEA', FLOAT , D0)
155 sysfield(126) =  field('TS', FLOAT , D0)
156 sysfield(127) =  field('WG', FLOAT , D0)
157 sysfield(128) =  field('SST', FLOAT , D0)
158 sysfield(129) =  field('T2', FLOAT , D0)
159 sysfield(130) =  field('W2', FLOAT , D0)
160 sysfield(131) =  field('WR', FLOAT , D0)
161 sysfield(132) =  field('WS', FLOAT , D0)
162 sysfield(133) =  field('ALBS', FLOAT , D0)
163 sysfield(134) =  field('RHOS', FLOAT , D0)
164 sysfield(135) =  field('LAND', FLOAT , D0)
165 sysfield(136) =  field('SEA', FLOAT , D0)
166 sysfield(137) =  field('Z0VEG', FLOAT , D0)
167 sysfield(138) =  field('Z0HVEG', FLOAT , D0)
168 sysfield(139) =  field('Z0REL', FLOAT , D0)
169 sysfield(140) =  field('Z0EFFIP', FLOAT , D0)
170 sysfield(141) =  field('Z0EFFIM', FLOAT , D0)
171 sysfield(142) =  field('Z0EFFJP', FLOAT , D0)
172 sysfield(143) =  field('Z0EFFJM', FLOAT , D0)
173 sysfield(144) =  field('SSO_STDEV', FLOAT , D0)
174 sysfield(145) =  field('SSO_ANIS', FLOAT , D0)
175 sysfield(146) =  field('SSO_DIRECTION', FLOAT , D0)
176 sysfield(147) =  field('SSO_SLOPE', FLOAT , D0)
177 sysfield(148) =  field('ALBVIS', FLOAT , D0)
178 sysfield(149) =  field('ALBNIR', FLOAT , D0)
179 sysfield(150) =  field('EMIS', FLOAT , D0)
180 sysfield(151) =  field('CLAY', FLOAT , D0)
181 sysfield(152) =  field('SAND', FLOAT , D0)
182 sysfield(153) =  field('D2', FLOAT , D0)
183 sysfield(154) =  field('VEG', FLOAT , D0)
184 sysfield(155) =  field('LAI', FLOAT , D0)
185 sysfield(156) =  field('RSMIN', FLOAT , D0)
186 sysfield(157) =  field('GAMMA', FLOAT , D0)
187 sysfield(158) =  field('RGL', FLOAT , D0)
188 sysfield(159) =  field('CV', FLOAT , D0)
189 sysfield(160) =  field('SFTHT', FLOAT , D0)
190 sysfield(161) =  field('SFTHP', FLOAT , D0)
191 sysfield(162) =  field('SFRT', FLOAT , D0)
192 sysfield(163) =  field('SFRP', FLOAT , D0)
193 sysfield(164) =  field('SFSVT', FLOAT , D0)
194 sysfield(165) =  field('SFSVP', FLOAT , D0)
195 sysfield(166) =  field('DTHRAD', FLOAT , D0)
196 sysfield(167) =  field('SRFLWD', FLOAT , D0)
197 sysfield(168) =  field('SRFSWD', FLOAT , D0)
198 sysfield(169) =  field('CLDFR', FLOAT , D0)
199 sysfield(170) =  field('COUNTCONV', INT , D0)
200 sysfield(171) =  field('DTHCONV', FLOAT , D0)
201 sysfield(172) =  field('DRVCONV', FLOAT , D0)
202 sysfield(173) =  field('DRCCONV', FLOAT , D0)
203 sysfield(174) =  field('DRICONV', FLOAT , D0)
204 sysfield(175) =  field('PRCONV', FLOAT , D0)
205 sysfield(176) =  field('PACCONV', FLOAT , D0)
206 sysfield(177) =  field('WSUBCONV', FLOAT , D0)
207 sysfield(178) =  field('INPRR', FLOAT , D0)
208 sysfield(179) =  field('ACPRR', FLOAT , D0)
209 sysfield(180) =  field('INPRS', FLOAT , D0)
210 sysfield(181) =  field('ACPRS', FLOAT , D0)
211 sysfield(182) =  field('INPRG', FLOAT , D0)
212 sysfield(183) =  field('ACPRG', FLOAT , D0)
213 sysfield(184) =  field('INPRT', FLOAT , D0)
214 sysfield(185) =  field('ACPRT', FLOAT , D0)
215 sysfield(186) =  field('FRC', INT, D0)
216 sysfield(187) =  field('UFRCxx', FLOAT , D0)
217 sysfield(188) =  field('VFRCxx', FLOAT , D0)
218 sysfield(189) =  field('WFRCxx', FLOAT , D0)
219 sysfield(190) =  field('THFRCxx', FLOAT , D0)
220 sysfield(191) =  field('RVFRCxx', FLOAT , D0)
221 sysfield(192) =  field('GXRVFRCxx', FLOAT , D0)
222 sysfield(193) =  field('GYRVFRCxx', FLOAT , D0)
223 sysfield(194) =  field('GXTHFRCxx', FLOAT , D0)
224 sysfield(195) =  field('GYTHFRCxx', FLOAT , D0)
225 sysfield(196) =  field('DUMMY_GRxxx', FLOAT , D0)
226 sysfield(197) =  field('MASDEV', INT , D0)
227 sysfield(198) =  field('EMISFILE_GR_NBR', INT , D0)
228 sysfield(199) =  field('EMISPEC_GR_NBR', INT , D0)
229 sysfield(200) =  field('EMISNAMExxx', TEXT , D0)
230 sysfield(201) =  field('EMISTIMESxxx', INT , D0)
231 sysfield(202) =  field('DUMMY_GR_NBR', INT , D0)
232 sysfield(203) =  field('COVERxxx', FLOAT , D0)
233 sysfield(204) =  field('TGx', FLOAT, D0)
234 sysfield(205) =  field('T_ROOFx', FLOAT, D0)
235 sysfield(206) =  field('T_ROADx', FLOAT, D0)
236 sysfield(207) =  field('T_WALLx', FLOAT, D0)
237 sysfield(208) =  field('WGx', FLOAT, D0)
238 sysfield(209) =  field('WGIx', FLOAT, D0)
239 sysfield(210) =  field('MAX_ZS', FLOAT, D0)
240 sysfield(211) =  field('MIN_ZS', FLOAT, D0)
241 sysfield(212) =  field('XOR', INT, D0)
242 sysfield(213) =  field('YOR', INT, D0)
243 sysfield(214) =  field('DXRATIO', INT, D0)
244 sysfield(215) =  field('DYRATIO', INT, D0)
245 sysfield(216) =  field('PATCH_NUMBER', INT, D0)
246 sysfield(217) =  field('BUGFIX', INT, D0)
247 sysfield(218) =  field('BIBUSER', TEXT, D0)
248 sysfield(219) =  field('LFI_COMPRESSED', INT, D0)
249 END SUBROUTINE init_sysfield
250
251   FUNCTION get_ftype(hfname,level)
252     CHARACTER(LEN=*) :: hfname
253     INTEGER          :: get_ftype
254     INTEGER,INTENT(IN) :: level
255
256     TYPE(field) :: tzf
257
258     ! Is this a diachronic field ?
259     IF (INDEX(hfname,".TY",.TRUE.)     /=0 .OR.& 
260     &   INDEX(hfname,".TI",.TRUE.)  /=0 .OR.& 
261     &   INDEX(hfname,".UN",.TRUE.)  /=0 .OR.&
262     &   INDEX(hfname,".CO",.TRUE.)/=0) THEN
263       get_ftype = TEXT
264     ELSE IF (INDEX(hfname,".DI",.TRUE.) /= 0) THEN 
265       get_ftype = INT
266     ELSE IF (INDEX(hfname,".PR",.TRUE.)/= 0 .OR.&
267          &   INDEX(hfname,".TR",.TRUE.)/= 0 .OR.&
268          &   INDEX(hfname,".DA",.TRUE.)/= 0) THEN
269       get_ftype = FLOAT
270     ELSE IF (searchfield(hfname,tzf,level)) THEN
271     ! search in databases  
272       get_ftype = tzf%TYPE
273     ELSE
274       get_ftype = -1
275     END IF
276     
277   END FUNCTION get_ftype
278   
279   FUNCTION searchfield(hfname, tpf, level)
280     CHARACTER(LEN=*), INTENT(IN) :: hfname
281     TYPE(field), INTENT(OUT)     :: tpf
282     INTEGER,INTENT(IN)           :: level
283     LOGICAL                      :: searchfield
284
285     INTEGER :: ji,iposx
286     LOGICAL :: found
287     CHARACTER(LEN=4) :: clevel
288
289     found = .FALSE.
290     
291     ! First is this a date field ?
292     DO ji=1,SIZE(datefield)
293        IF (INDEX(hfname,TRIM(datefield(ji)%name)) /= 0) THEN 
294           found = .TRUE.
295           tpf = datefield(ji)
296           EXIT
297        END IF
298     END DO
299
300     IF (.NOT. found) THEN
301        ! Next, search in user field tab
302        IF (ALLOCATED(userfield)) THEN
303           DO ji=1,SIZE(userfield)
304              IF (hfname==userfield(ji)%name) THEN
305                 found = .TRUE.
306                 tpf = userfield(ji)
307                 EXIT
308              END IF
309           END DO
310        END IF
311        
312        IF (.NOT. found) THEN
313           ! then search in system field tab
314           DO ji=1,SIZE(sysfield)
315              IF (hfname==sysfield(ji)%name) THEN
316                 found = .TRUE.
317                 tpf = sysfield(ji)
318                 EXIT
319              ELSE
320                 iposx = INDEX(sysfield(ji)%name,'x')
321                 IF (iposx /= 0) THEN
322                    IF (isnumeric(hfname(iposx:LEN_TRIM(sysfield(ji)%name))) .AND. &
323                         sysfield(ji)%name(1:iposx-1)//&
324                         hfname(iposx:LEN_TRIM(sysfield(ji)%name))==hfname) THEN 
325                       found = .TRUE.
326                       tpf = sysfield(ji)
327                       EXIT
328                    END IF
329                 ELSE IF (level>-1) THEN
330                   !Maybe it is a z-level splitted field
331                   !Warning: false positives are possible (but should be rare)
332                   write(clevel,'(I4.4)') level
333                   iposx = INDEX(hfname,clevel)
334                   IF (iposx /= 0) THEN
335                     IF (hfname(:iposx-1)==sysfield(ji)%name) THEN
336                       found = .TRUE.
337                       tpf = sysfield(ji)
338                       EXIT
339                     END IF
340                   END IF
341                 END IF
342              END IF
343           END DO
344        END IF
345     END IF
346     
347     searchfield = found
348
349   END FUNCTION searchfield
350   
351   FUNCTION isnumeric(hname)
352     CHARACTER(LEN=*) :: hname
353     LOGICAL          :: isnumeric
354
355     INTEGER :: ji
356     
357     isnumeric = .TRUE.
358
359     DO ji = 1,LEN(hname)
360        IF (hname(ji:ji) > '9' .OR. hname(ji:ji) < '0') THEN
361           isnumeric = .FALSE.
362           EXIT
363        END IF
364     END DO
365     
366   END FUNCTION isnumeric
367
368 END MODULE MODE_FIELDTYPE