27!||--- uses -----------------------------------------------------
36#include "implicit_f.inc"
73#include "implicit_f.inc"
98 CALL write_i_c(
SIZE(table(n)%X(k)%VALUES) , len)
102 CALL write_i_c(
SIZE(table(n)%Y%VALUES),len)
122#include "implicit_f.inc"
126#include "com04_c.inc"
140 len =
SIZE( table(n)%X(k)%VALUES)
141 CALL write_db(table(n)%X(k)%VALUES,len)
144 len =
SIZE( table(n)%Y%VALUES)
145 CALL write_db(table(n)%Y%VALUES,len)
169#include "implicit_f.inc"
175#include "com04_c.inc"
183 INTEGER LEN, N, K, NXK, NY, STAT, NDIM
192 ALLOCATE(table(n)%X(ndim),stat=stat)
193 IF(stat/=0)
GOTO 1000
198 ALLOCATE(table(n)%X(k)%VALUES(nxk),stat=stat)
199 IF(stat/=0)
GOTO 1000
204 ALLOCATE(table(n)%Y,stat=stat)
205 IF(stat/=0)
GOTO 1000
207 ALLOCATE(table(n)%Y%VALUES(ny),stat=stat)
208 IF(stat/=0)
GOTO 1000
213 CALL ancmsg(msgid=20,anmode=aninfo)
217!||====================================================================
232#include "implicit_f.inc"
236#include "com04_c.inc"
244 INTEGER LEN, N, K, STAT, i
248 len =
SIZE( table(n)%X(k)%VALUES )
249 CALL read_db(table(n)%X(k)%VALUES,len)
251 len =
SIZE( table(n)%Y%VALUES )
252 CALL read_db(table(n)%Y%VALUES,len)
269!||--- uses -----------------------------------------------------
280#include "implicit_f.inc"
291 INTEGER NDIM, I,K,IP,IN,IM,IL,P,N,M,L,N1,N12,N123
292 INTEGER NXK(4),IPOS(4)
295 . dx1,dx2,r(4),unr(4)
298 IF(
SIZE(xx) < ndim )
THEN
299 CALL ancmsg(msgid=36,anmode=aninfo,
300 . c1='table interpolation
')
308 NXK(K) = SIZE(TABLE%X(K)%VALUES)
310 DX2 = TABLE%X(K)%VALUES(I) - XX(K)
311.OR.
IF (DX2>=ZERO I==NXK(K)) THEN
313 R(K) =(TABLE%X(K)%VALUES(I)-XX(K))/
314 . (TABLE%X(K)%VALUES(I)-TABLE%X(K)%VALUES(I-1))
332 IP=N123*(IPOS(4)-1+P)
339 IB(L+1,M+1,N+1,P+1)=IP+IN+IM+IL
345 YY = R(4) * (R(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
346 . + UNR(2) * (R(1)*TY%VALUES(IB(1,2,1,1)) + UNR(1)*TY%VALUES(IB(2,2,1,1))))
347 . +UNR(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,2,1)) + UNR(1)*TY%VALUES(IB(2,1,2,1)))
348 . + UNR(2) * (R(1)*TY%VALUES(IB(1,2,2,1)) + UNR(1)*TY%VALUES(IB(2,2,2,1)))))
349 . +UNR(4) *(R(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,1,2)) + UNR(1)*TY%VALUES(IB(2,1,1,2)))
350 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,1,2)) + UNR(1)*TY%VALUES(IB(2,2,1,2))))
351 . +UNR(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,2,2)) + UNR(1)*TY%VALUES(IB(2,1,2,2)))
352 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,2,2)) + UNR(1)*TY%VALUES(IB(2,2,2,2)))))
359 IN = N12*(IPOS(3)-1+N)
361 IM = N1*(IPOS(2)-1+M)
364 IB(L+1,M+1,N+1,1) = IN+IM+IL
369 IF (R(2) == ONE) THEN ! case when second variable has only one value
370 YY = R(3) * (R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
371 . + UNR(3) * (R(1)*TY%VALUES(IB(1,1,2,1)) + UNR(1)*TY%VALUES(IB(2,1,2,1)))
374 YY = R(3) *(R(2) * (R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
375 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,1,1)) + UNR(1)*TY%VALUES(IB(2,2,1,1))))
376 . + UNR(3) *(R(2) * (R(1)*TY%VALUES(IB(1,1,2,1)) + UNR(1)*TY%VALUES(IB(2,1,2,1)))
377 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,2,1)) + UNR(1)*TY%VALUES(IB(2,2,2,1))))
387 IB(L+1,M+1,1,1)=IM+IL
391 YY = (R(2)*(R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
392 . +UNR(2)*(R(1)*TY%VALUES(IB(1,2,1,1)) + UNR(1)*TY%VALUES(IB(2,2,1,1))))
398 YY = R(1) * TY%VALUES(IPOS(1)) + UNR(1) * TY%VALUES(IPOS(1)+1)
404 END SUBROUTINE TABLE_INTERP
405!||====================================================================
406!|| table_interp_dydx ../engine/source/tools/curve/table_tools.F
407!||--- called by ------------------------------------------------------
408!|| get_table_value_dydx ../engine/source/user_interface/utable.F
409!|| material_flow ../engine/source/tools/seatbelts/material_flow.F
410!|| press_seg3 ../engine/source/loads/general/load_pcyl/press_seg3.F
411!||--- calls -----------------------------------------------------
412!|| ancmsg ../engine/source/output/message/message.F
413!|| arret ../engine/source/system/arret.F
414!||--- uses -----------------------------------------------------
415!|| message_mod ../engine/share/message_module/message_mod.F
416!|| table_mod ../engine/share/modules/table_mod.F
417!||====================================================================
418 SUBROUTINE TABLE_INTERP_DYDX(TABLE,XX,XXDIM,YY,DYDX)
425#include "implicit_f.inc"
431 my_real, INTENT(IN),DIMENSION(XXDIM) :: XX
432 my_real, INTENT(OUT) :: YY,DYDX
436 TYPE(TTABLE_XY), POINTER :: TY
437 INTEGER NDIM, I,K,IP,IN,IM,IL,P,N,M,L,N1,N12,N123
438 INTEGER NXK(4),IPOS(4)
441 . DX1,DX2,R(4),UNR(4)
444 IF( XXDIM < NDIM )THEN
445 CALL ANCMSG(MSGID=36,ANMODE=ANINFO,
446 . C1='table interpolation
')
454 NXK(K) = SIZE(TABLE%X(K)%VALUES)
456 DX2 = TABLE%X(K)%VALUES(I) - XX(K)
457.OR.
IF (DX2>=ZERO I==NXK(K)) THEN
459 R(K) =(TABLE%X(K)%VALUES(I)-XX(K))/
460 . (TABLE%X(K)%VALUES(I)-TABLE%X(K)%VALUES(I-1))
478 IP=N123*(IPOS(4)-1+P)
485 IB(L+1,M+1,N+1,P+1)=IP+IN+IM+IL
491 YY = R(4) * (R(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
492 . + UNR(2) * (R(1)*TY%VALUES(IB(1,2,1,1)) + UNR(1)*TY%VALUES(IB(2,2,1,1))))
493 . +UNR(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,2,1)) + UNR(1)*TY%VALUES(IB(2,1,2,1)))
494 . + UNR(2) * (R(1)*TY%VALUES(IB(1,2,2,1)) + UNR(1)*TY%VALUES(IB(2,2,2,1)))))
495 . +UNR(4) *(R(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,1,2)) + UNR(1)*TY%VALUES(IB(2,1,1,2)))
496 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,1,2)) + UNR(1)*TY%VALUES(IB(2,2,1,2))))
497 . +UNR(3)*(R(2) * (R(1)*TY%VALUES(IB(1,1,2,2)) + UNR(1)*TY%VALUES(IB(2,1,2,2)))
498 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,2,2)) + UNR(1)*TY%VALUES(IB(2,2,2,2)))))
501 . (R(4) * (R(3) * (R(2) * ( TY%VALUES(IB(2,1,1,1)) - TY%VALUES(IB(1,1,1,1)))
502 . +UNR(2) * ( TY%VALUES(IB(2,2,1,1)) - TY%VALUES(IB(1,2,1,1))))
503 . + UNR(3) * (R(2) * ( TY%VALUES(IB(2,1,2,1)) - TY%VALUES(IB(1,1,2,1)))
504 . + UNR(2) * ( TY%VALUES(IB(2,2,2,1)) - TY%VALUES(IB(1,2,2,1)))))
505 . + UNR(4) * (R(3) * (R(2) * ( TY%VALUES(IB(2,1,1,1)) - TY%VALUES(IB(1,1,1,1)))
506 . + UNR(2) * ( TY%VALUES(IB(2,2,1,1)) - TY%VALUES(IB(1,2,1,1))))
507 . + UNR(3) * (R(2) * ( TY%VALUES(IB(2,1,2,1)) - TY%VALUES(IB(1,1,2,1)))
508 . + UNR(2) * ( TY%VALUES(IB(2,2,2,1)) - TY%VALUES(IB(1,2,2,1))))))/
509 . (TABLE%X(1)%VALUES(IPOS(1)+1)-TABLE%X(1)%VALUES(IPOS(1)))
518 IN = N12*(IPOS(3)-1+N)
520 IM = N1*(IPOS(2)-1+M)
523 IB(L+1,M+1,N+1,1) = IN+IM+IL
528 IF (R(2) == ONE) THEN ! case when second variable has only one value
529 YY = R(3) * (R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
530 . + UNR(3) * (R(1)*TY%VALUES(IB(1,1,2,1)) + UNR(1)*TY%VALUES(IB(2,1,2,1)))
533 YY = R(3) *(R(2) * (R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
534 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,1,1)) + UNR(1)*TY%VALUES(IB(2,2,1,1))))
535 . + UNR(3) *(R(2) * (R(1)*TY%VALUES(IB(1,1,2,1)) + UNR(1)*TY%VALUES(IB(2,1,2,1)))
536 . +UNR(2) * (R(1)*TY%VALUES(IB(1,2,2,1)) + UNR(1)*TY%VALUES(IB(2,2,2,1))))
540 . (R(3) * (R(2) * ( TY%VALUES(IB(2,1,1,1)) - TY%VALUES(IB(1,1,1,1)))
541 . + UNR(2) * ( TY%VALUES(IB(2,2,1,1)) - TY%VALUES(IB(1,2,1,1))))
542 . + UNR(3) * (R(2) * ( TY%VALUES(IB(2,1,2,1)) - TY%VALUES(IB(1,1,2,1)))
543 . +UNR(2) * ( TY%VALUES(IB(2,2,2,1)) - TY%VALUES(IB(1,2,2,1)))))/
544 . (TABLE%X(1)%VALUES(IPOS(1)+1)-TABLE%X(1)%VALUES(IPOS(1)))
553 IB(L+1,M+1,1,1)=IM+IL
557 YY = (R(2)*(R(1)*TY%VALUES(IB(1,1,1,1)) + UNR(1)*TY%VALUES(IB(2,1,1,1)))
558 . +UNR(2)*(R(1)*TY%VALUES(IB(1,2,1,1)) + UNR(1)*TY%VALUES(IB(2,2,1,1))))
561 . (R(2) * ( TY%VALUES(IB(2,1,1,1)) - TY%VALUES(IB(1,1,1,1)))
562 . + UNR(2) * ( TY%VALUES(IB(2,2,1,1)) - TY%VALUES(IB(1,2,1,1))))/
563 . (TABLE%X(1)%VALUES(IPOS(1)+1)-TABLE%X(1)%VALUES(IPOS(1)))
569 YY = R(1) * TY%VALUES(IPOS(1)) + UNR(1) * TY%VALUES(IPOS(1)+1)
571 DYDX = (TY%VALUES(IPOS(1)+1)-TY%VALUES(IPOS(1)))/
572 . (TABLE%X(1)%VALUES(IPOS(1)+1)-TABLE%X(1)%VALUES(IPOS(1)))
578 END SUBROUTINE TABLE_INTERP_DYDX
579!||====================================================================
580!|| table_vinterp ../engine/source/tools/curve/table_tools.F
581!||--- called by ------------------------------------------------------
582!|| fail_gene1_b ../engine/source/materials/fail/gene1/fail_gene1_b.F90
583!|| fail_gene1_c ../engine/source/materials/fail/gene1/fail_gene1_c.F
584!|| fail_gene1_ib ../engine/source/materials/fail/gene1/fail_gene1_ib.F90
585!|| fail_gene1_s ../engine/source/materials/fail/gene1/fail_gene1_s.F
586!|| fail_inievo_b ../engine/source/materials/fail/inievo/fail_inievo_b.F90
587!|| fail_inievo_c ../engine/source/materials/fail/inievo/fail_inievo_c.F
588!|| fail_inievo_ib ../engine/source/materials/fail/inievo/fail_inievo_ib.F90
589!|| fail_inievo_s ../engine/source/materials/fail/inievo/fail_inievo_s.F
590!|| fail_tab2_b ../engine/source/materials/fail/tabulated/fail_tab2_b.F90
591!|| fail_tab2_c ../engine/source/materials/fail/tabulated/fail_tab2_c.F
592!|| fail_tab2_ib ../engine/source/materials/fail/tabulated/fail_tab2_ib.F90
593!|| fail_tab2_s ../engine/source/materials/fail/tabulated/fail_tab2_s.F
594!|| fail_tab_c ../engine/source/materials/fail/tabulated/fail_tab_c.F
595!|| fail_tab_s ../engine/source/materials/fail/tabulated/fail_tab_s.F
596!|| get_u_vtable ../engine/source/user_interface/utable.F
597!|| get_vtable_value ../engine/source/user_interface/utable.F
598!|| law119_membrane ../engine/source/materials/mat/mat119/law119_membrane.F
599!|| sigeps109 ../engine/source/materials/mat/mat109/sigeps109.F
600!|| sigeps109c ../engine/source/materials/mat/mat109/sigeps109c.F
601!|| sigeps110c_lite_newton ../engine/source/materials/mat/mat110/sigeps110c_lite_newton.F
602!|| sigeps110c_lite_nice ../engine/source/materials/mat/mat110/sigeps110c_lite_nice.F
603!|| sigeps110c_newton ../engine/source/materials/mat/mat110/sigeps110c_newton.F
604!|| sigeps110c_nice ../engine/source/materials/mat/mat110/sigeps110c_nice.F
605!|| sigeps120_connect_tab_dp ../engine/source/materials/mat/mat120/sigeps120_connect_tab_dp.F
606!|| sigeps120_connect_tab_vm ../engine/source/materials/mat/mat120/sigeps120_connect_tab_vm.F
607!|| sigeps120_tab_dp ../engine/source/materials/mat/mat120/sigeps120_tab_dp.F
608!|| sigeps120_tab_vm ../engine/source/materials/mat/mat120/sigeps120_tab_vm.F
609!|| sigeps73c ../engine/source/materials/mat/mat073/sigeps73c.F
610!|| sigeps74 ../engine/source/materials/mat/mat074/sigeps74.F
611!|| sigeps80 ../engine/source/materials/mat/mat080/sigeps80.F
612!|| sigeps80c ../engine/source/materials/mat/mat080/sigeps80c.F
613!||--- calls -----------------------------------------------------
614!|| ancmsg ../engine/source/output/message/message.F
615!|| arret ../engine/source/system/arret.F
616!||--- uses -----------------------------------------------------
617!|| message_mod ../engine/share/message_module/message_mod.F
618!|| table_mod ../engine/share/modules/table_mod.F
619!||====================================================================
620 SUBROUTINE TABLE_VINTERP(TABLE,DIMX,NEL,IPOS,XX,YY,DYDX1)
627#include "implicit_f.inc"
632 INTEGER ,INTENT(IN) :: NEL
633 INTEGER ,VALUE ,INTENT(IN) :: DIMX
634 INTEGER ,DIMENSION(DIMX,TABLE%NDIM) :: IPOS
635 my_real ,DIMENSION(DIMX,TABLE%NDIM) :: XX
636 my_real ,DIMENSION(NEL) :: YY, DYDX1
640 LOGICAL, DIMENSION(NEL) :: NEED_TO_COMPUTE
641 INTEGER NDIM, K, NXK(4), I, IB(NEL,2,2,2,2),
642 . IP,IN,IM,IL,P,N,M,L,N1,N12,N123
643 my_real :: DX2,R(NEL,4),UNR(NEL,4),DX2_0(NEL)
645 INTEGER :: NINDX_1,M_INDX1,NINDX_2,M_INDX2
646 INTEGER, DIMENSION(NEL) :: INDX_1,INDX_2
650 IF( SIZE(XX,2) < TABLE%NDIM )THEN
651 CALL ANCMSG(MSGID=36,ANMODE=ANINFO,
652 . C1='table interpolation
')
657 NXK(K)=SIZE(TABLE%X(K)%VALUES)
661 IPOS(1:NEL,K)=MAX(IPOS(1:NEL,K),1)
666#include "vectorize.inc"
669 DX2_0(I) = TABLE%X(K)%VALUES(M) - XX(I,K)
670 IF(DX2_0(I) >= ZERO)THEN
671 NINDX_1 = NINDX_1 + 1
673 M_INDX1 = MAX(M_INDX1,M)
675 NINDX_2 = NINDX_2 + 1
677 M_INDX2 = MIN(M_INDX2,M)
681 NEED_TO_COMPUTE(1:NINDX_1) = .TRUE.
683#include "vectorize.inc"
685 IF(NEED_TO_COMPUTE(J)) THEN
688 DX2 = TABLE%X(K)%VALUES(N) - XX(I,K)
689.OR.
IF(DX2<ZERON <=1)THEN
690 IPOS(I,K)=MAX(N,1) !N
691 NEED_TO_COMPUTE(J) = .FALSE.
696 NEED_TO_COMPUTE(1:NINDX_2) = .TRUE.
698#include "vectorize.inc"
700 IF(NEED_TO_COMPUTE(J)) THEN
703 DX2 = TABLE%X(K)%VALUES(N) - XX(I,K)
704.OR.
IF(DX2>=ZERON==NXK(K))THEN
706 NEED_TO_COMPUTE(J) = .FALSE.
714#include "vectorize.inc"
717 R(I,K) =(TABLE%X(K)%VALUES(N+1)-XX(I,K))/
718 . (TABLE%X(K)%VALUES(N+1)-TABLE%X(K)%VALUES(N))
731 IP=N123*(IPOS(I,4)-1+P)
733 IN=N12*(IPOS(I,3)-1+N)
735 IM=N1*(IPOS(I,2)-1+M)
738 IB(I,L+1,M+1,N+1,P+1)=IP+IN+IM+IL
745 UNR(1:NEL,1:4)=ONE-R(1:NEL,1:4)
746#include "vectorize.inc"
750 . R(I,4)*(R(I,3)*(R(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,1,1,1))
751 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,1,1,1)))
752 . +UNR(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,2,1,1))
753 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,2,1,1))))
754 . +UNR(I,3)*(R(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,1,2,1))
755 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,1,2,1)))
756 . +UNR(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,2,2,1))
757 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,2,2,1)))))
758 . +UNR(I,4)*(R(I,3)*(R(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,1,1,1))
759 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,1,1,1)))
760 . +UNR(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,2,1,1))
761 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,2,1,1))))
762 . +UNR(I,3)*(R(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,1,2,1))
763 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,1,2,1)))
764 . +UNR(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,2,2,1))
765 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,2,2,1)))))
768 . (R(I,4)*(R(I,3)*(R(I,2)*( TABLE%Y%VALUES(IB(I,2,1,1,1))
769 . -TABLE%Y%VALUES(IB(I,1,1,1,1)))
770 . +UNR(I,2)*( TABLE%Y%VALUES(IB(I,2,2,1,1))
771 . -TABLE%Y%VALUES(IB(I,1,2,1,1))))
772 . +UNR(I,3)*(R(I,2)*( TABLE%Y%VALUES(IB(I,2,1,2,1))
773 . -TABLE%Y%VALUES(IB(I,1,1,2,1)))
774 . +UNR(I,2)*( TABLE%Y%VALUES(IB(I,2,2,2,1))
775 . -TABLE%Y%VALUES(IB(I,1,2,2,1)))))
776 . +UNR(I,4)*(R(I,3)*(R(I,2)*( TABLE%Y%VALUES(IB(I,2,1,1,1))
777 . -TABLE%Y%VALUES(IB(I,1,1,1,1)))
778 . +UNR(I,2)*( TABLE%Y%VALUES(IB(I,2,2,1,1))
779 . -TABLE%Y%VALUES(IB(I,1,2,1,1))))
780 . +UNR(I,3)*(R(I,2)*( TABLE%Y%VALUES(IB(I,2,1,2,1))
781 . -TABLE%Y%VALUES(IB(I,1,1,2,1)))
782 . +UNR(I,2)*( TABLE%Y%VALUES(IB(I,2,2,2,1))
783 . -TABLE%Y%VALUES(IB(I,1,2,2,1))))))/
784 . (TABLE%X(1)%VALUES(IPOS(I,1)+1)-TABLE%X(1)%VALUES(IPOS(I,1)))
794 IN=N12*(IPOS(I,3)-1+N)
796 IM=N1*(IPOS(I,2)-1+M)
799 IB(I,L+1,M+1,N+1,1)=IN+IM+IL
805 UNR(1:NEL,1:3)=ONE-R(1:NEL,1:3)
806#include "vectorize.inc"
810 . (R(I,3)*(R(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,1,1,1))
811 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,1,1,1)))
812 . +UNR(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,2,1,1))
813 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,2,1,1))))
814 . +UNR(I,3)*(R(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,1,2,1))
815 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,1,2,1)))
816 . +UNR(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,2,2,1))
817 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,2,2,1)))))
820 . (R(I,3)*(R(I,2)*( TABLE%Y%VALUES(IB(I,2,1,1,1))
821 . -TABLE%Y%VALUES(IB(I,1,1,1,1)))
822 . +UNR(I,2)*( TABLE%Y%VALUES(IB(I,2,2,1,1))
823 . -TABLE%Y%VALUES(IB(I,1,2,1,1))))
824 . +UNR(I,3)*(R(I,2)*( TABLE%Y%VALUES(IB(I,2,1,2,1))
825 . -TABLE%Y%VALUES(IB(I,1,1,2,1)))
826 . +UNR(I,2)*( TABLE%Y%VALUES(IB(I,2,2,2,1))
827 . -TABLE%Y%VALUES(IB(I,1,2,2,1)))))/
828 . (TABLE%X(1)%VALUES(IPOS(I,1)+1)-TABLE%X(1)%VALUES(IPOS(I,1)))
837 IM=N1*(IPOS(I,2)-1+M)
840 IB(I,L+1,M+1,1,1)=IM+IL
845 UNR(1:NEL,1:2)=ONE-R(1:NEL,1:2)
846#include "vectorize.inc"
850 . (R(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,1,1,1))
851 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,1,1,1)))
852 . +UNR(I,2)*(R(I,1)*TABLE%Y%VALUES(IB(I,1,2,1,1))
853 . +UNR(I,1)*TABLE%Y%VALUES(IB(I,2,2,1,1))))
855 . (R(I,2)*( TABLE%Y%VALUES(IB(I,2,1,1,1))
856 . -TABLE%Y%VALUES(IB(I,1,1,1,1)))
857 . +UNR(I,2)*( TABLE%Y%VALUES(IB(I,2,2,1,1))
858 . -TABLE%Y%VALUES(IB(I,1,2,1,1))))/
859 . (TABLE%X(1)%VALUES(IPOS(I,1)+1)-TABLE%X(1)%VALUES(IPOS(I,1)))
864 UNR(1:NEL,1:1)=ONE-R(1:NEL,1:1)
865#include "vectorize.inc"
868 YY(I)= R(I,1)*TABLE%Y%VALUES(IPOS(I,1))
869 . +UNR(I,1)*TABLE%Y%VALUES(IPOS(I,1)+1)
870 DYDX1(I)=(TABLE%Y%VALUES(IPOS(I,1)+1)-TABLE%Y%VALUES(IPOS(I,1)))/
871 . (TABLE%X(1)%VALUES(IPOS(I,1)+1)-TABLE%X(1)%VALUES(IPOS(I,1)))
876 END SUBROUTINE TABLE_VINTERP
877!||====================================================================
878!|| table_interp_law76 ../engine/source/tools/curve/table_tools.F
879!||--- called by ------------------------------------------------------
880!|| sigeps52 ../engine/source/materials/mat/mat052/sigeps52.F
881!|| sigeps52c ../engine/source/materials/mat/mat052/sigeps52c.F
882!||--- calls -----------------------------------------------------
883!|| ancmsg ../engine/source/output/message/message.F
884!|| arret ../engine/source/system/arret.F
885!||--- uses -----------------------------------------------------
886!|| message_mod ../engine/share/message_module/message_mod.F
887!|| table_mod ../engine/share/modules/table_mod.F
888!||====================================================================
889 SUBROUTINE TABLE_INTERP_LAW76(TABLE,IPOS2,XX,R2,DYDX,YY)
896#include "implicit_f.inc"
909 TYPE(TTABLE_XY), POINTER :: TY
910 INTEGER NDIM, K, NXK, I, IPOS, IB(2,2,2,2),
911 . IP,IN,IM,IL,P,N,M,L,N1,N12,N123
917 IF( SIZE(XX) < NDIM )THEN
918 CALL ANCMSG(MSGID=36,ANMODE=ANINFO,
919 . C1='table interpolation
')
926 NXK=SIZE(TABLE%X(1)%VALUES)
928 DX = TABLE%X(1)%VALUES(I) - XX(1)
929.OR.
IF(DX >= ZEROI == NXK)THEN
931 R(1) =(TABLE%X(1)%VALUES(I)-XX(1))/
932 . (TABLE%X(1)%VALUES(I)-TABLE%X(1)%VALUES(I-1))
947 IB(L+1,M+1,1,1)=IM+IL
955 YY=( R(2)*( R(1)*TY%VALUES(IB(1,1,1,1))
956 . +UNR(1)*TY%VALUES(IB(2,1,1,1)))
957 . +UNR(2)*( R(1)*TY%VALUES(IB(1,2,1,1))
958 . +UNR(1)*TY%VALUES(IB(2,2,1,1))))
960 . (R(2)*( TY%VALUES(IB(2,1,1,1))
961 . -TY%VALUES(IB(1,1,1,1)))
962 . +UNR(2)*( TY%VALUES(IB(2,2,1,1))
963 . -TY%VALUES(IB(1,2,1,1))))
964 . /(TABLE%X(1)%VALUES(IPOS+1)-TABLE%X(1)%VALUES(IPOS))
973 YY=R(1)*TY%VALUES(IPOS)
974 . +UNR(1)*TY%VALUES(IPOS+1)
975 DYDX=(TY%VALUES(IPOS+1)-TY%VALUES(IPOS))
976 . /(TABLE%X(1)%VALUES(IPOS+1)-TABLE%X(1)%VALUES(IPOS))
981 END SUBROUTINE TABLE_INTERP_LAW76
subroutine radioss2(idata, midata, rdata, mrdata)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
subroutine write_db(a, n)
void write_i_c(int *w, int *len)
void read_i_c(int *w, int *len)