source: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba_io.f90 @ 854

Last change on this file since 854 was 12, checked in by mmaipsl, 14 years ago

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