The TELEMAC-MASCARET system  trunk
get_tomspec_value2.f
Go to the documentation of this file.
1 ! *****************************
2  SUBROUTINE get_tomspec_value2
3 ! *****************************
4 !
5  &(spec)
6 !
7 !***********************************************************************
8 ! ARTEMIS V7P3 Aug 2017
9 !***********************************************************************
10 !
11 !brief READS IN THE TOMAWAC ENERGY SPECTRA.
12 !
13 !history N.DURAND (HRW)
14 !+ 09/03/2001
15 !+
16 !+ Original version
17 !
18 !history T.ELLAM (HRW)
19 !+ 13/03/2002
20 !+
21 !+ Modified to read in serafin format.spe
22 !
23 !history N.DURAND (HRW)
24 !+ June 2014
25 !+
26 !+ Streamlined for V7P0
27 !
28 !history N.DURAND (HRW)
29 !+ Feb 2017
30 !+ V7P2
31 !+ Revisited to use the hermes module
32 !+ Covers nesting option 2 only
33 !
34 !history N.DURAND (HRW)
35 !+ August 2017
36 !+ V7P3
37 !+ DEGRAD now defined in DECLARATIONS_ARTEMIS
38 !
39 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
40 !| SPEC |<->| SPECTRUM STRUCTURE
41 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
42 !
43  USE bief
45 !
47  IMPLICIT NONE
48 !
49 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
50 !
51  TYPE(spectrum) , INTENT(INOUT) :: SPEC
52 !
53 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
54 !
55  INTEGER :: IERR, I, IFF, IDD, ISPEC
56  INTEGER :: NFIC, TYP
57  INTEGER :: IDEC
58  INTEGER :: RECORD
59 !
60  DOUBLE PRECISION :: EPS, DIST
61  DOUBLE PRECISION,ALLOCATABLE :: X1(:),Y1(:),STOCK(:)
62 !
63  CHARACTER(LEN=8) :: FFORMAT
64  CHARACTER(LEN=16),ALLOCATABLE :: VARNAME(:),VARUNIT(:)
65 !
66  INTRINSIC dsqrt, datan, datan2
67 !
68 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
69 !
70  ALLOCATE(varname(spec%N),stat=ierr)
71  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE2:VARNAME')
72  ALLOCATE(varunit(spec%N),stat=ierr)
73  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE2:VARUNIT')
74 !
75  ALLOCATE(x1(nf*ndir),stat=ierr)
76  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE2:X1')
77  ALLOCATE(y1(nf*ndir),stat=ierr)
78  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE2:Y1')
79  ALLOCATE(stock(ndir),stat=ierr)
80  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE2:STOCK')
81 !
82 !=======================================================================
83 !
84  nfic = art_files(wacspe)%LU
85  fformat = art_files(wacspe)%FMT
86 ! THE SUPPORT MESH FOR TOMAWAC SPECTRA IS MADE OF QUADRANGLES
88 !
89 !-----------------------------------------------------------------------
90 !
91  IF(spec%N.GE.1) THEN
92 !
93 ! NODE NUMBER FOR EACH SPECTRUM/POINT IN SPEC
94 !
95  CALL get_data_var_list(fformat,nfic,spec%N,varname,varunit,ierr)
96  CALL check_call(ierr,'GET_TOMSPEC_VALUE2:GET_DATA_VAR_LIST')
97  DO ispec=1,spec%N
98  READ (varname(ispec)(9:16),'(I8)') spec%NOUTER(ispec)
99  ENDDO
100 !
101 ! WITH NESTING OPTION 2, GEOGRAPHICAL COORDINATES OF THE SPECTRAL POINTS
102 ! IN THE TOMAWAC OUTER MESH ARE REQUIRED FOR INTERPOLATION PURPOSES
103 ! AND TO IDENTIFY NODE CLOSEST TO REQUESTED REFERENCE POINT
104 !
105  CALL xy_tomawac(spec)
106 !
107 ! IDENTIFIES NODE CLOSEST TO REQUESTED REFERENCE POINT
108 !
109  eps = 3000.d0
110  n_sfref = 0
111  DO ispec = 1,spec%N
112  dist = dsqrt((spec%XOUTER(ispec)-x_sfref)**2 +
113  & (spec%YOUTER(ispec)-y_sfref)**2 )
114  IF(dist.LT.eps) THEN
115  eps = dist
116  n_sfref = ispec
117  ENDIF
118  ENDDO
119 !
120  IF(n_sfref.EQ.0) THEN
121  WRITE(lu,201) x_sfref, y_sfref
122  DEALLOCATE(x1,y1,stock)
123  DEALLOCATE(varname,varunit)
124  CALL plante(1)
125  stop
126  ELSEIF(debug.GT.0) THEN
127  WRITE(lu,*) 'GET_TOMSPEC_VALUE2: N_SFREF:',n_sfref
128  WRITE(lu,*) ' : NOUTER:',spec%NOUTER(n_sfref)
129  ENDIF
130 !
131 !-----------------------------------------------------------------------
132 !
133 ! "X AND Y COORDINATES" OF THE SPECTRA IN SPEC
134 !
135  CALL get_mesh_coord(fformat,nfic,1,2,nf*ndir,x1,ierr)
136  CALL check_call(ierr,'GET_TOMSPEC_VALUE2:GET_MESH_COORD:X')
137  CALL get_mesh_coord(fformat,nfic,2,2,nf*ndir,y1,ierr)
138  CALL check_call(ierr,'GET_TOMSPEC_VALUE2:GET_MESH_COORD:Y')
139 !
140 ! COMPUTES THE DISCRETE FREQUENCIES FROM "X AND Y"
141 !
142  DO i = 1,nf
143  spec%FRE(i) = dsqrt(x1((i-1)*ndir+1)**2+y1((i-1)*ndir+1)**2)
144 ! IF(DEBUG.GT.0) WRITE(*,*) I,SPEC%FRE(I)
145  ENDDO
146 !
147 ! COMPUTES THE DISCRETE DIRECTIONS FROM "X AND Y"
148 ! CONVENTION: FROM X, COUNTER-CLOCKWISE, TOWARDS
149 ! THE CALCULATION MEANS THAT DIRECTIONS ARE NO LONGER IN TOMAWAC CONVENTION
150 ! BUT RATHER DIRECTLY IN ARTEMIS CONVENTION
151 !
152  DO i = 1,ndir
153  spec%DIR(i) = datan2(y1(i),x1(i))
154  spec%DIR(i) = spec%DIR(i)/degrad
155 ! IN RANGE [0;360]
156  IF (spec%DIR(i).LT.0d0) THEN
157  spec%DIR(i) = 360.d0 + spec%DIR(i)
158  ENDIF
159 ! IF(DEBUG.GT.0) WRITE(*,*) I,SPEC%DIR(I)
160  ENDDO
161 !
162 ! RE-ORDERS DIRECTIONS FROM 0 to 360
163 ! STARTS BY FINDING THE SMALLEST DIRECTION IN [0;360] => IDEC
164  idec=0
165  eps=360.d0
166  DO i = 1,ndir
167 ! STOCKS THE DIRECTION
168  stock(i)=spec%DIR(i)
169  IF (spec%DIR(i).LT.eps) THEN
170  idec=i
171  eps=spec%DIR(i)
172  ENDIF
173  ENDDO
174 !
175 ! ORDERS SPEC%DIR FROM 0 to 360
176  DO i = 1,ndir
177  IF (i.GT.idec) THEN
178  idd=ndir+idec-i+1
179  ELSE
180  idd=idec-i+1
181  ENDIF
182  spec%DIR(idd)=stock(i)
183  ENDDO
184  spec%DIR(ndir+1)=spec%DIR(1)+360.d0
185 !
186 !-----------------------------------------------------------------------
187 !
188 ! ENERGY DENSITIES FOR EACH SPECTRUM/POINT IN SPEC, AND FOR RECORD TPSTWC
189 !
190  CALL get_data_timestep(fformat,nfic,record,tpstwc,ierr)
191  CALL check_call(ierr,'GET_TOMSPEC_VALUE2:GET_DATA_TIMESTEP')
192 !
193  DO ispec=1,nspec
194 ! IF(DEBUG.GT.0) WRITE(LU,*) VARNAME(ISPEC)
195  CALL get_data_value(fformat,nfic,record,varname(ispec),x1,
196  & nf*ndir,ierr)
197  CALL check_call(ierr,'GET_TOMSPEC_VALUE2:GET_DATA_VALUE')
198 !
199  DO iff=1,nf
200  DO idd=1,ndir
201  spec%ADR(ispec)%SOUTER(iff,idd) = x1((iff-1)*ndir+idd)
202  ENDDO
203 ! CLOSING THE LOOP
204  spec%ADR(ispec)%SOUTER(iff,ndir+1) =
205  & spec%ADR(ispec)%SOUTER(iff,1)
206  ENDDO
207 !
208 ! RE-ORDERS ENERGY DENSITIES
209 ! IN LINE WITH RE_ORDERING OF DIRECTIONS ABOVE
210 !
211  DO iff = 1,nf
212  DO i = 1,ndir
213  stock(i)=spec%ADR(ispec)%SOUTER(iff,i)
214  ENDDO
215  DO i = 1,ndir
216  IF (i.GT.idec) THEN
217  idd=ndir+idec-i+1
218  ELSE
219  idd=idec-i+1
220  ENDIF
221  spec%ADR(ispec)%SOUTER(iff,idd)=stock(i)
222  ENDDO
223  spec%ADR(ispec)%SOUTER(iff,ndir+1) =
224  & spec%ADR(ispec)%SOUTER(iff,1)
225  ENDDO
226 !
227  ENDDO ! ISPEC=1,NSPEC
228 !
229 !=======================================================================
230 !
231  DEALLOCATE(x1,y1,stock)
232  DEALLOCATE(varname,varunit)
233 !
234  ELSE
235  WRITE(lu,101) art_files(wacspe)%NAME
236  DEALLOCATE(varname,varunit)
237  CALL plante(1)
238  stop
239 !
240  ENDIF ! (SPEC%N.GE.1)
241 !
242 !-----------------------------------------------------------------------
243 !
244 ! PRINTOUT FORMATS:
245 !
246  WRITE(lu,301) tpstwc
247 !
248 301 FORMAT(/,1x,'GET_TOMSPEC_VALUE2 : READING TIME STEP ',1f9.2,'S')
249 !
250 201 FORMAT(/,1x,'GET_TOMSPEC_VALUE2 : NO SPECTRAL POINT FOUND LESS',
251  & ' THAN 3KM FROM REFERENCE POINT (',1f9.2,';',1f9.2,')',/,
252  & 'PLEASE REVIEW')
253 !
254 101 FORMAT(/,1x,'GET_TOMSPEC_VALUE2 : NO SPECTRAL POINT IN THE',
255  & ' TOMAWAC FILE ',1a30,';',/,
256  & 'PLEASE REVIEW')
257 !
258 !-----------------------------------------------------------------------
259 !
260 ! USER DEFINED FUNCTION TOTNRJ FOR CHECKS ONLY
261 !
262 ! IF(DEBUG.GT.0) THEN
263 ! DO I=1,NSPEC
264 ! CALL TOTNRJ(SPEC,I)
265 ! ENDDO
266 ! ENDIF
267 !
268 !-----------------------------------------------------------------------
269 !
270  RETURN
271  END
subroutine get_tomspec_value2(SPEC)
subroutine get_data_var_list(FFORMAT, FID, NVAR, VARLIST, UNITLIST, IERR)
subroutine get_data_value(FFORMAT, FID, RECORD, VAR_NAME, RES_VALUE, N, IERR)
Definition: get_data_value.f:7
subroutine xy_tomawac(SPEC)
Definition: xy_tomawac.f:7
subroutine get_data_timestep(FFORMAT, FID, RECORD, TIME, IERR)
type(bief_file), dimension(maxlu_art), target art_files
double precision, dimension(:), pointer x
integer, parameter quadrangle_elt_type
subroutine get_mesh_coord(FFORMAT, FID, JDIM, NDIM, NPOIN, COORD, IERR)
Definition: get_mesh_coord.f:7
Definition: bief.f:3