source: tags/ORCHIDEE/src_sechiba/sechiba_io.f90 @ 6

Last change on this file since 6 was 6, checked in by orchidee, 14 years ago

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