source: branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/sechiba_io_p.f90 @ 64

Last change on this file since 64 was 64, checked in by didier.solyga, 13 years ago

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