source: branches/publications/ORCHIDEE-LEAK-r5919/src_sechiba/sechiba_io.f90 @ 7346

Last change on this file since 7346 was 1078, checked in by anne.cozic, 12 years ago

Merge between branche OpenMP2 at revision 1076 and trunk revision 1062

this merge doesn't change results for Orchidee with compilation MPI

test with OFFLINE and LMDZOR

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