The TELEMAC-MASCARET system  trunk
read_fic_conc_gaia.f
Go to the documentation of this file.
1 ! *****************************
2  SUBROUTINE read_fic_conc_gaia
3 ! *****************************
4 !
5  &(cgl_gaia , what , at , nfic , listin , found )
6 !
7 !***********************************************************************
8 ! GAIA
9 !***********************************************************************
10 !
12 !
13 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
20 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
21 !
23  & choix_rfc,il1_rfc,il2_rfc,
24  & tl1_rfc,tl2_rfc,nvalue_rfc,
25  & lastwhat_rfc,lastat_rfc,nlig_rfc,
26  & maxval_rfc
28  IMPLICIT NONE
29 !
30 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
31 !
32  CHARACTER(LEN=8) , INTENT(IN) :: WHAT
33  DOUBLE PRECISION, INTENT(IN) :: AT
34  DOUBLE PRECISION, INTENT(INOUT) :: CGL_GAIA
35  INTEGER , INTENT(IN) :: NFIC
36  LOGICAL , INTENT(IN) :: LISTIN
37  LOGICAL , INTENT(OUT) :: FOUND
38 !
39 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
40 !
41 ! MAXIMUM NUMBER OF CHARACTERS PER LIGN (MAY BE CHANGED)
42 !
43  INTEGER, PARAMETER :: SIZELIGN = 3000
44 !
45  INTEGER IVALUE,ILIG,OK,J,IWHAT,IDEB,IFIN
46  DOUBLE PRECISION TETA
47  DOUBLE PRECISION, PARAMETER :: TOL = 1.d-3
48 !
49  CHARACTER(LEN=SIZELIGN) :: LIGNE
50 !
51 !
52  INTRINSIC abs
53 !
54 !-----------------------------------------------------------------------
55 !
56 ! 1) (AT FIRST CALL)
57 ! READS THE LIQUID BOUNDARY FILE
58 ! INITIALISES CURRENT LINES AND INTERVAL OF TIME_RFC
59 !
60  IF(.NOT.deja_rfc) THEN
61  rewind(nfic)
62 ! SKIPS COMMENTS
63 1 READ(nfic,fmt='(A)',err=10) ligne
64  GO TO 20
65 10 CONTINUE
66  WRITE(lu,*) 'READ ERROR IN THE'
67  WRITE(lu,*) 'LIQUID BOUNDARIES FILE FOR CONC'
68  WRITE(lu,*) 'PROBABLY A PROBLEM OF FORMAT'
69  WRITE(lu,*) 'ANY WINDOWS CARRIAGE RETURNS ON UNIX OR LINUX'
70  WRITE(lu,*) 'GUILTY LINE:'
71  WRITE(lu,*) ligne
72  CALL plante(1)
73  stop
74 20 CONTINUE
75  IF(ligne(1:1).EQ.'#') GO TO 1
76 !
77 ! FINDS OUT WHAT AND HOW MANY VALUES ARE GIVEN IN THE FILE
78 !
79  nvalue_rfc = -1
80  ifin = 1
81 40 ideb = ifin
82 !
83 ! IDENTIFIES FIRST CHARACTER OF NAME
84 50 IF(ligne(ideb:ideb).EQ.' '.AND.ideb.LT.sizelign) THEN
85  ideb=ideb+1
86  GO TO 50
87  ENDIF
88 ! IDENTIFIES LAST CHARACTER OF NAME
89  ifin = ideb
90 60 IF(ligne(ifin:ifin).NE.' '.AND.ifin.LT.sizelign) THEN
91  ifin=ifin+1
92  GO TO 60
93  ENDIF
94 !
95  IF(ideb.EQ.ifin) GO TO 4
96 !
97  nvalue_rfc = nvalue_rfc + 1
98  IF(nvalue_rfc.EQ.0) THEN
99  IF(ligne(ideb:ifin-1).NE.'T') THEN
100  WRITE(lu,*) 'FIRST VALUE MUST BE TIME_RFC, DENOTED T'
101  WRITE(lu,*) 'IN FILE OF LIQUID BOUNDARIES'
102  CALL plante(1)
103  stop
104  ENDIF
105  ELSEIF(nvalue_rfc.LE.maxval_rfc) THEN
106  choix_rfc(nvalue_rfc)=' '
107  choix_rfc(nvalue_rfc)(1:ifin-ideb+1)=ligne(ideb:ifin-1)
108  ELSE
109  WRITE(lu,*) 'INCREASE MAXVAL_RFC IN DECLARATIONS_GAIA'
110  CALL plante(1)
111  stop
112  ENDIF
113  IF(ifin.LT.sizelign) GO TO 40
114 !
115 ! SKIPS THE LINE WITH UNITS OR NAMES
116 4 READ(nfic,fmt='(A)',err=10) ligne
117  IF(ligne(1:1).EQ.'#') GO TO 4
118 !
119 ! COUNTS LINES OF DATA
120  nlig_rfc = 0
121 998 READ(nfic,*,end=1000,err=999) ligne
122  IF(ligne(1:1).NE.'#') nlig_rfc=nlig_rfc+1
123  GO TO 998
124 999 CONTINUE
125  WRITE(lu,*) 'READING ERROR ON THE LIQUID BOUNDARIES FILE'
126  WRITE(lu,*) 'AT LINE OF DATA : ',nlig_rfc
127  WRITE(lu,*) '(COMMENTS EXCLUDED)'
128  CALL plante(1)
129  stop
130 1000 CONTINUE
131 !
132 ! DYNAMICALLY ALLOCATES TIME_RFC AND INFIC_RFC
133 !
134  ALLOCATE(time_rfc(nlig_rfc),stat=ok)
135  CALL check_allocate(ok, 'TIME_RFC')
136  ALLOCATE(infic_rfc(nvalue_rfc,nlig_rfc),stat=ok)
137  CALL check_allocate(ok, 'INFIC_RFC')
138 !
139 ! FINAL READ OF TIME_RFC AND INFIC_RFC
140 !
141  rewind(nfic)
142 ! SKIPS COMMENTS AND FIRST TWO MANDATORY LINES
143 2 READ(nfic,fmt='(A)') ligne
144  IF(ligne(1:1).EQ.'#') GO TO 2
145  READ(nfic,fmt='(A)') ligne
146 !
147  DO ilig=1,nlig_rfc
148 3 READ(nfic,fmt='(A)') ligne
149  IF(ligne(1:1).EQ.'#') THEN
150  GO TO 3
151  ELSE
152  backspace(nfic)
153  READ(nfic,*) time_rfc(ilig),
154  & (infic_rfc(ivalue,ilig),ivalue=1,nvalue_rfc)
155  ENDIF
156  ENDDO
157 !
158  CLOSE(nfic)
159  deja_rfc = .true.
160 !
161  il1_rfc = 1
162  il2_rfc = 2
163  tl1_rfc = time_rfc(1)
164  tl2_rfc = time_rfc(2)
165 !
166  WRITE(lu,*) 'THE LIQUID BOUNDARIES FILE CONTAINS'
167  WRITE(lu,*) nlig_rfc,' LINES WITH:'
168  WRITE(lu,*) (choix_rfc(ivalue),ivalue=1,nvalue_rfc)
169 !
170  ENDIF
171 !
172 !-----------------------------------------------------------------------
173 !
174 ! 2) INTERPOLATES THE DATA TO GET THE CORRECT TIME_RFC
175 !
176 ! 2.A) FINDS THE ADDRESS IN THE ARRAY OF STORED DATA
177 !
178 ! 2.B) INTERPOLATES DATA FROM THE ARRAY INFIC_RFC
179 !
180 !-----------------------------------------------------------------------
181 !
182 !
183 ! WHICH VARIABLE ?
184  iwhat = 0
185  DO j=1,nvalue_rfc
186  IF(what.EQ.choix_rfc(j)) iwhat=j
187  ENDDO
188  IF(iwhat.EQ.0) THEN
189  found=.false.
190  RETURN
191  ENDIF
192 !
193 !
194 !
195 70 IF(at.GE.tl1_rfc-tol.AND.at.LE.tl2_rfc+tol) THEN
196  teta = (at-tl1_rfc)/(tl2_rfc-tl1_rfc)
197  ELSE
198  DO j=1,nlig_rfc-1
199  IF(at.GE.time_rfc(j)-tol.AND.at.LE.time_rfc(j+1)+tol) THEN
200  tl1_rfc=time_rfc(j)
201  tl2_rfc=time_rfc(j+1)
202  il1_rfc=j
203  il2_rfc=j+1
204  GO TO 70
205  ENDIF
206  ENDDO
207  il1_rfc=il2_rfc
208  il2_rfc=il2_rfc+1
209  IF(il2_rfc.GT.nlig_rfc) THEN
210  WRITE(lu,*) 'T=',at,' OUT OF RANGE'
211  WRITE(lu,*) 'OF THE FILE OF LIQUID BOUNDARIES'
212  CALL plante(1)
213  stop
214  ENDIF
215  tl1_rfc=time_rfc(il1_rfc)
216  tl2_rfc=time_rfc(il2_rfc)
217 
218  GO TO 70
219  ENDIF
220 !
221  cgl_gaia = (1.d0-teta)*infic_rfc(iwhat,il1_rfc)
222  & + teta *infic_rfc(iwhat,il2_rfc)
223 !
224  found=.true.
225 
226  lastat_rfc=at
227  lastwhat_rfc=what
228 !
229 !-----------------------------------------------------------------------
230 !
231  RETURN
232  END
double precision, dimension(:,:), allocatable infic_rfc
double precision, dimension(:), allocatable time_rfc
double precision function cgl_gaia(I, AT)
Definition: cgl_gaia.f:7
subroutine read_fic_conc_gaia(CGL_GAIA, WHAT, AT, NFIC, LISTIN, FOUND)