OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
write_viscparam.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine write_viscparam (visc)

Function/Subroutine Documentation

◆ write_viscparam()

subroutine write_viscparam ( type(visc_param_), intent(in) visc)

Definition at line 36 of file write_viscparam.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE visc_param_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 TYPE(VISC_PARAM_) ,INTENT(IN) :: VISC
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER :: I,IAD,NFIX,NUPARAM,NIPARAM,NUMTABL
54 INTEGER ,DIMENSION(NCHARTITLE) :: NAME
55 INTEGER ,DIMENSION(:) ,ALLOCATABLE :: IBUF
56C=======================================================================
57 nfix = 6
58 ALLOCATE (ibuf(nfix + 1))
59c
60 iad = 1
61 ibuf(iad) = nfix
62c
63 iad = iad+1
64 ibuf(iad) = visc%ILAW
65 iad = iad+1
66 ibuf(iad) = visc%NUPARAM
67 iad = iad+1
68 ibuf(iad) = visc%NIPARAM
69 iad = iad+1
70 ibuf(iad) = visc%NUVAR
71 iad = iad+1
72 ibuf(iad) = visc%NFUNC
73 iad = iad+1
74 ibuf(iad) = visc%NTABLE
75 iad = iad+1
76c
77 CALL write_i_c(ibuf,nfix+1)
78 DEALLOCATE(ibuf)
79
80c write viscosity model title
81
82 DO i=1,nchartitle
83 name(i) = ichar(visc%TITLE(i:i))
84 END DO
85 CALL write_c_c(name,nchartitle)
86c
87c write viscosity parameter array
88
89 nuparam = visc%NUPARAM
90 niparam = visc%NIPARAM
91 IF (nuparam > 0) THEN
92 CALL write_db(visc%UPARAM ,nuparam)
93 END IF
94 IF (niparam > 0) THEN
95 CALL write_i_c(visc%IPARAM ,niparam)
96 END IF
97c
98c write viscosity law tables
99c
100 numtabl = visc%NTABLE
101 IF (numtabl > 0) THEN
102 CALL write_mat_table(visc%TABLE, numtabl)
103 END IF
104c-----------
105 RETURN
integer, parameter nchartitle
subroutine write_mat_table(table, numtabl)
subroutine write_db(a, n)
Definition write_db.F:140
void write_i_c(int *w, int *len)
void write_c_c(int *w, int *len)