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	MODULE getincom
2
3	! From getincom.f90, version 2.0 2004/04/05 14:47:48
4
5	use gensig_m, only: gensig
6	use find_sig_m, only: find_sig
7	use getincom2, only: nb_keys, keysig, keystr, getfill, getdbwl, getdbrl, &
8	getfili, getdbwi, getdbri, getfilr, getdbwr, getdbrr
9
10	IMPLICIT NONE
11
12	PRIVATE
13	PUBLIC getin
14
15	INTERFACE getin
16	MODULE PROCEDURE getinrs, getinis, getinls
17	END INTERFACE
18
19	CONTAINS
20
21	SUBROUTINE getinrs(MY_TARGET, ret_val)
22
23	! 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
27	CHARACTER(LEN=*) MY_TARGET
28	REAL ret_val
29
30	! Local:
31	REAL, DIMENSION(1):: tmp_ret_val
32	INTEGER:: target_sig, pos, status = 0, fileorig
33
34	!--------------------------------------------------------------------
35
36	! Compute the signature of the target
37	CALL gensig(MY_TARGET, target_sig)
38
39	! Do we have this my_target in our database ?
40
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	CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
46	else
47	pos = -1
48	end if
49
50	tmp_ret_val(1) = ret_val
51
52	IF (pos < 0) THEN
53	! 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	ELSE
58	! Get the value out of the database
59	CALL getdbrr (pos, 1, MY_TARGET, tmp_ret_val)
60	ENDIF
61	ret_val = tmp_ret_val(1)
62
63	END SUBROUTINE getinrs
64
65	!****************************
66
67	SUBROUTINE getinis(MY_TARGET, ret_val)
68
69	! 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
72	! getini1d and getini2d are written on the same pattern
73
74
75	CHARACTER(LEN=*) :: MY_TARGET
76	INTEGER :: ret_val
77
78	INTEGER, DIMENSION(1) :: tmp_ret_val
79	INTEGER :: target_sig, pos, status=0, fileorig
80
81
82	! Compute the signature of the target
83
84	CALL gensig(MY_TARGET, target_sig)
85
86	! Do we have this target in our database ?
87
88	CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)
89
90	tmp_ret_val(1) = ret_val
91
92	IF (pos < 0) THEN
93	! 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	ELSE
98	! Get the value out of the database
99	CALL getdbri (pos, 1, MY_TARGET, tmp_ret_val)
100	ENDIF
101	ret_val = tmp_ret_val(1)
102
103	END SUBROUTINE getinis
104
105	!****************************
106
107	!=== LOGICAL INTERFACES
108
109	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	LOGICAL :: ret_val
119
120	LOGICAL, DIMENSION(1) :: tmp_ret_val
121	INTEGER :: target_sig, pos, status=0, fileorig
122
123
124	! Compute the signature of the target
125
126	CALL gensig(MY_TARGET, target_sig)
127
128	! Do we have this target in our database ?
129
130	if (nb_keys > 0) then
131	CALL find_sig(nb_keys, keystr, my_target, keysig, target_sig, pos)
132	else
133	pos = -1
134	end if
135
136	tmp_ret_val(1) = ret_val
137
138	IF (pos < 0) THEN
139	! 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	ELSE
144	! Get the value out of the database
145	CALL getdbrl (pos, 1, MY_TARGET, tmp_ret_val)
146	ENDIF
147	ret_val = tmp_ret_val(1)
148
149	END SUBROUTINE getinls
150
151	END MODULE getincom