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