trunk/IOIPSL/getincom.f90

MODULE getincom

  ! From getincom.f90, version 2.0 2004/04/05 14:47:48

  use gensig_m, only: gensig
  use find_sig_m, only: find_sig
  use getincom2, only: nb_keys, keysig, keystr, getfill, getdbwl, getdbrl, &
       getfili, getdbwi, getdbri, getfilr, getdbwr, getdbrr

  IMPLICIT NONE

  PRIVATE
  PUBLIC getin

  INTERFACE getin
     MODULE PROCEDURE getinrs, getinis, getinls
  END INTERFACE

CONTAINS

  SUBROUTINE getinrs(MY_TARGET, ret_val)

    ! Get a real scalar. We first check whether we find it in the
    ! database and if not we get it from "run.def". "getinr1d" and
    ! "getinr2d" are written on the same pattern.

    CHARACTER(LEN=*) MY_TARGET
    REAL ret_val

    ! Local:
    REAL, DIMENSION(1):: tmp_ret_val
    INTEGER:: target_sig, pos, status = 0, fileorig

    !--------------------------------------------------------------------

    ! Compute the signature of the target
    CALL gensig(MY_TARGET, target_sig)

    ! Do we have this my_target in our database ?

    ! "find_sig" should not be called if "keystr" and "keysig" are not
    ! allocated.
    ! Avoid this problem with a test on "nb_keys":
    if (nb_keys > 0) then
       CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
    else
       pos = -1
    end if

    tmp_ret_val(1) = ret_val

    IF (pos < 0) THEN
       ! Get the information out of the file
       CALL getfilr(MY_TARGET, status, fileorig, tmp_ret_val)
       ! Put the data into the database
       CALL getdbwr(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
    ELSE
       ! Get the value out of the database
       CALL getdbrr (pos, 1, MY_TARGET, tmp_ret_val)
    ENDIF
    ret_val = tmp_ret_val(1)

  END SUBROUTINE getinrs

  !****************************

  SUBROUTINE getinis(MY_TARGET, ret_val)

    ! Get a interer scalar. We first check if we find it
    ! in the database and if not we get it from the run.def

    ! getini1d and getini2d are written on the same pattern


    CHARACTER(LEN=*) :: MY_TARGET
    INTEGER :: ret_val

    INTEGER, DIMENSION(1) :: tmp_ret_val
    INTEGER :: target_sig, pos, status=0, fileorig


    ! Compute the signature of the target

    CALL gensig(MY_TARGET, target_sig)

    ! Do we have this target in our database ?

    CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)

    tmp_ret_val(1) = ret_val

    IF (pos < 0) THEN
       ! Ge the information out of the file
       CALL getfili(MY_TARGET, status, fileorig, tmp_ret_val)
       ! Put the data into the database
       CALL getdbwi(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
    ELSE
       ! Get the value out of the database
       CALL getdbri (pos, 1, MY_TARGET, tmp_ret_val)
    ENDIF
    ret_val = tmp_ret_val(1)

  END SUBROUTINE getinis

  !****************************

  !=== LOGICAL INTERFACES

  SUBROUTINE getinls(MY_TARGET, ret_val)

    ! Get a logical scalar. We first check if we find it
    ! in the database and if not we get it from the run.def

    ! getinl1d and getinl2d are written on the same pattern


    CHARACTER(LEN=*) :: MY_TARGET
    LOGICAL :: ret_val

    LOGICAL, DIMENSION(1) :: tmp_ret_val
    INTEGER :: target_sig, pos, status=0, fileorig


    ! Compute the signature of the target

    CALL gensig(MY_TARGET, target_sig)

    ! Do we have this target in our database ?

    if (nb_keys > 0) then
       CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
    else
       pos = -1
    end if

    tmp_ret_val(1) = ret_val

    IF (pos < 0) THEN
       ! Ge the information out of the file
       CALL getfill(MY_TARGET, status, fileorig, tmp_ret_val)
       ! Put the data into the database
       CALL getdbwl(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
    ELSE
       ! Get the value out of the database
       CALL getdbrl (pos, 1, MY_TARGET, tmp_ret_val)
    ENDIF
    ret_val = tmp_ret_val(1)

  END SUBROUTINE getinls

END MODULE getincom
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	guez	72	getfili, getdbwi, getdbri, getfilr, getdbwr, getdbrr
9	guez	30
10			IMPLICIT NONE
11
12			PRIVATE
13	guez	51	PUBLIC getin
14	guez	30
15			INTERFACE getin
16	guez	72	MODULE PROCEDURE getinrs, getinis, getinls
17	guez	30	END INTERFACE
18
19	guez	51	CONTAINS
20	guez	30
21	guez	51	SUBROUTINE getinrs(MY_TARGET, ret_val)
22	guez	30
23	guez	51	! Get a real scalar. We first check whether we find it in the
24			! database and if not we get it from "run.def". "getinr1d" and
25			! "getinr2d" are written on the same pattern.
26	guez	30
27	guez	51	CHARACTER(LEN=*) MY_TARGET
28			REAL ret_val
29	guez	30
30	guez	51	! Local:
31			REAL, DIMENSION(1):: tmp_ret_val
32			INTEGER:: target_sig, pos, status = 0, fileorig
33	guez	30
34	guez	51	!--------------------------------------------------------------------
35	guez	30
36	guez	51	! Compute the signature of the target
37			CALL gensig(MY_TARGET, target_sig)
38	guez	30
39	guez	51	! Do we have this my_target in our database ?
40	guez	30
41			! "find_sig" should not be called if "keystr" and "keysig" are not
42			! allocated.
43			! Avoid this problem with a test on "nb_keys":
44			if (nb_keys > 0) then
45	guez	51	CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
46	guez	30	else
47			pos = -1
48			end if
49	guez	51
50	guez	30	tmp_ret_val(1) = ret_val
51	guez	51
52	guez	30	IF (pos < 0) THEN
53	guez	51	! Get the information out of the file
54			CALL getfilr(MY_TARGET, status, fileorig, tmp_ret_val)
55			! Put the data into the database
56			CALL getdbwr(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
57	guez	30	ELSE
58	guez	51	! Get the value out of the database
59			CALL getdbrr (pos, 1, MY_TARGET, tmp_ret_val)
60	guez	30	ENDIF
61			ret_val = tmp_ret_val(1)
62	guez	51
63	guez	30	END SUBROUTINE getinrs
64
65			!****************************
66
67	guez	51	SUBROUTINE getinis(MY_TARGET, ret_val)
68	guez	30
69	guez	51	! Get a interer scalar. We first check if we find it
70			! in the database and if not we get it from the run.def
71	guez	30
72	guez	51	! getini1d and getini2d are written on the same pattern
73
74
75			CHARACTER(LEN=*) :: MY_TARGET
76	guez	30	INTEGER :: ret_val
77	guez	51
78			INTEGER, DIMENSION(1) :: tmp_ret_val
79	guez	30	INTEGER :: target_sig, pos, 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	tmp_ret_val(1) = ret_val
91	guez	51
92	guez	30	IF (pos < 0) THEN
93	guez	51	! Ge the information out of the file
94			CALL getfili(MY_TARGET, status, fileorig, tmp_ret_val)
95			! Put the data into the database
96			CALL getdbwi(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
97	guez	30	ELSE
98	guez	51	! Get the value out of the database
99			CALL getdbri (pos, 1, MY_TARGET, tmp_ret_val)
100	guez	30	ENDIF
101			ret_val = tmp_ret_val(1)
102	guez	51
103	guez	30	END SUBROUTINE getinis
104
105			!****************************
106
107			!=== LOGICAL INTERFACES
108
109	guez	51	SUBROUTINE getinls(MY_TARGET, ret_val)
110
111			! Get a logical scalar. We first check if we find it
112			! in the database and if not we get it from the run.def
113
114			! getinl1d and getinl2d are written on the same pattern
115
116
117			CHARACTER(LEN=*) :: MY_TARGET
118	guez	30	LOGICAL :: ret_val
119	guez	51
120			LOGICAL, DIMENSION(1) :: tmp_ret_val
121	guez	30	INTEGER :: target_sig, pos, status=0, fileorig
122	guez	51
123
124	guez	30	! Compute the signature of the target
125	guez	51
126			CALL gensig(MY_TARGET, target_sig)
127
128	guez	30	! Do we have this target in our database ?
129	guez	51
130	guez	30	if (nb_keys > 0) then
131	guez	51	CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
132	guez	30	else
133			pos = -1
134			end if
135	guez	51
136	guez	30	tmp_ret_val(1) = ret_val
137	guez	51
138	guez	30	IF (pos < 0) THEN
139	guez	51	! Ge the information out of the file
140			CALL getfill(MY_TARGET, status, fileorig, tmp_ret_val)
141			! Put the data into the database
142			CALL getdbwl(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)
143	guez	30	ELSE
144	guez	51	! Get the value out of the database
145			CALL getdbrl (pos, 1, MY_TARGET, tmp_ret_val)
146	guez	30	ENDIF
147			ret_val = tmp_ret_val(1)
148	guez	51
149	guez	30	END SUBROUTINE getinls
150
151			END MODULE getincom