source: tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_sechiba/sechiba_io_p.f90 @ 579

Last change on this file since 579 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: 18.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_p
22
23  USE defprec
24
25  USE constantes
26  USE constantes_veg
27  USE ioipsl
28  USE parallel
29 
30  IMPLICIT NONE
31
32  INTERFACE setvar_p
33    MODULE PROCEDURE i0setvar_p, i10setvar_p, i20setvar_p, i11setvar_p, i21setvar_p, i22setvar_p
34    MODULE PROCEDURE r0setvar_p, r10setvar_p, r20setvar_p, r11setvar_p, r21setvar_p, r22setvar_p, r30setvar_p
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_p=.FALSE.  !! change to true to have more information
44
45CONTAINS 
46
47!! pour déclancher les restarts rajoutés avec un paramètre externe
48FUNCTION ok_var ( varname )
49  CHARACTER(LEN=*), INTENT(IN) :: varname
50  LOGICAL ok_var
51  ok_var=.FALSE.
52  CALL getin_p(varname, ok_var)
53END FUNCTION ok_var
54
55!! Interface for integer scalar to scalar.
56SUBROUTINE i0setvar_p (var, val_exp, key_wd, val_put)
57
58  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar to modify
59  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
60  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
61  INTEGER(i_std), INTENT(in)                      :: val_put              !! Initial value to stored
62
63  INTEGER(i_std)                                  :: val_tmp
64  INTEGER(i_std)                                  :: is_key
65
66  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
67 
68  IF (long_print_setvar_p) WRITE (numout,*) "i0setvar :", key_wd, val_exp, val_put
69
70  val_tmp = val_put
71
72  IF ( var == val_exp ) THEN
73     IF ( is_key <= 0 ) THEN
74        CALL getin_p(key_wd,  val_tmp)
75     ENDIF
76     var = val_tmp
77  END IF
78 
79END SUBROUTINE i0setvar_p
80
81
82!! Interface for initialising an 1D integer array with a scalar integer.
83SUBROUTINE i10setvar_p (var, val_exp, key_wd, val_put)
84
85  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D integer array to modify
86  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
87  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
88  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
89 
90  INTEGER(i_std)                                  :: val_tmp
91  INTEGER(i_std)                                  :: is_key
92
93  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
94
95  IF (long_print_setvar_p) WRITE (numout,*) "i10setvar :", key_wd, val_exp, val_put
96
97  val_tmp = val_put
98
99  IF ( ALL( var(:) == val_exp ) ) THEN
100     IF ( is_key <= 0 ) THEN
101       CALL getin_p(key_wd,  val_tmp)
102     ENDIF
103     var(:) = val_tmp
104  END IF
105 
106END SUBROUTINE i10setvar_p
107
108
109!! Interface for initialising an 1D array integer with an other 1D array integer.
110SUBROUTINE i11setvar_p (var, val_exp, key_wd, val_put, is_grid)
111 
112  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
113  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
114  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
115  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
116  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
117
118  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
119  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp_g
120  INTEGER(i_std)                                  :: is_key
121
122  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
123 
124  IF (long_print_setvar_p) WRITE (numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
125
126  ALLOCATE(val_tmp(SIZE(val_put)))
127  val_tmp(:) = val_put(:)
128
129  IF ( ALL( var(:) == val_exp ) ) THEN
130     IF ( is_key <= 0 ) THEN
131        IF (PRESENT(is_grid) ) THEN
132           IF (is_root_prc) &
133              ALLOCATE( val_tmp_g(nbp_glo) )
134           CALL gather( val_tmp,val_tmp_g )
135           IF (is_root_prc) &
136              CALL getin(key_wd,  val_tmp_g)
137           CALL scatter( val_tmp,val_tmp_g )
138           IF (is_root_prc) &
139              DEALLOCATE( val_tmp_g )
140        ELSE
141           CALL getin_p(key_wd,  val_tmp)
142        ENDIF
143     ENDIF
144     var(:) = val_tmp (:)
145  END IF
146
147  DEALLOCATE(val_tmp)
148 
149END SUBROUTINE i11setvar_p
150
151
152!! Interface for initialising an 2D array integer with a scalar integer.
153SUBROUTINE i20setvar_p (var, val_exp, key_wd, val_put)
154 
155  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
156  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
157  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
158  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
159
160  INTEGER(i_std)                                  :: val_tmp
161  INTEGER(i_std)                                  :: is_key
162
163  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
164 
165  !
166  ! this subroutine set val_put value to var if var is constant
167  !
168  !
169  IF (long_print_setvar_p) WRITE (numout,*) "i20setvar :", key_wd, val_exp, val_put
170
171  val_tmp = val_put
172
173  IF ( ALL( var(:,:) == val_exp ) ) THEN
174     IF ( is_key <= 0 ) THEN
175       CALL getin_p(key_wd,  val_tmp)
176     ENDIF
177     var(:,:) = val_tmp
178  END IF
179 
180END SUBROUTINE i20setvar_p
181
182
183!! Interface for initialising an 2D array integer with an 1D array integer.
184!! Row or column depending size of 1D array to stored.
185!!
186!! example: 1D 1,2,3     2D is 1, 2, 3,
187!!                             1, 2, 3
188!!
189!!
190!! example: 1D 1,2,3     2D is 1, 1,
191!!                             2, 2,
192!!                             3, 3
193!!
194SUBROUTINE i21setvar_p (var, val_exp, key_wd, val_put, is_grid)
195 
196  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
197  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
198  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
199  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
200  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
201 
202  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
203  INTEGER(i_std)                                  :: is_key
204
205  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
206
207  ! test if the 1D array dimension is compatible with first or second
208  ! dimension of the 2D array
209
210  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, val_put
211
212  ALLOCATE(val_tmp(SIZE(val_put)))
213  val_tmp(:) = val_put(:)
214
215  IF (SIZE(val_put)==SIZE(var,1)) THEN 
216      !
217      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
218      !                                1., 2., 3.
219      !
220      IF ( ALL( var(:,:) == val_exp ) ) THEN
221         IF ( is_key <= 0 ) THEN
222           CALL getin_p(key_wd,  val_tmp)
223         ENDIF
224         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
225      END IF
226  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
227      !
228      ! example: 1D 1.,2.,3.     2D is 1., 1.,
229      !                                2., 2.,
230      !                                3., 3.
231      !
232      IF ( ALL( var(:,:) == val_exp ) ) THEN
233         IF ( is_key <= 0 ) THEN
234           CALL getin_p(key_wd,  val_tmp)
235         ENDIF
236         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
237      END IF
238  ELSE
239      WRITE (numout,*) ' incompatible dimension var and val_put'
240      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
241      WRITE (numout,*) ' val_put ', SIZE(val_put)
242      STOP 'setvar'
243  END IF
244
245  DEALLOCATE(val_tmp)
246 
247END SUBROUTINE i21setvar_p
248
249!! Interface for initialising an 2D array integer with an other 2D array integer.
250SUBROUTINE i22setvar_p (var, val_exp, key_wd, val_put, is_grid)
251 
252  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D integer array to modify
253  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
254  CHARACTER(LEN=*), INTENT(in)                :: key_wd              !! The Key word we will look for
255  INTEGER(i_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
256  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
257
258  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
259  INTEGER(i_std)                                  :: is_key
260
261  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
262 
263  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
264
265  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
266  val_tmp(:,:) = val_put(:,:)
267
268  IF ( ALL(var(:,:) == val_exp ) ) THEN
269     IF ( is_key <= 0 ) THEN
270       CALL getin_p(key_wd,  val_tmp)
271     ENDIF
272     var(:,:) = val_tmp(:,:)
273  END IF
274
275  DEALLOCATE(val_tmp)
276 
277END SUBROUTINE i22setvar_p
278
279
280!! Interface for scalar to scalar real
281SUBROUTINE r0setvar_p (var, val_exp, key_wd, val_put)
282 
283  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
284  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
285  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
286  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
287 
288  REAL(r_std)                                  :: val_tmp
289  INTEGER(i_std)                                     :: is_key
290
291  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
292
293  IF (long_print_setvar_p) WRITE (numout,*) "r0setvar :", key_wd, val_exp, val_put
294
295  val_tmp = val_put
296
297  IF ( var==val_exp ) THEN
298     IF ( is_key <= 0 ) THEN
299       CALL getin_p(key_wd,  val_tmp)
300     ENDIF
301     var = val_tmp
302  END IF
303 
304END SUBROUTINE r0setvar_p
305
306
307!! Interface for initialising an 1D real array with a scalar real.
308SUBROUTINE r10setvar_p (var, val_exp, key_wd, val_put)
309 
310  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
311  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
312  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
313  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
314   
315  REAL(r_std)                                  :: val_tmp
316  INTEGER(i_std)                                     :: is_key
317
318  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
319 
320  IF (long_print_setvar_p) WRITE (numout,*) "r10setvar :", key_wd, val_exp, val_put
321
322  val_tmp = val_put
323
324  IF ( ALL( var(:) == val_exp ) ) THEN
325     IF ( is_key <= 0 ) THEN
326       CALL getin_p(key_wd,  val_tmp)
327     ENDIF
328     var(:) = val_tmp
329  END IF
330 
331END SUBROUTINE r10setvar_p
332
333
334!! Interface for initialising an 1D array real with an other 1D array real.
335SUBROUTINE r11setvar_p (var, val_exp, key_wd, val_put, is_grid)
336 
337  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
338  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
339  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
340  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
341  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
342
343  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
344  INTEGER(i_std)                                     :: is_key
345
346  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
347   
348  IF (long_print_setvar_p) WRITE (numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
349
350  ALLOCATE(val_tmp(SIZE(val_put)))
351  val_tmp(:) = val_put(:)
352
353  IF ( ALL( var(:) == val_exp ) ) THEN
354     IF ( is_key <= 0 ) THEN
355       CALL getin_p(key_wd,  val_tmp)
356     ENDIF
357     var(:) = val_tmp (:)
358  END IF
359
360  DEALLOCATE(val_tmp)
361 
362END SUBROUTINE r11setvar_p
363
364
365!! Interface for initialising an 2D array real with a scalar real.
366SUBROUTINE r20setvar_p (var, val_exp, key_wd, val_put)
367 
368  ! interface for scalar to 2D array real
369
370  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
371  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
372  CHARACTER(LEN=*), INTENT(in)                   :: key_wd                  !! The Key word we will look for
373  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
374 
375  REAL(r_std)                                  :: val_tmp 
376  INTEGER(i_std)                                     :: is_key
377
378  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
379 
380  IF (long_print_setvar_p) WRITE (numout,*) "r20setvar :", key_wd, val_exp, val_put
381
382  val_tmp = val_put
383
384  IF ( ALL( var(:,:) == val_exp ) ) THEN
385     IF ( is_key <= 0 ) THEN
386       CALL getin_p(key_wd,  val_tmp)
387     ENDIF
388     var(:,:) = val_tmp
389  END IF
390 
391END SUBROUTINE r20setvar_p
392
393
394!! Interface for initialising an 2D array real with an 1D array real.
395!! Row or column depending size of 1D array to stored.
396!!
397!! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
398!!                                1., 2., 3.
399!!
400!!
401!! example: 1D 1.,2.,3.     2D is 1., 1.,
402!!                                2., 2.,
403!!                                3., 3.
404!!
405SUBROUTINE r21setvar_p (var, val_exp, key_wd, val_put, is_grid)
406 
407  ! interface for 1D array to 2D array real
408
409  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
410  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
411  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
412  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
413  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
414
415  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
416  INTEGER(i_std)                                     :: is_key
417
418  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
419 
420  ! test if the 1D array dimension is compatible with first or second
421  ! dimension of the 2D array
422
423  IF (long_print_setvar_p) WRITE (numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
424
425  ALLOCATE(val_tmp(SIZE(val_put)))
426  val_tmp(:) = val_put(:)
427
428  IF (SIZE(val_put)==SIZE(var,1)) THEN 
429      !
430      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
431      !                                1., 2., 3.
432      !
433      IF ( ALL( var(:,:) == val_exp ) ) THEN
434         IF ( is_key <= 0 ) THEN
435           CALL getin_p(key_wd,  val_tmp)
436         ENDIF
437         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
438      END IF
439  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
440      !
441      ! example: 1D 1.,2.,3.     2D is 1., 1.,
442      !                                2., 2.,
443      !                                3., 3.
444      !
445      IF ( ALL( var(:,:) == val_exp ) ) THEN
446         IF ( is_key <= 0 ) THEN
447           CALL getin_p(key_wd,  val_tmp)
448         ENDIF
449         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
450      END IF
451  ELSE
452      WRITE (numout,*) ' incompatible dimension var and val_put'
453      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
454      WRITE (numout,*) ' val_put ', SIZE(val_put)
455      STOP 'setvar'
456  END IF
457
458  DEALLOCATE(val_tmp)
459 
460END SUBROUTINE r21setvar_p
461
462
463!! Interface for initialising an 2D array real with an other 2D array real.
464SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put, is_grid)
465 
466  ! interface for 2D array to 2D array real
467
468  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
469  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
470  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
471  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
472  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
473
474  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
475  INTEGER(i_std)                                     :: is_key
476
477  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
478
479  IF (long_print_setvar_p) WRITE (numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
480
481  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
482  val_tmp(:,:) = val_put(:,:)
483
484  IF ( ALL( var(:,:) == val_exp ) ) THEN
485     IF ( is_key <= 0 ) THEN
486       CALL getin_p(key_wd,  val_tmp)
487     ENDIF
488     var(:,:) = val_tmp(:,:)
489  END IF
490
491  DEALLOCATE(val_tmp)
492 
493END SUBROUTINE r22setvar_p
494
495!! Interface for initialising an 3D array real with a scalar real.
496SUBROUTINE r30setvar_p (var, val_exp, key_wd, val_put)
497
498  ! interface for scalar to 3D array real
499
500  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
501  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
502  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
503  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
504
505  REAL(r_std)                                  :: val_tmp 
506  INTEGER(i_std)                              :: is_key
507
508  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
509
510  IF (long_print_setvar_p) WRITE(numout,*) 'r30setvar',val_exp, val_put
511
512  val_tmp = val_put
513
514  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
515     IF ( is_key <= 0 ) THEN
516       CALL getin_p(key_wd,  val_tmp)
517     ENDIF
518     var(:,:,:) = val_tmp
519  END IF
520
521END SUBROUTINE r30setvar_p
522
523END MODULE sechiba_io_p
Note: See TracBrowser for help on using the repository browser.