Context Navigation

source: branches/ORCHIDEE_Quest/ORCHIDEE/src_sechiba/sechiba_io_p.f90 @ 7406

Last change on this file since 7406 was 4470, checked in by josefine.ghattas, 8 years ago
Change adresse for orchidee-help in the comments.
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 24.6 KB

Line
1	! ================================================================================================================================
2	! MODULE : sechiba_io_p
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.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
40	MODULE 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, r22setvar_p, r30setvar_p
56	END INTERFACE
57
58	LOGICAL, SAVE :: long_print_setvar_p=.FALSE. !! change to true to have more information
59	!$OMP THREADPRIVATE(long_print_setvar_p)
60
61	CONTAINS
62
63	!! =============================================================================================================================
64	!! SUBROUTINE: i0setvar_p
65	!!
66	!>\BRIEF Subroutine for initializing an integer scalar variable with a scalar integer.
67	!!
68	!! DESCRIPTION: Subroutine for initializing an integer scalar variable with a scalar integer.
69	!! This subroutine must be called by all processes.
70	!! \n
71	!_ ==============================================================================================================================
72	SUBROUTINE i0setvar_p (var, val_exp, key_wd, val_put)
73
74	INTEGER(i_std), INTENT(inout) :: var !! Integer scalar to modify
75	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
76	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
77	INTEGER(i_std), INTENT(in) :: val_put !! Initial value to stored
78
79	INTEGER(i_std) :: val_tmp
80	INTEGER(i_std) :: is_key
81
82	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
83
84	IF (long_print_setvar_p) WRITE (numout,*) "i0setvar :", key_wd, val_exp, val_put
85
86	val_tmp = val_put
87
88	IF ( var == val_exp ) THEN
89	IF ( is_key <= 0 ) THEN
90	CALL getin_p(key_wd, val_tmp)
91	ENDIF
92	var = val_tmp
93	END IF
94
95	END SUBROUTINE i0setvar_p
96
97
98	!! =============================================================================================================================
99	!! SUBROUTINE: i10setvar_p
100	!!
101	!>\BRIEF Subroutine for initializing an integer 1D array with a integer scalar variable.
102	!!
103	!! DESCRIPTION: Subroutine for initializing an integer 1D array with a integer scalar variable.
104	!! This subroutine must be called by all processes.
105	!! \n
106	!_ ==============================================================================================================================
107	SUBROUTINE i10setvar_p (var, val_exp, key_wd, val_put)
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), INTENT(in) :: val_put !! Scalar value to stored
113
114	INTEGER(i_std) :: val_tmp
115	INTEGER(i_std) :: is_key
116
117	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
118
119	IF (long_print_setvar_p) WRITE (numout,*) "i10setvar :", key_wd, val_exp, val_put
120
121	val_tmp = val_put
122
123	IF ( ALL( var(:) == val_exp ) ) THEN
124	IF ( is_key <= 0 ) THEN
125	CALL getin_p(key_wd, val_tmp)
126	ENDIF
127	var(:) = val_tmp
128	END IF
129
130	END SUBROUTINE i10setvar_p
131
132
133	!! =============================================================================================================================
134	!! SUBROUTINE: i11setvar_p
135	!!
136	!>\BRIEF Subroutine for initializing an integer 1D array with another integer 1D array.
137	!!
138	!! DESCRIPTION: Subroutine for initializing an integer 1D array with another integer 1D array.
139	!! This subroutine must be called by all processes.
140	!! \n
141	!_ ==============================================================================================================================
142	SUBROUTINE i11setvar_p (var, val_exp, key_wd, val_put, is_grid)
143
144	INTEGER(i_std), DIMENSION(:), INTENT(inout) :: var !! 1D integer array to modify
145	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
146	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
147	INTEGER(i_std), DIMENSION(:), INTENT(in) :: val_put !! 1D integer array to stored
148	LOGICAL, OPTIONAL :: is_grid !! Parameter present indicates a setvar for a grid variable
149
150	INTEGER(i_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
151	INTEGER(i_std), ALLOCATABLE,DIMENSION(:) :: val_tmp_g
152	INTEGER(i_std) :: is_key
153
154	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
155
156	IF (long_print_setvar_p) WRITE (numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
157
158	ALLOCATE(val_tmp(SIZE(val_put)))
159	val_tmp(:) = val_put(:)
160
161	IF ( ALL( var(:) == val_exp ) ) THEN
162	IF ( is_key <= 0 ) THEN
163	IF (PRESENT(is_grid) ) THEN
164	IF (is_root_prc) THEN
165	ALLOCATE( val_tmp_g(nbp_glo) )
166	ELSE
167	ALLOCATE( val_tmp_g(1) )
168	ENDIF
169	CALL gather( val_tmp,val_tmp_g )
170	IF (is_root_prc) &
171	CALL getin(key_wd, val_tmp_g)
172	CALL scatter( val_tmp,val_tmp_g )
173	DEALLOCATE( val_tmp_g )
174	ELSE
175	CALL getin_p(key_wd, val_tmp)
176	ENDIF
177	ENDIF
178	var(:) = val_tmp (:)
179	END IF
180
181	DEALLOCATE(val_tmp)
182
183	END SUBROUTINE i11setvar_p
184
185
186	!! =============================================================================================================================
187	!! SUBROUTINE: i20setvar_p
188	!!
189	!>\BRIEF Subroutine for initializing an integer 2D variable with a scalar integer variable.
190	!!
191	!! DESCRIPTION: Subroutine for initializing an integer 2D variable with a scalar integer variable.
192	!! This subroutine must be called by all processes.
193	!! \n
194	!_ ==============================================================================================================================
195	SUBROUTINE i20setvar_p (var, val_exp, key_wd, val_put)
196
197	INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D integer array to modify
198	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
199	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
200	INTEGER(i_std), INTENT(in) :: val_put !! Scalar value to be used as default
201
202	INTEGER(i_std) :: val_tmp
203	INTEGER(i_std) :: is_key
204
205	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
206
207	IF (long_print_setvar_p) WRITE (numout,*) "i20setvar :", key_wd, val_exp, val_put
208
209	val_tmp = val_put
210
211	IF ( ALL( var(:,:) == val_exp ) ) THEN
212	IF ( is_key <= 0 ) THEN
213	CALL getin_p(key_wd, val_tmp)
214	ENDIF
215	var(:,:) = val_tmp
216	END IF
217
218	END SUBROUTINE i20setvar_p
219
220
221	!! =============================================================================================================================
222	!! SUBROUTINE: i21setvar_p
223	!!
224	!>\BRIEF Subroutine for initialieing an 2D integer variable with a 1D array integer.
225	!!
226	!! DESCRIPTION: Subroutine for initialieing an 2D integer variable with a 1D array integer.
227	!! This subroutine must be called by all processes.
228	!! Row or column depending size of 1D array to stored.
229	!!
230	!! example: 1D 1,2,3 2D is 1, 2, 3,
231	!! 1, 2, 3
232	!!
233	!! example: 1D 1,2,3 2D is 1, 1,
234	!! 2, 2,
235	!! 3, 3
236	!! \n
237	!_ ==============================================================================================================================
238	SUBROUTINE i21setvar_p (var, val_exp, key_wd, val_put, is_grid)
239
240	INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D integer array to modify
241	INTEGER(i_std), INTENT(in) :: val_exp !! Exceptional value
242	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
243	INTEGER(i_std), DIMENSION(:), INTENT(in) :: val_put !! 1D integer array to stored
244	LOGICAL, OPTIONAL :: is_grid !! Parameter present indicates a setvar for a grid variable
245
246	INTEGER(i_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
247	INTEGER(i_std) :: is_key
248
249	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
250
251	! test if the 1D array dimension is compatible with first or second
252	! dimension of the 2D array
253
254	IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, val_put
255
256	ALLOCATE(val_tmp(SIZE(val_put)))
257	val_tmp(:) = val_put(:)
258
259	IF (SIZE(val_put)==SIZE(var,1)) THEN
260	!
261	! example: 1D 1.,2.,3. 2D is 1., 2., 3.,
262	! 1., 2., 3.
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(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
269	END IF
270	ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN
271	!
272	! example: 1D 1.,2.,3. 2D is 1., 1.,
273	! 2., 2.,
274	! 3., 3.
275	!
276	IF ( ALL( var(:,:) == val_exp ) ) THEN
277	IF ( is_key <= 0 ) THEN
278	CALL getin_p(key_wd, val_tmp)
279	ENDIF
280	var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
281	END IF
282	ELSE
283	WRITE (numout,*) ' incompatible dimension var and val_put'
284	WRITE (numout,*) ' var ', SIZE(var,1), SIZE(var,2)
285	WRITE (numout,*) ' val_put ', SIZE(val_put)
286	STOP 'setvar'
287	END IF
288
289	DEALLOCATE(val_tmp)
290
291	END SUBROUTINE i21setvar_p
292
293
294	!! =============================================================================================================================
295	!! SUBROUTINE: r0setvar_p
296	!!
297	!>\BRIEF Subroutine for initializing a real scalar variable.
298	!!
299	!! DESCRIPTION: Subroutine for initializing a real scalar variable with a real scalar variable.
300	!! This subroutine must be called by all processes.
301	!! \n
302	!_ ==============================================================================================================================
303	SUBROUTINE r0setvar_p (var, val_exp, key_wd, val_put)
304
305	REAL(r_std), INTENT(inout) :: var !! Real scalar to modify
306	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
307	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
308	REAL(r_std), INTENT(in) :: val_put !! Initial value to stored
309
310	REAL(r_std) :: val_tmp
311	INTEGER(i_std) :: is_key
312
313	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
314
315	IF (long_print_setvar_p) WRITE (numout,*) "r0setvar :", key_wd, val_exp, val_put
316
317	val_tmp = val_put
318
319	IF ( var==val_exp ) THEN
320	IF ( is_key <= 0 ) THEN
321	CALL getin_p(key_wd, val_tmp)
322	ENDIF
323	var = val_tmp
324	END IF
325
326	END SUBROUTINE r0setvar_p
327
328
329	!! =============================================================================================================================
330	!! SUBROUTINE: r10setvar_p
331	!!
332	!>\BRIEF Subroutine for initializing an real 1D array with a real scalar variable.
333	!!
334	!! DESCRIPTION: Subroutine for initializing an real 1D array with a real scalar variable.
335	!! This subroutine must be called by all processes.
336	!! \n
337	!_ ==============================================================================================================================
338	SUBROUTINE r10setvar_p (var, val_exp, key_wd, val_put)
339
340	REAL(r_std), DIMENSION(:), INTENT(inout) :: var !! 1D real array to modify
341	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
342	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
343	REAL(r_std), INTENT(in) :: val_put !! Scalar value to stored
344
345	REAL(r_std) :: val_tmp
346	INTEGER(i_std) :: is_key
347
348	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
349
350	IF (long_print_setvar_p) WRITE (numout,*) "r10setvar :", key_wd, val_exp, val_put
351
352	val_tmp = val_put
353
354	IF ( ALL( var(:) == val_exp ) ) THEN
355	IF ( is_key <= 0 ) THEN
356	CALL getin_p(key_wd, val_tmp)
357	ENDIF
358	var(:) = val_tmp
359	END IF
360
361	END SUBROUTINE r10setvar_p
362
363
364	!! =============================================================================================================================
365	!! SUBROUTINE: r11setvar_p
366	!!
367	!>\BRIEF Subroutine for initializing an real 1D array with another real 1D array.
368	!!
369	!! DESCRIPTION: Subroutine for initializing an real 1D array with another real 1D array.
370	!! This subroutine must be called by all processes.
371	!! \n
372	!_ ==============================================================================================================================
373	SUBROUTINE r11setvar_p (var, val_exp, key_wd, val_put, is_grid)
374
375	REAL(r_std), DIMENSION(:), INTENT(inout) :: var !! 1D real array to modify
376	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
377	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
378	REAL(r_std), DIMENSION(:), INTENT(in) :: val_put !! 1D integer array to stored
379	LOGICAL, OPTIONAL :: is_grid !! Parameter present indicates a setvar for a grid variable
380
381	REAL(r_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
382	INTEGER(i_std) :: is_key
383
384	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
385
386	IF (long_print_setvar_p) WRITE (numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
387
388	ALLOCATE(val_tmp(SIZE(val_put)))
389	val_tmp(:) = val_put(:)
390
391	IF ( ALL( var(:) == val_exp ) ) THEN
392	IF ( is_key <= 0 ) THEN
393	CALL getin_p(key_wd, val_tmp)
394	ENDIF
395	var(:) = val_tmp (:)
396	END IF
397
398	DEALLOCATE(val_tmp)
399
400	END SUBROUTINE r11setvar_p
401
402
403	!! =============================================================================================================================
404	!! SUBROUTINE: r20setvar_p
405	!!
406	!>\BRIEF Subroutine for initializing an real 2D variable with a scalar real variable.
407	!!
408	!! DESCRIPTION: Subroutine for initializing an real 2D variable with a scalar real variable.
409	!! This subroutine must be called by all processes.
410	!! \n
411	!_ ==============================================================================================================================
412	SUBROUTINE r20setvar_p (var, val_exp, key_wd, val_put)
413
414	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D integer array to modify
415	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
416	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
417	REAL(r_std), INTENT(in) :: val_put !! Scalar value to stored
418
419	REAL(r_std) :: val_tmp
420	INTEGER(i_std) :: is_key
421
422	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
423
424	IF (long_print_setvar_p) WRITE (numout,*) "r20setvar :", key_wd, val_exp, val_put
425
426	val_tmp = val_put
427
428	IF ( ALL( var(:,:) == val_exp ) ) THEN
429	IF ( is_key <= 0 ) THEN
430	CALL getin_p(key_wd, val_tmp)
431	ENDIF
432	var(:,:) = val_tmp
433	END IF
434
435	END SUBROUTINE r20setvar_p
436
437	!! =============================================================================================================================
438	!! SUBROUTINE: r21setvar_p
439	!!
440	!>\BRIEF Subroutine for initialieing an 2D real variable with a 1D array real.
441	!!
442	!! DESCRIPTION: Subroutine for initialieing an 2D real variable with a 1D array real.
443	!! This subroutine must be called by all processes.
444	!! Row or column depending size of 1D array to stored.
445	!!
446	!! example: 1D 1,2,3 2D is 1, 2, 3,
447	!! 1, 2, 3
448	!!
449	!! example: 1D 1,2,3 2D is 1, 1,
450	!! 2, 2,
451	!! 3, 3
452	!! \n
453	!_ ==============================================================================================================================
454	SUBROUTINE r21setvar_p (var, val_exp, key_wd, val_put, is_grid)
455
456	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D real array to modify
457	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
458	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
459	REAL(r_std), DIMENSION(:), INTENT(in) :: val_put !! 1D real array to stored
460	LOGICAL, OPTIONAL :: is_grid !! Parameter present indicates a setvar for a grid variable
461
462	REAL(r_std), ALLOCATABLE,DIMENSION(:) :: val_tmp
463	INTEGER(i_std) :: is_key
464
465	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
466
467	! test if the 1D array dimension is compatible with first or second
468	! dimension of the 2D array
469
470	IF (long_print_setvar_p) WRITE (numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
471
472	ALLOCATE(val_tmp(SIZE(val_put)))
473	val_tmp(:) = val_put(:)
474
475	IF (SIZE(val_put)==SIZE(var,1)) THEN
476	!
477	! example: 1D 1.,2.,3. 2D is 1., 2., 3.,
478	! 1., 2., 3.
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(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
485	END IF
486	ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN
487	!
488	! example: 1D 1.,2.,3. 2D is 1., 1.,
489	! 2., 2.,
490	! 3., 3.
491	!
492	IF ( ALL( var(:,:) == val_exp ) ) THEN
493	IF ( is_key <= 0 ) THEN
494	CALL getin_p(key_wd, val_tmp)
495	ENDIF
496	var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
497	END IF
498	ELSE
499	WRITE (numout,*) ' incompatible dimension var and val_put'
500	WRITE (numout,*) ' var ', SIZE(var,1), SIZE(var,2)
501	WRITE (numout,*) ' val_put ', SIZE(val_put)
502	STOP 'setvar'
503	END IF
504
505	DEALLOCATE(val_tmp)
506
507	END SUBROUTINE r21setvar_p
508
509
510	!! =============================================================================================================================
511	!! SUBROUTINE: r22setvar_p
512	!!
513	!>\BRIEF Subroutine for initializing a 2D real variable with a real with the same size.
514	!!
515	!! DESCRIPTION: Subroutine for initializing a 2D real variable with a real with the same size or by reading an scalar value
516	!! from run.def if key_wd is different from "NO_KEYWORD" or "NOKEYWORD".
517	!! It is not possible to read a 2D variable from run.def.
518	!! This subroutine must be called by all processes.
519	!! \n
520	!_ ==============================================================================================================================
521	SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put)
522
523	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: var !! 2D real array to modify
524	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
525	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
526	REAL(r_std), DIMENSION(:,:), INTENT(in) :: val_put !! 2D integer array to stored
527	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: val_tmp
528	REAL(r_std) :: val_scal !! Temporary variable to read a scalar value from run.def
529	INTEGER(i_std) :: is_key
530
531	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
532
533	IF (long_print_setvar_p) WRITE (numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
534
535	ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
536	val_tmp(:,:) = val_put(:,:)
537
538	IF ( ALL( var(:,:) == val_exp ) ) THEN
539	IF ( is_key <= 0 ) THEN
540	! This case only read a scalar value with getin
541	val_scal=val_exp
542	CALL getin_p(key_wd, val_scal)
543	! If a value was found in run.def, then set val_tmp to this value.
544	IF (val_scal/=val_exp) val_tmp(:,:)=val_scal
545	ENDIF
546	var(:,:) = val_tmp(:,:)
547	END IF
548
549	DEALLOCATE(val_tmp)
550
551	END SUBROUTINE r22setvar_p
552
553	!! =============================================================================================================================
554	!! SUBROUTINE: r30setvar_p
555	!!
556	!>\BRIEF Subroutine for initializing an real 3D variable with a scalar real variable.
557	!!
558	!! DESCRIPTION: Subroutine for initializing an real 3D variable with a scalar real variable.
559	!! This subroutine must be called by all processes.
560	!! \n
561	!_ ==============================================================================================================================
562	SUBROUTINE r30setvar_p (var, val_exp, key_wd, val_put)
563
564	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var !! 3D integer array to modify
565	REAL(r_std), INTENT(in) :: val_exp !! Exceptional value
566	CHARACTER(LEN=*), INTENT(in) :: key_wd !! The Key word we will look for
567	REAL(r_std), INTENT(in) :: val_put !! Scalar value to stored
568
569	REAL(r_std) :: val_tmp
570	INTEGER(i_std) :: is_key
571
572	is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
573
574	IF (long_print_setvar_p) WRITE(numout,*) 'r30setvar',val_exp, val_put
575
576	val_tmp = val_put
577
578	IF ( ALL( var(:,:,:) == val_exp ) ) THEN
579	IF ( is_key <= 0 ) THEN
580	CALL getin_p(key_wd, val_tmp)
581	ENDIF
582	var(:,:,:) = val_tmp
583	END IF
584
585	END SUBROUTINE r30setvar_p
586
587	END MODULE sechiba_io_p

Note: See TracBrowser for help on using the repository browser.

Download in other formats: