Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
!***********************************************************************
!
!
SUBROUTINE read_redsh
!
!
!***********************************************************************
!
!
! Subroutine to read the File out32.tab:
!
! List of the programmed output (in red-shift) corrected in position files
!
!=======================================================================
USE fly_h
IMPLICIT NONE
INCLUDE 'mpif.h'
REAL(KIND=4), DIMENSION(100) :: z32_sort,z32_ou_temp
INTEGER(KIND=4) :: z32_last_temp, i, j
REAL(KIND=4) ::z32_min,z32_max
!=======================================================================
i = 0
j = 0
z32_sort=0.
z32_ou_temp=z32_ou
z32_last_temp=z32_last
IF(me.eq.0) THEN
OPEN(UNIT=upar35,FILE=fpar35,STATUS='OLD')
do i=1,100
READ(upar35,170,END=200) z32_ou(i)
IF(z32_ou(i).eq.0.0)z32_ou(i)=0.00001
enddo
200 CONTINUE
nr_z32=i-1
CLOSE(UNIT=upar35)
ENDIF
NLONG=1
CALL MPI_Bcast(nr_z32, NLONG, MPI_INTEGER4, PE0, MPI_COMM_WORLD, ierror)
NLONG=100
CALL MPI_Bcast(z32_ou, NLONG, MPI_REAL4, PE0, MPI_COMM_WORLD, ierror)
!-----------------------------------------------------------------------------
! Sort and Compute final values
!-----------------------------------------------------------------------------
IF(nr_z32.lt.1) halt_sim=2 !Stop simulation: no output founded
z32_min=z32_ou(1)
do i=1,nr_z32
IF(z32_ou(i).lt.z32_min) THEN
z32_min=z32_ou(i)
ENDIF
enddo
z32_min=z32_min-1.0
z32_last=0
DO WHILE (.TRUE.)
z32_max=z32_ou(1)
do i=1,nr_z32
IF(z32_max.lt.z32_ou(i)) THEN
z32_max=z32_ou(i)
ENDIF
enddo
IF(z32_max.eq.z32_min) EXIT
do i=1,nr_z32
IF(z32_max.eq.z32_ou(i)) THEN
z32_ou(i)=z32_min
ENDIF
enddo
z32_last=z32_last+1
z32_sort(z32_last)=z32_max
ENDDO ! do while
!-------------------------------------------------------------------------------
! Set parameters
!-------------------------------------------------------------------------------
!
z32_ou=z32_sort
z32_end=z32_ou(z32_last)
IF(z32_end.ge.znow) THEN
halt_sim=1 !stop simulation
IF(me.eq.0) THEN
write(uterm,*)'SET STOP SIMULATION: Already reached final redshift'
call flush(uterm)
ENDIF
ENDIF
!-------------------------------------------------------------------------------
! Update next_out at the start or if the out32.tab file is updated
!-------------------------------------------------------------------------------
DO i=1,z32_last
IF(z32_ou(i).ne.z32_ou_temp(i)) THEN
EXIT
ENDIF
ENDDO
IF(i.le.z32_last .or. z32_last.ne.z32_last_temp) THEN
DO i=1,z32_last
IF(me.eq.0) write(uterm,*)'redsh:i,z32_ou(i),znow : ',i,z32_ou(i),znow
IF(z32_ou(i).lt.znow) THEN
next_out=i
IF(me.eq.0) write(uterm,*)'redsh:i, next_out : ',i,next_out
EXIT
ENDIF
ENDDO
ENDIF
!-------------------------------------------------------------------------------
! Write values
!-------------------------------------------------------------------------------
IF(me.eq.0) THEN
write(uterm,*)'----------------------------'
write(uterm,*)'PROGRAMMED OUTPUT FILES '
write(uterm,*)'(redshift values) '
write(uterm,*)'----------------------------'
write(uterm,170)(z32_ou(j),j=1,z32_last)
write(uterm,*)'----------------------------'
170 FORMAT(10(F7.3,1x))
ENDIF ! if(me.eq.0)
RETURN
END