Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/sechiba_io.f90 @ 104

Last change on this file since 104 was 64, checked in by didier.solyga, 14 years ago
Import first version of ORCHIDEE_EXT
File size: 16.8 KB

Line
1	!! This subroutines initialize a variable or an array
2	!! with a variable or an array of smaller rank
3	!! - i is for integer interface - r for real interface
4	!! - 0 is for a scalar - 1 for a 1D array - 2 for a 2D array
5	!! Thee right routines is automatically called depending type of input variable
6	!! This initialisation is done only if the value of input field is egal to val_exp
7	!!
8	!! If a key word is provided which is not equal to "NO_KEYWORD" or "NOKEYWORD" then
9	!! we try to find the value to fill in in the configuration file.
10	!!
11	!! @author Marie-Alice Foujols and Jan Polcher
12	!! @Version : $Revision: 1.8 $, $Date: 2008/03/21 13:56:12 $
13	!!
14	!! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/sechiba_io.f90,v 1.8 2008/03/21 13:56:12 ssipsl Exp $
15	!! IPSL (2006)
16	!! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
17	!!
18	MODULE sechiba_io
19
20	USE defprec
21	USE constantes
22	USE ioipsl
23	USE sechiba_io_p
24
25	IMPLICIT NONE
26
27	INTERFACE setvar
28	MODULE PROCEDURE i0setvar, i10setvar, i20setvar, i11setvar, i21setvar, i22setvar
29	MODULE PROCEDURE r0setvar, r10setvar, r20setvar, r11setvar, r21setvar, r22setvar, r30setvar
30	END INTERFACE
31
32	!
33	! mettre la l'interface des routines utilisees:
34	!
35	! restget/put/ini histbeg/def flinopen/close
36	!
37
38	LOGICAL, SAVE :: long_print_setvar=.FALSE. !! change to true to have more information
39
40	CONTAINS
41
42
43	!! Interface for integer scalar to scalar.
44	SUBROUTINE i0setvar (var, val_exp, key_wd, val_put)
45
46	INTEGER(i_std), INTENT(inout) :: var !! Integer scalar to modify
47	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
48	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
49	INTEGER(i_std), INTENT(in) :: val_put !! Initial value to stored
50
51	INTEGER(i_std) :: val_tmp
52	INTEGER(i_std) :: is_key
53
54	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
55
56	IF (long_print_setvar) WRITE(numout,*) "i0setvar :", key_wd, val_exp, val_put
57
58	val_tmp = val_put
59
60	IF ( var == val_exp ) THEN
61	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
62	var = val_tmp
63	END IF
64
65	END SUBROUTINE i0setvar
66
67
68	!! Interface for initialising an 1D integer array with a scalar integer.
69	SUBROUTINE i10setvar (var, val_exp, key_wd, val_put)
70
71	INTEGER(i_std), DIMENSION(:), INTENT(inout) :: var !! 1D integer array to modify
72	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
73	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
74	INTEGER(i_std), INTENT(in) :: val_put !! Scalar value to stored
75
76	INTEGER(i_std) :: val_tmp
77	INTEGER(i_std) :: is_key
78
79	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
80
81	IF (long_print_setvar) WRITE(numout,*) "i10setvar :", key_wd, val_exp, val_put
82
83	val_tmp = val_put
84
85	IF ( ALL( var(:) == val_exp ) ) THEN
86	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
87	var(:) = val_tmp
88	END IF
89
90	END SUBROUTINE i10setvar
91
92
93	!! Interface for initialising an 1D array integer with an other 1D array integer.
94	SUBROUTINE i11setvar (var, val_exp, key_wd, val_put)
95
96	INTEGER(i_std), DIMENSION(:), INTENT(inout) :: var !! 1D integer array to modify
97	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
98	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
99	INTEGER(i_std), DIMENSION(:), INTENT(in) :: val_put !! 1D integer array to stored
100
101	INTEGER(i_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
102	INTEGER(i_std) :: is_key
103
104	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
105
106	IF (long_print_setvar) WRITE(numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
107
108	ALLOCATE(val_tmp(SIZE(val_put)))
109	val_tmp(:) = val_put(:)
110
111	IF ( ALL( var(:) == val_exp ) ) THEN
112	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
113	var(:) = val_tmp (:)
114	END IF
115
116	DEALLOCATE(val_tmp)
117
118	END SUBROUTINE i11setvar
119
120
121	!! Interface for initialising an 2D array integer with a scalar integer.
122	SUBROUTINE i20setvar (var, val_exp, key_wd, val_put)
123
124	INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D integer array to modify
125	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
126	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
127	INTEGER(i_std), INTENT(in) :: val_put !! Scalar value to stored
128
129	INTEGER(i_std) :: val_tmp
130	INTEGER(i_std) :: is_key
131
132	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
133
134	!
135	! this subroutine set val_put value to var if var is constant
136	!
137	!
138	IF (long_print_setvar) WRITE(numout,*) "i20setvar :", key_wd, val_exp, val_put
139
140	val_tmp = val_put
141
142	IF ( ALL( var(:,:) == val_exp ) ) THEN
143	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
144	var(:,:) = val_tmp
145	END IF
146
147	END SUBROUTINE i20setvar
148
149
150	!! Interface for initialising an 2D array integer with an 1D array integer.
151	!! Row or column depending size of 1D array to stored.
152	!!
153	!! example: 1D 1,2,3 2D is 1, 2, 3,
154	!! 1, 2, 3
155	!!
156	!!
157	!! example: 1D 1,2,3 2D is 1, 1,
158	!! 2, 2,
159	!! 3, 3
160	!!
161	SUBROUTINE i21setvar (var, val_exp, key_wd, val_put)
162
163	INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D integer array to modify
164	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
165	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
166	INTEGER(i_std), DIMENSION(:), INTENT(in) :: val_put !! 1D integer array to stored
167
168	INTEGER(i_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
169	INTEGER(i_std) :: is_key
170
171	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
172
173	! test if the 1D array dimension is compatible with first or second
174	! dimension of the 2D array
175
176	IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, val_put
177
178	ALLOCATE(val_tmp(SIZE(val_put)))
179	val_tmp(:) = val_put(:)
180
181	IF (SIZE(val_put)==SIZE(var,1)) THEN
182	!
183	! example: 1D 1.,2.,3. 2D is 1., 2., 3.,
184	! 1., 2., 3.
185	!
186	IF ( ALL( var(:,:) == val_exp ) ) THEN
187	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
188	var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
189	END IF
190	ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN
191	!
192	! example: 1D 1.,2.,3. 2D is 1., 1.,
193	! 2., 2.,
194	! 3., 3.
195	!
196	IF ( ALL( var(:,:) == val_exp ) ) THEN
197	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
198	var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
199	END IF
200	ELSE
201	WRITE(numout,*) ' incompatible dimension var and val_put'
202	WRITE(numout,*) ' var ', SIZE(var,1), SIZE(var,2)
203	WRITE(numout,*) ' val_put ', SIZE(val_put)
204	STOP 'setvar'
205	END IF
206
207	DEALLOCATE(val_tmp)
208
209	END SUBROUTINE i21setvar
210
211	!! Interface for initialising an 2D array integer with an other 2D array integer.
212	SUBROUTINE i22setvar (var, val_exp, key_wd, val_put)
213
214	INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D integer array to modify
215	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
216	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
217	INTEGER(i_std), DIMENSION(:,:), INTENT(in) :: val_put !! 2D integer array to stored
218
219	INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: val_tmp
220	INTEGER(i_std) :: is_key
221
222	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
223
224	IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
225
226	ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
227	val_tmp(:,:) = val_put(:,:)
228
229	IF ( ALL(var(:,:) == val_exp ) ) THEN
230	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
231	var(:,:) = val_tmp(:,:)
232	END IF
233
234	DEALLOCATE(val_tmp)
235
236	END SUBROUTINE i22setvar
237
238
239	!! Interface for scalar to scalar real
240	SUBROUTINE r0setvar (var, val_exp, key_wd, val_put)
241
242	REAL(r_std), INTENT(inout) :: var !! Real scalar to modify
243	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
244	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
245	REAL(r_std), INTENT(in) :: val_put !! Initial value to stored
246
247	REAL(r_std) :: val_tmp
248	INTEGER(i_std) :: is_key
249
250	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
251
252	IF (long_print_setvar) WRITE(numout,*) "r0setvar :", key_wd, val_exp, val_put
253
254	val_tmp = val_put
255
256	IF ( var==val_exp ) THEN
257	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
258	var = val_tmp
259	END IF
260
261	END SUBROUTINE r0setvar
262
263
264	!! Interface for initialising an 1D real array with a scalar real.
265	SUBROUTINE r10setvar (var, val_exp, key_wd, val_put)
266
267	REAL(r_std), DIMENSION(:), INTENT(inout) :: var !! 1D real array to modify
268	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
269	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
270	REAL(r_std), INTENT(in) :: val_put !! Scalar value to stored
271
272	REAL(r_std) :: val_tmp
273	INTEGER(i_std) :: is_key
274
275	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
276
277	IF (long_print_setvar) WRITE(numout,*) "r10setvar :", key_wd, val_exp, val_put
278
279	val_tmp = val_put
280
281	IF ( ALL( var(:) == val_exp ) ) THEN
282	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
283	var(:) = val_tmp
284	END IF
285
286	END SUBROUTINE r10setvar
287
288
289	!! Interface for initialising an 1D array real with an other 1D array real.
290	SUBROUTINE r11setvar (var, val_exp, key_wd, val_put)
291
292	REAL(r_std), DIMENSION(:), INTENT(inout) :: var !! 1D real array to modify
293	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
294	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
295	REAL(r_std), DIMENSION(:), INTENT(in) :: val_put !! 1D integer array to stored
296
297	REAL(r_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
298	INTEGER(i_std) :: is_key
299
300	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
301
302	IF (long_print_setvar) WRITE(numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
303
304	ALLOCATE(val_tmp(SIZE(val_put)))
305	val_tmp(:) = val_put(:)
306
307	IF ( ALL( var(:) == val_exp ) ) THEN
308	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
309	var(:) = val_tmp (:)
310	END IF
311
312	DEALLOCATE(val_tmp)
313
314	END SUBROUTINE r11setvar
315
316
317	!! Interface for initialising an 2D array real with a scalar real.
318	SUBROUTINE r20setvar (var, val_exp, key_wd, val_put)
319
320	! interface for scalar to 2D array real
321
322	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D integer array to modify
323	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
324	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
325	REAL(r_std), INTENT(in) :: val_put !! Scalar value to stored
326
327	REAL(r_std) :: val_tmp
328	INTEGER(i_std) :: is_key
329
330	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
331
332	IF (long_print_setvar) WRITE(numout,*) "r20setvar :", key_wd, val_exp, val_put
333
334	val_tmp = val_put
335
336	IF ( ALL( var(:,:) == val_exp ) ) THEN
337	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
338	var(:,:) = val_tmp
339	END IF
340
341	END SUBROUTINE r20setvar
342
343
344	!! Interface for initialising an 2D array real with an 1D array real.
345	!! Row or column depending size of 1D array to stored.
346	!!
347	!! example: 1D 1.,2.,3. 2D is 1., 2., 3.,
348	!! 1., 2., 3.
349	!!
350	!!
351	!! example: 1D 1.,2.,3. 2D is 1., 1.,
352	!! 2., 2.,
353	!! 3., 3.
354	!!
355	SUBROUTINE r21setvar (var, val_exp, key_wd, val_put)
356
357	! interface for 1D array to 2D array real
358
359	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D real array to modify
360	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
361	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
362	REAL(r_std), DIMENSION(:), INTENT(in) :: val_put !! 1D real array to stored
363
364	REAL(r_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
365	INTEGER(i_std) :: is_key
366
367	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
368
369	! test if the 1D array dimension is compatible with first or second
370	! dimension of the 2D array
371
372	IF (long_print_setvar) WRITE(numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
373
374	ALLOCATE(val_tmp(SIZE(val_put)))
375	val_tmp(:) = val_put(:)
376
377	IF (SIZE(val_put)==SIZE(var,1)) THEN
378	!
379	! example: 1D 1.,2.,3. 2D is 1., 2., 3.,
380	! 1., 2., 3.
381	!
382	IF ( ALL( var(:,:) == val_exp ) ) THEN
383	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
384	var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
385	END IF
386	ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN
387	!
388	! example: 1D 1.,2.,3. 2D is 1., 1.,
389	! 2., 2.,
390	! 3., 3.
391	!
392	IF ( ALL( var(:,:) == val_exp ) ) THEN
393	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
394	var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
395	END IF
396	ELSE
397	WRITE(numout,*) ' incompatible dimension var and val_put'
398	WRITE(numout,*) ' var ', SIZE(var,1), SIZE(var,2)
399	WRITE(numout,*) ' val_put ', SIZE(val_put)
400	STOP 'setvar'
401	END IF
402
403	DEALLOCATE(val_tmp)
404
405	END SUBROUTINE r21setvar
406
407
408	!! Interface for initialising an 2D array real with an other 2D array real.
409	SUBROUTINE r22setvar (var, val_exp, key_wd, val_put)
410
411	! interface for 2D array to 2D array real
412
413	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D real array to modify
414	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
415	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
416	REAL(r_std), DIMENSION(:,:), INTENT(in) :: val_put !! 2D integer array to stored
417
418	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: val_tmp
419	INTEGER(i_std) :: is_key
420
421	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
422
423	IF (long_print_setvar) WRITE(numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
424
425	ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
426	val_tmp(:,:) = val_put(:,:)
427
428	IF ( ALL( var(:,:) == val_exp ) ) THEN
429	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
430	var(:,:) = val_tmp(:,:)
431	END IF
432
433	DEALLOCATE(val_tmp)
434
435	END SUBROUTINE r22setvar
436
437	!! Interface for initialising an 3D array real with a scalar real.
438	SUBROUTINE r30setvar (var, val_exp, key_wd, val_put)
439
440	! interface for scalar to 3D array real
441
442	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var !! 3D integer array to modify
443	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
444	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
445	REAL(r_std), INTENT(in) :: val_put !! Scalar value to stored
446
447	REAL(r_std) :: val_tmp
448	INTEGER(i_std) :: is_key
449
450	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
451
452	IF (long_print_setvar) WRITE(numout,*) 'r30setvar',val_exp, val_put
453
454	val_tmp = val_put
455
456	IF ( ALL( var(:,:,:) == val_exp ) ) THEN
457	IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
458	var(:,:,:) = val_tmp
459	END IF
460
461	END SUBROUTINE r30setvar
462
463	END MODULE sechiba_io

Note: See TracBrowser for help on using the repository browser.

Download in other formats: