39
40
41
45 USE create_h3d_output_per_part_mod
46
47
48
49#include "implicit_f.inc"
50
51
52
53 TYPE (H3D_DATABASE) :: H3D_DATA
54 INTEGER ID_SOLID_SCALAR,ID_INPUT,STEXT1,SCOMMENT,
55 . LAYER,IUVAR,IR,IS,IT
56 INTEGER IPART(LIPART1,*)
57 CHARACTER(LEN=STEXT1) :: TEXT1
58 CHARACTER(LEN=NCHARLINE100) :: KEY3_GLOB
59 CHARACTER(LEN=SCOMMENT) :: COMMENT
60 TYPE(GROUP_) ,DIMENSION(NGRPART) ,INTENT(IN) :: IGRPART
61
62
63
64#include "com04_c.inc"
65#include "scr17_c.inc"
66
67
68
69
70
71
72 INTEGER I,N_H3D_PART
73
74 h3d_data%N_OUTP_H3D = h3d_data%N_OUTP_H3D + 1
75 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%OK = 1
76 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%KEYWORD = key3_glob
77 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%N_OUTP = h3d_data%N_OUTP_H3D + 3
78 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%ETYPE = 7
79 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%OUTP_TYPE = 1
80 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%LAYER = layer
81 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%IR = ir
82 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%IS = is
83 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%IT = it
84 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%IUVAR = iuvar
85 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%IS_INFO1 = 0
86 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%S_STRING1 = stext1
87 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%STRING1(1:stext1) = text1(1:stext1)
88 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%S_COMMENT = scomment
89 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%COMMENT(1:scomment) = comment(1:scomment)
90
91 n_h3d_part = h3d_data%INPUT_LIST(id_input)%NB_PART
92 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%N_H3D_PART_LIST = n_h3d_part
93
94 IF (n_h3d_part /= 0 )
95 . ALLOCATE(h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%PART_LIST(n_h3d_part))
96 ALLOCATE(h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%PART(npart))
97
98 IF (n_h3d_part /= 0 ) THEN
99 DO i=1,npart
100 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%PART(i) = 0
101 ENDDO
102 ELSE
103 DO i=1,npart
104 h3d_data%OUTPUT_LIST(h3d_data%N_OUTP_H3D)%PART(i) = 1
105 ENDDO
106 ENDIF
107
108 CALL create_h3d_output_per_part(n_h3d_part
109
110
111 RETURN
integer, parameter ncharline100