/[lmdze]/trunk/IOIPSL/getincom.f90
ViewVC logotype

Annotation of /trunk/IOIPSL/getincom.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 51 - (hide annotations)
Tue Sep 20 09:14:34 2011 UTC (12 years, 8 months ago) by guez
Original Path: trunk/libf/IOIPSL/getincom.f90
File size: 17468 byte(s) 
Split "getincom.f90" into "getincom.f90" and "getincom2.f90". Split
"nuage.f" into "nuage.f90", "diagcld1.f90" and "diagcld2.f90". Created
module "chem" from included file "chem.h". Moved "YOEGWD.f90" to
directory "Orography".

In "physiq", for evaporation of water, "zlsdcp" was equal to
"zlvdc". Removed useless variables.
1 guez 30 MODULE getincom
2    
3 guez 51 ! From getincom.f90, version 2.0 2004/04/05 14:47:48
4 guez 30
5 guez 32 use gensig_m, only: gensig
6     use find_sig_m, only: find_sig
7 guez 51 use getincom2, only: nb_keys, keysig, keystr, getfill, getdbwl, getdbrl, &
8     getfilc, getdbwc, getdbrc, getfili, getdbwi, getdbri, getfilr, &
9     getdbwr, getdbrr
10 guez 30
11     IMPLICIT NONE
12    
13     PRIVATE
14 guez 51 PUBLIC getin
15 guez 30
16     INTERFACE getin
17 guez 51 MODULE PROCEDURE getinrs, getinr1d, getinr2d, getinis, getini1d, &
18     getini2d, getincs, getinc1d, getinc2d, getinls, getinl1d, getinl2d
19 guez 30 END INTERFACE
20    
21 guez 51 CONTAINS
22 guez 30
23 guez 51 SUBROUTINE getinrs(MY_TARGET, ret_val)
24 guez 30
25 guez 51 ! Get a real scalar. We first check whether we find it in the
26     ! database and if not we get it from "run.def". "getinr1d" and
27     ! "getinr2d" are written on the same pattern.
28 guez 30
29 guez 51 CHARACTER(LEN=*) MY_TARGET
30     REAL ret_val
31 guez 30
32 guez 51 ! Local:
33     REAL, DIMENSION(1):: tmp_ret_val
34     INTEGER:: target_sig, pos, status = 0, fileorig
35 guez 30
36 guez 51 !--------------------------------------------------------------------
37 guez 30
38 guez 51 ! Compute the signature of the target
39     CALL gensig(MY_TARGET, target_sig)
40 guez 30
41 guez 51 ! Do we have this my_target in our database ?
42 guez 30
43     ! "find_sig" should not be called if "keystr" and "keysig" are not
44     ! allocated.
45     ! Avoid this problem with a test on "nb_keys":
46     if (nb_keys > 0) then
47 guez 51 CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
48 guez 30 else
49     pos = -1
50     end if
51 guez 51
52 guez 30 tmp_ret_val(1) = ret_val
53 guez 51
54 guez 30 IF (pos < 0) THEN
55 guez 51 ! Get the information out of the file
56     CALL getfilr(MY_TARGET, status, fileorig, tmp_ret_val)
57     ! Put the data into the database
58     CALL getdbwr(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
59 guez 30 ELSE
60 guez 51 ! Get the value out of the database
61     CALL getdbrr (pos, 1, MY_TARGET, tmp_ret_val)
62 guez 30 ENDIF
63     ret_val = tmp_ret_val(1)
64 guez 51
65 guez 30 END SUBROUTINE getinrs
66    
67     !****************************
68    
69 guez 51 SUBROUTINE getinr1d(MY_TARGET, ret_val)
70    
71     ! See getinrs for details. It is the same thing but for a vector
72    
73    
74     CHARACTER(LEN=*) :: MY_TARGET
75     REAL, DIMENSION(:) :: ret_val
76    
77     REAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
78     INTEGER, SAVE :: tmp_ret_size = 0
79 guez 30 INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
80 guez 51
81    
82 guez 30 ! Compute the signature of the target
83 guez 51
84     CALL gensig(MY_TARGET, target_sig)
85    
86 guez 30 ! Do we have this target in our database ?
87 guez 51
88     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
89    
90 guez 30 size_of_in = SIZE(ret_val)
91     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
92     ALLOCATE (tmp_ret_val(size_of_in))
93     ELSE IF (size_of_in > tmp_ret_size) THEN
94     DEALLOCATE (tmp_ret_val)
95     ALLOCATE (tmp_ret_val(size_of_in))
96     tmp_ret_size = size_of_in
97     ENDIF
98     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
99 guez 51
100 guez 30 IF (pos < 0) THEN
101 guez 51 ! Ge the information out of the file
102     CALL getfilr(MY_TARGET, status, fileorig, tmp_ret_val)
103     ! Put the data into the database
104 guez 30 CALL getdbwr &
105 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
106 guez 30 ELSE
107 guez 51 ! Get the value out of the database
108     CALL getdbrr (pos, size_of_in, MY_TARGET, tmp_ret_val)
109 guez 30 ENDIF
110     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
111 guez 51
112 guez 30 END SUBROUTINE getinr1d
113    
114     !****************************
115    
116 guez 51 SUBROUTINE getinr2d(MY_TARGET, ret_val)
117    
118     ! See getinrs for details. It is the same thing but for a matrix
119    
120    
121     CHARACTER(LEN=*) :: MY_TARGET
122     REAL, DIMENSION(:, :) :: ret_val
123    
124     REAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
125     INTEGER, SAVE :: tmp_ret_size = 0
126     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig
127 guez 30 INTEGER :: jl, jj, ji
128 guez 51
129    
130 guez 30 ! Compute the signature of the target
131 guez 51
132     CALL gensig(MY_TARGET, target_sig)
133    
134 guez 30 ! Do we have this target in our database ?
135 guez 51
136     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
137    
138 guez 30 size_of_in = SIZE(ret_val)
139 guez 51 size_1 = SIZE(ret_val, 1)
140     size_2 = SIZE(ret_val, 2)
141 guez 30 IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
142     ALLOCATE (tmp_ret_val(size_of_in))
143     ELSE IF (size_of_in > tmp_ret_size) THEN
144     DEALLOCATE (tmp_ret_val)
145     ALLOCATE (tmp_ret_val(size_of_in))
146     tmp_ret_size = size_of_in
147     ENDIF
148 guez 51
149 guez 30 jl=0
150 guez 51 DO jj=1, size_2
151     DO ji=1, size_1
152 guez 30 jl=jl+1
153 guez 51 tmp_ret_val(jl) = ret_val(ji, jj)
154 guez 30 ENDDO
155     ENDDO
156 guez 51
157 guez 30 IF (pos < 0) THEN
158 guez 51 ! Ge the information out of the file
159     CALL getfilr(MY_TARGET, status, fileorig, tmp_ret_val)
160     ! Put the data into the database
161 guez 30 CALL getdbwr &
162 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
163 guez 30 ELSE
164 guez 51 ! Get the value out of the database
165     CALL getdbrr (pos, size_of_in, MY_TARGET, tmp_ret_val)
166 guez 30 ENDIF
167 guez 51
168 guez 30 jl=0
169 guez 51 DO jj=1, size_2
170     DO ji=1, size_1
171 guez 30 jl=jl+1
172 guez 51 ret_val(ji, jj) = tmp_ret_val(jl)
173 guez 30 ENDDO
174     ENDDO
175 guez 51
176 guez 30 END SUBROUTINE getinr2d
177    
178     !****************************
179    
180 guez 51 SUBROUTINE getinis(MY_TARGET, ret_val)
181 guez 30
182 guez 51 ! Get a interer scalar. We first check if we find it
183     ! in the database and if not we get it from the run.def
184 guez 30
185 guez 51 ! getini1d and getini2d are written on the same pattern
186    
187    
188     CHARACTER(LEN=*) :: MY_TARGET
189 guez 30 INTEGER :: ret_val
190 guez 51
191     INTEGER, DIMENSION(1) :: tmp_ret_val
192 guez 30 INTEGER :: target_sig, pos, status=0, fileorig
193 guez 51
194    
195 guez 30 ! Compute the signature of the target
196 guez 51
197     CALL gensig(MY_TARGET, target_sig)
198    
199 guez 30 ! Do we have this target in our database ?
200 guez 51
201     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
202    
203 guez 30 tmp_ret_val(1) = ret_val
204 guez 51
205 guez 30 IF (pos < 0) THEN
206 guez 51 ! Ge the information out of the file
207     CALL getfili(MY_TARGET, status, fileorig, tmp_ret_val)
208     ! Put the data into the database
209     CALL getdbwi(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
210 guez 30 ELSE
211 guez 51 ! Get the value out of the database
212     CALL getdbri (pos, 1, MY_TARGET, tmp_ret_val)
213 guez 30 ENDIF
214     ret_val = tmp_ret_val(1)
215 guez 51
216 guez 30 END SUBROUTINE getinis
217    
218     !****************************
219    
220 guez 51 SUBROUTINE getini1d(MY_TARGET, ret_val)
221    
222     ! See getinis for details. It is the same thing but for a vector
223    
224    
225     CHARACTER(LEN=*) :: MY_TARGET
226     INTEGER, DIMENSION(:) :: ret_val
227    
228     INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
229     INTEGER, SAVE :: tmp_ret_size = 0
230 guez 30 INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
231 guez 51
232    
233 guez 30 ! Compute the signature of the target
234 guez 51
235     CALL gensig(MY_TARGET, target_sig)
236    
237 guez 30 ! Do we have this target in our database ?
238 guez 51
239     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
240    
241 guez 30 size_of_in = SIZE(ret_val)
242     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
243     ALLOCATE (tmp_ret_val(size_of_in))
244     ELSE IF (size_of_in > tmp_ret_size) THEN
245     DEALLOCATE (tmp_ret_val)
246     ALLOCATE (tmp_ret_val(size_of_in))
247     tmp_ret_size = size_of_in
248     ENDIF
249     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
250 guez 51
251 guez 30 IF (pos < 0) THEN
252 guez 51 ! Ge the information out of the file
253     CALL getfili(MY_TARGET, status, fileorig, tmp_ret_val)
254     ! Put the data into the database
255 guez 30 CALL getdbwi &
256 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
257 guez 30 ELSE
258 guez 51 ! Get the value out of the database
259     CALL getdbri (pos, size_of_in, MY_TARGET, tmp_ret_val)
260 guez 30 ENDIF
261     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
262 guez 51
263 guez 30 END SUBROUTINE getini1d
264    
265     !****************************
266    
267 guez 51 SUBROUTINE getini2d(MY_TARGET, ret_val)
268    
269     ! See getinis for details. It is the same thing but for a matrix
270    
271    
272     CHARACTER(LEN=*) :: MY_TARGET
273     INTEGER, DIMENSION(:, :) :: ret_val
274    
275     INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
276     INTEGER, SAVE :: tmp_ret_size = 0
277     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig
278 guez 30 INTEGER :: jl, jj, ji
279 guez 51
280    
281 guez 30 ! Compute the signature of the target
282 guez 51
283     CALL gensig(MY_TARGET, target_sig)
284    
285 guez 30 ! Do we have this target in our database ?
286 guez 51
287     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
288    
289 guez 30 size_of_in = SIZE(ret_val)
290 guez 51 size_1 = SIZE(ret_val, 1)
291     size_2 = SIZE(ret_val, 2)
292 guez 30 IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
293     ALLOCATE (tmp_ret_val(size_of_in))
294     ELSE IF (size_of_in > tmp_ret_size) THEN
295     DEALLOCATE (tmp_ret_val)
296     ALLOCATE (tmp_ret_val(size_of_in))
297     tmp_ret_size = size_of_in
298     ENDIF
299 guez 51
300 guez 30 jl=0
301 guez 51 DO jj=1, size_2
302     DO ji=1, size_1
303 guez 30 jl=jl+1
304 guez 51 tmp_ret_val(jl) = ret_val(ji, jj)
305 guez 30 ENDDO
306     ENDDO
307 guez 51
308 guez 30 IF (pos < 0) THEN
309 guez 51 ! Ge the information out of the file
310     CALL getfili(MY_TARGET, status, fileorig, tmp_ret_val)
311     ! Put the data into the database
312 guez 30 CALL getdbwi &
313 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
314 guez 30 ELSE
315 guez 51 ! Get the value out of the database
316     CALL getdbri (pos, size_of_in, MY_TARGET, tmp_ret_val)
317 guez 30 ENDIF
318 guez 51
319 guez 30 jl=0
320 guez 51 DO jj=1, size_2
321     DO ji=1, size_1
322 guez 30 jl=jl+1
323 guez 51 ret_val(ji, jj) = tmp_ret_val(jl)
324 guez 30 ENDDO
325     ENDDO
326 guez 51
327 guez 30 END SUBROUTINE getini2d
328    
329     !****************************
330    
331     !=== CHARACTER INTERFACES
332    
333 guez 51 SUBROUTINE getincs(MY_TARGET, ret_val)
334    
335     ! Get a CHARACTER scalar. We first check if we find it
336     ! in the database and if not we get it from the run.def
337    
338     ! getinc1d and getinc2d are written on the same pattern
339    
340    
341     CHARACTER(LEN=*) :: MY_TARGET
342 guez 30 CHARACTER(LEN=*) :: ret_val
343 guez 51
344     CHARACTER(LEN=100), DIMENSION(1) :: tmp_ret_val
345 guez 30 INTEGER :: target_sig, pos, status=0, fileorig
346 guez 51
347    
348 guez 30 ! Compute the signature of the target
349 guez 51
350     CALL gensig(MY_TARGET, target_sig)
351    
352 guez 30 ! Do we have this target in our database ?
353 guez 51
354     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
355    
356 guez 30 tmp_ret_val(1) = ret_val
357 guez 51
358 guez 30 IF (pos < 0) THEN
359 guez 51 ! Ge the information out of the file
360     CALL getfilc(MY_TARGET, status, fileorig, tmp_ret_val)
361     ! Put the data into the database
362     CALL getdbwc(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
363 guez 30 ELSE
364 guez 51 ! Get the value out of the database
365     CALL getdbrc (pos, 1, MY_TARGET, tmp_ret_val)
366 guez 30 ENDIF
367     ret_val = tmp_ret_val(1)
368 guez 51
369 guez 30 END SUBROUTINE getincs
370    
371     !****************************
372    
373 guez 51 SUBROUTINE getinc1d(MY_TARGET, ret_val)
374    
375     ! See getincs for details. It is the same thing but for a vector
376    
377    
378     CHARACTER(LEN=*) :: MY_TARGET
379     CHARACTER(LEN=*), DIMENSION(:) :: ret_val
380    
381     CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
382     INTEGER, SAVE :: tmp_ret_size = 0
383 guez 30 INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
384 guez 51
385    
386 guez 30 ! Compute the signature of the target
387 guez 51
388     CALL gensig(MY_TARGET, target_sig)
389    
390 guez 30 ! Do we have this target in our database ?
391 guez 51
392     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
393    
394 guez 30 size_of_in = SIZE(ret_val)
395     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
396     ALLOCATE (tmp_ret_val(size_of_in))
397     ELSE IF (size_of_in > tmp_ret_size) THEN
398     DEALLOCATE (tmp_ret_val)
399     ALLOCATE (tmp_ret_val(size_of_in))
400     tmp_ret_size = size_of_in
401     ENDIF
402     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
403 guez 51
404 guez 30 IF (pos < 0) THEN
405 guez 51 ! Ge the information out of the file
406     CALL getfilc(MY_TARGET, status, fileorig, tmp_ret_val)
407     ! Put the data into the database
408 guez 30 CALL getdbwc &
409 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
410 guez 30 ELSE
411 guez 51 ! Get the value out of the database
412     CALL getdbrc (pos, size_of_in, MY_TARGET, tmp_ret_val)
413 guez 30 ENDIF
414     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
415 guez 51
416 guez 30 END SUBROUTINE getinc1d
417    
418     !****************************
419    
420 guez 51 SUBROUTINE getinc2d(MY_TARGET, ret_val)
421    
422     ! See getincs for details. It is the same thing but for a matrix
423    
424    
425     CHARACTER(LEN=*) :: MY_TARGET
426     CHARACTER(LEN=*), DIMENSION(:, :) :: ret_val
427    
428     CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
429     INTEGER, SAVE :: tmp_ret_size = 0
430     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig
431     INTEGER :: jl, jj, ji
432    
433    
434 guez 30 ! Compute the signature of the target
435 guez 51
436     CALL gensig(MY_TARGET, target_sig)
437    
438 guez 30 ! Do we have this target in our database ?
439 guez 51
440     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
441    
442 guez 30 size_of_in = SIZE(ret_val)
443 guez 51 size_1 = SIZE(ret_val, 1)
444     size_2 = SIZE(ret_val, 2)
445 guez 30 IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
446     ALLOCATE (tmp_ret_val(size_of_in))
447     ELSE IF (size_of_in > tmp_ret_size) THEN
448     DEALLOCATE (tmp_ret_val)
449     ALLOCATE (tmp_ret_val(size_of_in))
450     tmp_ret_size = size_of_in
451     ENDIF
452 guez 51
453 guez 30 jl=0
454 guez 51 DO jj=1, size_2
455     DO ji=1, size_1
456 guez 30 jl=jl+1
457 guez 51 tmp_ret_val(jl) = ret_val(ji, jj)
458 guez 30 ENDDO
459     ENDDO
460 guez 51
461 guez 30 IF (pos < 0) THEN
462 guez 51 ! Ge the information out of the file
463     CALL getfilc(MY_TARGET, status, fileorig, tmp_ret_val)
464     ! Put the data into the database
465 guez 30 CALL getdbwc &
466 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
467 guez 30 ELSE
468 guez 51 ! Get the value out of the database
469     CALL getdbrc (pos, size_of_in, MY_TARGET, tmp_ret_val)
470 guez 30 ENDIF
471 guez 51
472 guez 30 jl=0
473 guez 51 DO jj=1, size_2
474     DO ji=1, size_1
475 guez 30 jl=jl+1
476 guez 51 ret_val(ji, jj) = tmp_ret_val(jl)
477 guez 30 ENDDO
478     ENDDO
479 guez 51
480 guez 30 END SUBROUTINE getinc2d
481    
482     !****************************
483    
484     !=== LOGICAL INTERFACES
485    
486 guez 51 SUBROUTINE getinls(MY_TARGET, ret_val)
487    
488     ! Get a logical scalar. We first check if we find it
489     ! in the database and if not we get it from the run.def
490    
491     ! getinl1d and getinl2d are written on the same pattern
492    
493    
494     CHARACTER(LEN=*) :: MY_TARGET
495 guez 30 LOGICAL :: ret_val
496 guez 51
497     LOGICAL, DIMENSION(1) :: tmp_ret_val
498 guez 30 INTEGER :: target_sig, pos, status=0, fileorig
499 guez 51
500    
501 guez 30 ! Compute the signature of the target
502 guez 51
503     CALL gensig(MY_TARGET, target_sig)
504    
505 guez 30 ! Do we have this target in our database ?
506 guez 51
507 guez 30 if (nb_keys > 0) then
508 guez 51 CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
509 guez 30 else
510     pos = -1
511     end if
512 guez 51
513 guez 30 tmp_ret_val(1) = ret_val
514 guez 51
515 guez 30 IF (pos < 0) THEN
516 guez 51 ! Ge the information out of the file
517     CALL getfill(MY_TARGET, status, fileorig, tmp_ret_val)
518     ! Put the data into the database
519     CALL getdbwl(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
520 guez 30 ELSE
521 guez 51 ! Get the value out of the database
522     CALL getdbrl (pos, 1, MY_TARGET, tmp_ret_val)
523 guez 30 ENDIF
524     ret_val = tmp_ret_val(1)
525 guez 51
526 guez 30 END SUBROUTINE getinls
527    
528     !****************************
529    
530 guez 51 SUBROUTINE getinl1d(MY_TARGET, ret_val)
531    
532     ! See getinls for details. It is the same thing but for a vector
533    
534    
535     CHARACTER(LEN=*) :: MY_TARGET
536     LOGICAL, DIMENSION(:) :: ret_val
537    
538     LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
539     INTEGER, SAVE :: tmp_ret_size = 0
540 guez 30 INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
541 guez 51
542    
543 guez 30 ! Compute the signature of the target
544 guez 51
545     CALL gensig(MY_TARGET, target_sig)
546    
547 guez 30 ! Do we have this target in our database ?
548 guez 51
549     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
550    
551 guez 30 size_of_in = SIZE(ret_val)
552     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
553     ALLOCATE (tmp_ret_val(size_of_in))
554     ELSE IF (size_of_in > tmp_ret_size) THEN
555     DEALLOCATE (tmp_ret_val)
556     ALLOCATE (tmp_ret_val(size_of_in))
557     tmp_ret_size = size_of_in
558     ENDIF
559     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
560 guez 51
561 guez 30 IF (pos < 0) THEN
562 guez 51 ! Ge the information out of the file
563     CALL getfill(MY_TARGET, status, fileorig, tmp_ret_val)
564     ! Put the data into the database
565 guez 30 CALL getdbwl &
566 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
567 guez 30 ELSE
568 guez 51 ! Get the value out of the database
569     CALL getdbrl (pos, size_of_in, MY_TARGET, tmp_ret_val)
570 guez 30 ENDIF
571     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
572 guez 51
573 guez 30 END SUBROUTINE getinl1d
574    
575     !****************************
576    
577 guez 51 SUBROUTINE getinl2d(MY_TARGET, ret_val)
578    
579     ! See getinls for details. It is the same thing but for a matrix
580    
581    
582     CHARACTER(LEN=*) :: MY_TARGET
583     LOGICAL, DIMENSION(:, :) :: ret_val
584    
585     LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val
586     INTEGER, SAVE :: tmp_ret_size = 0
587     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig
588     INTEGER :: jl, jj, ji
589    
590    
591 guez 30 ! Compute the signature of the target
592 guez 51
593     CALL gensig(MY_TARGET, target_sig)
594    
595 guez 30 ! Do we have this target in our database ?
596 guez 51
597     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
598    
599 guez 30 size_of_in = SIZE(ret_val)
600 guez 51 size_1 = SIZE(ret_val, 1)
601     size_2 = SIZE(ret_val, 2)
602 guez 30 IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
603     ALLOCATE (tmp_ret_val(size_of_in))
604     ELSE IF (size_of_in > tmp_ret_size) THEN
605     DEALLOCATE (tmp_ret_val)
606     ALLOCATE (tmp_ret_val(size_of_in))
607     tmp_ret_size = size_of_in
608     ENDIF
609 guez 51
610 guez 30 jl=0
611 guez 51 DO jj=1, size_2
612     DO ji=1, size_1
613 guez 30 jl=jl+1
614 guez 51 tmp_ret_val(jl) = ret_val(ji, jj)
615 guez 30 ENDDO
616     ENDDO
617 guez 51
618 guez 30 IF (pos < 0) THEN
619 guez 51 ! Ge the information out of the file
620     CALL getfill(MY_TARGET, status, fileorig, tmp_ret_val)
621     ! Put the data into the database
622 guez 30 CALL getdbwl &
623 guez 51 & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)
624 guez 30 ELSE
625 guez 51 ! Get the value out of the database
626     CALL getdbrl (pos, size_of_in, MY_TARGET, tmp_ret_val)
627 guez 30 ENDIF
628 guez 51
629 guez 30 jl=0
630 guez 51 DO jj=1, size_2
631     DO ji=1, size_1
632 guez 30 jl=jl+1
633 guez 51 ret_val(ji, jj) = tmp_ret_val(jl)
634 guez 30 ENDDO
635     ENDDO
636 guez 51
637 guez 30 END SUBROUTINE getinl2d
638    
639     END MODULE getincom
  ViewVC Help
Powered by ViewVC 1.1.21