The TELEMAC-MASCARET system  trunk
api_instance_wac.f
Go to the documentation of this file.
1 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4 !
5  MODULE api_instance_wac
6 !
8  USE bief
12  IMPLICIT NONE
13 
14  PRIVATE
15 
16  PUBLIC :: create_instance_wac
17  PUBLIC :: delete_instance_wac
18  PUBLIC :: check_instance_wac
19  PUBLIC :: get_instance_error_wac
20  PUBLIC :: instance_wac
21  PUBLIC :: instance_list_wac
22 !
23  TYPE instance_wac
24  ! RUN POSITION
25  INTEGER myposition
26  ! ERROR MESSAGE
27  CHARACTER(LEN=200) :: error_message
28  INTEGER :: maxkeyword
29  ! LIST OF ALL THE VARIABLE FOR MODEL
30 !
31  TYPE(bief_mesh), POINTER :: mesh
32 !
33  INTEGER, POINTER :: nit
34  INTEGER, POINTER :: lt
35  DOUBLE PRECISION, POINTER :: at
36  DOUBLE PRECISION, POINTER :: dt
37 !
38  TYPE(bief_file), POINTER :: wac_files(:)
39  INTEGER :: maxlu_wac
40  INTEGER, POINTER :: wacres
41  INTEGER, POINTER :: wacgeo
42  INTEGER, POINTER :: waccli
43 !
44  INTEGER, POINTER :: debug
45  DOUBLE PRECISION, POINTER :: zf(:)
46 
47  INTEGER :: nbmaxnshare
48  INTEGER, POINTER :: nptir
49  ! <new_var>
50 !
51  END TYPE ! MODEL_WAC
52 !
53  INTEGER, PARAMETER :: max_instances=10
54  TYPE(instance_wac), POINTER :: instance_list_wac(:)
55  LOGICAL, ALLOCATABLE :: used_instance(:)
56 !
57  CONTAINS
58 !
59  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
61  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
65  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
66  SUBROUTINE create_instance_wac(ID,IERR)
67  ! initialise instance for tomawac
68  INTEGER, INTENT(OUT) :: ID
69  INTEGER, INTENT(OUT) :: IERR
70 !
71  INTEGER :: I
72  id = 0
73  ierr = 0
74  ! If first time createing an instance allocating the instance array
75  IF(.NOT. ALLOCATED(used_instance)) THEN
76  ALLOCATE(used_instance(max_instances),stat=ierr)
77  IF(ierr.NE.0) THEN
78  err_mess = 'ERROR WHILE ALLOCATING USED INSTANCE ARRAY'
79  RETURN
80  ENDIF
81  used_instance = .false.
82  ALLOCATE(instance_list_wac(max_instances),stat=ierr)
83  IF(ierr.NE.0) THEN
84  err_mess = 'ERROR WHILE ALLOCATING INSTANCE ARRAY'
85  RETURN
86  ENDIF
87  ENDIF
88 !
89  ! look for the first instance available
90  i = 1
91  DO WHILE(used_instance(i).AND.i.LE.max_instances)
92  i = i + 1
93  ENDDO
94  id = i
95  used_instance(id) = .true.
96 !
97  ! if still equals 0 no available instance was found then we crash
98  IF(id.EQ.(max_instances+1))THEN
99  ierr = max_instance_error
100  err_mess = "MAX INSTANCE REACHED "
101  RETURN
102  ENDIF
103  !
104  instance_list_wac(id)%MYPOSITION = no_position
105 ! Link with tomawac variables
106  CALL update_instance_wac(id,ierr)
107 
108  END SUBROUTINE create_instance_wac
109 !
110  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
112  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
116  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
117  SUBROUTINE update_instance_wac(ID,IERR)
118  ! initialise instance for tomawac
119  INTEGER, INTENT(IN) :: ID
120  INTEGER, INTENT(OUT) :: IERR
121 !
122  ierr = 0
123 ! Link with tomawac variables
124  instance_list_wac(id)%MESH => mesh
125  instance_list_wac(id)%MAXLU_WAC = maxlu_wac
126 !
127  instance_list_wac(id)%NIT => nit
128  instance_list_wac(id)%LT => lt
129  instance_list_wac(id)%AT => at
130  instance_list_wac(id)%DT => dt
131 !
132  instance_list_wac(id)%WAC_FILES => wac_files
133  instance_list_wac(id)%WACRES => wacres
134  instance_list_wac(id)%WACGEO => wacgeo
135  instance_list_wac(id)%WACCLI => waccli
136  instance_list_wac(id)%MAXKEYWORD = maxkeyword
137  instance_list_wac(id)%ZF => zf
138 
139  instance_list_wac(id)%NPTIR => nptir
140  instance_list_wac(id)%NBMAXNSHARE = nbmaxnshare
141  ! <new_link>
142 !
143  END SUBROUTINE update_instance_wac
144 !
145  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
147  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
151  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
152  SUBROUTINE delete_instance_wac(ID,IERR)
153  INTEGER, INTENT(IN) :: ID
154  INTEGER, INTENT(OUT) :: IERR
155 !
156  ierr = 0
157  !
158  CALL check_instance_wac(id,ierr)
159  IF(ierr.NE.0) RETURN
160  used_instance(id) = .false.
161  END SUBROUTINE delete_instance_wac
162 !
163  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
165  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
169  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
170  SUBROUTINE check_instance_wac(ID,IERR)
171  INTEGER, INTENT(IN) :: ID
172  INTEGER, INTENT(OUT) :: IERR
173 !
174  ierr = 0
175  IF(id.LE.0 .OR. id.GT.max_instances) THEN
177  err_mess = 'INVALID INSTANCE NUMBER'
178  RETURN
179  ENDIF
180  IF(.NOT.used_instance(id)) THEN
181  ierr = unused_instance_error
182  err_mess = 'INSTANCE NUMBER WAS NOT CREATED'
183  RETURN
184  ENDIF
185  CALL update_instance_wac(id,ierr)
186  END SUBROUTINE check_instance_wac
187 !
188  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
190  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
193  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
194  SUBROUTINE get_instance_error_wac(ID,MESS)
195  INTEGER, INTENT(IN) :: ID
196  CHARACTER(LEN=200), INTENT(OUT) :: MESS
197 !
198  mess = instance_list_wac(id)%ERROR_MESSAGE
199 !
200  END SUBROUTINE get_instance_error_wac
201  END MODULE api_instance_wac
type(instance_wac), dimension(:), pointer, public instance_list_wac
double precision, target at
subroutine, public create_instance_wac(ID, IERR)
double precision, dimension(:), pointer zf
integer, parameter maxlu_wac
integer, parameter max_instance_error
integer, parameter maxkeyword
subroutine update_instance_wac(ID, IERR)
integer, parameter no_position
integer, parameter invalid_instance_num_error
subroutine, public check_instance_wac(ID, IERR)
subroutine, public get_instance_error_wac(ID, MESS)
character(len=error_mess_len) err_mess
Error message.
integer, parameter max_instances
subroutine, public delete_instance_wac(ID, IERR)
type(bief_mesh), target mesh
integer, parameter unused_instance_error
character(len=path_len), target coupling
logical, dimension(:), allocatable used_instance
double precision, target dt
type(bief_file), dimension(maxlu_wac), target wac_files
Definition: bief.f:3