The TELEMAC-MASCARET system  trunk
read_sections_gaia.f
Go to the documentation of this file.
1 ! *****************************
2  SUBROUTINE read_sections_gaia
3 ! *****************************
4 !
5 !
6 !***********************************************************************
7 ! GAIA
8 !***********************************************************************
9 !
27 !
28 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
29 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
30 !
31  USE bief, ONLY: ncsize
32  USE declarations_gaia, ONLY: mesh, chain, ncp, ctrlsc,
33  & gai_files, gaisec
35  IMPLICIT NONE
36 !
37  INTEGER :: NSEC, IHOWSEC, I, N, ERR, INP
38  DOUBLE PRECISION :: XA, YA, DISTB, DISTE, DMINB, DMINE
39 !
40 !-----------------------------------------------------------------------
41 !
42 ! WRITE(LU,*) '-> ENTERING READ_SECTIONS_GAIA'
43  inp=gai_files(gaisec)%LU
44  READ (inp,*) ! THE NECESSARY COMMENT LINE
45  READ (inp,*) nsec, ihowsec
46  IF (.NOT.ALLOCATED(chain)) THEN
47  ALLOCATE (chain(nsec), stat=err)
48  IF (err/=0) THEN
49  WRITE(lu,*)
50  & 'READ_SECTIONS: ERROR BY REALLOCATING CHAIN:',err
51  CALL plante(1)
52  stop
53  ENDIF
54  ENDIF
55  SELECT CASE (ihowsec)
56  CASE (:-1) ! SECTION END POINTS PROVIDED AS GLOBAL NODES
57  DO n=1,nsec
58  READ (inp,*) chain(n)%DESCR
59  READ (inp,*) chain(n)%NPAIR(:)
60  IF (ncsize>1) THEN
61  chain(n)%XYBEG(:)=0.0d0
62  chain(n)%XYEND(:)=0.0d0
63  ELSE
64  chain(n)%XYBEG(:)= (/mesh%X%R(chain(n)%NPAIR(1)),
65  & mesh%Y%R(chain(n)%NPAIR(1))/)
66  chain(n)%XYEND(:)= (/mesh%X%R(chain(n)%NPAIR(2)),
67  & mesh%Y%R(chain(n)%NPAIR(2))/)
68  ENDIF
69  chain(n)%NSEG=-1
70  NULLIFY(chain(n)%LISTE)
71  END DO
72 ! WRITE(LU,'(A)') ' -> SECTION, TERMINAL COORDINATES:'
73 ! DO N=1,NSEC
74 ! WRITE(LU,'(I9,4(1X,1PG13.6))') N,
75 ! & CHAIN(N)%XYBEG, CHAIN(N)%XYEND
76 ! END DO
77  CASE (0) ! SECTION END POINTS PROVIDED BY COORDINATES
78  DO n=1,nsec
79  READ (inp,*) chain(n)%DESCR
80 !##>JR @ ADJOINTWARE: AVOID PART-REF WITH NON-ZERO RANK IN MODE T1V
81  READ (inp,*)
82  & ( chain(n)%XYBEG(i), i=1, SIZE(chain(n)%XYBEG,1) ),
83  & ( chain(n)%XYEND(i), i=1, SIZE(chain(n)%XYEND,1) )
84 ! READ (INP,*) CHAIN(N)%XYBEG(:), CHAIN(N)%XYEND(:)
85 !##<JR @ ADJOINTWARE
86  chain(n)%NPAIR(:)=0
87  chain(n)%NSEG=-1
88  NULLIFY(chain(n)%LISTE)
89  END DO
90  DO n=1,nsec ! FIND NEAREST NODES
91  xa=mesh%X%R(1)
92  ya=mesh%Y%R(1)
93  dminb = sqrt( (chain(n)%XYBEG(1)-xa)**2
94  & + (chain(n)%XYBEG(2)-ya)**2 )
95  dmine = sqrt( (chain(n)%XYEND(1)-xa)**2
96  & + (chain(n)%XYEND(2)-ya)**2 )
97  chain(n)%NPAIR(1)=1
98  chain(n)%NPAIR(2)=1
99  DO i=2,mesh%NPOIN ! COMPUTATIONALLY INTENSIVE
100  xa=mesh%X%R(i)
101  ya=mesh%Y%R(i)
102  distb = sqrt( (chain(n)%XYBEG(1)-xa)**2
103  & + (chain(n)%XYBEG(2)-ya)**2 )
104  diste = sqrt( (chain(n)%XYEND(1)-xa)**2
105  & + (chain(n)%XYEND(2)-ya)**2 )
106  IF ( distb < dminb ) THEN
107  chain(n)%NPAIR(1)=i
108  dminb=distb
109  ENDIF
110  IF ( diste < dmine ) THEN
111  chain(n)%NPAIR(2)=i
112  dmine=diste
113  ENDIF
114  END DO
115 ! WRITE(LU,'(A,3(1X,I9))')
116 ! & ' -> SECTION, TERMINAL NODES: ', N, CHAIN(N)%NPAIR(:)
117  END DO
118  CASE (1:) ! PARTITIONED, INSTEAD OF END POINTS, READY CHAINS PROVIDED
119  DO n=1,nsec
120  READ (inp,*) chain(n)%DESCR
121  READ (inp,*) chain(n)%NSEG
122  IF (chain(n)%NSEG>0) THEN
123  ALLOCATE (chain(n)%LISTE(chain(n)%NSEG,2), stat=err)
124  IF (err/=0) THEN
125  WRITE(lu,*) 'READ_SECTIONS: ',
126  & ' ERROR BY REALLOCATING CHAIN(N)%LISTE, N, ERR:',n,err
127  CALL plante(1)
128  stop
129  ENDIF
130  DO i=1,chain(n)%NSEG
131  READ(inp,*) chain(n)%LISTE(i,:)
132  chain(n)%NPAIR=-1 ! HM...
133  chain(n)%XYBEG=0.0d0
134  chain(n)%XYEND=0.0d0
135  END DO
136  ELSE
137  NULLIFY(chain(n)%LISTE)
138  ENDIF
139  END DO
140  END SELECT
141 !
142 !-----------------------------------------------------------------------
143 !
144 ! WRITE(LU,*) 'SECTIONS SUMMARY:'
145 ! WRITE(LU,*) 'NSEC,IHOWSEC: ',NSEC,IHOWSEC
146 ! SELECT CASE (IHOWSEC)
147 ! CASE(:0) ! SERIAL CASE, OR "CLASSICAL CASE" IN PARALLEL (DEVEL)
148 ! DO N=1,NSEC
149 ! WRITE(LU,*) CHAIN(N)%DESCR
150 ! WRITE(LU,*) CHAIN(N)%XYBEG(:), CHAIN(N)%XYEND(:)
151 ! WRITE(LU,*) CHAIN(N)%NPAIR(:)
152 ! END DO
153 ! CASE (1:) ! PARTITIONED, READY SEGMENT CHAINS GIVEN
154 ! DO N=1,NSEC
155 ! WRITE(LU,*) 'NAME: ', CHAIN(N)%DESCR
156 ! WRITE(LU,*) 'NSEG: ', CHAIN(N)%NSEG
157 ! DO I=1,CHAIN(N)%NSEG
158 ! WRITE(LU,*) CHAIN(N)%LISTE(I,:)
159 ! END DO
160 ! END DO
161 ! END SELECT
162 !
163 !-----------------------------------------------------------------------
164 ! TRANSFER TO THE GLOBAL TELEMAC OR GAIA VARIABLES
165 ! NCP IS 2 * NUMBER OF SECTIONS
166 ! CTRLSC IS THE LIST OF THE SECTION END NODES
167 ! CTRLSC HAS TO BE RE-ALLOCATED CAREFULLY
168 !
169 ! WRITE (LU,*) 'ARRANGING SECTIONS FOR GAIA'
170 ! WRITE (LU,*) 'GAIA NCP WAS: ',NCP
171  ncp = 2*nsec
172  IF (ALLOCATED(ctrlsc)) THEN
173  DEALLOCATE(ctrlsc, stat=err)
174  IF (err/=0) THEN
175  WRITE(lu,*)
176  & 'READ_SECTIONS_GAIA: ERROR BY DEALLOCATING CTRLSC:',err
177  CALL plante(1)
178  stop
179  ENDIF
180  ENDIF
181  ALLOCATE (ctrlsc(ncp), stat=err)
182  IF (err/=0) THEN
183  WRITE(lu,*)
184  & 'READ_SECTIONS_GAIA: ERROR BY REALLOCATING CTRLSC:',err
185  CALL plante(1)
186  stop
187  ENDIF
188  i=1
189  DO n=1,nsec
190  ctrlsc(i) = chain(n)%NPAIR(1)
191  ctrlsc(i+1) = chain(n)%NPAIR(2)
192  i=i+2
193  END DO
194 ! WRITE (LU,*) 'NCP@GAIA: ',NCP
195 ! WRITE (LU,*) 'CTRLSC@GAIA: ',CTRLSC
196 !
197 !-----------------------------------------------------------------------
198 !
199 ! WRITE(LU,*) '-> LEAVING READ_SECTIONS_GAIA'
200  RETURN
201  END SUBROUTINE read_sections_gaia
subroutine read_sections_gaia
type(bief_mesh), target mesh
Mesh structure.
integer ncp
Number of control sections points.
type(chain_type), dimension(:), allocatable chain
integer, dimension(:), allocatable ctrlsc
Array containing the global number of the points in the control sections.
Definition: bief.f:3