OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_skin_scalar.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "com08_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_skin_scalar (elbuf_tab, skin_scalar, ifunc, iparg, geo, ixs, ixs10, ixs16, ixs20, pm, ipm, igeo, x, v, w, iparts, h3d_part, is_written_skin, info1, keyword, h3d_data, iad_elem, fr_elem, weight, tag_skins6, npf, tf, bufmat, ibcl, iloadp, lloadp, fac, nsensor, sensor_tab, tagncont, loadp_hyd_inter, xframe, forc, nodal_ipart, imapskp, loads, table, iframe, mat_param, d, pblast)
subroutine h3d_pre_skin_scalar (skin_scalar, nodal_ipart, is_written_skin, h3d_part, info1, keyword, ib, iloadp, lloadp, fac, npc, tf, sensor_tab, tagncont, loadp_hyd_inter, forc, xframe, x, v, imapskp, nskin, nsensor, loads, table, iframe, dis, pblast)

Function/Subroutine Documentation

◆ h3d_pre_skin_scalar()

subroutine h3d_pre_skin_scalar ( skin_scalar,
integer, dimension(*) nodal_ipart,
integer, dimension(*) is_written_skin,
integer, dimension(*) h3d_part,
integer info1,
character(len=ncharline100) keyword,
integer, dimension(nibcld,*) ib,
integer, dimension(sizloadp,*) iloadp,
integer, dimension(slloadp) lloadp,
fac,
integer, dimension(*) npc,
tf,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(nloadp_hyd) loadp_hyd_inter,
forc,
xframe,
x,
v,
integer, dimension(numskinp0), intent(in) imapskp,
integer nskin,
integer, intent(in) nsensor,
type (loads_), intent(in) loads,
type (ttable), dimension(ntable), intent(in) table,
integer, dimension(liskn,numfram+1), intent(in) iframe,
dimension(3,numnod), intent(in) dis,
type(pblast_), intent(in) pblast )

Definition at line 529 of file h3d_skin_scalar.F.

535C-----------------------------------------------
536C M o d u l e s
537C-----------------------------------------------
538 USE h3d_mod
539 USE pinchtype_mod
540 USE pblast_mod
541 USE sensor_mod
542 USE h3d_inc_mod
543 USE loads_mod
544 USE table_mod
545 USE names_and_titles_mod, ONLY: ncharline100
546C-----------------------------------------------
547C I m p l i c i t T y p e s
548C-----------------------------------------------
549#include "implicit_f.inc"
550#include "param_c.inc"
551C-----------------------------------------------
552C C o m m o n B l o c k s
553C-----------------------------------------------
554#include "com04_c.inc"
555#include "com08_c.inc"
556#include "tabsiz_c.inc"
557C-----------------------------------------------
558C E x t e r n a l F u n c t i o n s
559C-----------------------------------------------
560 INTEGER GET_U_NUMSENS,GET_U_SENS_FPAR,GET_U_SENS_IPAR,
561 . GET_U_SENS_VALUE,SET_U_SENS_VALUE
562 EXTERNAL get_u_numsens,get_u_sens_fpar,get_u_sens_ipar,
563 . get_u_sens_value,set_u_sens_value
564C-----------------------------------------------,
565C D u m m y A r g u m e n t s
566C-----------------------------------------------
567 INTEGER ,INTENT(IN) :: NSENSOR
568 my_real
569 . skin_scalar(*),tf(*),x(3,*),v(3,*)
570 my_real, INTENT(IN) :: dis(3,numnod)
571 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
572
573 INTEGER , DIMENSION(NUMSKINP0), INTENT(IN) :: IMAPSKP
574 integer
575 . h3d_part(*),is_written_skin(*),info1,npc(*)
576 INTEGER LLOADP(SLLOADP),NSKIN
577 INTEGER ILOADP(SIZLOADP,*),IB(NIBCLD,*)
578 INTEGER TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
579 . LOADP_HYD_INTER(NLOADP_HYD),NODAL_IPART(*)
580 my_real
581 . fac(lfacload,nloadp),xframe(nxframe,*),forc(lfaccld,*)
582 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
583 TYPE (LOADS_) , INTENT(IN) :: LOADS
584 INTEGER , DIMENSION(LISKN,NUMFRAM+1) ,INTENT(IN) :: IFRAME
585 TYPE (TTABLE) ,DIMENSION(NTABLE) ,INTENT(IN) :: TABLE
586 TYPE(PBLAST_), INTENT(IN) :: PBLAST
587C-----------------------------------------------
588C L o c a l V a r i a b l e s
589C-----------------------------------------------
590 INTEGER NL, N1, N2, N3, N4, N5,
591 . IAD ,NP ,IFUNC ,NPRES,NSKIN0,NSKIN1,N1FRAM,DIR_HSP,I,N
592 INTEGER K1, K2, K3, ISENS, K,
593 . N_OLD, ISMOOTH,IDEL,NINTERP ,NPL,TAGN1,TAGN2,TAGN3,TAGN4,
594 . FUN_CX,FUN_VEL,DIR_VEL,IFRA2, IANIM,IJK,UP_BOUND,
595 . IZ_UPDATE,ABAC_ID,ISIZ_SEG,IERR1,
596 . Phi_I, ID, USER_ID, ITA_SHIFT,NDT,NDT0,
597 . NITER,ITER,IMODEL,IL,IS,SEGCONT,FUN_HSP,IFRA1,IFLOAD,NP0,NPI
598 my_real
599 . nx, ny, nz, axi, aa, a0, vv, fx, fy, fz, ax, dydx, ts,
600 . sixth,x_old, f1, f2,xsens,fcx,fcy,fcypinch,fp,
601 . fcx1,fcy1,fcx2,fcy2,vx,vy,vz,vel,vseg,norm
602 my_real finter, zfx,zfy,zfz, zzfx,zzfy,zzfz,ps, zx,zy,zz,finter_smooth
603c
604 my_real coormean,ymean,zmean,pvel,nsign,dnorm,
605 . xdet,ydet,zdet,tdet,wtnt,pmin,dx,dy,dz,normd, p,
606 . fac_m_bb, fac_l_bb, fac_t_bb, fac_p_bb, fac_i_bb, t0inf_loc, ta_shift, tt_star
607
608 INTEGER :: IFUN,IFRA,M1,M2,NDIM,NPOINT, IIOUT,SHIFT,FUNCTYPE
609 my_real :: len, dirx, diry, dirz,
610 . beta,gamma,r,s,rmax,xfacr,xfact,yfac,segp,press,disp
611 my_real, DIMENSION(3) :: p0,dir,a,b,c,d,m
612
613 EXTERNAL finter,finter_smooth
614C=======================================================================
615C---- fill SKIN_SCALAR(*) w/ IS_WRITTEN_SKIN(*)=1
616 IF (keyword /= 'PEXT') RETURN
617 is_written_skin(nskin+1:numskin) = 0
618 skin_scalar(nskin+1:numskin)=zero
619 np0= 0
620 nskin0 = nskin
621C-----Force (pressure) first
622 n_old = 0
623 x_old = zero
624 DO nl=1,nconld-nploadpinch
625 n1 = ib(1,nl)
626 n2 = ib(2,nl)
627 n3 = ib(3,nl)
628 n4 = ib(4,nl)
629 n5 = ib(5,nl)
630 idel = ib(8,nl)
631 functype= ib(9,nl)
632 fcy = forc(1,nl)
633 fcx = forc(2,nl)
634 IF (n1==0.OR.n2==0.OR.n3==0.OR.n4==-1) cycle
635C--------default zero
636 np0 = np0 + 1
637 nskin = nskin0+ imapskp(np0)
638 IF (nodal_ipart(n1)>0) THEN
639 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
640 END IF
641 isens = 0
642 xsens = one
643 DO k=1,nsensor
644 IF(ib(6,nl)==sensor_tab(k)%SENS_ID) isens=k
645 ENDDO
646 IF(isens==0)THEN
647 ts=tt
648 ELSE
649 ts = tt-sensor_tab(isens)%TSTART
650 ENDIF
651 IF(idel > 0 .OR. ts < zero) cycle ! SEGMENT DELETED,SENSOR
652 IF (functype == 1) THEN
653 IF(n_old/=n5.OR.x_old/=ts) THEN
654 ismooth = 0
655 IF (n5 > 0) ismooth = npc(2*nfunct+n5+1)
656 IF (ismooth == 0) THEN
657 f1 = finter(n5,ts*fcx,npc,tf,dydx)
658 ELSE
659 f1 = finter_smooth(n5,ts*fcx,npc,tf,dydx)
660 ENDIF ! IF (ISMOOTH == 0)
661 n_old = n5
662 x_old = ts
663 ENDIF
664 ELSE IF(functype == 2) THEN
665 IF(n_old/=n5) THEN
666 disp = (dis(3,n1)+dis(3,n2)+dis(3,n3)+dis(3,n4))/4.0
667 ismooth = 0
668 IF (n5 > 0) ismooth = npc(2*nfunct+n5+1)
669 IF (ismooth == 0) THEN
670 f1 = finter(n5,disp*fcx,npc,tf,dydx)
671 ELSE
672 f1 = finter_smooth(n5,disp*fcx,npc,tf,dydx)
673 ENDIF ! IF (ISMOOTH == 0)
674 n_old = n5
675 x_old = disp
676 ENDIF
677 ELSE IF(functype == 3) THEN
678 IF(n_old/=n5) THEN
679 vel = (v(3,n1)+v(3,n2)+v(3,n3)+v(3,n4))/4.0
680 ismooth = 0
681 IF (n5 > 0) ismooth = npc(2*nfunct+n5+1)
682 IF (ismooth == 0) THEN
683 f1 = finter(n5,vel*fcx,npc,tf,dydx)
684 ELSE
685 f1 = finter_smooth(n5,vel*fcx,npc,tf,dydx)
686 ENDIF ! IF (ISMOOTH == 0)
687 n_old = n5
688 x_old = vel
689 ENDIF
690 ENDIF
691 aa = fcy*f1*xsens
692 skin_scalar(nskin)=aa
693 END DO
694C----------load_pressure
695 shift = nloadp_f+pblast%NLOADP_B
696 DO np=1+shift,nloadp_hyd+shift
697 isiz_seg = iloadp(1,np)/4
698 ifunc = iloadp(3,np)
699 iad = iloadp(4,np)
700 ninterp = iloadp(5,np)
701 isens = iloadp(7,np)
702 ifload = iloadp(10,np)
703 fcy = fac(1,np)
704 fcx = fac(2,np)
705C--------default zero
706 DO n=1, isiz_seg
707 n1 = lloadp(iad+4*(n-1))
708 n2 = lloadp(iad+4*(n-1)+1)
709 n3 = lloadp(iad+4*(n-1)+2)
710 n4 = lloadp(iad+4*(n-1)+3)
711 IF (n1==0.OR.n2==0.OR.n3==0) cycle
712 nskin = nskin0+ imapskp(np0+n)
713 IF (nodal_ipart(n1)>0) THEN
714 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
715 END IF
716 ENDDO
717C
718 IF(isens==0)THEN
719 ts=tt
720 ELSE
721 ts = tt-sensor_tab(isens)%TSTART
722 ENDIF
723 DO n=1, isiz_seg
724 n1 = lloadp(iad+4*(n-1))
725 n2 = lloadp(iad+4*(n-1)+1)
726 n3 = lloadp(iad+4*(n-1)+2)
727 n4 = lloadp(iad+4*(n-1)+3)
728 IF (n1==0.OR.n2==0.OR.n3==0) cycle
729
730 np0 = np0 + 1
731 IF(ts<zero) cycle
732 nskin = nskin0+ imapskp(np0)
733 f1 = finter(ifunc,ts*fcx,npc,tf,dydx)
734 aa = fcy*f1
735C----------------
736C Check if segment is in contact
737C----------------
738 segcont = 0
739
740 tagn1 = 0
741 tagn2 = 0
742 tagn3 = 0
743 tagn4 = 0
744 fp = one
745 IF(ninterp > 0 ) THEN
746 npl = loadp_hyd_inter(np)
747 IF(n4/=0) THEN
748 segcont = tagncont(npl,n1) + tagncont(npl,n2) +
749 . tagncont(npl,n3)+tagncont(npl,n4)
750 IF(segcont >= 2 .AND.ifload==1) THEN
751 segcont = 1
752 ELSEIF(segcont <= 1.AND.ifload==2) THEN
753 segcont = 1
754 ELSE
755 segcont = 0
756 ENDIF
757 ELSE
758 segcont = tagncont(npl,n1) + tagncont(npl,n2) +
759 . tagncont(npl,n3)
760 IF(segcont >= 2 .AND.ifload==1) THEN
761 segcont = 1
762 ELSEIF(segcont <= 1.AND.ifload==2) THEN
763 segcont = 1
764 ELSE
765 segcont = 0
766 ENDIF
767 ENDIF
768c IF (FP==ZERO) FP = ONE
769 ENDIF
770 IF (segcont==1) aa = zero
771 skin_scalar(nskin)=skin_scalar(nskin)+aa*fp
772 END DO !N=1, NPRES/4
773 END DO !NP=1,NLOADP_HYD
774C---------pfluid
775 DO nl=1,nloadp_f
776C--------default zero
777 isiz_seg = iloadp(1,nl)/4
778 iad = iloadp(4,nl)
779 DO n=1, isiz_seg
780 n1 = lloadp(iad+4*(n-1))
781 n2 = lloadp(iad+4*(n-1)+1)
782 n3 = lloadp(iad+4*(n-1)+2)
783 n4 = lloadp(iad+4*(n-1)+3)
784 IF (n1==0.OR.n2==0.OR.n3==0) cycle
785 nskin = nskin0+ imapskp(np0+n)
786 IF (nodal_ipart(n1)>0) THEN
787 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
788 END IF
789 ENDDO
790 fun_hsp=iloadp(7,nl)
791 dir_hsp=iloadp(8,nl)
792 ifra1=iloadp(9,nl)
793 fcy = fac(1,nl)
794 fcx = fac(2,nl)
795 fun_cx=iloadp(10,nl)
796 fcy1 = fac(3,nl)
797 fcx1 = fac(4,nl)
798 fun_vel=iloadp(11,nl)
799 fcy2 = fac(5,nl)
800 fcx2 = fac(6,nl)
801 ! To avoid a check bound issue when the velocity options are not set in the input,
802 ! the DIR_VEL variable is bounded to a minimal value of 1
803 dir_vel=max(iloadp(12,nl),1)
804 ifra2=iloadp(13,nl)
805 isens=0
806 xsens = one
807 DO k=1,nsensor
808 IF(iloadp(6,nl)==sensor_tab(k)%SENS_ID) isens=k
809 ENDDO
810 IF(isens==0)THEN
811 ts=tt
812 ELSE
813 ts = tt-sensor_tab(isens)%TSTART
814 ENDIF
815 DO i = 1,isiz_seg
816 n1=lloadp(iloadp(4,nl)+4*(i-1))
817 n2=lloadp(iloadp(4,nl)+4*(i-1)+1)
818 n3=lloadp(iloadp(4,nl)+4*(i-1)+2)
819 n4=lloadp(iloadp(4,nl)+4*(i-1)+3)
820 IF (n1==0.OR.n2==0.OR.n3==0) cycle
821 np0 = np0 + 1
822 IF(ts < zero) cycle
823 nskin = nskin0+ imapskp(np0)
824C
825 aa = zero
826 vel = zero
827 pvel=zero
828C------ ----------
829C
830 IF(n4/=0 .AND. n1/=n2 .AND. n1/=n3 .AND. n1/=n4 .AND.
831 . n2/=n3 .AND. n2/=n4 .AND. n3/=n4 )THEN
832C
833 k1=3*dir_hsp-2
834 k2=3*dir_hsp-1
835 k3=3*dir_hsp
836 ! hydrostatic pressure
837 IF(fun_hsp /=0)THEN
838 coormean = (xframe(k1,ifra1)*(x(1,n1)+x(1,n2)+x(1,n3)+x(1,n4))/four)+
839 . (xframe(k2,ifra1)*(x(2,n1)+x(2,n2)+x(2,n3)+x(2,n4))/four)+
840 . (xframe(k3,ifra1)*(x(3,n1)+x(3,n2)+x(3,n3)+x(3,n4))/four)
841 aa = fcy*finter(fun_hsp,(coormean-xframe(9+dir_hsp,ifra1))*fcx,npc,tf,dydx)
842 ENDIF
843 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2)) - (x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
844 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2)) - (x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
845 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2)) - (x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
846 norm = sqrt(nx*nx+ny*ny+nz*nz)
847 aa = aa * half * norm
848C vel pressure
849 k1=3*dir_vel-2
850 k2=3*dir_vel-1
851 k3=3*dir_vel
852c
853 nsign = (nx * xframe(k1,ifra2) +
854 . ny * xframe(k2,ifra2) +
855 . nz * xframe(k3,ifra2))
856 IF(nsign/=zero) nsign = sign(one,nsign)
857C
858 vseg= (xframe(k1,ifra2)*
859 . (v(1,n1) + v(1,n2) + v(1,n3) + v(1,n4)) /four)+
860 . (xframe(k2,ifra2)*
861 . (v(2,n1) + v(2,n2) + v(2,n3) + v(2,n4)) /four)+
862 . (xframe(k3,ifra2)*
863 . (v(3,n1) + v(3,n2) + v(3,n3) + v(3,n4)) /four)
864
865 IF(fun_vel /=0)THEN
866 vel = fcy2*finter(fun_vel,tt*fcx2,npc,tf,dydx)- vseg
867 ELSE
868 vel = - vseg
869 ENDIF
870 IF(fun_cx /=0)
871 . pvel = ( (-(nx/norm)*vel*xframe(k1,ifra2)-
872 . (ny/norm)*vel*xframe(k2,ifra2)-
873 . (nz/norm)*vel*xframe(k3,ifra2))**2 )* fcy1*
874 . finter(fun_cx,tt*fcx1,npc,tf,dydx)/two
875C
876 ELSE
877 IF(n1 == n2)THEN
878 n2 = n3
879 n3 = n4
880 n4 = 0
881 ELSEIF(n1 == n3)THEN
882 n3 = n4
883 n4 = 0
884 ELSEIF(n1 == n4)THEN
885 n4 = 0
886 ELSEIF(n2 == n3)THEN
887 n3 = n4
888 n4 = 0
889 ELSEIF(n2 == n4)THEN
890 n2 = n3
891 n3 = n4
892 n4 = 0
893 ELSEIF(n3 == n4)THEN
894 n4 = 0
895 ENDIF
896 IF (n4==0) n4=n3
897C true triangles.
898 IF(fun_hsp /=0)THEN
899 k1=3*dir_hsp-2
900 k2=3*dir_hsp-1
901 k3=3*dir_hsp
902 ! hydrostatic pressure
903 coormean = (xframe(k1,ifra1)*(x(1,n1)+x(1,n2)+x(1,n3))/three)+
904 . (xframe(k2,ifra1)*(x(2,n1)+x(2,n2)+x(2,n3))/three)+
905 . (xframe(k3,ifra1)*(x(3,n1)+x(3,n2)+x(3,n3))/three)
906 aa = fcy*finter(fun_hsp,(coormean-xframe(9+dir_hsp,ifra1))*fcx,npc,tf,dydx)
907 ENDIF
908 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2)) - (x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
909 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2)) - (x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
910 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2)) - (x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
911 norm = sqrt(nx*nx+ny*ny+nz*nz)
912 aa = aa * half * norm
913C vel pressure
914 k1=3*dir_vel-2
915 k2=3*dir_vel-1
916 k3=3*dir_vel
917c
918 nsign = (nx * xframe(k1,ifra2) +
919 . ny * xframe(k2,ifra2) +
920 . nz * xframe(k3,ifra2))
921 IF(nsign/=zero) nsign = sign(one,nsign)
922C
923 vseg= (xframe(k1,ifra2)*
924 . (v(1,n1) + v(1,n2) + v(1,n3)) /three)+
925 . (xframe(k2,ifra2)*
926 . (v(2,n1) + v(2,n2) + v(2,n3)) /three)+
927 . (xframe(k3,ifra2)*
928 . (v(3,n1) + v(3,n2) + v(3,n3)) /three)
929
930 IF(fun_vel /=0)THEN
931 vel = fcy2*finter(fun_vel,tt*fcx2,npc,tf,dydx)- vseg
932 ELSE
933 vel = - vseg
934 ENDIF
935 IF(fun_cx /=0)
936 . pvel = ( (-(nx/norm)*vel*xframe(k1,ifra2)-
937 . (ny/norm)*vel*xframe(k2,ifra2)-
938 . (nz/norm)*vel*xframe(k3,ifra2))**2 )* fcy1*
939 . finter(fun_cx,tt*fcx1,npc,tf,dydx)/two
940 ENDIF
941 skin_scalar(nskin)=skin_scalar(nskin)-aa+pvel*nsign
942 END DO
943 END DO
944C---------pblast
945 DO nl=1+nloadp_f,nloadp_f+pblast%NLOADP_B
946C--------default zero
947 isiz_seg = iloadp(1,nl)/4
948 iad = iloadp(4,nl)
949 DO n=1, isiz_seg
950 n1 = lloadp(iad+4*(n-1))
951 n2 = lloadp(iad+4*(n-1)+1)
952 n3 = lloadp(iad+4*(n-1)+2)
953 n4 = lloadp(iad+4*(n-1)+3)
954 IF (n1==0.OR.n2==0.OR.n3==0) cycle
955 nskin = nskin0+ imapskp(np0+n)
956 IF (nodal_ipart(n1)>0) THEN
957 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
958 END IF
959 ENDDO
960 il = nl-nloadp_f
961 tdet = fac(01,nl)
962 id = iloadp(08,nl) !user_id
963 DO i = 1,isiz_seg
964 np0 = np0 + 1
965 IF (tt<tdet) cycle
966 nskin = nskin0+ imapskp(np0)
967 p = pblast%PBLAST_TAB(il)%PRES(i)
968 skin_scalar(nskin)= skin_scalar(nskin)-p
969 enddo!next I
970 END DO
971C---------/LOAD/PCYL
972 DO nl=1,loads%NLOAD_CYL
973C--------default zero
974 isiz_seg = loads%LOAD_CYL(nl)%NSEG
975 DO n=1, isiz_seg
976 n1 = loads%LOAD_CYL(nl)%SEGNOD(n,1)
977 n2 = loads%LOAD_CYL(nl)%SEGNOD(n,2)
978 n3 = loads%LOAD_CYL(nl)%SEGNOD(n,3)
979 n4 = loads%LOAD_CYL(nl)%SEGNOD(n,4)
980 IF (n1==0.OR.n2==0.OR.n3==0) cycle
981 nskin = nskin0+ imapskp(np0+n)
982 IF (nodal_ipart(n1)>0) THEN
983 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
984 END IF
985 ENDDO
986 isens = loads%LOAD_CYL(nl)%ISENS
987 iiout = 0
988 IF (isens > 0) THEN
989 IF (sensor_tab(isens)%STATUS == 0) THEN
990 np0 = np0 + isiz_seg
991 cycle
992 END IF
993 END IF
994 ifra = loads%LOAD_CYL(nl)%IFRAME + 1
995 xfacr= loads%LOAD_CYL(nl)%XSCALE_R
996 xfact= loads%LOAD_CYL(nl)%XSCALE_T
997 yfac = loads%LOAD_CYL(nl)%YSCALE
998 ifun = loads%LOAD_CYL(nl)%ITABLE
999 ndim = table(ifun)%NDIM
1000 npoint = SIZE(table(ifun)%X(1)%VALUES)
1001 rmax = table(ifun)%X(1)%VALUES(npoint)
1002 m1 = iframe(1,ifra)
1003 m2 = iframe(2,ifra)
1004 dirx = x(1,m1) - x(1,m2)
1005 diry = x(2,m1) - x(2,m2)
1006 dirz = x(3,m1) - x(3,m2)
1007 len = sqrt(dirx**2 + diry**2 + dirz**2)
1008 ! SEGP beam axis
1009 dir(1) = dirx / len
1010 dir(2) = diry / len
1011 dir(3) = dirz / len
1012 p0(1) = x(1,m2)
1013 p0(2) = x(2,m2)
1014 p0(3) = x(3,m2)
1015 !---------------------------------------------
1016 ! LOOP ON SEGMENTS (4N or 3N)
1017 !---------------------------------------------
1018 DO n = 1,isiz_seg
1019 n1 = loads%LOAD_CYL(nl)%SEGNOD(n,1)
1020 n2 = loads%LOAD_CYL(nl)%SEGNOD(n,2)
1021 n3 = loads%LOAD_CYL(nl)%SEGNOD(n,3)
1022 n4 = loads%LOAD_CYL(nl)%SEGNOD(n,4)
1023 press = zero
1024 a(1) = x(1,n1)
1025 a(2) = x(2,n1)
1026 a(3) = x(3,n1)
1027 b(1) = x(1,n2)
1028 b(2) = x(2,n2)
1029 b(3) = x(3,n2)
1030 c(1) = x(1,n3)
1031 c(2) = x(2,n3)
1032 c(3) = x(3,n3)
1033 np0 = np0 + 1
1034 IF (n4 == 0) THEN ! 3 node segment
1035 CALL press_seg3(a ,b ,c ,p0 ,dir ,
1036 . ifun ,table ,xfacr ,xfact ,segp )
1037 press = abs(segp) * yfac
1038c
1039 ELSE ! 4 node segment
1040 d(1) = x(1,n4)
1041 d(2) = x(2,n4)
1042 d(3) = x(3,n4)
1043 m(1) = (x(1,n1) + x(1,n2) + x(1,n3) + x(1,n4)) * fourth
1044 m(2) = (x(2,n1) + x(2,n2) + x(2,n3) + x(2,n4)) * fourth
1045 m(3) = (x(3,n1) + x(3,n2) + x(3,n3) + x(3,n4)) * fourth
1046c 1st internal triangle
1047 CALL press_seg3(a ,b ,m ,p0 ,dir ,
1048 . ifun ,table ,xfacr ,xfact ,segp )
1049 press = press + segp * fourth
1050c 2nd internal triangle
1051 CALL press_seg3(b ,c ,m ,p0 ,dir ,
1052 . ifun ,table ,xfacr ,xfact ,segp )
1053 press = press + segp * fourth
1054c 3rd internal triangle
1055 CALL press_seg3(c ,d ,m ,p0 ,dir ,
1056 . ifun ,table ,xfacr ,xfact ,segp )
1057 press = press + segp * fourth
1058c 4th internal triangle
1059 CALL press_seg3(d ,a ,m ,p0 ,dir ,
1060 . ifun ,table ,xfacr ,xfact ,segp )
1061 press = abs(press) * yfac
1062 END IF ! seg 4 node
1063 nskin = nskin0+ imapskp(np0)
1064 skin_scalar(nskin)= skin_scalar(nskin)+press
1065 enddo!next N
1066 END DO
1067C
1068 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
h3d_inc_mod
Definition h3d_inc_mod.F:42
h3d_mod
Definition h3d_mod.F:311
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1007
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::nploadpinch
integer nploadpinch
Definition pinchtype_mod.F:74
table_mod
Definition table_mod.F:113
ninterp
subroutine ninterp(ifunc, npc, pld, npoint, xv, yv)
Definition ninterp.F:32
press_seg3
subroutine press_seg3(a, b, c, n1, dir, ifunc, table, xfacr, xfact, press)
Definition press_seg3.F:37
nl
character *2 function nl()
Definition message.F:2360
set_u_sens_value
integer function set_u_sens_value(nsens, ivar, var)
Definition usensor.F:138
get_u_sens_ipar
integer function get_u_sens_ipar(nsens, ivar, var)
Definition usensor.F:346
get_u_sens_value
integer function get_u_sens_value(nsens, ivar, var)
Definition usensor.F:190
get_u_sens_fpar
integer function get_u_sens_fpar(nsens, ivar, var)
Definition usensor.F:289
get_u_numsens
integer function get_u_numsens(idsens)
Definition usensor.F:50

◆ h3d_skin_scalar()

subroutine h3d_skin_scalar ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
skin_scalar,
integer ifunc,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(nixs,*) ixs,
integer, dimension(*) ixs10,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
pm,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
x,
v,
w,
integer, dimension(*) iparts,
integer, dimension(*) h3d_part,
integer, dimension(*) is_written_skin,
integer info1,
character(len=ncharline100) keyword,
type (h3d_database) h3d_data,
integer, dimension(*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
integer, dimension(*) tag_skins6,
integer, dimension(*) npf,
tf,
bufmat,
integer, dimension(nibcld,*) ibcl,
integer, dimension(sizloadp,*) iloadp,
integer, dimension(*) lloadp,
fac,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(nloadp_hyd) loadp_hyd_inter,
xframe,
forc,
integer, dimension(*) nodal_ipart,
integer, dimension(numskinp0), intent(in) imapskp,
type (loads_), intent(in) loads,
type (ttable), dimension(ntable), intent(in) table,
integer, dimension(liskn,numfram+1), intent(in) iframe,
type (matparam_struct_), dimension(nummat), intent(in) mat_param,
dimension(3,numnod), intent(in) d,
type (pblast_), intent(in) pblast )

Definition at line 48 of file h3d_skin_scalar.F.

58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE initbuf_mod
62 USE mat_elem_mod
63 USE schlieren_mod
64 USE h3d_mod
65 USE multi_fvm_mod
66 USE sensor_mod
67 USE h3d_inc_mod
68 USE table_mod
69 USE loads_mod
70 USE names_and_titles_mod, ONLY: ncharline100
71 USE elbufdef_mod
72 USE pblast_mod
73 use element_mod , only : nixs
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "vect01_c.inc"
82#include "mvsiz_p.inc"
83#include "com01_c.inc"
84#include "com04_c.inc"
85#include "param_c.inc"
86C-----------------------------------------------
87C D u m m y A r g u m e n t s
88C-----------------------------------------------
89 INTEGER ,INTENT(IN) :: NSENSOR
90 my_real
91 . skin_scalar(*),x(3,*),v(3,*),w(3,*),geo(npropg,*),pm(npropm,*),
92 . tf(*),bufmat(*)
93 my_real, INTENT(IN) :: d(3,numnod)
94 INTEGER , DIMENSION(NUMSKINP0), INTENT(IN) :: IMAPSKP
95 INTEGER IPARG(NPARG,*),IXS(NIXS,*),IFUNC,IXS10(*),IXS16(*), IXS20(*),
96 . IPM(NPROPMI,*),IGEO(NPROPGI,*),IPARTS(*),
97 . H3D_PART(*),IS_WRITTEN_SKIN(*),INFO1,
98 . IAD_ELEM(*),FR_ELEM(*), WEIGHT(*),TAG_SKINS6(*),NPF(*)
99 INTEGER LLOADP(*)
100 INTEGER ILOADP(SIZLOADP,*),IBCL(NIBCLD,*),NODAL_IPART(*)
101 INTEGER TAGNCONT(NLOADP_HYD_INTER,NUMNOD),LOADP_HYD_INTER(NLOADP_HYD)
102 my_real
103 . fac(lfacload,nloadp),xframe(nxframe,*),forc(*)
104 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
105 CHARACTER(LEN=NCHARLINE100)::KEYWORD
106 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
107 TYPE (H3D_DATABASE) :: H3D_DATA
108 TYPE (LOADS_) , INTENT(IN) :: LOADS
109 INTEGER , DIMENSION(LISKN,NUMFRAM+1) ,INTENT(IN) :: IFRAME
110 TYPE (TTABLE) ,DIMENSION(NTABLE) ,INTENT(IN) :: TABLE
111 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
112 TYPE (PBLAST_),INTENT(IN) :: PBLAST
113C-----------------------------------------------
114C L o c a l V a r i a b l e s
115C-----------------------------------------------
116 my_real
117 . value(mvsiz),rindx,strain(3,mvsiz),f_exp,f_gauss(9)
118 INTEGER I, NG, NEL, NPTR, NPTS, NPTT, NLAY, IFAIL, ILAY,
119 . IR,IS,IT,IL,MLW, NUVAR,IUS,LENF,PTF,PTM,PTS,NFAIL,
120 . N,NN,K,K1,K2,JTURB,MT,IMID,IALEL,IPID,ISH3N,NNI,
121 . NN1,NN2,NN3,NN4,NN5,NN6,NN9,NF,BUF,NVARF,
122 . OFFSET,IHBE,NPTM,NPG, MPT,IPT,IADD,IADR,IPMAT,IFAILT,
123 . IIGEO,IADI,ISUBSTACK,ITHK,NB_PLYOFF,IUVAR,IDX,IPOS,ITRIMAT,
124 . IALEFVM_FLG, IMAT,IADBUF,NUPARAM,IOK_PART(MVSIZ),
125 . MLWI,PID,MID,MX,KCVT,IOR_TSH,ICSTR
126 INTEGER
127 . IS_WRITTEN_VALUE(MVSIZ),NFRAC,IU(4),IV,NB_FACE,KFACE,NSKIN
128 INTEGER NGL(MVSIZ)
129
130
131
132
133 TYPE(BUF_FAIL_) ,POINTER :: FBUF
134 DATA f_gauss /
135 9 1.000000000000000,1.732050807568877,1.290994448735806,
136 9 1.161256338324528,1.103533701926633,1.072421119155361,
137 9 1.053620970803647,1.041352247171806,1.032886870574820/
138C-----------------------------------------------
139 nskin = 0
140 is_written_skin(1:numskin) = 0
141 IF (numskin> numskinp) THEN
142 DO ng=1,ngroup
143C
144 CALL initbuf( iparg ,ng ,
145 2 mlw ,nel ,nft ,iad ,ity ,
146 3 npt ,jale ,ismstr ,jeul ,jtur ,
147 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
148 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
149 6 irep ,iint ,igtyp ,israt ,isrot ,
150 7 icsen ,isorth ,isorthg ,ifailure,jsms )
151C
152 IF (mlw == 13 .OR. mlw == 0) cycle
153C-----------------------------------------------
154C THICK-SHELL
155C-----------------------------------------------
156! 8--------------7
157! / | /|
158! 5--------------|6
159! | | | |
160! | 4-----------|-3
161! | / |/
162! 1--------------2
163 IF (ity == 1.AND.(igtyp==20 .OR. igtyp==21 .OR. igtyp==22)) THEN
164 nft = iparg(3,ng)
165 icstr = iparg(17,ng)
166 llt=nel
167 nlay = elbuf_tab(ng)%NLAY
168 nptr = elbuf_tab(ng)%NPTR
169 npts = elbuf_tab(ng)%NPTS
170 nptt = elbuf_tab(ng)%NPTT
171 ior_tsh = 0
172 IF (igtyp == 21) THEN
173 ior_tsh = 1
174 ELSEIF (igtyp == 22) THEN
175 ior_tsh = 2
176 END IF
177 IF (kcvt==1.AND.ior_tsh/=0) kcvt=2
178c
179 DO i=1,nel
180 VALUE(i) = zero
181 is_written_value(i) = 0
182 iok_part(i) = 0
183 IF( h3d_part(iparts(nft+i)) == 1) iok_part(i) = 1
184 ENDDO
185 mlwi = mlw
186 IF (igtyp == 22 .AND. nlay>9) THEN
187 f_exp = one
188 ELSE
189 f_exp = f_gauss(nlay)
190 END IF
191 IF (jhbe==14.OR.jhbe==16) f_exp = f_exp/(nptr*npts)
192C-----------------------------------------------
193 IF (keyword == 'FLDZ/OUTER') THEN
194 is_written_value(1:nel) = 1
195 mx = ixs(1,1 + nft)
196 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
197 it = 1
198C-----------------------------------------------
199 ilay=1
200C-------- grp skin_inf first
201 IF (igtyp == 22) THEN
202 pid = ixs(nixs-1,1 + nft)
203 mid = igeo(100+ilay,pid)
204 mlwi=nint(pm(19,mid))
205 END IF
206 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
207 . jhbe,mlwi,ilay,kcvt,ior_tsh,
208 . icstr,nptr,npts,nel,f_exp,strain )
209C---------- F.I. uses also average strain to be consisting
210 ir = 1
211 is = 1
212 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
213 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
214 DO ifail=1,nfail
215 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
216 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
217 . ir,is,it,ilay,ifail,
218 . npf,tf,ngl,strain,nel )
219 DO i=1,nel
220 rindx = fbuf%FLOC(ifail)%INDX(i)
221 value(i) = max(value(i),rindx)
222 is_written_value(i) = 1
223 ENDDO
224 ENDIF
225 END DO
226C------
227 DO i=1,nel
228 skin_scalar(nskin+i) = value(i)
229 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
230 END DO
231 nskin = nskin + nel
232C-------- grp skin_up
233 ilay=nlay
234 value(1:nel) = zero
235 IF (igtyp == 22) THEN
236 pid = ixs(nixs-1,1 + nft)
237 mid = igeo(100+ilay,pid)
238 mlwi=nint(pm(19,mid))
239 END IF
240 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
241 . jhbe,mlwi,ilay,kcvt,ior_tsh,
242 . icstr,nptr,npts,nel,f_exp,strain )
243 ir = 1
244 is = 1
245 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
246 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
247 DO ifail=1,nfail
248 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
249 DO i=1,nel
250 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
251 . ir,is,it,ilay,ifail,
252 . npf,tf,ngl,strain,nel )
253 rindx = fbuf%FLOC(ifail)%INDX(i)
254 value(i) = max(value(i),rindx)
255 is_written_value(i) = 1
256 ENDDO
257 ENDIF
258 END DO
259 DO i=1,nel
260 skin_scalar(nskin+i) = value(i)
261 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
262 END DO
263 nskin = nskin + nel
264C-----------------------------------------------
265 ELSEIF (keyword == 'FLDZ/OUTER_AVERAGE') THEN
266 is_written_value(1:nel) = 1
267 mx = ixs(1,1 + nft)
268 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
269 it = 1
270C-----------------------------------------------
271 ilay=(1+nlay)/2
272C-------- grp skin_inf first
273 IF (igtyp == 22) THEN
274 pid = ixs(nixs-1,1 + nft)
275 mid = igeo(100+ilay,pid)
276 mlwi=nint(pm(19,mid))
277 END IF
278 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
279 . jhbe,mlwi,ilay,kcvt,ior_tsh,
280 . icstr,nptr,npts,nel,f_exp,strain )
281C------
282 ir = 1
283 is = 1
284 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
285 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
286 DO ifail=1,nfail
287 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
288 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
289 . ir,is,it,ilay,ifail,
290 . npf,tf,ngl,strain,nel )
291 DO i=1,nel
292 rindx = fbuf%FLOC(ifail)%INDX(i)
293 value(i) = max(value(i),rindx)
294 is_written_value(i) = 1
295 ENDDO
296 ENDIF
297 END DO
298C------
299 DO i=1,nel
300 skin_scalar(nskin+i) = value(i)
301 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
302 END DO
303 nskin = nskin + nel
304C-------- grp skin_up
305 ilay=(1+nlay)/2
306 value(1:nel) = zero
307 IF (igtyp == 22) THEN
308 pid = ixs(nixs-1,1 + nft)
309 mid = igeo(100+ilay,pid)
310 mlwi=nint(pm(19,mid))
311 END IF
312 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
313 . jhbe,mlwi,ilay,kcvt,ior_tsh,
314 . icstr,nptr,npts,nel,f_exp,strain )
315 ir = 1
316 is = 1
317 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
318 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
319 DO ifail=1,nfail
320 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
321 DO i=1,nel
322 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
323 . ir,is,it,ilay,ifail,
324 . npf,tf,ngl,strain,nel )
325 rindx = fbuf%FLOC(ifail)%INDX(i)
326 value(i) = max(value(i),rindx)
327 is_written_value(i) = 1
328 ENDDO
329 ENDIF
330 END DO
331 DO i=1,nel
332 skin_scalar(nskin+i) = value(i)
333 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
334 END DO
335 nskin = nskin + nel
336C-----------------------------------------------
337 ELSEIF (keyword == 'FLDF/OUTER') THEN
338 is_written_value(1:nel) = 1
339 mx = ixs(1,1 + nft)
340 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
341C-----------------------------------------------
342 ilay=1
343 it = 1
344 IF (igtyp == 22) THEN
345 pid = ixs(nixs-1,1 + nft)
346 mid = igeo(100+ilay,pid)
347 mlwi=nint(pm(19,mid))
348 END IF
349 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
350 . jhbe,mlwi,ilay,kcvt,ior_tsh,
351 . icstr,nptr,npts,nel,f_exp,strain )
352C-------- grp skin_inf first
353 ir = 1
354 is = 1
355 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
356 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
357 DO ifail=1,nfail
358 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
359 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
360 . ir,is,it,ilay,ifail,
361 . npf,tf,ngl,strain,nel )
362 DO i=1,nel
363 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
364 is_written_value(i) = 1
365 ENDDO
366 ENDIF
367 END DO
368C------
369 DO i=1,nel
370 n = i + nft
371 skin_scalar(nskin+i) = value(i)
372 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
373 END DO
374 nskin = nskin + nel
375C-------- grp skin_up
376 ilay=nlay
377 it = 1
378 value(1:nel) = zero
379 IF (igtyp == 22) THEN
380 pid = ixs(nixs-1,1 + nft)
381 mid = igeo(100+ilay,pid)
382 mlwi=nint(pm(19,mid))
383 END IF
384 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
385 . jhbe,mlwi,ilay,kcvt,ior_tsh,
386 . icstr,nptr,npts,nel,f_exp,strain )
387 ir = 1
388 is = 1
389 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
390 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
391 DO ifail=1,nfail
392 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
393 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
394 . ir,is,it,ilay,ifail,
395 . npf,tf,ngl,strain,nel )
396 DO i=1,nel
397 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
398 is_written_value(i) = 1
399 ENDDO
400 ENDIF
401 END DO
402 DO i=1,nel
403 n = i + nft
404 skin_scalar(nskin+i) = value(i)
405 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
406 END DO
407 nskin = nskin + nel
408C------------to get right NSKIN for next case
409 ELSEIF (keyword == 'FLDF/OUTER_AVERAGE') THEN
410 is_written_value(1:nel) = 1
411 mx = ixs(1,1 + nft)
412 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
413C-----------------------------------------------
414 ilay=(1+nlay)/2
415 it = 1
416 IF (igtyp == 22) THEN
417 pid = ixs(nixs-1,1 + nft)
418 mid = igeo(100+ilay,pid)
419 mlwi=nint(pm(19,mid))
420 END IF
421 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
422 . jhbe,mlwi,ilay,kcvt,ior_tsh,
423 . icstr,nptr,npts,nel,f_exp,strain )
424C-------- grp skin_inf first
425 ir = 1
426 is = 1
427 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
428 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
429 DO ifail=1,nfail
430 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
431 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
432 . ir,is,it,ilay,ifail,
433 . npf,tf,ngl,strain,nel )
434 DO i=1,nel
435 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
436 is_written_value(i) = 1
437 ENDDO
438 ENDIF
439 END DO
440C------
441 DO i=1,nel
442 n = i + nft
443 skin_scalar(nskin+i) = value(i)
444 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
445 END DO
446 nskin = nskin + nel
447C-------- grp skin_up
448 ilay=(1+nlay)/2
449 it = 1
450 value(1:nel) = zero
451 IF (igtyp == 22) THEN
452 pid = ixs(nixs-1,1 + nft)
453 mid = igeo(100+ilay,pid)
454 mlwi=nint(pm(19,mid))
455 END IF
456 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
457 . jhbe,mlwi,ilay,kcvt,ior_tsh,
458 . icstr,nptr,npts,nel,f_exp,strain )
459 ir = 1
460 is = 1
461 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
462 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
463 DO ifail=1,nfail
464 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
465 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
466 . ir,is,it,ilay,ifail,
467 . npf,tf,ngl,strain,nel )
468 DO i=1,nel
469 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
470 is_written_value(i) = 1
471 ENDDO
472 ENDIF
473 END DO
474 DO i=1,nel
475 n = i + nft
476 skin_scalar(nskin+i) = value(i)
477 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
478 END DO
479 nskin = nskin + nel
480C------------to get right NSKIN for next case
481 ELSE
482 nskin = nskin + 2*nel
483 END IF !(KEYWORD
484 END IF !(ITY == 1.AND.(IGTYP==20 .OR. IGTYP==21 .OR. IGTYP==22)) THEN
485 END DO !NG=1,NGROUP
486 END IF !(NUMSKIN> NUMSKINP) THEN
487C------for solid elements
488 IF (numskin> (nskin+numskinp))
489 . CALL h3d_sol_skin_scalar(
490 . elbuf_tab,skin_scalar, iparg ,ixs ,x ,pm ,
491 4 iparts ,igeo ,ixs10 ,ixs16 , ixs20 ,
492 5 is_written_skin ,h3d_part,info1 ,keyword ,nskin ,
493 6 iad_elem ,fr_elem , weight ,tag_skins6,
494 7 npf ,tf ,mat_param)
495C------for solid elements
496 IF (numskinp> 0)
497 . CALL h3d_pre_skin_scalar(skin_scalar,nodal_ipart,
498 . is_written_skin ,h3d_part,info1 ,keyword ,
499 . ibcl,iloadp,lloadp,fac ,npf,tf ,sensor_tab,
500 . tagncont,loadp_hyd_inter,forc,xframe ,x ,v ,
501 . imapskp,nskin ,nsensor,loads ,table, iframe,d,
502 . pblast)
503C-----------------------------------------------
504 RETURN
h3d_fld_strain
subroutine h3d_fld_strain(elbuf_tab, x, ixs, jhbe, mlwi, ilay, kcvt, ior_tsh, icstr, nptr, npts, nel, f_exp, evar)
Definition h3d_fld_strain.F:38
h3d_fld_tsh
subroutine h3d_fld_tsh(elbuf_tab, fail, ir, is, it, ilay, ifail, npf, tf, ngl, evar, nel)
Definition h3d_fld_tsh.F:36
h3d_pre_skin_scalar
subroutine h3d_pre_skin_scalar(skin_scalar, nodal_ipart, is_written_skin, h3d_part, info1, keyword, ib, iloadp, lloadp, fac, npc, tf, sensor_tab, tagncont, loadp_hyd_inter, forc, xframe, x, v, imapskp, nskin, nsensor, loads, table, iframe, dis, pblast)
Definition h3d_skin_scalar.F:535
h3d_sol_skin_scalar
subroutine h3d_sol_skin_scalar(elbuf_tab, skin_scalar, iparg, ixs, x, pm, iparts, igeo, ixs10, ixs16, ixs20, is_written_skin, h3d_part, info1, keyword, nskin, iad_elem, fr_elem, weight, tag_skins6, npf, tf, mat_param)
Definition h3d_sol_skin_scalar.F:45
h3d_inc_mod::numskinp
integer numskinp
Definition h3d_inc_mod.F:44
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
schlieren_mod
Definition schlieren_mod.F:46