The TELEMAC-MASCARET system  trunk
ad_solve.F
Go to the documentation of this file.
1 !#if defined COMPAD_SYMBOLIC_LINSOLVE
2 !# undef COMPAD_SYMBOLIC_LINSOLVE
3 !#endif COMPAD_SYMBOLIC_LINSOLVE
4 !
5 !#if defined COMPAD_DCO_T1S
6 !# define COMPAD_SYMBOLIC_LINSOLVE
7 !#endif
8 !
9 !#if defined COMPAD_DCO_T1S_FD
10 !# undef COMPAD_SYMBOLIC_LINSOLVE
11 !#endif
12 !
13 !#if defined COMPAD_SYMBOLIC_LINSOLVE
14 !# include 'ad_solve_deep_copy_bief_obj.f'
15 !# include 'ad_solve_T1X_set_bief_obj.f'
16 !# include 'ad_solve_T1X_set_int_bief_obj.f'
17 !# define AD_BIEF_OBJ_PRINT
18 !# include 'ad_solve_print_bief_obj.f'
19 !# undef AD_BIEF_OBJ_DIFF_PRINT
20 !# define AD_BIEF_OBJ_DIFF_PRINT
21 !# include 'ad_solve_diff_print_bief_obj.f'
22 !# include 'ad_solve_diff_int_print_bief_obj.f'
23 !# undef AD_BIEF_OBJ_DIFF_PRINT
24 !#endif COMPAD_SYMBOLIC_LINSOLVE
25 
26 
27 ! *******************
28  SUBROUTINE ad_solve
29 ! *******************
30 !
31  &(x, a,b,tb,cfg,infogr,mesh,aux)
32 !
33 !***********************************************************************
34 ! BIEF V7P2 23/11/2016
35 !***********************************************************************
36 !
37 !brief Wrapper for call to SOLVE to be used with Algorithmic
38 !+ Differentiation. See SOLVE for more details on arguments.
39 !+
40 !
41 !history J.RIEHME (ADJOINTWARE) and S.E.BOURBAN (HRW)
42 !+ 23/11/2016
43 !+ V7P2
44 !+ Implementation and validation
45 !
46 !history S.E.BOURBAN (HRW) and J.RIEHME (ADJOINTWARE)
47 !+ 20/03/2017
48 !+ V7P3
49 !+ Assembling recursive dependencies within this subroutine
50 !
51 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
52 !| A |-->| MATRIX OF THE SYSTEM (OR BLOCK OF MATRICES)
53 !| AUX |-->| MATRIX FOR PRECONDITIONING.
54 !| B |-->| RIGHT-HAND SIDE OF THE SYSTEM
55 !| CFG |-->| STRUCTURE OF SOLVER CONFIGURATION
56 !| | | CFG%KRYLOV IS USED ONLY IF CFG%SLV = 7 (GMRES)
57 !| INFOGR |-->| IF YES, PRINT A LOG.
58 !| MESH |-->| MESH STRUCTURE.
59 !| TB |-->| BLOCK OF VECTORS WITh AT LEAST
60 !| | | MAX(7,2+2*CFG%KRYLOV)*S VECTORS, S IS 1
61 !| | | IF A IS A MATRIX, 2 IF A BLOCK OF 4 MATRICES
62 !| | | AND 3 IF A BLOCK OF 9.
63 !| X |<->| INITIAL VALUE, THEN SOLUTION
64 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
65 !
66  USE bief
67 !
68  USE declarations_special
69  IMPLICIT NONE
70 !
71 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
72 !
73  TYPE(slvcfg), INTENT(INOUT) :: CFG
74 !
75 ! STRUCTURES OF VECTORS OR BLOCKS OF VECTORS
76 !
77  TYPE(bief_obj), TARGET, INTENT(INOUT) :: X,B
78  TYPE(bief_obj), INTENT(INOUT) :: TB
79 !
80 ! STRUCTURES OF MATRIX OR BLOCK OF MATRICES
81 !
82  TYPE(bief_obj), INTENT(INOUT) :: A,AUX
83 !
84  LOGICAL, INTENT(IN) :: INFOGR
85 !
86 ! MESH STRUCTURE
87 !
88  TYPE(bief_mesh), INTENT(INOUT) :: MESH
89 !
90 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
91 #if defined COMPAD_SYMBOLIC_LINSOLVE
92 !
93 ! LOCAL BIEF_OBJ
94 !
95  TYPE(bief_obj) :: A0, B0, XS
96  TYPE(bief_obj) :: A1, B1, X1A, X1B
97 ! addional for testing
98  TYPE(bief_obj) :: A00, B00
99 !
100 ! LOCAL INTEGERS
101 !
102  INTEGER, PARAMETER :: NIX = 0, val=0, drv=1, all=-1
103  INTEGER :: I
104 #endif /* COMPAD_SYMBOLIC_LINSOLVE */
105  INTEGER, SAVE :: CNT = 0
106 
107 !
108 !-----------------------------------------------------------------------
109 !
110 ! DENY REQUEST OF SYMBOLIC LINEAR SOLVER IF NOT AVAILABLE
111 !
112 #ifndef COMPAD_SYMBOLIC_LINSOLVE
113  ad_symblinsolv = .false.
114 #endif
115  cnt = cnt + 1
116 !
117 !-----------------------------------------------------------------------
118 !
119 ! CHECK IF SYMBOLIC LINEAR SOLVER IS **NOT** REQUESTED
120 !
121 #if defined AD_BIEF_OBJ_PRINT
122  CALL ad_print_bief_obj( x, 1, "X (INPUT)", "" )
123  CALL ad_print_bief_obj( a, 1, "A (INPUT)", "" )
124 #endif
125 
126  IF ( .NOT. ad_symblinsolv ) THEN
127 !
128 ! WRITE(LU,*)' AD_SOLVE SYMBOLIC LINEAR SOLVER (', CNT,
129 ! & ') :: not requested'
130 !
131 ! 0.1 SOLVE ORIGINAL SYSTEM
132 !
133  CALL solve(x,a,b,tb,cfg,infogr,mesh,aux)
134 !
135  RETURN
136 !
137  ENDIF
138 !
139 !
140 !-----------------------------------------------------------------------
141 !
142 #if defined COMPAD_SYMBOLIC_LINSOLVE && COMPAD
143 !
144  WRITE(lu,*)' AD_SOLVE SYMBOLIC LINEAR SOLVER (', cnt,
145  & ') :: REQUESTED'
146 !
147 ! 1. SYMBOLIC LINEAR SOLVER
148 !
149 ! 1.1 TURN OF OTHER STABILISERS
150  ad_linsolv_resetderiv = .false.
151  ad_linsolv_derivative_convergence = .false.
152 !
153 !-----------------------------------------------------------------------
154 !
155 ! 1.2 CREATE DEEP COPIES OF REQUIRED BIEF_OBJ
156 !
157  CALL ad_deep_copy_bief_obj( a00, a, cnt,1 )
158  CALL ad_deep_copy_bief_obj( b00, b, cnt,1 )
159 
160  CALL ad_deep_copy_bief_obj( a0, a, cnt,1 )
161  CALL ad_deep_copy_bief_obj( a1, a, cnt,1 )
162  CALL ad_deep_copy_bief_obj( b0, b, cnt,1 )
163  CALL ad_deep_copy_bief_obj( b1, b, cnt,1 )
164  CALL ad_deep_copy_bief_obj( x1a, x, cnt,1 )
165  CALL ad_deep_copy_bief_obj( x1b, x, cnt,1 )
166  CALL ad_deep_copy_bief_obj( xs, x, cnt,1 )
167 
168 #if defined AD_BIEF_OBJ_PRINT
169  CALL ad_print_bief_obj( x, cnt,1,'','')
170 #endif
171 #if defined AD_BIEF_OBJ_DIFF_PRINT
172  CALL ad_diff_print_bief_obj( x,all,x1a,all,cnt,1,'X <--> X1A','')
173  CALL ad_diff_print_bief_obj( x,all,x1b,all,cnt,1,'X <--> X1B','')
174  CALL ad_diff_print_bief_obj( x,all,xs ,all,cnt,1,'X <--> XS ','')
175  CALL ad_diff_print_bief_obj( b,all,b0 ,all,cnt,1,'B <--> B0 ','')
176  CALL ad_diff_print_bief_obj( b,all,b1 ,all,cnt,1,'B <--> B1 ','')
177  CALL ad_diff_print_bief_obj( a,all,a0 ,all,cnt,1,'A <--> A0 ','')
178  CALL ad_diff_print_bief_obj( a,all,a1 ,all,cnt,1,'A <--> A1 ','')
179 #endif
180 !
181 !-----------------------------------------------------------------------
182 !
183 ! SET TANGENTS OF COPIES TO ZERO
184 !
185  CALL ad_t1x_set_int_bief_obj( a0,drv, 0, 1 )
186  CALL ad_t1x_set_int_bief_obj( b0,drv, 0, 1 )
187  CALL ad_t1x_set_int_bief_obj( xs,drv, 0, 1 )
188 
189 #if defined AD_BIEF_OBJ_DIFF_PRINT
190  CALL ad_diff_int_print_bief_obj( a0,drv, 0,cnt,1,'A0 <--> 0','')
191  CALL ad_diff_int_print_bief_obj( b0,drv, 0,cnt,1,'B0 <--> 0','')
192  CALL ad_diff_int_print_bief_obj( xs,drv, 0,cnt,1,'XS <--> 0','')
193 #endif
194 !
195 !-----------------------------------------------------------------------
196 !
197 ! COMPUTE PRIMAL SOLUTION
198 !
199  CALL solve(xs,a0,b0,tb,cfg,infogr,mesh,aux)
200 !
201 #if defined AD_BIEF_OBJ_DIFF_PRINT
202 ! DIFFERS SOLUTION XS FROM STARTING POINT X ?
203  CALL ad_diff_print_bief_obj( x,all,xs ,all,cnt,1,'X <--> XS ','')
204 #endif
205 !
206 #if defined AD_BIEF_OBJ_DIFF_PRINT
207 ! TANGENTS OF SOLUTION STILL ZERO ???
208  CALL ad_diff_int_print_bief_obj( xs,drv, 0,cnt,1,'XS <--> 0','')
209 ! CALL AD_T1X_SET_INT_BIEF_OBJ( XS,DRV, 0, 1 )
210 #endif
211 !
212 #if defined AD_BIEF_OBJ_DIFF_PRINT
213 ! WAS A0 OR B0 (VALUE COMPONENT) modified during solving the system ??
214  CALL ad_diff_print_bief_obj(a0,val,a00,val,cnt,1,'A0 <--> A00','')
215  CALL ad_diff_print_bief_obj(b0,val,b00,val,cnt,1,'B0 <--> B00','')
216 ! WAS A0 OR B0 (TANGENT COMPONENT) modified during solving the system ??
217  CALL ad_diff_print_bief_obj(a0,drv,a00,drv,cnt,1,'A0 <--> A00','')
218  CALL ad_diff_print_bief_obj(b0,drv,b00,drv,cnt,1,'B0 <--> B00','')
219 #endif
220 !
221 !-----------------------------------------------------------------------
222 !
223 ! SOLVE LINEAR SYSTEM TO GET PARTIAL OF XS wrt. RHS B
224 !
225  CALL ad_t1x_set_int_bief_obj( x1b,val, 0, 1 )
226  CALL ad_t1x_set_int_bief_obj( x1b,drv, 0, 1 )
227  CALL ad_t1x_set_int_bief_obj( a1, drv, 0, 1 )
228  CALL ad_t1x_set_int_bief_obj( b1, drv, 0, 1 )
229  CALL ad_t1x_set_bief_obj( b1, val, b, drv, 1 )
230 !
231 #if defined AD_BIEF_OBJ_DIFF_PRINT
232  CALL ad_diff_print_bief_obj( b1, val, b , drv,
233  & cnt,1, 'VAL(B1) <--> T1S(B) ', '' )
234 #endif
235 !
236  CALL solve(x1b,a1,b1,tb,cfg,infogr,mesh,aux)
237 
238 !
239 !-----------------------------------------------------------------------
240 !
241 ! SOLVE LINEAR SYSTEM TO GET PARTIAL OF XS wrt. SYSTEM MATRIX A
242 !
243  CALL ad_t1x_set_int_bief_obj( x1a,val, 0, 1 )
244  CALL ad_t1x_set_int_bief_obj( x1a,drv, 0, 1 )
245 
246  CALL ad_t1x_set_bief_obj( a1,val, a,drv, 1 )
247  CALL ad_t1x_set_int_bief_obj( a1,drv, 0, 1 )
248 
249  CALL ad_t1x_set_int_bief_obj( b1 ,val, 0, 1 )
250  CALL ad_t1x_set_int_bief_obj( b1 ,drv, 0, 1 )
251 
252  CALL matrbl( 'X=X+CAY ', x=b1 , a=a1, y=xs, c=-1.d0, mesh=mesh )
253 ! CALL MATRBL( 'X=X+CAY ', X=B1 , A=A1, Y=XS, C=1.D0, MESH=MESH )
254 
255 ! CALL AD_T1X_SET_INT_BIEF_OBJ( TB,VAL, 0, 1 )
256 ! CALL AD_T1X_SET_INT_BIEF_OBJ( TB,DRV, 0, 1 )
257 
258  CALL solve(x1a,a1,b1,tb,cfg,infogr,mesh,aux)
259 
260 ! CALL SOLVE(X1A,A0,B1,TB,CFG,INFOGR,MESH,AUX)
261 
262 !
263 !-----------------------------------------------------------------------
264 !
265 ! ASSEMBLE FINAL A AND B (INOUT)
266 !
267  CALL ad_t1x_set_bief_obj( a,val, a00,val, 1 )
268  CALL ad_t1x_set_bief_obj( a,drv, a00,drv, 1 )
269 !
270  CALL ad_t1x_set_bief_obj( b,val, b00,val, 1 )
271  CALL ad_t1x_set_bief_obj( b,drv, b00,drv, 1 )
272 !
273 !-----------------------------------------------------------------------
274 !
275 ! ASSEMBLE SOLUTION AND ITS TANGENTS
276 !
277  CALL ad_t1x_set_bief_obj( x,val, xs,val, 1 )
278 !
279 ! CALL AD_T1X_SET_INT_BIEF_OBJ( X, 1, 0, 1 )
280 
281  CALL os( 'X=X+Y ' , x=x1b, y=x1a )
282  CALL ad_t1x_set_bief_obj( x,drv, x1b,val, 1 )
283 !
284 !-----------------------------------------------------------------------
285 !
286  RETURN
287 
288  CONTAINS
289 !
290 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
291 !
292  RECURSIVE SUBROUTINE ad_t1x_set_bief_obj
293  & ( tgt, twhat, src, swhat, reclvl )
294 !
295 !note TGT is allocated properly to SRC
296 !
297 ! MODULES -----------------------
298 !
299 ! USE BIEF
300 ! USE DECLARATIONS_SPECIAL
301  IMPLICIT NONE
302 !
303 ! ARGUMENTS ---------------------
304 !
305  TYPE(bief_obj), INTENT(INOUT) :: TGT
306  TYPE(bief_obj), INTENT(IN) :: SRC
307  INTEGER , INTENT(IN) :: TWHAT, SWHAT, RECLVL
308 !
309 ! LOCAL VARS --------------------
310 !
311  INTEGER :: I
312 !
313 ! FOR VECTORS -------------------
314 !
315  IF ( ASSOCIATED( tgt%R ) ) THEN
316  IF ( swhat .EQ. 0 ) THEN
317  CALL dco_t1s_set( tgt%R,dco_t1s_get_value(src%R),twhat)
318  ELSEIF ( swhat .EQ. 1 ) THEN
319  CALL dco_t1s_set( tgt%R,dco_t1s_get_derivative(src%R),twhat)
320  ENDIF
321  ENDIF
322 !
323 ! FOR MATRICES ------------------
324 !
325  IF ( tgt%TYPE .EQ. 3 ) THEN
326 ! TYPE(BIEF_OBJ), POINTER :: D
327  IF ( ASSOCIATED( tgt%D ) ) THEN
328  CALL ad_t1x_set_bief_obj
329  & ( tgt%D, twhat, src%D, swhat, reclvl+1 )
330  ENDIF
331 ! TYPE(BIEF_OBJ), POINTER :: X
332  IF ( ASSOCIATED( tgt%X ) ) THEN
333  CALL ad_t1x_set_bief_obj
334  & ( tgt%X, twhat, src%X, swhat, reclvl+1 )
335  ENDIF
336  ENDIF
337 !
338 ! FOR BLOCKS --------------------
339 !
340 ! TYPE(POINTER_TO_BIEF_OBJ), POINTER, DIMENSION(:) :: ADR
341  IF ( ASSOCIATED( tgt%ADR ) ) THEN
342  DO i = 1,tgt%N
343  CALL ad_t1x_set_bief_obj
344  & ( tgt%ADR(i)%P, twhat, src%ADR(i)%P, swhat, reclvl+1 )
345  ENDDO
346  ENDIF
347 
348  END SUBROUTINE ad_t1x_set_bief_obj
349 !
350 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
351 !
352  RECURSIVE SUBROUTINE ad_t1x_set_int_bief_obj
353  & ( tgt, what, val, reclvl )
354 !
355 !note TGT is allocated properly
356 !
357 ! MODULES -----------------------
358 !
359 ! USE BIEF
360 ! USE DECLARATIONS_SPECIAL
361  IMPLICIT NONE
362 !
363 ! ARGUMENTS ---------------------
364 !
365  TYPE(bief_obj), INTENT(INOUT) :: TGT
366  INTEGER , INTENT(IN) :: VAL, WHAT, RECLVL
367 !
368 ! LOCAL VARS --------------------
369 !
370  INTEGER :: I
371 !
372 ! FOR VECTORS -------------------
373 !
374  IF ( ASSOCIATED( tgt%R ) ) THEN
375  CALL dco_t1s_set( tgt%R, val, what)
376  ENDIF
377 !
378 ! FOR MATRICES ------------------
379 !
380  IF ( tgt%TYPE .EQ. 3 ) THEN
381 ! TYPE(BIEF_OBJ), POINTER :: D
382  IF ( ASSOCIATED( tgt%D ) ) THEN
383  CALL ad_t1x_set_int_bief_obj( tgt%D, what,val,reclvl+1 )
384  ENDIF
385 ! TYPE(BIEF_OBJ), POINTER :: X
386  IF ( ASSOCIATED( tgt%X ) ) THEN
387  CALL ad_t1x_set_int_bief_obj( tgt%X, what,val,reclvl+1 )
388  ENDIF
389  ENDIF
390 !
391 ! FOR BLOCKS --------------------
392 !
393 ! TYPE(POINTER_TO_BIEF_OBJ), POINTER, DIMENSION(:) :: ADR
394  IF ( ASSOCIATED( tgt%ADR ) ) THEN
395  DO i = 1, tgt%N
396  CALL ad_t1x_set_int_bief_obj
397  & ( tgt%ADR(i)%P, what, val, reclvl+1 )
398  ENDDO
399  ENDIF
400 !
401  END SUBROUTINE ad_t1x_set_int_bief_obj
402 !
403 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
404 !
405  RECURSIVE SUBROUTINE ad_deep_copy_bief_obj
406  & ( tgt, src, scnt, reclvl )
407 !
408 ! MODULES -----------------------
409 !
410 ! USE BIEF
411 ! USE DECLARATIONS_SPECIAL
412  IMPLICIT NONE
413 !
414 ! ARGUMENTS ---------------------
415 !
416  TYPE(bief_obj), INTENT(INOUT) :: TGT
417  TYPE(bief_obj), INTENT(IN) :: SRC
418  INTEGER , INTENT(IN) :: SCNT, RECLVL
419 !
420 ! LOCAL VARS --------------------
421 !
422  INTEGER :: I
423 !
424 ! HEADER COMMON TO ALL OBJECTS
425 !
426  tgt%KEY = src%KEY
427  tgt%TYPE = src%TYPE
428  tgt%FATHER = src%NAME
429  tgt%NAME = 'c'//src%NAME
430 ! TGT%NAME(6) = 'c'
431 !
432 ! FOR VECTORS
433 !
434  tgt%NAT = src%NAT
435  tgt%ELM = src%ELM
436  tgt%DIM1 = src%DIM1
437  tgt%MAXDIM1 = src%MAXDIM1
438  tgt%DIM2 = src%DIM2
439  tgt%MAXDIM2 = src%MAXDIM2
440  tgt%DIMDISC = src%DIMDISC
441  tgt%STATUS = src%STATUS
442  tgt%TYPR = src%TYPR
443  tgt%TYPI = src%TYPI
444 !
445 ! DOUBLE PRECISION, POINTER,DIMENSION(:)::R
446  NULLIFY( tgt%R )
447  IF ( ASSOCIATED( src%R ) ) THEN
448  ALLOCATE( tgt%R( SIZE(src%R) ) )
449  tgt%R = src%R
450 ! TGT%R = AD_DEEP_COPY_REAL_ARRAY( SRC%R, SRC%NAME//"%R", TGT )
451  ENDIF
452 !
453 ! INTEGER, POINTER,DIMENSION(:)::I
454  NULLIFY( tgt%I )
455  IF ( ASSOCIATED( src%I ) ) THEN
456  ALLOCATE( tgt%I( SIZE(src%I) ) )
457  tgt%I = src%I
458  ENDIF
459 !
460 ! FOR MATRICES
461 !
462  tgt%STO = src%STO
463  tgt%STOX = src%STOX
464  tgt%ELMLIN = src%ELMLIN
465  tgt%ELMCOL = src%ELMCOL
466  tgt%TYPDIA = src%TYPDIA
467  tgt%TYPEXT = src%TYPEXT
468 !
469 ! TYPE(BIEF_OBJ), POINTER :: D
470  NULLIFY( tgt%D )
471  IF ( src%TYPE .EQ. 3 ) THEN
472  IF ( ASSOCIATED( src%D ) ) THEN
473  ALLOCATE(tgt%D)
474  CALL ad_deep_copy_bief_obj( tgt%D, src%D, scnt, reclvl+1 )
475  ENDIF
476  ENDIF
477 !
478 ! TYPE(BIEF_OBJ), POINTER :: X
479  NULLIFY( tgt%X )
480  IF ( src%TYPE .EQ. 3 ) THEN
481  IF ( ASSOCIATED( src%X ) ) THEN
482  ALLOCATE(tgt%X)
483  CALL ad_deep_copy_bief_obj( tgt%X, src%X, scnt, reclvl+1 )
484  ENDIF
485  ENDIF
486  tgt%PRO = src%PRO
487 !
488 ! FOR BLOCKS
489 !
490  tgt%N = src%N
491  tgt%MAXBLOCK = src%MAXBLOCK
492 ! TYPE(POINTER_TO_BIEF_OBJ), POINTER, DIMENSION(:) :: ADR
493  IF ( ASSOCIATED( src%ADR ) ) THEN
494  ALLOCATE( tgt%ADR( tgt%MAXBLOCK ) )
495  DO i = 1, tgt%N
496  ALLOCATE( tgt%ADR(i)%P )
497  CALL ad_deep_copy_bief_obj(tgt%ADR(i)%P,src%ADR(i)%P,
498  & scnt, reclvl+1 )
499  ENDDO
500  DO i = tgt%N+1, tgt%MAXBLOCK
501  NULLIFY( tgt%ADR(i)%P )
502  ENDDO
503  ENDIF
504 !
505  END SUBROUTINE ad_deep_copy_bief_obj
506 !
507 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
508 !
509  RECURSIVE SUBROUTINE ad_print_bief_obj
510  & ( tgt, scnt, reclvl, msg, fil )
511 !
512 ! MODULES -----------------------
513 !
514 ! USE BIEF
515 ! USE DECLARATIONS_SPECIAL
516  IMPLICIT NONE
517 !
518 ! ARGUMENTS ---------------------
519 !
520  TYPE(bief_obj), INTENT(IN) :: TGT
521  INTEGER , INTENT(IN) :: SCNT, RECLVL
522  CHARACTER(LEN=*) :: MSG, FIL
523 !
524 ! LOCAL VARS --------------------
525 !
526  INTEGER :: I
527  INTEGER, SAVE :: CNT = 0
528 ! /!\ HOW IS SPC ALLOCATED ?
529  CHARACTER(LEN=2*RECLVL+2) :: SPC
530  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: TMPA
531 !
532  spc = ' '
533  DO i=1,reclvl-1
534  spc = spc//' '
535  ENDDO
536  IF( reclvl .EQ. 1 ) THEN
537  cnt = cnt + 1
538  WRITE(lu,*)
539  WRITE(lu,*)
540  & '======================== START ',scnt, '::',cnt,' ==='
541  WRITE(lu,*)' AD_PRINT_BIEF_OBJ :: ', msg
542  WRITE(lu,*)'======================================='
543  ENDIF
544 !
545 ! HEADER COMMON TO ALL OBJECTS
546 !
547  WRITE(lu,*) spc,'(G)',' KEY ',tgt%KEY,' TYPE ',tgt%TYPE,
548  & ' FATHER::',tgt%FATHER,':: NAME::',tgt%NAME,'::'
549 !
550 ! FOR VECTORS
551 !
552  WRITE(lu,*) spc,'(V)',' NAT', tgt%NAT, ' ELM',tgt%ELM,
553  & ' DIM1',tgt%DIM1, ' MAXDIM1', tgt%MAXDIM1,
554  & ' DIM2', tgt%DIM2,' MAXDIM2', tgt%MAXDIM2,
555  & ' DIMDISC', tgt%DIMDISC, ' STATUS ', tgt%STATUS
556  IF ( ASSOCIATED(tgt%R) .AND. tgt%TYPE .EQ. 2 ) THEN
557 #ifndef COMPAD_DCO_T1S
558  DO i=1,SIZE(tgt%R)
559  WRITE(lu,*) spc,' (V)',i,':', tgt%R(i)
560  ENDDO
561 #else
562  ALLOCATE( tmpa(SIZE(tgt%R)))
563  CALL dco_t1s_get( tgt%R, tmpa, 1 )
564  DO i=1,SIZE(tgt%R)
565  WRITE(lu,*) spc,' (V)',i,':', tgt%R(i),' T1S', tmpa(i)
566  ENDDO
567  DEALLOCATE(tmpa)
568 #endif
569  ENDIF
570 !
571 ! FOR MATRICES
572 !
573  WRITE(lu,*) spc,'(M)',' STO', tgt%STO,' STOX', tgt%STOX,
574  & ' ELMLIN', tgt%ELMLIN,' ELMCOL', tgt%ELMCOL
575  IF ( tgt%TYPE .EQ. 3 ) THEN
576  IF ( ASSOCIATED(tgt%D) ) THEN
577  CALL ad_print_bief_obj( tgt%D, scnt,reclvl+1,"","" )
578  ENDIF
579  IF ( ASSOCIATED(tgt%X) ) THEN
580  CALL ad_print_bief_obj( tgt%X, scnt,reclvl+1,"","" )
581  ENDIF
582  ENDIF
583 !
584 ! FOR BLOCKS
585 !
586  WRITE(lu,*) spc,'(B)',' N', tgt%N,' MAXBLOCK', tgt%MAXBLOCK
587  IF ( tgt%TYPE .EQ. 4 ) THEN
588  IF ( ASSOCIATED(tgt%ADR) ) THEN
589  DO i = 1, tgt%N
590  CALL ad_print_bief_obj( tgt%ADR(i)%P,scnt,reclvl+1,"","" )
591  ENDDO
592  ENDIF
593  ENDIF
594 !
595  IF ( reclvl.EQ.1 ) THEN
596  WRITE(lu,*)
597  & '======================= END ',scnt, '::',cnt,' ==='
598  ENDIF
599 !
600  END SUBROUTINE ad_print_bief_obj
601 !
602 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
603 !
604  RECURSIVE SUBROUTINE ad_diff_int_print_bief_obj
605  & ( tgta,whta, pval, scnt, reclvl, msg, fil )
606 !
607 ! MODULES -----------------------
608 !
609 ! USE BIEF
610 ! USE DECLARATIONS_SPECIAL
611  IMPLICIT NONE
612 !
613 ! ARGUMENTS ---------------------
614 !
615  TYPE(bief_obj), INTENT(IN) :: TGTA
616  INTEGER , INTENT(IN) :: WHTA, PVAL, SCNT, RECLVL
617  CHARACTER(LEN=*) :: MSG, FIL
618 !
619 ! LOCAL VARS --------------------
620 !
621  INTEGER :: I
622  INTEGER, SAVE :: CNT = 0
623 ! /!\ HOW IS SPC ALLOCATED ?
624  CHARACTER(LEN=2*RECLVL+2) :: SPC
625  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: TMPA, TMPB
626  LOGICAL :: DIFF
627 !
628  spc = ' '
629  DO i=1,reclvl-1
630  spc = spc//' '
631  ENDDO
632  IF( reclvl .EQ. 1) THEN
633  cnt = cnt + 1
634  WRITE(lu,*)
635  WRITE(lu,*)
636  & '======================== START ',scnt, '::', cnt,' ==='
637  WRITE(lu,*)' AD_DIFF_INT_PRINT_BIEF_OBJ :: ', msg
638  WRITE(lu,*)' COMPARING :: ', tgta%NAME,' with value ',
639  & pval, ' what: ', whta
640  WRITE(lu,*)'======================================='
641  ENDIF
642 !
643 ! HEADER COMMON TO ALL OBJECTS
644 !
645  WRITE(lu,*) spc,'(G) TGTA',' KEY ',tgta%KEY,
646  & ' TYPE ',tgta%TYPE,' FATHER::',tgta%FATHER,
647  & ':: NAME::',tgta%NAME,'::'
648 !
649 ! FOR VECTORS
650 !
651  WRITE(lu,*) spc,'(V) TGTA ',' NAT', tgta%NAT,
652  & ' ELM',tgta%ELM,
653  & ' DIM1',tgta%DIM1, ' MAXDIM1', tgta%MAXDIM1,
654  & ' DIM2', tgta%DIM2,' MAXDIM2', tgta%MAXDIM2,
655  & ' DIMDISC', tgta%DIMDISC, ' STATUS ', tgta%STATUS
656  IF ( ASSOCIATED(tgta%R) .AND. 2 == tgta%TYPE) THEN
657 #ifndef COMPAD_DCO_T1S
658  DO i=1,SIZE(tgta%R)
659  IF ( tgta%R(i) .NE. pval )
660  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
661  & ' BIEFDIFF VALUE:',tgta%R(i), ' <--> ', pval
662  ENDDO
663 #else
664  ALLOCATE( tmpa(SIZE(tgta%R)) )
665  CALL dco_t1s_get( tgta%R, tmpa, 1 )
666  DO i=1,SIZE(tgta%R)
667  IF ( whta .EQ. 0 ) THEN
668  IF ( tgta%R(i) .NE. pval )
669  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
670  & ' BIEFDIFF VAL/PVAL :',tgta%R(i), ' <--> ', pval
671  ELSEIF ( whta .EQ. 1 ) THEN
672  IF ( tmpa(i) .NE. pval )
673  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
674  & ' BIEFDIFF T1S/PVAL :',tmpa(i), ' <--> ', pval
675  ELSE
676  IF ( tgta%R(i) .NE. pval )
677  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
678  & ' BIEFDIFF VAL/PVAL :',tgta%R(i), ' <--> ', pval
679  ENDIF
680  ENDDO
681  DEALLOCATE(tmpa)
682 #endif
683  ENDIF
684 !
685 ! FOR MATRICES
686 !
687  WRITE(lu,*) spc,'(M) TGTA',' STO', tgta%STO,
688  & ' STOX', tgta%STOX,
689  & ' ELMLIN', tgta%ELMLIN,' ELMCOL', tgta%ELMCOL
690  IF ( tgta%TYPE .EQ. 3 ) THEN
691  IF ( ASSOCIATED(tgta%D) ) THEN
692  CALL ad_diff_int_print_bief_obj( tgta%D,whta, pval,
693  & scnt, reclvl+1,msg,fil )
694  ENDIF
695  IF ( ASSOCIATED(tgta%X) ) THEN
696  CALL ad_diff_int_print_bief_obj( tgta%X,whta, pval,
697  & scnt, reclvl+1,msg,fil )
698  ENDIF
699  ENDIF
700 !
701 ! FOR BLOCKS
702 !
703  WRITE(lu,*) spc,'(B) TGTA',' N', tgta%N,
704  & ' MAX BLOCK', tgta%MAXBLOCK
705  IF ( tgta%TYPE .EQ. 4 ) THEN
706  IF ( ASSOCIATED(tgta%ADR) ) THEN
707  DO i = 1, tgta%N
708  CALL ad_diff_int_print_bief_obj( tgta%ADR(i)%P, pval,
709  & whta,scnt, reclvl+1,msg,fil )
710  ENDDO
711  ENDIF
712  ENDIF
713 !
714  IF ( reclvl .EQ. 1 ) THEN
715  WRITE(lu,*)'======================= END ',
716  & scnt, '::', cnt,' ==='
717  ENDIF
718 !
719  END SUBROUTINE ad_diff_int_print_bief_obj
720 !
721 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
722 !
723  RECURSIVE SUBROUTINE ad_diff_print_bief_obj
724  & ( tgta, whta, tgtb, whtb, scnt, reclvl, msg, fil )
725 !
726 ! MODULES -----------------------
727 !
728 ! USE BIEF
729 ! USE DECLARATIONS_SPECIAL
730  IMPLICIT NONE
731 !
732 ! ARGUMENTS ---------------------
733 !
734  TYPE(bief_obj), INTENT(IN) :: TGTA, TGTB
735  INTEGER , INTENT(IN) :: WHTA, WHTB, SCNT, RECLVL
736  CHARACTER(LEN=*) :: MSG, FIL
737 !
738 ! LOCAL VARS --------------------
739 !
740  INTEGER :: I
741  INTEGER, SAVE :: CNT = 0
742 ! /!\ HOW IS SPC ALLOCATED ?
743  CHARACTER(LEN=2*RECLVL+2) :: SPC
744  DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: TMPA, TMPB
745  LOGICAL :: DIFF
746 !
747  spc = ' '
748  DO i=1,reclvl-1
749  spc = spc//' '
750  ENDDO
751  IF( reclvl .EQ. 1 ) THEN
752  cnt = cnt + 1
753  WRITE(lu,*)
754  WRITE(lu,*)
755  & '======================== START ',scnt, '::', cnt,' ==='
756  WRITE(lu,*)' AD_DIFF_PRINT_BIEF_OBJ :: ', msg
757  WRITE(lu,*)' COMPARING :: ', tgta%NAME, ' with ',
758  & tgtb%NAME, ' what: ', whta, whtb
759  WRITE(lu,*)'======================================='
760  ENDIF
761 !
762 ! HEADER COMMON TO ALL OBJECTS
763 !
764  WRITE(lu,*) spc,'(G) TGTA',' KEY ',tgta%KEY,
765  & ' TYPE ',tgta%TYPE,
766  & ' FATHER::',tgta%FATHER,':: NAME::',tgta%NAME,'::'
767  WRITE(lu,*) spc,'(G) TGTB',' KEY ',tgtb%KEY,
768  & ' TYPE ',tgtb%TYPE,
769  & ' FATHER::',tgtb%FATHER,':: NAME::',tgtb%NAME,'::'
770  WRITE(lu,'(1x,A,A)',advance='NO') spc,'(G) CHECK ::: '
771  IF ( tgta%KEY .NE. tgtb%KEY )
772  & WRITE(lu,'(A)',advance='NO') 'KEY'
773  IF ( tgta%TYPE .NE. tgtb%TYPE )
774  & WRITE(lu,'(A)',advance='NO') 'TYPE'
775  diff = tgta%KEY .NE. tgtb%KEY
776  diff = diff .AND. ( tgta%TYPE .NE. tgtb%TYPE )
777  IF ( diff ) WRITE(lu,*) ' BIEFDIFF'
778  WRITE(lu,*)
779 !
780 ! FOR VECTORS
781 !
782  WRITE(lu,*) spc,'(V) TGTA ',' NAT', tgta%NAT,
783  & ' ELM',tgta%ELM,
784  & ' DIM1',tgta%DIM1, ' MAXDIM1', tgta%MAXDIM1,
785  & ' DIM2', tgta%DIM2,' MAXDIM2', tgta%MAXDIM2,
786  & ' DIMDISC', tgta%DIMDISC, ' STATUS ', tgta%STATUS
787  WRITE(lu,*) spc,'(V) TGTB ',' NAT', tgtb%NAT,
788  & ' ELM',tgtb%ELM,
789  & ' DIM1',tgtb%DIM1, ' MAXDIM1', tgtb%MAXDIM1,
790  & ' DIM2', tgtb%DIM2,' MAXDIM2', tgtb%MAXDIM2,
791  & ' DIMDISC', tgtb%DIMDISC, ' STATUS ', tgtb%STATUS
792  WRITE(lu,'(1x,A,A)',advance='NO') spc,'(V) CHECK ::: '
793  IF ( tgta%NAT .NE. tgtb%NAT )
794  & WRITE(lu,'(A)',advance='NO') ' NAT '
795  IF ( tgta%ELM .NE. tgtb%ELM )
796  & WRITE(lu,'(A)',advance='NO') ' ELM '
797  IF ( tgta%DIM1 .NE. tgtb%DIM1 )
798  & WRITE(lu,'(A)',advance='NO') ' DIM1 '
799  IF ( tgta%MAXDIM1 .NE. tgtb%MAXDIM1 )
800  & WRITE(lu,'(A)',advance='NO') ' MAXDIM1 '
801  IF ( tgta%DIM2 .NE. tgtb%DIM2 )
802  & WRITE(lu,'(A)',advance='NO') ' DIM2 '
803  IF ( tgta%MAXDIM2 .NE. tgtb%MAXDIM2 )
804  & WRITE(lu,'(A)',advance='NO') ' MAXDIM2 '
805  IF ( tgta%DIMDISC .NE. tgtb%DIMDISC )
806  & WRITE(lu,'(A)',advance='NO') ' DIMDISC '
807  IF ( tgta%STATUS .NE. tgtb%STATUS )
808  & WRITE(lu,'(A)',advance='NO') ' STATUS '
809  IF ( tgta%TYPR .NE. tgtb%TYPR )
810  & WRITE(lu,'(A)',advance='NO') ' TYPR '
811  IF ( tgta%TYPI .NE. tgtb%TYPI )
812  & WRITE(lu,'(A)',advance='NO') ' TYPI '
813  diff = tgta%ELM .NE. tgtb%ELM
814  diff = diff .AND. ( tgta%DIM1 .NE. tgtb%DIM1 )
815  diff = diff .AND. ( tgta%MAXDIM1 .NE. tgtb%MAXDIM1 )
816  diff = diff .AND. ( tgta%DIM2 .NE. tgtb%DIM2 )
817  diff = diff .AND. ( tgta%MAXDIM2 .NE. tgtb%MAXDIM2 )
818  diff = diff .AND. ( tgta%DIMDISC .NE. tgtb%DIMDISC )
819  diff = diff .AND. ( tgta%STATUS .NE. tgtb%STATUS )
820  diff = diff .AND. ( tgta%TYPR .NE. tgtb%TYPR )
821  diff = diff .AND. ( tgta%TYPI .NE. tgtb%TYPI )
822  IF ( diff ) WRITE(lu,*) ' BIEFDIFF'
823  WRITE(lu,*)
824 
825  IF ( ASSOCIATED(tgta%R) .AND. 2 == tgta%TYPE) THEN
826 #ifndef COMPAD_DCO_T1S
827  DO i=1,SIZE(tgta%R)
828  IF ( tgta%R(i) .NE. tgtb%R(i) )
829  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
830  & ' BIEFDIFF VALUE:', tgta%R(i), ' <--> ', tgtb%R(i)
831  ENDDO
832 #else
833  ALLOCATE( tmpa(SIZE(tgta%R)), tmpb(SIZE(tgtb%R)) )
834  CALL dco_t1s_get( tgta%R, tmpa, 1 )
835  CALL dco_t1s_get( tgtb%R, tmpb, 1 )
836  DO i=1,SIZE(tgta%R)
837  IF ( whta .EQ. 0 .AND. whtb .EQ. 0 ) THEN
838  IF ( tgta%R(i) .NE. tgtb%R(i) )
839  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
840  & ' BIEFDIFF VAL/VAL :',tgta%R(i),' <--> ',tgtb%R(i)
841  ELSEIF ( whta .EQ. 0 .AND. whtb .EQ. 1 ) THEN
842  IF ( tgta%R(i) .NE. tmpb(i) )
843  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
844  & ' BIEFDIFF VAL/T1S :',tgta%R(i),' <--> ',tmpb(i)
845  ELSEIF ( whta .EQ. 1 .AND. whtb .EQ. 0 ) THEN
846  IF ( tmpa(i) .NE. tgtb%R(i) )
847  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
848  & ' BIEFDIFF T1S/VAL :',tmpa(i),' <--> ',tgtb%R(i)
849  ELSEIF ( whta .EQ. 1 .AND. whtb .EQ. 1 ) THEN
850  IF ( tmpa(i) .NE. tmpb(i) )
851  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
852  & ' BIEFDIFF T1S/T1S :',tmpa(i),' <--> ',tgtb%R(i)
853  ELSE
854  IF ( tgta%R(i) .NE. tgtb%R(i) )
855  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
856  & ' BIEFDIFF VAL/VAL :',tgta%R(i),' <--> ',tgtb%R(i)
857  IF ( tmpa(i) .NE. tmpb(i) )
858  & WRITE(lu,*) spc,' (V)',i,'(',msg,',',scnt,')',
859  & ' BIEFDIFF T1S :',tmpa(i),' <--> ',tmpb(i)
860  ENDIF
861  ENDDO
862  DEALLOCATE(tmpa,tmpb)
863 #endif
864  ENDIF
865 !
866 ! FOR MATRICES
867 !
868  WRITE(lu,*) spc,'(M) TGTA',' STO', tgta%STO,
869  & ' STOX', tgta%STOX,
870  & ' ELMLIN', tgta%ELMLIN,' ELMCOL', tgta%ELMCOL
871  WRITE(lu,*) spc,'(M) TGTB',' STO', tgtb%STO,
872  & ' STOX', tgtb%STOX,
873  & ' ELMLIN', tgtb%ELMLIN,' ELMCOL', tgtb%ELMCOL
874  WRITE(lu,'(1x,A,A)',advance='NO') spc,'(M) CHECK ::: '
875  IF ( tgta%STO .NE. tgtb%STO )
876  & WRITE(lu,'(A)',advance='NO') ' STO '
877  IF ( tgta%STOX .NE. tgtb%STOX )
878  & WRITE(lu,'(A)',advance='NO') ' STOX '
879  IF ( tgta%ELMLIN .NE. tgtb%ELMLIN )
880  & WRITE(lu,'(A)',advance='NO') ' ELMLIN '
881  IF ( tgta%ELMCOL .NE. tgtb%ELMCOL )
882  & WRITE(lu,'(A)',advance='NO') ' ELMCOL '
883  IF ( tgta%TYPDIA .NE. tgtb%TYPDIA )
884  & WRITE(lu,'(A)',advance='NO') ' TYPDIA '
885  IF ( tgta%TYPEXT .NE. tgtb%TYPEXT )
886  & WRITE(lu,'(A)',advance='NO') ' TYPEXT '
887  WRITE(lu,*)
888  diff = tgta%STO .NE. tgtb%STO
889  diff = diff .AND. ( tgta%STOX .NE. tgtb%STOX )
890  diff = diff .AND. ( tgta%ELMLIN.NE. tgtb%ELMLIN)
891  diff = diff .AND. ( tgta%ELMCOL.NE. tgtb%ELMCOL)
892  diff = diff .AND. ( tgta%DIM2 .NE. tgtb%DIM2 )
893  diff = diff .AND. ( tgta%TYPDIA.NE. tgtb%TYPDIA)
894  diff = diff .AND. ( tgta%TYPEXT.NE. tgtb%TYPEXT )
895  IF ( diff ) WRITE(lu,*) ' BIEFDIFF'
896  IF ( tgta%TYPE .EQ. 3 ) THEN
897  IF ( ASSOCIATED(tgta%D) ) THEN
898  WRITE(lu,*) spc,'(M) DIFFING NOW TGTA%D TGTB%D'
899  CALL ad_diff_print_bief_obj( tgta%D,whta, tgtb%D,whtb,
900  & scnt, reclvl+1,msg,fil )
901  ENDIF
902  IF ( ASSOCIATED(tgta%X) ) THEN
903  WRITE(lu,*) spc,'(M) DIFFING NOW TGTA%X TGTB%X'
904  CALL ad_diff_print_bief_obj( tgta%X,whta, tgtb%X,whtb,
905  & scnt, reclvl+1,msg,fil )
906  ENDIF
907  ENDIF
908 !
909 ! FOR BLOCKS
910 !
911  WRITE(lu,*) spc,'(B) TGTA',' N', tgta%N,
912  & ' MAX BLOCK', tgta%MAXBLOCK
913  WRITE(lu,*) spc,'(B) TGTB',' N', tgtb%N,
914  & ' MAXBLOCK', tgtb%MAXBLOCK
915  WRITE(lu,'(1x,A,A)',advance='NO') spc,'(B) CHECK ::: '
916  IF ( tgta%N .NE. tgtb%N ) WRITE(lu,'(A)',advance='NO') ' N '
917  IF ( tgta%MAXBLOCK .NE. tgtb%MAXBLOCK )
918  & WRITE(lu,'(A)',advance='NO') ' MAXBLOCK '
919  diff = tgta%N .NE. tgtb%N
920  diff = diff .AND. ( tgta%MAXBLOCK.NE.tgtb%MAXBLOCK )
921  IF ( diff ) WRITE(lu,*) ' BIEFDIFF'
922  WRITE(lu,*)
923  IF ( tgta%TYPE .EQ. 4 ) THEN
924  IF ( ASSOCIATED(tgta%ADR) ) THEN
925  DO i = 1, tgta%N
926  WRITE(lu,*) spc,'(M) DIFFING NOW BLOCKS ',
927  & 'TGTA%ADR(',i,')%P TGTB%ADR(',i,')%P'
928  CALL ad_diff_print_bief_obj(tgta%ADR(i)%P,whta,
929  & tgtb%ADR(i)%P, whtb, scnt, reclvl+1,msg,fil )
930  ENDDO
931  ENDIF
932  ENDIF
933 !
934  IF ( 1 .EQ. reclvl ) THEN
935  WRITE(lu,*)
936  & '======================= END ',scnt, '::', cnt,' ==='
937  ENDIF
938 !
939  END SUBROUTINE ad_diff_print_bief_obj
940 !
941 #endif /* COMPAD_SYMBOLIC_LINSOLVE .AND. COMPAD */
942 !
943 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
944 !
945  END
ad_deep_copy_bief_obj
recursive subroutine ad_deep_copy_bief_obj(TGT, SRC, SCNT, RECLVL)
Definition: ad_solve.F:407
ad_solve
subroutine ad_solve(X, A, B, TB, CFG, INFOGR, MESH, AUX)
Definition: ad_solve.F:33
ad_t1x_set_bief_obj
recursive subroutine ad_t1x_set_bief_obj(TGT, TWHAT, SRC, SWHAT, RECLVL)
Definition: ad_solve.F:294
ad_t1x_set_int_bief_obj
recursive subroutine ad_t1x_set_int_bief_obj(TGT, WHAT, VAL, RECLVL)
Definition: ad_solve.F:354
declarations_special
Definition: declarations_special.F:3
declarations_special::ad_symblinsolv
logical ad_symblinsolv
Definition: declarations_special.F:140
solve
subroutine solve(X, A, B, TB, CFG, INFOGR, MESH, AUX)
Definition: solve.f:7
declarations_special::lu
integer lu
Definition: declarations_special.F:45
ad_diff_int_print_bief_obj
recursive subroutine ad_diff_int_print_bief_obj(TGTA, WHTA, PVAL, SCNT, RECLVL, MSG, FIL)
Definition: ad_solve.F:606
declarations_special::ad_linsolv_resetderiv
logical ad_linsolv_resetderiv
Definition: declarations_special.F:144
ad_print_bief_obj
recursive subroutine ad_print_bief_obj(TGT, SCNT, RECLVL, MSG, FIL)
Definition: ad_solve.F:511
os
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
matrbl
subroutine matrbl(OP, X, A, Y, C, MESH)
Definition: matrbl.f:7
ad_diff_print_bief_obj
recursive subroutine ad_diff_print_bief_obj(TGTA, WHTA, TGTB, WHTB, SCNT, RECLVL, MSG, FIL)
Definition: ad_solve.F:725
declarations_special::ad_linsolv_derivative_convergence
logical ad_linsolv_derivative_convergence
Definition: declarations_special.F:148
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:36:09 for The TELEMAC-MASCARET system by doxygen 1.8.13