File: /nfs/home/0/users/jenkins/mfix.git/model/write_res0.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Subroutine: WRITE_RES0                                              C
4     !  Purpose: write out the initial restart records (namelist data)      C
5     !                                                                      C
6     !  Author: P. Nicoletti                               Date: 13-DEC-91  C
7     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date: 24-JAN-92  C
8     !                                                                      C
9     !  Revision Number:                                                    C
10     !  Purpose:                                                            C
11     !  Author:                                            Date: dd-mmm-yy  C
12     !  Reviewer:                                          Date: dd-mmm-yy  C
13     !                                                                      C
14     ! TODO:                                                                C
15     !    this file may need work for GHD which has internally incremented  C
16     !    user mmax to mmax+1 to represent a mixture solids phase and the   C
17     !    number of real soldis phases is now smax... consequently several  C
18     !    physical properties will not be set at 'mmax' the mixture phase   C
19     !                                                                      C
20     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
21     
22           SUBROUTINE WRITE_RES0
23     
24     !-----------------------------------------------
25     ! Modules
26     !-----------------------------------------------
27           USE param
28           USE param1
29           USE geometry
30           USE physprop
31           USE run
32           USE ic
33           USE is
34           USE bc
35           USE constant
36           USE funits
37           USE output
38           USE scales
39           USE scalars
40           USE rxns
41           USE ur_facs
42           USE leqsol
43           USE toleranc
44           USE cdist
45           USE compar
46           USE mpi_utility      ! for gather
47           USE sendrecv         ! for filling the boundary information
48           USE stiff_chem
49           USE in_binary_512i
50     
51           IMPLICIT NONE
52     !-----------------------------------------------
53     ! Local variables
54     !-----------------------------------------------
55           integer, allocatable :: arr1(:)
56           integer, allocatable :: arr2(:)
57           integer :: work_around(100)
58     ! loop counters
59           INTEGER :: LC, L, N, M, IDX
60     ! Pointer to the next record
61           INTEGER :: NEXT_RECA
62     ! file version id
63     
64     ! Place holder for deprecated variables:
65           LOGICAL, PARAMETER :: lCALL_ISAT = .FALSE.
66     
67           CHARACTER(LEN=512) :: VERSION
68     !-----------------------------------------------
69     
70           NEXT_RECA = 5
71     
72     ! note: the value below for version must be the same as the value
73     !       of version in mfix.f
74     !       If you change it in this subroutine, you must change it in
75     !       mfix.f also.
76     
77     !       The value should also be consistent with the check in
78     !       read_res0
79     
80           VERSION = 'RES = 01.8'
81     
82     ! Add new data entries at the end of the file and identify version no.
83     
84           if (myPE.eq.PE_IO) then
85              allocate (arr1(ijkmax3))
86              allocate (arr2(ijkmax2))
87           else
88              allocate (arr1(1))
89              allocate (arr2(1))
90              goto 1100
91           end if
92     
93     !------------------------------------------------------------------------
94           WRITE (UNIT_RES, REC=1) VERSION
95           WRITE (UNIT_RES, REC=2) RUN_NAME, ID_MONTH, ID_DAY, ID_YEAR, ID_HOUR, &
96              ID_MINUTE, ID_SECOND
97           WRITE (UNIT_RES, REC=3) NEXT_RECA
98           WRITE (UNIT_RES, REC=4) IMIN1, JMIN1, KMIN1, IMAX, JMAX, KMAX, IMAX1, &
99              JMAX1, KMAX1, IMAX2, JMAX2, KMAX2, IJMAX2, IJKMAX2, MMAX, DIMENSION_IC&
100              , DIMENSION_BC, DIMENSION_C, DIMENSION_IS, DT, XMIN, XLENGTH, YLENGTH&
101              , ZLENGTH, C_E, C_F, PHI, PHI_W
102           CALL OUT_BIN_512 (UNIT_RES, C, DIMENSION_C, NEXT_RECA)
103           NEXT_RECA = 1 + NEXT_RECA                  ! work around for -O3 compiler bug
104           NEXT_RECA = NEXT_RECA - 1
105           DO LC = 1, DIMENSION_C
106              WRITE (UNIT_RES, REC=NEXT_RECA) C_NAME(LC)
107              NEXT_RECA = NEXT_RECA + 1
108           END DO
109           write (*,*) 'next_reca = ' , next_reca
110           do l = 0,mmax
111              write (*,*) L,nmax(l)
112              work_around(L+1) = nmax(L)
113           end do
114     
115     !      next_reca = next_reca + 1
116     !      CALL OUT_BIN_512I (UNIT_RES, work_around, MMAX+1, NEXT_RECA)
117     !      WRITE (UNIT_RES, REC=NEXT_RECA) (work_around(L),L=1,MMAX+1)
118     
119           WRITE (UNIT_RES, REC=NEXT_RECA) (NMAX(L),L=0,MMAX)
120     
121     !      do l =0,mmax
122     !         write (unit_res,rec=next_reca) nmax(l)
123     !         next_reca = next_reca + 1
124     !      end do
125     !      write (unit_res,rec=next_reca) nmax(0) , nmax(1)
126     
127           NEXT_RECA = NEXT_RECA + 1
128           write (*,*) ' next_reca = ' , next_reca
129     
130           CALL OUT_BIN_512 (UNIT_RES, DX(1), IMAX2, NEXT_RECA)
131           CALL OUT_BIN_512 (UNIT_RES, DY(1), JMAX2, NEXT_RECA)
132           CALL OUT_BIN_512 (UNIT_RES, DZ(1), KMAX2, NEXT_RECA)
133           WRITE (UNIT_RES, REC=NEXT_RECA) RUN_NAME, DESCRIPTION, UNITS, RUN_TYPE, &
134              COORDINATES
135           NEXT_RECA = NEXT_RECA + 1
136           WRITE (UNIT_RES, REC=NEXT_RECA) (D_P0(L),L=1,MMAX), (RO_S0(L),L=1,MMAX), &
137              EP_STAR, RO_G0, MU_G0, MW_AVG
138           NEXT_RECA = NEXT_RECA + 1
139           CALL OUT_BIN_512 (UNIT_RES, MW_G, NMAX(0), NEXT_RECA)
140           DO LC = 1, MMAX
141              WRITE (UNIT_RES, REC=NEXT_RECA) (MW_S(LC,N),N=1,NMAX(LC))
142              NEXT_RECA = NEXT_RECA + 1
143           END DO
144           CALL OUT_BIN_512 (UNIT_RES, IC_X_W, DIMENSION_IC, NEXT_RECA)
145           CALL OUT_BIN_512 (UNIT_RES, IC_X_E, DIMENSION_IC, NEXT_RECA)
146           CALL OUT_BIN_512 (UNIT_RES, IC_Y_S, DIMENSION_IC, NEXT_RECA)
147           CALL OUT_BIN_512 (UNIT_RES, IC_Y_N, DIMENSION_IC, NEXT_RECA)
148           CALL OUT_BIN_512 (UNIT_RES, IC_Z_B, DIMENSION_IC, NEXT_RECA)
149           CALL OUT_BIN_512 (UNIT_RES, IC_Z_T, DIMENSION_IC, NEXT_RECA)
150           CALL OUT_BIN_512I (UNIT_RES, IC_I_W, DIMENSION_IC, NEXT_RECA)
151           CALL OUT_BIN_512I (UNIT_RES, IC_I_E, DIMENSION_IC, NEXT_RECA)
152           CALL OUT_BIN_512I (UNIT_RES, IC_J_S, DIMENSION_IC, NEXT_RECA)
153           CALL OUT_BIN_512I (UNIT_RES, IC_J_N, DIMENSION_IC, NEXT_RECA)
154           CALL OUT_BIN_512I (UNIT_RES, IC_K_B, DIMENSION_IC, NEXT_RECA)
155           CALL OUT_BIN_512I (UNIT_RES, IC_K_T, DIMENSION_IC, NEXT_RECA)
156           CALL OUT_BIN_512 (UNIT_RES, IC_EP_G, DIMENSION_IC, NEXT_RECA)
157           CALL OUT_BIN_512 (UNIT_RES, IC_P_G, DIMENSION_IC, NEXT_RECA)
158           CALL OUT_BIN_512 (UNIT_RES, IC_T_G, DIMENSION_IC, NEXT_RECA)
159           DO N = 1, NMAX(0)
160              CALL OUT_BIN_512 (UNIT_RES, IC_X_G(1,N), DIMENSION_IC, NEXT_RECA)
161           END DO
162           CALL OUT_BIN_512 (UNIT_RES, IC_U_G, DIMENSION_IC, NEXT_RECA)
163           CALL OUT_BIN_512 (UNIT_RES, IC_V_G, DIMENSION_IC, NEXT_RECA)
164           CALL OUT_BIN_512 (UNIT_RES, IC_W_G, DIMENSION_IC, NEXT_RECA)
165     
166           DO LC = 1, MMAX
167              CALL OUT_BIN_512 (UNIT_RES, IC_ROP_S(1,LC), DIMENSION_IC, NEXT_RECA)
168              CALL OUT_BIN_512 (UNIT_RES, IC_U_S(1,LC), DIMENSION_IC, NEXT_RECA)
169              CALL OUT_BIN_512 (UNIT_RES, IC_V_S(1,LC), DIMENSION_IC, NEXT_RECA)
170              CALL OUT_BIN_512 (UNIT_RES, IC_W_S(1,LC), DIMENSION_IC, NEXT_RECA)
171              CALL OUT_BIN_512 (UNIT_RES, IC_T_S(1,LC), DIMENSION_IC, NEXT_RECA)
172              DO N = 1, NMAX(LC)
173                 CALL OUT_BIN_512(UNIT_RES,IC_X_S(1,LC,N),DIMENSION_IC,NEXT_RECA)
174              END DO
175           END DO
176           CALL OUT_BIN_512 (UNIT_RES, BC_X_W, DIMENSION_BC, NEXT_RECA)
177           CALL OUT_BIN_512 (UNIT_RES, BC_X_E, DIMENSION_BC, NEXT_RECA)
178           CALL OUT_BIN_512 (UNIT_RES, BC_Y_S, DIMENSION_BC, NEXT_RECA)
179           CALL OUT_BIN_512 (UNIT_RES, BC_Y_N, DIMENSION_BC, NEXT_RECA)
180           CALL OUT_BIN_512 (UNIT_RES, BC_Z_B, DIMENSION_BC, NEXT_RECA)
181           CALL OUT_BIN_512 (UNIT_RES, BC_Z_T, DIMENSION_BC, NEXT_RECA)
182     
183           CALL OUT_BIN_512I (UNIT_RES, BC_I_W, DIMENSION_BC, NEXT_RECA)
184           CALL OUT_BIN_512I (UNIT_RES, BC_I_E, DIMENSION_BC, NEXT_RECA)
185           CALL OUT_BIN_512I (UNIT_RES, BC_J_S, DIMENSION_BC, NEXT_RECA)
186           CALL OUT_BIN_512I (UNIT_RES, BC_J_N, DIMENSION_BC, NEXT_RECA)
187           CALL OUT_BIN_512I (UNIT_RES, BC_K_B, DIMENSION_BC, NEXT_RECA)
188           CALL OUT_BIN_512I (UNIT_RES, BC_K_T, DIMENSION_BC, NEXT_RECA)
189           CALL OUT_BIN_512 (UNIT_RES, BC_EP_G, DIMENSION_BC, NEXT_RECA)
190           CALL OUT_BIN_512 (UNIT_RES, BC_P_G, DIMENSION_BC, NEXT_RECA)
191           CALL OUT_BIN_512 (UNIT_RES, BC_T_G, DIMENSION_BC, NEXT_RECA)
192           DO N = 1, NMAX(0)
193              CALL OUT_BIN_512 (UNIT_RES, BC_X_G(1,N), DIMENSION_BC, NEXT_RECA)
194           END DO
195           CALL OUT_BIN_512 (UNIT_RES, BC_U_G, DIMENSION_BC, NEXT_RECA)
196           CALL OUT_BIN_512 (UNIT_RES, BC_V_G, DIMENSION_BC, NEXT_RECA)
197           CALL OUT_BIN_512 (UNIT_RES, BC_W_G, DIMENSION_BC, NEXT_RECA)
198           CALL OUT_BIN_512 (UNIT_RES, BC_RO_G, DIMENSION_BC, NEXT_RECA)
199           CALL OUT_BIN_512 (UNIT_RES, BC_ROP_G, DIMENSION_BC, NEXT_RECA)
200           CALL OUT_BIN_512 (UNIT_RES, BC_VOLFLOW_G, DIMENSION_BC, NEXT_RECA)
201           CALL OUT_BIN_512 (UNIT_RES, BC_MASSFLOW_G, DIMENSION_BC, NEXT_RECA)
202           DO LC = 1, MMAX
203              CALL OUT_BIN_512 (UNIT_RES, BC_ROP_S(1,LC), DIMENSION_BC, NEXT_RECA)
204              CALL OUT_BIN_512 (UNIT_RES, BC_U_S(1,LC), DIMENSION_BC, NEXT_RECA)
205              CALL OUT_BIN_512 (UNIT_RES, BC_V_S(1,LC), DIMENSION_BC, NEXT_RECA)
206              CALL OUT_BIN_512 (UNIT_RES, BC_W_S(1,LC), DIMENSION_BC, NEXT_RECA)
207              CALL OUT_BIN_512 (UNIT_RES, BC_T_S(1,LC), DIMENSION_BC, NEXT_RECA)
208              DO N = 1, NMAX(LC)
209                 CALL OUT_BIN_512(UNIT_RES,BC_X_S(1,LC,N),DIMENSION_BC,NEXT_RECA)
210              END DO
211              CALL OUT_BIN_512 (UNIT_RES, BC_VOLFLOW_S(1,LC), DIMENSION_BC, &
212                 NEXT_RECA)
213              CALL OUT_BIN_512 (UNIT_RES, BC_MASSFLOW_S(1,LC), DIMENSION_BC, &
214                 NEXT_RECA)
215           END DO
216           DO LC = 1, DIMENSION_BC
217              WRITE (UNIT_RES, REC=NEXT_RECA) BC_TYPE(LC)
218              NEXT_RECA = NEXT_RECA + 1
219           END DO
220     
221     
222      1100 continue
223     
224     !      call MPI_Barrier(MPI_COMM_WORLD,mpierr)  !//PAR_I/O enforce barrier here
225     !      call send_recv (flag,2)
226           call gather (flag,arr1,root)
227     ! To take care of filling the processor ghost layers with the correct values
228           call scatter (flag,arr1,root)
229     !      call MPI_Barrier(MPI_COMM_WORLD,mpierr)  !//PAR_I/O enforce barrier here
230           if (myPE .ne. PE_IO) goto 1200
231           call convert_to_io_i(arr1,arr2,ijkmax2)
232           CALL OUT_BIN_512I (UNIT_RES, arr2, IJKMAX2, NEXT_RECA)
233     
234           CALL OUT_BIN_512 (UNIT_RES, IS_X_W, DIMENSION_IS, NEXT_RECA)
235           CALL OUT_BIN_512 (UNIT_RES, IS_X_E, DIMENSION_IS, NEXT_RECA)
236           CALL OUT_BIN_512 (UNIT_RES, IS_Y_S, DIMENSION_IS, NEXT_RECA)
237           CALL OUT_BIN_512 (UNIT_RES, IS_Y_N, DIMENSION_IS, NEXT_RECA)
238           CALL OUT_BIN_512 (UNIT_RES, IS_Z_B, DIMENSION_IS, NEXT_RECA)
239           CALL OUT_BIN_512 (UNIT_RES, IS_Z_T, DIMENSION_IS, NEXT_RECA)
240           CALL OUT_BIN_512I (UNIT_RES, IS_I_W, DIMENSION_IS, NEXT_RECA)
241           CALL OUT_BIN_512I (UNIT_RES, IS_I_E, DIMENSION_IS, NEXT_RECA)
242           CALL OUT_BIN_512I (UNIT_RES, IS_J_S, DIMENSION_IS, NEXT_RECA)
243           CALL OUT_BIN_512I (UNIT_RES, IS_J_N, DIMENSION_IS, NEXT_RECA)
244           CALL OUT_BIN_512I (UNIT_RES, IS_K_B, DIMENSION_IS, NEXT_RECA)
245           CALL OUT_BIN_512I (UNIT_RES, IS_K_T, DIMENSION_IS, NEXT_RECA)
246           CALL OUT_BIN_512 (UNIT_RES, IS_PC(1,1), DIMENSION_IS, NEXT_RECA)
247           CALL OUT_BIN_512 (UNIT_RES, IS_PC(1,2), DIMENSION_IS, NEXT_RECA)
248           DO LC = 1, MMAX
249              CALL OUT_BIN_512 (UNIT_RES, IS_VEL_S(1,LC), DIMENSION_IS, NEXT_RECA)
250           END DO
251           DO LC = 1, DIMENSION_IS
252              WRITE (UNIT_RES, REC=NEXT_RECA) IS_TYPE(LC)
253              NEXT_RECA = NEXT_RECA + 1
254           END DO
255           WRITE (UNIT_RES, REC=NEXT_RECA) CYCLIC_X, CYCLIC_Y, CYCLIC_Z, CYCLIC_X_PD&
256              , CYCLIC_Y_PD, CYCLIC_Z_PD, DELP_X, DELP_Y, DELP_Z, U_G0, U_S0, V_G0, &
257              V_S0, W_G0, W_S0
258           NEXT_RECA = NEXT_RECA + 1
259     
260     ! Version 01.09
261     ! ------------------------------------------------------------------------
262           WRITE (UNIT_RES, REC=NEXT_RECA) TIME, TSTOP, ENERGY_EQ, RES_DT, OUT_DT, &
263              NLOG, L_SCALE0, NO_I, NO_J, NO_K, CALL_USR
264           NEXT_RECA = NEXT_RECA + 1
265           write (unit_res,rec=next_reca) n_spx
266           NEXT_RECA = NEXT_RECA + 1
267           DO LC = 1, N_SPX
268              WRITE (UNIT_RES, REC=NEXT_RECA) SPX_DT(LC)
269              NEXT_RECA = NEXT_RECA + 1
270           END DO
271           DO LC = 0, MMAX
272              WRITE (UNIT_RES, REC=NEXT_RECA) SPECIES_EQ(LC)
273              NEXT_RECA = NEXT_RECA + 1
274           END DO
275           CALL OUT_BIN_512 (UNIT_RES, USR_DT, DIMENSION_USR, NEXT_RECA)
276           CALL OUT_BIN_512 (UNIT_RES, USR_X_W, DIMENSION_USR, NEXT_RECA)
277           CALL OUT_BIN_512 (UNIT_RES, USR_X_E, DIMENSION_USR, NEXT_RECA)
278           CALL OUT_BIN_512 (UNIT_RES, USR_Y_S, DIMENSION_USR, NEXT_RECA)
279           CALL OUT_BIN_512 (UNIT_RES, USR_Y_N, DIMENSION_USR, NEXT_RECA)
280           CALL OUT_BIN_512 (UNIT_RES, USR_Z_B, DIMENSION_USR, NEXT_RECA)
281           CALL OUT_BIN_512 (UNIT_RES, USR_Z_T, DIMENSION_USR, NEXT_RECA)
282           DO LC = 1, DIMENSION_USR
283              WRITE (UNIT_RES, REC=NEXT_RECA) USR_FORMAT(LC), USR_EXT(LC), USR_TYPE(&
284                 LC), USR_VAR(LC)
285              NEXT_RECA = NEXT_RECA + 1
286           END DO
287           CALL OUT_BIN_512 (UNIT_RES, IC_P_STAR, DIMENSION_IC, NEXT_RECA)
288           CALL OUT_BIN_512 (UNIT_RES, IC_L_SCALE, DIMENSION_IC, NEXT_RECA)
289           DO LC = 1, DIMENSION_IC
290              WRITE (UNIT_RES, REC=NEXT_RECA) IC_TYPE(LC)
291              NEXT_RECA = NEXT_RECA + 1
292           END DO
293           CALL OUT_BIN_512 (UNIT_RES, BC_DT_0, DIMENSION_BC, NEXT_RECA)
294           CALL OUT_BIN_512 (UNIT_RES, BC_JET_G0, DIMENSION_BC, NEXT_RECA)
295           CALL OUT_BIN_512 (UNIT_RES, BC_DT_H, DIMENSION_BC, NEXT_RECA)
296           CALL OUT_BIN_512 (UNIT_RES, BC_JET_GH, DIMENSION_BC, NEXT_RECA)
297           CALL OUT_BIN_512 (UNIT_RES, BC_DT_L, DIMENSION_BC, NEXT_RECA)
298           CALL OUT_BIN_512 (UNIT_RES, BC_JET_GL, DIMENSION_BC, NEXT_RECA)
299     
300     
301     ! Version 01.10
302     ! ------------------------------------------------------------------------
303           WRITE (UNIT_RES, REC=NEXT_RECA) MU_GMAX
304           NEXT_RECA = NEXT_RECA + 1
305     
306     ! Version 01.11
307     ! ------------------------------------------------------------------------
308           WRITE (UNIT_RES, REC=NEXT_RECA) V_EX, MODEL_B
309           NEXT_RECA = NEXT_RECA + 1
310     
311     ! Version 01.12
312     ! ------------------------------------------------------------------------
313           WRITE (UNIT_RES, REC=NEXT_RECA) P_REF, P_SCALE, UR_FAC, TOL_RESID, DT_MAX&
314              , DT_MIN, DT_FAC, CLOSE_PACKED, GRAVITY, MU_S0
315           NEXT_RECA = NEXT_RECA + 1
316           WRITE (UNIT_RES, REC=NEXT_RECA) LEQ_IT, LEQ_METHOD
317           NEXT_RECA = NEXT_RECA + 1
318           CALL OUT_BIN_512 (UNIT_RES, BC_HW_G, DIMENSION_BC, NEXT_RECA)
319           CALL OUT_BIN_512 (UNIT_RES, BC_UW_G, DIMENSION_BC, NEXT_RECA)
320           CALL OUT_BIN_512 (UNIT_RES, BC_VW_G, DIMENSION_BC, NEXT_RECA)
321           CALL OUT_BIN_512 (UNIT_RES, BC_WW_G, DIMENSION_BC, NEXT_RECA)
322           DO LC = 1, MMAX
323              CALL OUT_BIN_512 (UNIT_RES, BC_HW_S(1,LC), DIMENSION_BC, NEXT_RECA)
324              CALL OUT_BIN_512 (UNIT_RES, BC_UW_S(1,LC), DIMENSION_BC, NEXT_RECA)
325              CALL OUT_BIN_512 (UNIT_RES, BC_VW_S(1,LC), DIMENSION_BC, NEXT_RECA)
326              CALL OUT_BIN_512 (UNIT_RES, BC_WW_S(1,LC), DIMENSION_BC, NEXT_RECA)
327           END DO
328           WRITE (UNIT_RES, REC=NEXT_RECA) MOMENTUM_X_EQ, MOMENTUM_Y_EQ, &
329              MOMENTUM_Z_EQ, TOL_DIVERGE, DISCRETIZE, FULL_LOG
330           NEXT_RECA = NEXT_RECA + 1
331     
332     ! Version 01.14
333     ! ------------------------------------------------------------------------
334           WRITE (UNIT_RES, REC=NEXT_RECA) DETECT_STALL
335           NEXT_RECA = NEXT_RECA + 1
336     
337     ! Version 01.15
338     ! ------------------------------------------------------------------------
339           WRITE (UNIT_RES, REC=NEXT_RECA) &
340              K_G0, K_S0(1), C_PG0, C_PS0(1), TOL_RESID_T, TOL_RESID_X
341           NEXT_RECA = NEXT_RECA + 1
342           CALL OUT_BIN_512 (UNIT_RES, IC_GAMA_RG, DIMENSION_IC, NEXT_RECA)
343           CALL OUT_BIN_512 (UNIT_RES, IC_T_RG, DIMENSION_IC, NEXT_RECA)
344           DO LC = 1, MMAX
345              CALL OUT_BIN_512 (UNIT_RES, IC_GAMA_RS(1,LC), DIMENSION_IC, NEXT_RECA)
346              CALL OUT_BIN_512 (UNIT_RES, IC_T_RS(1,LC), DIMENSION_IC, NEXT_RECA)
347           END DO
348     
349     ! Version 01.2
350     ! ------------------------------------------------------------------------
351           WRITE (UNIT_RES, REC=NEXT_RECA) NORM_G, NORM_S
352           NEXT_RECA = NEXT_RECA + 1
353     
354     ! Version 01.3
355     ! ------------------------------------------------------------------------
356           WRITE (UNIT_RES, REC=NEXT_RECA) NScalar, TOL_RESID_Scalar, DIM_SCALAR
357           NEXT_RECA = NEXT_RECA + 1
358           CALL OUT_BIN_512I (UNIT_RES, Phase4Scalar, DIM_SCALAR, NEXT_RECA)
359     
360     ! Version 1.4 -- write radiation variables in write_res1
361     ! ------------------------------------------------------------------------
362     
363     ! Version 1.5 -- write nRR
364     ! ------------------------------------------------------------------------
365           WRITE (UNIT_RES, REC=NEXT_RECA) nRR
366           NEXT_RECA = NEXT_RECA + 1
367     
368     ! Version 1.6 -- write k and epsilon in write_res1 and spx1
369     ! ------------------------------------------------------------------------
370           WRITE (UNIT_RES, REC=NEXT_RECA) K_epsilon
371           NEXT_RECA = NEXT_RECA + 1
372     
373     ! Version 1.7 -- write STIFF_CHEMISTRY and lCALL_ISAT
374     ! ------------------------------------------------------------------------
375           WRITE (UNIT_RES, REC=NEXT_RECA) STIFF_CHEMISTRY, lCALL_ISAT
376           NEXT_RECA = NEXT_RECA + 1
377     
378     ! Version 1.8 -- write densities of each solids species
379     ! ------------------------------------------------------------------------
380           WRITE (UNIT_RES, REC=NEXT_RECA) (SOLVE_ROs(LC),LC=1,MMAX)
381           NEXT_RECA = NEXT_RECA + 1
382           DO LC = 1, MMAX
383              IDX = INERT_SPECIES(LC)
384              WRITE (UNIT_RES, REC=NEXT_RECA) IDX, BASE_ROs(LC),&
385                 (X_s0(LC,N),N=1,NMAX(LC))
386              NEXT_RECA = NEXT_RECA + 1
387           ENDDO
388     
389     
390     
391     !  Add new write statements above this line.  Remember to update NEXT_RECA.
392     !  Remember to change the version number near beginning of this subroutine.
393     !  Also modify READ_RES0.  The routines such as OUT_BIN_512 etc. writes
394     !  arrays dimensioned ARRAY(DIM).  So arrays dimensioned ARRAY(DIM1:DIM2)
395     !  should be passed as ARRAY(DIM1) and array length as DIM2-DIM1+1.
396     !---------------------------------------------------------------------------
397           WRITE (UNIT_RES, REC=3) NEXT_RECA
398           FLUSH (UNIT_RES)
399     
400      1200 continue
401     
402           if (bDist_IO .and. myPE.ne.PE_IO) then
403              WRITE (UNIT_RES, REC=1) VERSION
404              WRITE (UNIT_RES, REC=2) RUN_NAME, ID_MONTH, ID_DAY, ID_YEAR, ID_HOUR, &
405                  ID_MINUTE, ID_SECOND
406              WRITE (UNIT_RES, REC=3) 4
407              FLUSH (UNIT_RES)
408           end if
409     
410           deallocate (arr1)
411           deallocate (arr2)
412     
413           RETURN
414           END SUBROUTINE WRITE_RES0
415