The TELEMAC-MASCARET system  trunk
get_tomspec_value1.f
Go to the documentation of this file.
1 ! *****************************
2  SUBROUTINE get_tomspec_value1
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 1 only (original reading routines superseded)
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
56  INTEGER :: NFIC, TYP
57  INTEGER :: IDEC
58  INTEGER :: RECORD
59 !
60  DOUBLE PRECISION :: EPS
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_VALUE1:VARNAME')
72  ALLOCATE(varunit(spec%N),stat=ierr)
73  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:VARUNIT')
74 !
75  ALLOCATE(x1(nf*ndir),stat=ierr)
76  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:X1')
77  ALLOCATE(y1(nf*ndir),stat=ierr)
78  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:Y1')
79  ALLOCATE(stock(ndir),stat=ierr)
80  CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1: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 ! ONLY ONE TOMAWAC SPECTRUM IS ALLOWED WHEN NESTING OPTION 1
92 !
93 ! IF MORE THAN ONE FOUND IN SPECTRUM FILE, WARNS THE USER THAT
94 ! THE FIRST IN FILE IS CONSIDERED
95 !
96  IF(spec%N.GT.1) THEN
97  WRITE(lu,*) 'WARNING: TOO MANY VARIABLES IN ',
98  & art_files(wacspe)%NAME,
99  & 'ONLY THE FIRST VARIABLE IN THE FILE WILL BE READ'
100  ENDIF
101 !
102 !-----------------------------------------------------------------------
103 !
104 ! NODE NUMBER FOR EACH SPECTRUM/POINT IN SPEC
105 !
106  CALL get_data_var_list(fformat,nfic,spec%N,varname,varunit,ierr)
107  CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_DATA_VAR_LIST')
108 ! THE 1ST SPECTRUM/POINT IN SPEC EVEN IF THERE ARE MORE THAN 1
109  READ (varname(1)(9:16),'(I8)') spec%NOUTER(1)
110 !
111 !-----------------------------------------------------------------------
112 !
113 ! "X AND Y COORDINATES" OF THE SPECTRA IN SPEC
114 !
115  CALL get_mesh_coord(fformat,nfic,1,2,nf*ndir,x1,ierr)
116  CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_MESH_COORD:X')
117  CALL get_mesh_coord(fformat,nfic,2,2,nf*ndir,y1,ierr)
118  CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_MESH_COORD:Y')
119 !
120 ! COMPUTES THE DISCRETE FREQUENCIES FROM "X AND Y"
121 !
122  DO i = 1,nf
123  spec%FRE(i) = dsqrt(x1((i-1)*ndir+1)**2+y1((i-1)*ndir+1)**2)
124 ! IF(DEBUG.GT.0) WRITE(*,*) SPEC%FRE(I)
125  ENDDO
126 !
127 ! COMPUTES THE DISCRETE DIRECTIONS FROM "X AND Y"
128 ! CONVENTION: FROM X, COUNTER-CLOCKWISE, TOWARDS
129 ! THE CALCULATION MEANS THAT DIRECTIONS ARE NO LONGER IN TOMAWAC CONVENTION
130 ! BUT RATHER DIRECTLY IN ARTEMIS CONVENTION
131 !
132  DO i = 1,ndir
133  spec%DIR(i) = datan2(y1(i),x1(i))
134  spec%DIR(i) = spec%DIR(i)/degrad
135 ! IN RANGE [0;360]
136  IF (spec%DIR(i).LT.0d0) THEN
137  spec%DIR(i) = 360.d0 + spec%DIR(i)
138  ENDIF
139 ! IF(DEBUG.GT.0) WRITE(*,*) SPEC%DIR(I)
140  ENDDO
141 !
142 ! RE-ORDERS DIRECTIONS FROM 0 to 360 WHEN NESTING OPTION 1
143 ! STARTS BY FINDING THE SMALLEST DIRECTION IN [0;360] => IDEC
144  idec=0
145  eps=360.d0
146  DO i = 1,ndir
147 ! STOCKS THE DIRECTION
148  stock(i)=spec%DIR(i)
149  IF (spec%DIR(i).LT.eps) THEN
150  idec=i
151  eps=spec%DIR(i)
152  ENDIF
153  ENDDO
154 !
155 ! ORDERS SPEC%DIR FROM 0 to 360
156  DO i = 1,ndir
157  IF (i.GT.idec) THEN
158  idd=ndir+idec-i+1
159  ELSE
160  idd=idec-i+1
161  ENDIF
162  spec%DIR(idd)=stock(i)
163  ENDDO
164  spec%DIR(ndir+1)=spec%DIR(1)+360.d0
165 !
166 !-----------------------------------------------------------------------
167 !
168 ! ENERGY DENSITIES FOR 1ST SPECTRUM/POINT IN SPEC ( HENCE ADR(1) ),
169 ! AND FOR RECORD TPSTWC
170 !
171  CALL get_data_timestep(fformat,nfic,record,tpstwc,ierr)
172  CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_DATA_TIMESTEP')
173 !
174  CALL get_data_value(fformat,nfic,record,varname(1),x1,
175  & nf*ndir,ierr)
176  CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_DATA_VALUE')
177 !
178  DO iff=1,nf
179  DO idd=1,ndir
180  spec%ADR(1)%SOUTER(iff,idd) = x1((iff-1)*ndir+idd)
181  ENDDO
182 ! CLOSING THE LOOP
183  spec%ADR(1)%SOUTER(iff,ndir+1) = spec%ADR(1)%SOUTER(iff,1)
184  ENDDO
185 !
186 !-----------------------------------------------------------------------
187 !
188 ! RE-ORDERS ENERGY DENSITIES WHEN NESTING OPTION 1
189 ! IN LINE WITH RE_ORDERING OF DIRECTIONS ABOVE
190 !
191  DO iff = 1,nf
192  DO i = 1,ndir
193  stock(i)=spec%ADR(1)%SOUTER(iff,i)
194  ENDDO
195  DO i = 1,ndir
196  IF (i.GT.idec) THEN
197  idd=ndir+idec-i+1
198  ELSE
199  idd=idec-i+1
200  ENDIF
201  spec%ADR(1)%SOUTER(iff,idd)=stock(i)
202  ENDDO
203  spec%ADR(1)%SOUTER(iff,ndir+1)=spec%ADR(1)%SOUTER(iff,1)
204  ENDDO
205 !
206 !=======================================================================
207 !
208  DEALLOCATE(x1,y1,stock)
209  DEALLOCATE(varname,varunit)
210 !
211 !-----------------------------------------------------------------------
212 !
213 ! PRINTOUT FORMATS:
214 !
215  WRITE(lu,301) tpstwc
216 !
217 301 FORMAT(/,1x,'GET_TOMSPEC_VALUE1 : READING TIME STEP ',1f9.2,'S')
218 !
219 !-----------------------------------------------------------------------
220 !
221 ! USER DEFINED FUNCTION TOTNRJ FOR CHECKS ONLY
222 !
223 ! IF(DEBUG.GT.0) CALL TOTNRJ(SPEC,1)
224 !
225 !-----------------------------------------------------------------------
226 !
227  RETURN
228  END
subroutine get_tomspec_value1(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 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