source: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_io_p.f90 @ 7346

Last change on this file since 7346 was 5554, checked in by sebastiaan.luyssaert, 6 years ago

DEV: more changes to prepare the code for reading an lai map for a structured canopy. See ticket #286. These changes were confirmed not to affect the model if read_lai = n
  • Property svn:keywords set to Revision Date HeadURL Date Author Revision
File size: 27.5 KB
Line 
1! ================================================================================================================================
2!  MODULE       : sechiba_io_p
3!
4!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
5!
6!  LICENCE      : IPSL (2006)
7!                 This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF          To be used for intializing variables not read available in the restart file
10!!
11!!\n DESCRIPTION: This module contains the interface to setvar_p to be used for intializing variables if they were
12!!                not found in the restart file. The variable will only be modified if it was not found in the restart
13!!                file (i.e. if it is eqaul val_exp).
14!!
15!!                Syntax : CALL setvar_p (var, val_exp, key_wd, val_put)
16!!                  var : the variable to initialize; It can be an integer or a real, a scalar or have 1 or 2 dimensions
17!!                  val_exp : the value set by restget_p if the variable was not found in the restart file (do not change this)
18!!                  key_wd  : parameter name to be searched for in run.def
19!!                  val_put : a value to be used if the kew_wd was not found in run.def. val_put must have the same or
20!!                            smaller rank as var
21!!
22!!                Note that setvar_p must always be called by all processes because it contains call to getin_p.
23!!                - The variable var, will only be modified if before the call it is equal to val_exp. Otherwise nothing is done.
24!!                - If var is equal to val_exp and if key_wd is not equal "NO_KEYWORD" or "NOKEYWORD", then the value for key_wd
25!!                  is read from run.def using getin_p and used to initialize var.
26!!                - If key_wd is not found in run.def or if key_wd="NO_KEYWORD" or "NOKEYWORD", then the val_put will be used to
27!!                  initialize var.
28!!
29!!                The interface will automatically call the right subroutine depending on the type of input variables.
30!!
31!! REFERENCE(S) : None
32!!
33!! SVN          :
34!! $HeadURL$
35!! $Date$
36!! $Revision$
37!! \n
38!_ ================================================================================================================================
39
40MODULE sechiba_io_p
41
42  USE defprec
43  USE constantes
44  USE ioipsl
45  USE ioipsl_para
46  USE mod_orchidee_para
47
48  IMPLICIT NONE
49
50  PRIVATE
51  PUBLIC setvar_p
52
53  INTERFACE setvar_p
54    MODULE PROCEDURE i0setvar_p, i10setvar_p, i20setvar_p, i11setvar_p, i21setvar_p
55    MODULE PROCEDURE r0setvar_p, r10setvar_p, r20setvar_p, r11setvar_p, r21setvar_p, &
56         r22setvar_p, r30setvar_p, r40setvar_p, r50setvar_p 
57  END INTERFACE
58
59  LOGICAL, SAVE                  :: long_print_setvar_p=.FALSE.  !! change to true to have more information
60!$OMP THREADPRIVATE(long_print_setvar_p)
61
62CONTAINS 
63
64!! =============================================================================================================================
65!! SUBROUTINE   : i0setvar_p
66!!
67!>\BRIEF          Subroutine for initializing an integer scalar variable with a scalar integer.
68!!
69!! DESCRIPTION  : Subroutine for initializing an integer scalar variable with a scalar integer.
70!!                This subroutine must be called by all processes.
71!! \n
72!_ =============================================================================================================================
73
74SUBROUTINE i0setvar_p (var, val_exp, key_wd, val_put)
75
76  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar 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              !! Initial 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_p) WRITE (numout,*) "i0setvar :", key_wd, val_exp, val_put
87
88  val_tmp = val_put
89
90  IF ( var == val_exp ) THEN
91     IF ( is_key <= 0 ) THEN
92        CALL getin_p(key_wd,  val_tmp)
93     ENDIF
94     var = val_tmp
95  END IF
96 
97END SUBROUTINE i0setvar_p
98
99
100!! =============================================================================================================================
101!! SUBROUTINE   : i10setvar_p
102!!
103!>\BRIEF          Subroutine for initializing an integer 1D array with a integer scalar variable.
104!!
105!! DESCRIPTION  : Subroutine for initializing an integer 1D array with a integer scalar variable.
106!!                This subroutine must be called by all processes.
107!! \n
108!_ =============================================================================================================================
109
110SUBROUTINE i10setvar_p (var, val_exp, key_wd, val_put)
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), INTENT(in)                      :: val_put              !! Scalar value to stored
116 
117  INTEGER(i_std)                                  :: val_tmp
118  INTEGER(i_std)                                  :: is_key
119
120  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
121
122  IF (long_print_setvar_p) WRITE (numout,*) "i10setvar :", key_wd, val_exp, val_put
123
124  val_tmp = val_put
125
126  IF ( ALL( var(:) == val_exp ) ) THEN
127     IF ( is_key <= 0 ) THEN
128       CALL getin_p(key_wd,  val_tmp)
129     ENDIF
130     var(:) = val_tmp
131  END IF
132 
133END SUBROUTINE i10setvar_p
134
135
136!! =============================================================================================================================
137!! SUBROUTINE   : i11setvar_p
138!!
139!>\BRIEF          Subroutine for initializing an integer 1D array with another integer 1D array.
140!!
141!! DESCRIPTION  : Subroutine for initializing an integer 1D array with another integer 1D array.
142!!                This subroutine must be called by all processes.
143!! \n
144!_ =============================================================================================================================
145
146SUBROUTINE i11setvar_p (var, val_exp, key_wd, val_put, is_grid)
147 
148  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
149  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
150  CHARACTER(LEN=*), INTENT(in)                    :: key_wd              !! The Key word we will look for
151  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
152  LOGICAL,        OPTIONAL                        :: is_grid             !! Parameter present indicates a setvar for a grid variable
153
154  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
155  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp_g
156  INTEGER(i_std)                                  :: is_key
157
158  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
159 
160  IF (long_print_setvar_p) WRITE (numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
161
162  ALLOCATE(val_tmp(SIZE(val_put)))
163  val_tmp(:) = val_put(:)
164
165  IF ( ALL( var(:) == val_exp ) ) THEN
166     IF ( is_key <= 0 ) THEN
167        IF (PRESENT(is_grid) ) THEN
168           IF (is_root_prc) THEN
169              ALLOCATE( val_tmp_g(nbp_glo) )
170           ELSE
171              ALLOCATE( val_tmp_g(1) )
172           ENDIF
173           CALL gather( val_tmp,val_tmp_g )
174           IF (is_root_prc) &
175              CALL getin(key_wd,  val_tmp_g)
176           CALL scatter( val_tmp,val_tmp_g )
177           DEALLOCATE( val_tmp_g )
178        ELSE
179           CALL getin_p(key_wd,  val_tmp)
180        ENDIF
181     ENDIF
182     var(:) = val_tmp (:)
183  END IF
184
185  DEALLOCATE(val_tmp)
186 
187END SUBROUTINE i11setvar_p
188
189
190!! =============================================================================================================================
191!! SUBROUTINE   : i20setvar_p
192!!
193!>\BRIEF          Subroutine for initializing an integer 2D variable with a scalar integer variable.
194!!
195!! DESCRIPTION  : Subroutine for initializing an integer 2D variable with a scalar integer variable.
196!!                This subroutine must be called by all processes.
197!! \n
198!_ =============================================================================================================================
199
200SUBROUTINE i20setvar_p (var, val_exp, key_wd, val_put)
201 
202  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
203  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
204  CHARACTER(LEN=*), INTENT(in)                    :: key_wd               !! The Key word we will look for
205  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to be used as default
206
207  INTEGER(i_std)                                  :: val_tmp
208  INTEGER(i_std)                                  :: is_key
209
210  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
211 
212  IF (long_print_setvar_p) WRITE (numout,*) "i20setvar :", key_wd, val_exp, val_put
213
214  val_tmp = val_put
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(:,:) = val_tmp
221  END IF
222 
223END SUBROUTINE i20setvar_p
224
225
226!! =============================================================================================================================
227!! SUBROUTINE   : i21setvar_p
228!!
229!>\BRIEF          Subroutine for initialieing an 2D integer variable with a 1D array integer.
230!!
231!! DESCRIPTION  : Subroutine for initialieing an 2D integer variable with a 1D array integer.
232!!                This subroutine must be called by all processes.
233!!                Row or column depending size of 1D array to stored.
234!!
235!!                example: 1D 1,2,3     2D is 1, 2, 3,
236!!                                            1, 2, 3
237!!
238!!                example: 1D 1,2,3     2D is 1, 1,
239!!                                            2, 2,
240!!                                            3, 3
241!! \n
242!_ =============================================================================================================================
243
244SUBROUTINE i21setvar_p (var, val_exp, key_wd, val_put, is_grid)
245 
246  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
247  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
248  CHARACTER(LEN=*), INTENT(in)                    :: key_wd               !! The Key word we will look for
249  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
250  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
251 
252  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
253  INTEGER(i_std)                                  :: is_key
254
255  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
256
257  ! test if the 1D array dimension is compatible with first or second
258  ! dimension of the 2D array
259
260  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, val_put
261
262  ALLOCATE(val_tmp(SIZE(val_put)))
263  val_tmp(:) = val_put(:)
264
265  IF (SIZE(val_put)==SIZE(var,1)) THEN 
266      !
267      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
268      !                                1., 2., 3.
269      !
270      IF ( ALL( var(:,:) == val_exp ) ) THEN
271         IF ( is_key <= 0 ) THEN
272           CALL getin_p(key_wd,  val_tmp)
273         ENDIF
274         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
275      END IF
276  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
277      !
278      ! example: 1D 1.,2.,3.     2D is 1., 1.,
279      !                                2., 2.,
280      !                                3., 3.
281      !
282      IF ( ALL( var(:,:) == val_exp ) ) THEN
283         IF ( is_key <= 0 ) THEN
284           CALL getin_p(key_wd,  val_tmp)
285         ENDIF
286         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
287      END IF
288  ELSE
289      WRITE (numout,*) ' incompatible dimension var and val_put'
290      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
291      WRITE (numout,*) ' val_put ', SIZE(val_put)
292      STOP 'setvar'
293  END IF
294
295  DEALLOCATE(val_tmp)
296 
297END SUBROUTINE i21setvar_p
298
299
300!! =============================================================================================================================
301!! SUBROUTINE   : r0setvar_p
302!!
303!>\BRIEF          Subroutine for initializing a real scalar variable.
304!!
305!! DESCRIPTION  : Subroutine for initializing a real scalar variable with a real scalar variable.
306!!                This subroutine must be called by all processes.
307!! \n
308!_ =============================================================================================================================
309
310SUBROUTINE r0setvar_p (var, val_exp, key_wd, val_put)
311 
312  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
313  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
314  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
315  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
316 
317  REAL(r_std)                                  :: val_tmp
318  INTEGER(i_std)                                     :: is_key
319
320  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
321
322  IF (long_print_setvar_p) WRITE (numout,*) "r0setvar :", key_wd, val_exp, val_put
323
324  val_tmp = val_put
325
326  IF ( var==val_exp ) THEN
327     IF ( is_key <= 0 ) THEN
328       CALL getin_p(key_wd,  val_tmp)
329     ENDIF
330     var = val_tmp
331  END IF
332 
333END SUBROUTINE r0setvar_p
334
335
336!! =============================================================================================================================
337!! SUBROUTINE   : r10setvar_p
338!!
339!>\BRIEF          Subroutine for initializing an real 1D array with a real scalar variable.
340!!
341!! DESCRIPTION  : Subroutine for initializing an real 1D array with a real scalar variable.
342!!                This subroutine must be called by all processes.
343!! \n
344!_ =============================================================================================================================
345
346SUBROUTINE r10setvar_p (var, val_exp, key_wd, val_put)
347 
348  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
349  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
350  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
351  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
352   
353  REAL(r_std)                                  :: val_tmp
354  INTEGER(i_std)                               :: is_key
355
356  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
357 
358  IF (long_print_setvar_p) WRITE (numout,*) "r10setvar :", key_wd, val_exp, val_put
359
360  val_tmp = val_put
361
362  IF ( ALL( var(:) == val_exp ) ) THEN
363     IF ( is_key <= 0 ) THEN
364       CALL getin_p(key_wd,  val_tmp)
365     ENDIF
366     var(:) = val_tmp
367  END IF
368 
369END SUBROUTINE r10setvar_p
370
371
372!! =============================================================================================================================
373!! SUBROUTINE   : r11setvar_p
374!!
375!>\BRIEF          Subroutine for initializing an real 1D array with another real 1D array.
376!!
377!! DESCRIPTION  : Subroutine for initializing an real 1D array with another real 1D array.
378!!                This subroutine must be called by all processes.
379!! \n
380!_ =============================================================================================================================
381
382SUBROUTINE r11setvar_p (var, val_exp, key_wd, val_put, is_grid)
383 
384  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
385  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
386  CHARACTER(LEN=*), INTENT(in)                 :: key_wd              !! The Key word we will look for
387  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
388  LOGICAL,        OPTIONAL                     :: is_grid             !! Parameter present indicates a setvar for a grid variable
389
390  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
391  INTEGER(i_std)                               :: is_key
392
393  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
394   
395  IF (long_print_setvar_p) WRITE (numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
396
397  ALLOCATE(val_tmp(SIZE(val_put)))
398  val_tmp(:) = val_put(:)
399
400  IF ( ALL( var(:) == val_exp ) ) THEN
401     IF ( is_key <= 0 ) THEN
402       CALL getin_p(key_wd,  val_tmp)
403     ENDIF
404     var(:) = val_tmp (:)
405  END IF
406
407  DEALLOCATE(val_tmp)
408 
409END SUBROUTINE r11setvar_p
410
411
412!! =============================================================================================================================
413!! SUBROUTINE   : r20setvar_p
414!!
415!>\BRIEF          Subroutine for initializing an real 2D variable with a scalar real variable.
416!!
417!! DESCRIPTION  : Subroutine for initializing an real 2D variable with a scalar real variable.
418!!                This subroutine must be called by all processes.
419!! \n
420!_ =============================================================================================================================
421
422SUBROUTINE r20setvar_p (var, val_exp, key_wd, val_put)
423 
424  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
425  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
426  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
427  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
428 
429  REAL(r_std)                                  :: val_tmp 
430  INTEGER(i_std)                               :: is_key
431
432  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
433 
434  IF (long_print_setvar_p) WRITE (numout,*) "r20setvar :", key_wd, val_exp, val_put
435
436  val_tmp = val_put
437
438  IF ( ALL( var(:,:) == val_exp ) ) THEN
439     IF ( is_key <= 0 ) THEN
440       CALL getin_p(key_wd,  val_tmp)
441     ENDIF
442     var(:,:) = val_tmp
443  END IF
444 
445END SUBROUTINE r20setvar_p
446
447!! =============================================================================================================================
448!! SUBROUTINE   : r21setvar_p
449!!
450!>\BRIEF          Subroutine for initialieing an 2D real variable with a 1D array real.
451!!
452!! DESCRIPTION  : Subroutine for initialieing an 2D real variable with a 1D array real.
453!!                This subroutine must be called by all processes.
454!!                Row or column depending size of 1D array to stored.
455!!
456!!                example: 1D 1,2,3     2D is 1, 2, 3,
457!!                                            1, 2, 3
458!!
459!!                example: 1D 1,2,3     2D is 1, 1,
460!!                                            2, 2,
461!!                                            3, 3
462!! \n
463!_ =============================================================================================================================
464
465SUBROUTINE r21setvar_p (var, val_exp, key_wd, val_put, is_grid)
466 
467  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
468  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
469  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
470  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
471  LOGICAL,        OPTIONAL                     :: is_grid              !! Parameter present indicates a setvar for a grid variable
472
473  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
474  INTEGER(i_std)                               :: is_key
475
476  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
477 
478  ! test if the 1D array dimension is compatible with first or second
479  ! dimension of the 2D array
480
481  IF (long_print_setvar_p) WRITE (numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
482
483  ALLOCATE(val_tmp(SIZE(val_put)))
484  val_tmp(:) = val_put(:)
485
486  IF (SIZE(val_put)==SIZE(var,1)) THEN 
487      !
488      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
489      !                                1., 2., 3.
490      !
491      IF ( ALL( var(:,:) == val_exp ) ) THEN
492         IF ( is_key <= 0 ) THEN
493           CALL getin_p(key_wd,  val_tmp)
494         ENDIF
495         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
496      END IF
497  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
498      !
499      ! example: 1D 1.,2.,3.     2D is 1., 1.,
500      !                                2., 2.,
501      !                                3., 3.
502      !
503      IF ( ALL( var(:,:) == val_exp ) ) THEN
504         IF ( is_key <= 0 ) THEN
505           CALL getin_p(key_wd,  val_tmp)
506         ENDIF
507         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
508      END IF
509  ELSE
510      WRITE (numout,*) ' incompatible dimension var and val_put'
511      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
512      WRITE (numout,*) ' val_put ', SIZE(val_put)
513      STOP 'setvar'
514  END IF
515
516  DEALLOCATE(val_tmp)
517 
518END SUBROUTINE r21setvar_p
519
520
521!! =============================================================================================================================
522!! SUBROUTINE   : r22setvar_p
523!!
524!>\BRIEF          Subroutine for initializing a 2D real variable with a real with the same size.
525!!
526!! DESCRIPTION  : Subroutine for initializing a 2D real variable with a real with the same size or by reading an scalar value
527!!                from run.def if key_wd is different from "NO_KEYWORD" or "NOKEYWORD".
528!!                It is not possible to read a 2D variable from run.def.
529!!                This subroutine must be called by all processes.
530!! \n
531!_ =============================================================================================================================
532
533SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put)
534
535  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
536  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
537  CHARACTER(LEN=*), INTENT(in)                 :: key_wd              !! The Key word we will look for
538  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
539  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
540  REAL(r_std)                                  :: val_scal            !! Temporary variable to read a scalar value from run.def
541  INTEGER(i_std)                               :: is_key
542
543  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
544
545  IF (long_print_setvar_p) WRITE (numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
546
547  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
548  val_tmp(:,:) = val_put(:,:)
549
550  IF ( ALL( var(:,:) == val_exp ) ) THEN
551     IF ( is_key <= 0 ) THEN
552        ! This case only read a scalar value with getin
553        val_scal=val_exp
554        CALL getin_p(key_wd, val_scal)
555        ! If a value was found in run.def, then set val_tmp to this value.
556        IF (val_scal/=val_exp) val_tmp(:,:)=val_scal 
557     ENDIF
558     var(:,:) = val_tmp(:,:)
559  END IF
560
561  DEALLOCATE(val_tmp)
562 
563END SUBROUTINE r22setvar_p
564
565!! =============================================================================================================================
566!! SUBROUTINE   : r30setvar_p
567!!
568!>\BRIEF          Subroutine for initializing an real 3D variable with a scalar real variable.
569!!
570!! DESCRIPTION  : Subroutine for initializing an real 3D variable with a scalar real variable.
571!!                This subroutine must be called by all processes.
572!! \n
573!_ =============================================================================================================================
574
575SUBROUTINE r30setvar_p (var, val_exp, key_wd, val_put)
576
577  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
578  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
579  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
580  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
581
582  REAL(r_std)                                  :: val_tmp 
583  INTEGER(i_std)                               :: is_key
584
585  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
586
587  IF (long_print_setvar_p) WRITE(numout,*) 'r30setvar',val_exp, val_put
588
589  val_tmp = val_put
590
591  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
592     IF ( is_key <= 0 ) THEN
593       CALL getin_p(key_wd,  val_tmp)
594     ENDIF
595     var(:,:,:) = val_tmp
596  END IF
597
598END SUBROUTINE r30setvar_p
599
600
601!! =============================================================================================================================
602!! SUBROUTINE   : r40setvar_p
603!!
604!>\BRIEF          Subroutine for initializing an real 4D variable with a scalar real variable.
605!!
606!! DESCRIPTION  : Subroutine for initializing an real 4D variable with a scalar real variable.
607!!                This subroutine must be called by all processes.
608!! \n
609!_ =============================================================================================================================
610
611SUBROUTINE r40setvar_p (var, val_exp, key_wd, val_put)
612
613  REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: var                !! 4D integer array to modify
614  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
615  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
616  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
617
618  REAL(r_std)                                  :: val_tmp 
619  INTEGER(i_std)                               :: is_key
620
621  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
622
623  IF (long_print_setvar_p) WRITE(numout,*) 'r40setvar',val_exp, val_put
624
625  val_tmp = val_put
626
627  IF ( ALL( var(:,:,:,:) == val_exp ) ) THEN
628     IF ( is_key <= 0 ) THEN
629       CALL getin_p(key_wd,  val_tmp)
630     ENDIF
631     var(:,:,:,:) = val_tmp
632  END IF
633
634END SUBROUTINE r40setvar_p
635
636!! =============================================================================================================================
637!! SUBROUTINE   : r50setvar_p
638!!
639!>\BRIEF          Subroutine for initializing an real 5D variable with a scalar real variable.
640!!
641!! DESCRIPTION  : Subroutine for initializing an real 5D variable with a scalar real variable.
642!!                This subroutine must be called by all processes.
643!! \n
644!_ =============================================================================================================================
645
646SUBROUTINE r50setvar_p (var, val_exp, key_wd, val_put)
647
648  REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: var              !! 5D integer array to modify
649  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
650  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
651  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
652
653  REAL(r_std)                                  :: val_tmp 
654  INTEGER(i_std)                               :: is_key
655
656  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
657
658  IF (long_print_setvar_p) WRITE(numout,*) 'r50setvar',val_exp, val_put
659
660  val_tmp = val_put
661
662  IF ( ALL( var(:,:,:,:,:) == val_exp ) ) THEN
663     IF ( is_key <= 0 ) THEN
664       CALL getin_p(key_wd,  val_tmp)
665     ENDIF
666     var(:,:,:,:,:) = val_tmp
667  END IF
668
669END SUBROUTINE r50setvar_p
670
671END MODULE sechiba_io_p
Note: See TracBrowser for help on using the repository browser.