The TELEMAC-MASCARET system  trunk
rescue_gaia.f
Go to the documentation of this file.
1 ! **********************
2  SUBROUTINE rescue_gaia
3 ! **********************
4 !
5  &(h,s,zf,zr,es,hw,tw,thetaw,npoin,nomblay,
6  & trouve,alire,pass,icf,listi,maxvar)
7 !
8 !***********************************************************************
9 ! GAIA
10 !***********************************************************************
11 !
14 !
15 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
30 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
31 !
32  USE bief
33 !
34  USE interface_gaia, ex_rescue_gaia
35  & => rescue_gaia
36 !
38  & nvar_laythi,nvar_mass_m,nvar_mass_s,nvar_ratiom,nvar_ratios,
39  & nvar_layconc,nvar_mtrans,nvar_tocemud,nvar_parthe,bed_model,
40  & conc_mud_found,toce_mud_found,partheniades_found,mtrans_found,
41  & mass_s, mass_m, ratios, ratiom, mass_sand, mass_mud, ratio_sand,
42  & ratio_mud, toce_mud, tocemud, parthe, partheniades, mtransfer,
43  & trans_mass, layconc, conc_mud
45  IMPLICIT NONE
46 !
47 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
48 !
49  INTEGER, INTENT(IN) :: MAXVAR,NOMBLAY
50  INTEGER, INTENT(IN) :: ALIRE(maxvar),NPOIN,ICF
51  LOGICAL, INTENT(IN) :: PASS,LISTI
52  DOUBLE PRECISION, INTENT(IN) :: ES(npoin,nomblay)
53 !
54  INTEGER, INTENT(INOUT) :: TROUVE(maxvar)
55  DOUBLE PRECISION, INTENT(INOUT) :: S(npoin) , ZF(npoin), H(npoin)
56  DOUBLE PRECISION, INTENT(INOUT) :: ZR(npoin)
57  DOUBLE PRECISION, INTENT(INOUT) :: HW(npoin), TW(npoin)
58  DOUBLE PRECISION, INTENT(INOUT) :: THETAW(npoin)
59 !
60 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
61 !
62  INTEGER K,I,J
63  INTEGER CHECK_ES,CHECK_RSNL,CHECK_RMNL
64  INTEGER CHECK_NSNL,CHECK_NMNL
65  INTEGER CHECK_CONC,CHECK_MTRANS,CHECK_TOCEMUD,CHECK_PARTHENIADES
66 !
67  conc_mud_found = .false.
68  toce_mud_found = .false.
69  partheniades_found = .false.
70  mtrans_found = .false.
71 !-----------------------------------------------------------------------
72 !
73 ! PRINTOUTS :
74 ! -----------
75  IF(pass.AND.listi) THEN
76  WRITE(lu,200)
77 200 FORMAT(80('-'))
78  IF(alire(8).EQ.1) THEN
79  WRITE(lu,301)
80 301 FORMAT(1x,'RESCUE : HYDRODYNAMIC FILE')
81  ELSE
82  WRITE(lu,311)
83 311 FORMAT(1x,'RESCUE : SEDIMENTOLOGICAL FILE')
84  ENDIF
85  ENDIF
86 !
87 ! ------------------------------------------------------------------
88 ! WATER DEPTH :
89 ! -------------
90  IF((alire(3).EQ.1).AND.(trouve(3).NE.1)) THEN
91  IF(trouve(4).EQ.1.AND.trouve(5).EQ.1) THEN
92  IF (listi) THEN
93  WRITE(lu,401)
94  ENDIF
95  CALL ov('X=Y-Z ', x=h, y=s, z=zf, dim1=npoin)
96  ELSE
97  IF (listi) THEN
98  WRITE(lu,421)
99  ENDIF
100  CALL plante(1)
101  stop
102  ENDIF
103  ENDIF
104 !
105 401 FORMAT(1x,'WATER DEPTH COMPUTED WITH BATHYMETRY',
106  & /,1x,'AND SURFACE ELEVATION')
107 421 FORMAT(1x,'WATER DEPTH UNABLE TO BE COMPUTED')
108 !
109 ! ----------------------------------------------------------------------
110 !
111 ! CLIPS NEGATIVE WATER DEPTHS :
112 ! -------------------------------------
113 !
114  DO k = 1,npoin
115  h(k) = max(h(k),0.d0)
116  ENDDO
117 !
118 !------------------------------------------------------------------------
119 !
120 ! WAVE HEIGHT AND PERIOD
121 !
122  IF(icf==4.OR.icf==5.OR.icf==8.OR.icf==9) THEN
123 !
124  IF(alire(12).EQ.1.AND.trouve(12).EQ.0) THEN
125  WRITE(lu,901)
126  CALL ov('X=C ', x=hw, c=0.d0, dim1=npoin)
127  ENDIF
128 !
129 901 FORMAT(1x,'PREVIOUS COMPUTATION WITHOUT WAVE HEIGHT : IT IS',
130  & ' FIXED TO ZERO')
131 !
132  IF(alire(13).EQ.1.AND.trouve(13).EQ.0) THEN
133  WRITE(lu,903)
134  CALL ov('X=C ', x=tw, c=0.d0, dim1=npoin)
135  ENDIF
136 903 FORMAT(1x,'PREVIOUS COMPUTATION WITHOUT WAVE PERIOD : IT IS',
137  & ' FIXED TO ZERO')
138 !
139  IF(alire(14).EQ.1.AND.trouve(14).EQ.0) THEN
140  WRITE(lu,903)
141  CALL ov('X=C ', x=thetaw, c=90.d0, dim1=npoin)
142  ENDIF
143  ENDIF
144 !909 FORMAT(1X,'CALCUL PRECEDENT SANS ANGLE DE HOULE : ON',
145 ! & ' PREND ZERO')
146 !910 FORMAT(1X,'PREVIOUS COMPUTATION WITHOUT WAVE ANGLE : IT IS',
147 ! & ' FIXED TO ZERO')
148 !
149 !-----------------------------------------------------------------------
150 ! NON-ERODABLE BED
151 !
152  IF(alire(9).EQ.1.AND.trouve(9).EQ.0) THEN
153  WRITE(lu,908)
154  check_es=0
155  DO i = 1,nomblay
156  IF(trouve(5).EQ.1.AND.
157  & trouve(nvar_laythi+i).EQ.1) THEN
158  check_es=check_es+1
159  ENDIF
160  ENDDO
161  IF(check_es.EQ.nomblay) THEN
162  WRITE(lu,910)
163  DO i = 1,npoin
164  zr(i)=zf(i)
165  DO j = 1,nomblay
166  zr(i)=zr(i)-es(i,j)
167  ENDDO
168  ENDDO
169  trouve(9) = 1
170  ENDIF
171  ENDIF
172 908 FORMAT(1x,'PREVIOUS CALCULATION WITHOUT NON ERODABLE',
173  & /,1x,'BOTTOM')
174 910 FORMAT(1x,'PREVIOUS CALCULATION CONTAINS ALL LAYERS',
175  & /,1x,'RIGID BED COMPUTED FROM LAYERS THICKNESS',
176  & /,1x,'AND BOTTOM')
177 !
178 !-----------------------------------------------------------------------
179 ! BED ELEVATION
180 !
181  IF(alire(5).EQ.1.AND.trouve(5).EQ.0) THEN
182 !
183  IF(trouve(4).EQ.1.AND.trouve(3).EQ.1) THEN
184  IF (listi) THEN
185  WRITE(lu,411)
186 411 FORMAT(1x,'BATHYMETRY COMPUTED FROM WATER DEPTH',
187  & /,1x,'AND SURFACE ELEVATION')
188  ENDIF
189  CALL ov('X=Y-Z ', x=zf, y=s, z=h, dim1=npoin)
190  ELSE
191  CALL ov('X=C ', x=zf, c=0.d0, dim1=npoin)
192  WRITE(lu,961)
193  ENDIF
194 !
195  ENDIF
196 961 FORMAT(1x,'BOTTOM TOPOGRAPHY NOT FOUND',/,
197  & 'IT IS SET TO ZERO')
198 !
199 ! --------------------------------------------------------------------
200 ! OPTIONS TO COMPUTE MASSES
201 ! --------------------------------------------------------------------
202  check_nsnl=0
203  DO i = 1,nsand
204  DO j=1,nomblay
205  IF(trouve(nvar_mass_s+(i-1)*nomblay+j).EQ.1) THEN
206  ! Updating mass_sand with what was read in file
207  mass_sand(i,j,1:npoin) = mass_s%ADR(j+(i-1)*nomblay)%P%R
208  check_nsnl=check_nsnl+1
209  ENDIF
210  ENDDO
211  ENDDO
212  check_nmnl=0
213  DO i = 1,nmud
214  DO j=1,nomblay
215  IF(trouve(nvar_mass_m+(i-1)*nomblay+j).EQ.1) THEN
216  ! Updating mass_mud with what was read in file
217  mass_mud(i,j,1:npoin) = mass_m%ADR(j+(i-1)*nomblay)%P%R
218  check_nmnl=check_nmnl+1
219  ENDIF
220  ENDDO
221  ENDDO
222  IF(check_nsnl.EQ.nsand*nomblay.AND.check_nmnl.EQ.
223  & nmud*nomblay) THEN
224 ! MASSES FROM PREVIOUS SEDIMENTOLOGICAL FILE
225  debu_mass=.true.
226  WRITE(lu,981)
227  ELSE
228  check_rsnl=0
229  DO i = 1,nsand
230  DO j=1,nomblay
231  IF(trouve(nvar_ratios+(i-1)*nomblay+j).EQ.1) THEN
232  ! Updating ratio_sand with what was read in file
233  ratio_sand(i,j,1:npoin) = ratios%ADR(j+(i-1)*nomblay)%P%R
234  check_rsnl=check_rsnl+1
235  ENDIF
236  ENDDO
237  ENDDO
238  check_rmnl=0
239  DO i = 1,nmud
240  DO j=1,nomblay
241  IF(trouve(nvar_ratiom+(i-1)*nomblay+j).EQ.1) THEN
242  ! Updating ratio_mud with what was read in file
243  ratio_mud(i,j,1:npoin) = ratiom%ADR(j+(i-1)*nomblay)%P%R
244  check_rmnl=check_rmnl+1
245  ENDIF
246  ENDDO
247  ENDDO
248  check_es=0
249  DO i=1,nomblay
250  IF(trouve(nvar_laythi+i).EQ.1) THEN
251  check_es=check_es+1
252  ENDIF
253  ENDDO
254  IF(check_rsnl.EQ.nsand*nomblay.AND.check_rmnl.EQ.nmud*nomblay
255  & .AND.check_es.EQ.nomblay) THEN
256 ! MASSES HAVE TO BE COMPUTED FROM OTHER PARAMETERS:
257 ! RATIO_S,RATIO_M,ES
258 ! XKV READ IN THE STEERING FILE
259  debu_mass=.false.
260  WRITE(lu,*)'MASSES COMPUTED USING RATIOS,POROSITY AND '//
261  & 'THICKNESS RETREIVED IN THE PREVIOUS FILE'
262  ELSE
263 ! NOT ENOUGH DATA TO RESTART COMPUTATION
264  WRITE(lu,1111)
265  CALL plante(1)
266  stop
267  ENDIF
268  ENDIF
269 981 FORMAT(1x,'MASS RETRIEVED FROM THE PREVIOUS SEDIMENTOLOGICAL',
270  & /,1x,'FILE')
271 1111 FORMAT(1x,'ERROR: COMPUTATION CANNOT RESTART SINCE MASSES OR',
272  & /,1x, 'RATIOS OR THICKNESS OR POROSITY ',
273  & /,1x, 'ARE MISSING IN THE PREVIOUS SEDIMENTOLOGICAL FILE')
274 !
275 ! CHECK ALL THE NECESSARY VARIABLES FOR SUSPENSION ARE HERE
276 !
277  IF (nmud.NE.0) THEN
278  check_conc=0
279  check_tocemud=0
280  check_partheniades=0
281  DO i=1,nomblay
282  IF(trouve(nvar_layconc+i).EQ.1) THEN
283  ! Updating conc_mud with what was read in file
284  conc_mud(i,1:npoin)=layconc%ADR(i)%P%R
285  check_conc=check_conc+1
286  ENDIF
287  IF(trouve(nvar_tocemud+i).EQ.1) THEN
288  ! Updating toce_mud with what was read in file
289  toce_mud(i,1:npoin) = tocemud%ADR(i)%P%R
290  check_tocemud=check_tocemud+1
291  ENDIF
292  IF(trouve(nvar_parthe+i).EQ.1) THEN
293  ! Updating partheniades with what was read in file
294  partheniades(i,1:npoin) = parthe%ADR(i)%P%R
295  check_partheniades=check_partheniades+1
296  ENDIF
297  ENDDO
298  IF(check_conc.EQ.nomblay) THEN
299  conc_mud_found = .true.
300  WRITE(lu,*)'MUD CONCENTRATION READ FROM PREVIOUS FILE'
301  ENDIF
302  IF(check_tocemud.EQ.nomblay) THEN
303  toce_mud_found = .true.
304  WRITE(lu,*)'MUD TOCE READ FROM PREVIOUS FILE'
305  ENDIF
306  IF(check_partheniades.EQ.nomblay) THEN
307  partheniades_found = .true.
308  WRITE(lu,*)'PARTHENIADES READ FROM PREVIOUS FILE'
309  ENDIF
310  IF (bed_model.EQ.2) THEN
311  check_mtrans=0
312  DO i=1,nomblay
313  IF(trouve(nvar_mtrans+1).EQ.1) THEN
314  ! Updating mtransfer with what was read in file
315  mtransfer%ADR(i)%P%R=trans_mass(i,1:npoin)
316  check_mtrans=check_mtrans+1
317  WRITE(lu,*)'MASS TRANSFER READ FROM PREVIOUS FILE'
318  ENDIF
319  ENDDO
320  IF(check_mtrans.EQ.nomblay) THEN
321  mtrans_found = .true.
322  ENDIF
323  ENDIF
324  ENDIF
325 !
326  IF (pass.AND.listi) THEN
327  WRITE(lu,970)
328 970 FORMAT(80('-'))
329  ENDIF
330 !
331 !-----------------------------------------------------------------------
332 !
333  RETURN
334  END SUBROUTINE rescue_gaia
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
integer nsand
Total number of sand.
integer nmud
Total number of muds.
logical debu_mass
Option used in computation continued: if true, mass is contained in the previous sedimentological fil...
subroutine rescue_gaia(H, S, ZF, ZR, ES, HW, TW, THETAW, NPOIN, NOMBLAY, TROUVE, ALIRE, PASS, ICF, LISTI, MAXVAR)
Definition: rescue_gaia.f:8
Definition: bief.f:3