1!------------------------------------------------------------------------------
2! Peter Råback, Vili Forsell
3! Created: 13.6.2011
4! Last Modified: 13.7.2011
5!------------------------------------------------------------------------------
6! This module contains functions for
7! - interpolating NetCDF data for an Elmer grid point (incl. coordinate transformation); Interpolate()
8! - coordinate transformations for an Elmer grid point
9!    o none by default (x,y,z) -> (x,y,z)
10!    o cs2cs interface with parameters defined in Solver Input File
11!    o cartesian-to-cylindrical transformation (x,y,z) -> (phi,r,z)
12! - scaling Elmer mesh points to fit NetCDF data
13!------------------------------------------------------------------------------
14MODULE NetCDFInterpolate
15  USE DefUtils, ONLY: dp, MAX_NAME_LEN
16  USE NetCDFGeneralUtils, ONLY: GetFromNetCDF
17  USE Messages
18  IMPLICIT NONE
19
20  INTERFACE
21    !--- For connecting the C code, which accesses the cs2cs
22    SUBROUTINE cs2cs_transform( coord, hasZ, isRad, elmer_proj, netcdf_proj, res ) BIND(c)
23      USE iso_c_binding
24
25      !--- Input parameters
26      REAL(C_DOUBLE) :: coord(3)
27      INTEGER(C_INT), VALUE :: hasZ, isRad
28      CHARACTER(KIND=C_CHAR) :: elmer_proj(*), netcdf_proj(*)
29
30      !--- Output parameters
31      REAL(C_DOUBLE) :: res(3)
32
33    END SUBROUTINE cs2cs_transform
34  END INTERFACE
35
36  LOGICAL :: DEBUG_INTERP = .FALSE.
37  PRIVATE :: GetSolutionInStencil, CoordinateTransformation, ScaleMeshPoint, ChooseInterpolation, GetScalar
38
39  CONTAINS
40
41    !------------------ LinearInterpolation() ---------------------
42    !--- Performs linear interpolation
43    !--------------------------------------------------------------
44    FUNCTION LinearInterpolation(x,u1,u2) RESULT(y)
45      USE DefUtils
46      IMPLICIT NONE
47      REAL(KIND=dp), INTENT(IN) :: u1(2),u2(2),x
48      REAL(KIND=dp) :: y
49
50      y = (((u2(2) - u1(2))/(u2(1) - u1(1)))*(x-u1(1)))+u1(2)
51    END FUNCTION LinearInterpolation
52
53
54    !------------------- BilinearInterpolation() -------------------
55    !--- Performs bilinear interpolation on a stencil (2x2 matrix of corner values)
56    !---  with given weights (a 2 dimensional vector)
57    !---------------------------------------------------------------
58    FUNCTION BiLinearInterpolation(stencil,weights) RESULT(y)
59      USE DefUtils
60      IMPLICIT NONE
61      REAL(KIND=dp), INTENT(IN) :: stencil(2,2), weights(2)
62      REAL(KIND=dp) :: y
63
64      y = stencil(1,1)*(1-weights(1))*(1-weights(2)) + &
65          stencil(2,1)*weights(1)*(1-weights(2)) + &
66          stencil(1,2)*(1-weights(1))*weights(2) + &
67          stencil(2,2)*weights(1)*weights(2)
68
69    END FUNCTION BiLinearInterpolation
70
71    !------------------- TrilinearInterpolation() -------------------
72    !--- Performs trilinear interpolation on a stencil (2x2x2 matrix of corner values)
73    !---  with given weights (a 3 dimensional vector)
74    !---------------------------------------------------------------
75    FUNCTION TriLinearInterpolation(stencil,weights) RESULT(y)
76      USE DefUtils
77      IMPLICIT NONE
78      REAL(KIND=dp), INTENT(IN) :: stencil(2,2,2), weights(3)
79      REAL(KIND=dp) :: val1,val2,y
80
81      val1 = BiLinearInterpolation(stencil(:,:,1),weights(1:2))
82      val2 = BiLinearInterpolation(stencil(:,:,2),weights(1:2))
83      y = val1*(1-weights(3)) + val2*weights(3)
84
85    END FUNCTION TriLinearInterpolation
86
87    !------------------ Interpolate() -----------------------------
88    !--- Takes and interpolates one Elmer grid point to match NetCDF data; includes coordinate transformation
89    !--- ASSUMES INPUT DIMENSIONS AGREE
90    !--------------------------------------------------------------
91    FUNCTION Interpolate(SOLVER,NCID,VAR_ID,DIM_LENS,GRID,&
92            TIME,TIME_IND,interp_val,COORD_SYSTEM,X) RESULT( success )
93      USE DefUtils, ONLY: Solver_t
94      USE NetCDFGridUtils, ONLY: UniformGrid_t
95      USE NetCDFGeneralUtils, ONLY: TimeType_t
96      IMPLICIT NONE
97
98      !------------------------------------------------------------------------------
99      ! ARGUMENTS
100      !------------------------------------------------------------------------------
101      TYPE(Solver_t), INTENT(IN) :: SOLVER
102      TYPE(UniformGrid_t), INTENT(IN) :: GRID
103      TYPE(TimeType_t), INTENT(IN) :: TIME
104      INTEGER, INTENT(IN) :: NCID,DIM_LENS(:),TIME_IND,VAR_ID
105      CHARACTER(len = *), INTENT(IN) :: COORD_SYSTEM
106      REAL(KIND=dp), INTENT(INOUT) :: interp_val ! Final Elmer point and interpolated value
107      REAL(KIND=dp), OPTIONAL, INTENT(IN) :: X(:)
108      LOGICAL :: success ! Return value
109
110      !------------------------------------------------------------------------------
111      ! VARIABLES
112      !------------------------------------------------------------------------------
113      INTEGER :: alloc_stat, i
114      INTEGER, ALLOCATABLE :: ind(:)
115      REAL(KIND=dp), ALLOCATABLE :: Xf(:)
116
117      IF ( PRESENT(X) .AND. GRID % COORD_COUNT .GT. 0 ) THEN
118        !------------------------------------------------------------------------------
119        ! Uses Elmer coordinates
120        !------------------------------------------------------------------------------
121        ALLOCATE (ind(GRID % DIMS), Xf(size(X)), STAT = alloc_stat)
122        IF ( alloc_stat .NE. 0 ) THEN
123          CALL Fatal('GridDataMapper','Interpolation vectors memory allocation failed')
124        END IF
125
126        !--- 1) Coordinate mapping from Elmer (x,y) to the one used by NetCDF
127        Xf = CoordinateTransformation( SOLVER, X, COORD_SYSTEM )
128
129        !--- 2) Scaling, if applicable
130        ! NOTE! By default the SCALE consists of 1's, and MOVE 0's; hence, nothing happens
131        !       without user specifically specifying so
132        Xf = GRID % SCALE(:)*Xf + GRID % MOVE(:) ! Scales the mesh point within the NetCDF grid
133
134        !--- 3) Index estimation
135        ! Find the (i,j) indices [1,...,max]
136        ! Calculates the normalized difference vector;
137        ! i.e. the distance/indices to Elmer grid point x from the leftmost points of the NetCDF bounding box
138        ind(1:GRID % COORD_COUNT) = CEILING( ( Xf(:) - GRID % X0(:) ) / GRID % DX(:) )
139        ind((GRID % COORD_COUNT+1):GRID % DIMS) = GRID % CONST_VALS
140
141        ! This could be done better, one could apply extrapolation
142        ! with a narrow layer.
143        DO i = 1,size(Xf,1),1 ! NOTE: Does not modify the constant dimensions
144
145          ! Checks that the estimated index is within the bounding box
146          IF( ind(i) < 1 .OR. ind(i) >= GRID % NMAX(i) ) THEN
147
148            ! If it's smaller than the leftmost index, but within tolerance (Eps), set it to lower bound; and vice versa
149            IF( Xf(i) <= GRID % X0(i) .AND. Xf(i) >= GRID % X0(i) - GRID % EPS(i) ) THEN
150              ind(i) = 1
151            ELSE IF( Xf(i) >= GRID % X1(i) .AND. Xf(i) <= GRID % X1(i) + GRID % EPS(i) ) THEN
152              ind(i) = GRID % NMAX(i)
153            ELSE ! The index is too far to be salvaged
154              WRITE (Message, '(A,F14.3,A,(F14.3),A,F14.3,A,I3,A,F14.3,A,F14.6,A)') &
155                'Adjusted Elmer value is out of NetCDF bounds: ',&
156               GRID % X0(i), ' <= ',Xf(i), ' <= ', GRID % X1(i), &
157              ' over dimension ',i,' and originating from ', X(i),' despite error tolerance epsilon: ', GRID % EPS(i), '.'
158              CALL Warn( 'GridDataMapper',Message)
159              success = .FALSE.
160              RETURN
161            END IF
162          END IF
163        END DO
164
165        !--- 4) Choose and perform interpolation
166        interp_val = ChooseInterpolation(NCID,VAR_ID,GRID,TIME,Xf,IND,TIME_IND,DIM_LENS)
167
168      ELSE
169        !------------------------------------------------------------------------------
170        ! No Elmer coordinates (only constants/time)
171        !------------------------------------------------------------------------------
172        CALL GetScalar(NCID,VAR_ID,GRID,TIME,TIME_IND,DIM_LENS,interp_val)
173
174      END IF
175
176      success = .TRUE.
177
178    END FUNCTION Interpolate
179
180    !----------------- ChooseInterpolation() ----------------------
181    !--- Chooses the appropriate weighting, stencil and interpolation method
182    FUNCTION ChooseInterpolation(NCID,VAR_ID,GRID,TIME,X_VAL,X_IND,TIME_IND,DIM_LENS) RESULT(interp_val)
183    !--------------------------------------------------------------
184      USE NetCDFGridUtils, ONLY: UniformGrid_t
185      USE NetCDFGeneralUtils, ONLY: TimeType_t
186      IMPLICIT NONE
187
188      !------------------------------------------------------------------------------
189      ! ARGUMENTS
190      !------------------------------------------------------------------------------
191      INTEGER, INTENT(IN) :: NCID, VAR_ID, X_IND(:), DIM_LENS(:), TIME_IND
192      TYPE(UniformGrid_t), INTENT(IN) :: GRID
193      TYPE(TimeType_t), INTENT(IN) :: TIME
194      REAL(KIND=dp), INTENT(IN) :: X_VAL(:)
195      REAL(KIND=dp) :: interp_val ! The output
196
197      !------------------------------------------------------------------------------
198      ! VARIABLES
199      !------------------------------------------------------------------------------
200      INTEGER :: alloc_stat, loop
201      INTEGER :: actual_size, & ! The actual amount of stencil values
202                 actual_dims ! How many dimensions remain in use
203      INTEGER :: last_loc ! Latest location on the array
204      LOGICAL :: changed ! True, if the stencil has been changed
205      INTEGER, ALLOCATABLE :: sizes(:) ! Possibly differing sizes of the stencils
206      REAL(KIND=dp), ALLOCATABLE :: xi(:), weights(:), stencil_data(:)
207      REAL(KIND=dp) :: u1(2),u2(2) ! For 1D (linear) interpolation
208      REAL(KIND=dp), ALLOCATABLE :: stencilLine(:),stencilSqr(:,:),stencilCube(:,:,:) ! Adjusted if seems to over-index
209
210      !------------------------------------------------------------------------------
211      ! INITIALIZATIONS
212      !------------------------------------------------------------------------------
213      changed = .FALSE.
214      actual_size = 1
215      actual_dims = GRID % DIMS
216
217      !--- Finds the locations which are on the edge of over-indexing, and limits them if necessary
218      ALLOCATE ( sizes(GRID % DIMS), STAT = alloc_stat )
219      IF ( alloc_stat .NE. 0 ) THEN
220        CALL Fatal('GridDataMapper','Memory ran out!')
221      END IF
222      sizes = 2
223
224      DO loop = 1,size(X_IND,1)
225        IF ( X_IND(loop) .EQ. DIM_LENS(loop) ) THEN ! Ignore last dimensions
226          sizes(loop) = 1
227          actual_dims = actual_dims - 1
228          changed = .TRUE.
229        END IF
230        actual_size = actual_size * sizes(loop) ! Calculates the actual size of the stencil
231      END DO
232
233      !--- The sizes will change: need to allocate a temporary array for reshaping into a size suitable for interpolation
234      IF ( changed ) THEN
235        ALLOCATE ( stencil_data(actual_size), STAT = alloc_stat )
236        IF ( alloc_stat .NE. 0 ) THEN
237          CALL Fatal('GridDataMapper','Memory ran out!')
238        END IF
239      END IF
240
241      !--- Allocates the weights and such
242      ALLOCATE ( xi(actual_dims), weights(actual_dims), STAT = alloc_stat )
243      IF ( alloc_stat .NE. 0 ) THEN
244        CALL Fatal('GridDataMapper','Memory ran out!')
245      END IF
246
247      !------------------------------------------------------------------------------
248      ! A) Calculating the weights for each used dimension
249      !------------------------------------------------------------------------------
250      last_loc = 1 ! The latest handled location of the modified vectors
251      DO loop = 1,size(sizes,1),1
252        ! If the dimension is used, its size is larger than one (otherwise doesn't affect actual_size)
253        IF ( sizes(loop) .GT. 1 ) THEN
254          ! The value of the estimated NetCDF grid point
255          xi(last_loc) = GRID % X0(loop) + (X_IND(loop)-1) * GRID % DX(loop)
256
257          ! Interpolation weights, which are the normalized differences of the estimation from the adjacent grid point
258          ! Can be negative if ceil for indices brings the value of xi higher than x
259          !----------- Assume xi > x ------
260          !  x0 + (ind-1)dx > x, where dx > 0
261          ! <=> (ind-1)dx > x-x0
262          ! <=> ind-1 > (x-x0)/dx
263          ! <=> ceil((x-x0)/dx) > ((x-x0)/dx) + 1
264          ! o Known  (x-x0)/dx  <= ceil((x-x0)/dx) < (x-x0)/dx+1
265          ! => Contradicts; Ergo, range ok.
266          !--------------------------------
267          ! p values should be within [0,1]
268          ! 0 exactly when x = xi, 1 when (x-x0)/dx = ceil((x-x0)/dx) = ind
269          weights(last_loc) = (X_VAL(loop)-xi(last_loc))/GRID % DX(loop)
270          last_loc = last_loc + 1
271        END IF
272      END DO
273
274      !------------------------------------------------------------------------------
275      ! B) Obtaining the stencil values
276      !------------------------------------------------------------------------------
277      !--- (Must be in original dimensions for the data acquisition to, f.ex., match the contents of X_IND)
278      SELECT CASE ( GRID % DIMS )
279        CASE (1) !-- 1D
280          ALLOCATE ( stencilLine(sizes(1)), STAT = alloc_stat )
281          IF ( alloc_stat .NE. 0 ) THEN
282            CALL Fatal('GridDataMapper','Memory ran out!')
283          END IF
284
285          CALL GetSolutionInStencil(NCID,VAR_ID,X_IND,TIME_IND,TIME,DIM_LENS,GRID % ACCESS_PERM,stencilLine = stencilLine)
286          IF ( changed ) stencil_data = RESHAPE(stencilLine,SHAPE(stencil_data))
287
288        CASE (2) !-- 2D
289          ALLOCATE ( stencilSqr(sizes(1),sizes(2)), STAT = alloc_stat )
290          IF ( alloc_stat .NE. 0 ) THEN
291            CALL Fatal('GridDataMapper','Memory ran out!')
292          END IF
293
294          ! get data on stencil size(stencil)=(2,2), ind -vector describes the lower left corner
295          CALL GetSolutionInStencil(NCID,VAR_ID,X_IND,TIME_IND,TIME,DIM_LENS,GRID % ACCESS_PERM,stencilSqr = stencilSqr)
296          IF ( changed ) stencil_data = RESHAPE(stencilSqr,SHAPE(stencil_data))
297
298        CASE (3) !-- 3D
299
300          ALLOCATE ( stencilCube(sizes(1),sizes(2),sizes(3)), STAT = alloc_stat )
301          IF ( alloc_stat .NE. 0 ) THEN
302            CALL Fatal('GridDataMapper','Memory ran out!')
303          END IF
304
305          CALL GetSolutionInStencil(NCID,VAR_ID,X_IND,TIME_IND,TIME,DIM_LENS,GRID % ACCESS_PERM,stencilCube = stencilCube)
306          IF ( changed ) stencil_data = RESHAPE(stencilCube,SHAPE(stencil_data))
307
308        CASE DEFAULT !-- Error
309          CALL Fatal('GridDataMapper','Cannot handle more than three variable dimensions!')
310      END SELECT
311
312      !------------------------------------------------------------------------------
313      ! C) Interpolation
314      !------------------------------------------------------------------------------
315      !--- Allocates the interpolation arrays, if necessary
316      SELECT CASE ( actual_size )
317        CASE (1) ! Scalar
318
319!          PRINT *, 'Scalar: ', stencil_data
320          !-- stencil_data contains it all
321          interp_val = stencil_data(1) ! NOTE: Returning a scalar follows only if changed is .TRUE.
322
323        CASE (2) ! Line
324
325          !--- Adjusts data/weights to proper size
326          IF ( changed ) THEN
327!            PRINT *, 'Line: ', stencil_data
328            ALLOCATE ( stencilLine(2), STAT = alloc_stat )
329            IF ( alloc_stat .NE. 0 ) THEN
330              CALL Fatal('GridDataMapper','Memory ran out!')
331            END IF
332            stencilLine = stencil_data
333          END IF
334
335          !--- Linear interpolation
336          !--- Note: X_IND is the point in the lower left corner; so, in this case the leftmost point of the linear line
337          u1(1) = X_IND(1) ! Linear location from scalar x coord (integer),
338          u1(2) = stencilLine(1) ! interpolation for the corresponding value
339          u2(1) = X_IND(1) + 1 ! Same for the adjacent point before interpolation
340          u2(2) = stencilLine(2)
341          interp_val = LinearInterpolation((X_IND(1) + weights(1)),u1,u2)
342
343        CASE (4) ! Square
344
345          !--- Adjusts data/weights to proper size
346          IF ( changed ) THEN
347!            PRINT *, 'Square: ', stencil_data
348            ALLOCATE ( stencilSqr(2,2), STAT = alloc_stat )
349            IF ( alloc_stat .NE. 0 ) THEN
350              CALL Fatal('GridDataMapper','Memory ran out!')
351            END IF
352            stencilSqr = RESHAPE(stencil_data,SHAPE(stencilSqr))
353          END IF
354
355          !--- Bilinear interpolation
356          interp_val = BiLinearInterpolation(stencilSqr,weights)
357
358        CASE (8) ! Cube
359
360          !--- Adjusts data/weights to proper size
361          IF ( changed ) THEN
362!            PRINT *, 'Cube: ', stencil_data
363            ALLOCATE ( stencilCube(2,2,2), STAT = alloc_stat )
364            IF ( alloc_stat .NE. 0 ) THEN
365              CALL Fatal('GridDataMapper','Memory ran out!')
366            END IF
367            stencilCube = RESHAPE(stencil_data,SHAPE(stencilCube))
368          END IF
369
370          !--- Trilinear interpolation
371          interp_val = TriLinearInterpolation(stencilCube,weights)
372
373        CASE DEFAULT ! Error
374          WRITE(Message,'(A,I5,A)') 'Cannot interpolate a stencil of size ', actual_size, '.'
375          CALL Fatal('GridDataMapper',Message)
376
377      END SELECT
378
379    END FUNCTION ChooseInterpolation
380
381    !----------------- CoordinateTransformation() -----------------
382    !--- Transforms input coordinates into the given coordinate system
383    FUNCTION CoordinateTransformation( SOLVER, INPUT, COORD_SYSTEM ) RESULT( output )
384    !--------------------------------------------------------------
385      USE DefUtils, ONLY: dp, MAX_NAME_LEN, Solver_t, GetSolverParams, GetString, GetLogical
386      USE iso_c_binding, ONLY: C_NULL_CHAR
387      USE Messages
388      IMPLICIT NONE
389
390      !--- Input arguments
391      TYPE(Solver_t), INTENT(IN) :: SOLVER
392      CHARACTER(*), INTENT(IN) :: COORD_SYSTEM ! Some coordinate
393      REAL(KIND=dp), INTENT(IN) :: INPUT(:) ! The input coordinates
394
395      !--- Return value
396      REAL(KIND=dp), ALLOCATABLE :: output(:) ! The output coordinates
397
398      !--- Others
399      REAL(KIND=dp) :: coord(3), res(3)
400      INTEGER :: alloc_stat, hasZcoord
401      LOGICAL :: found
402      CHARACTER(len=MAX_NAME_LEN) :: elmer, netcdf
403
404      !--- DEBUG printout
405!      WRITE (*,*) 'Input ', input
406
407      !--- Initializations
408      coord = 0
409      res = 0
410      ALLOCATE ( output(size(INPUT)), STAT = alloc_stat )
411      IF ( alloc_stat .NE. 0 ) THEN
412        CALL Fatal('GridDataMapper','Coordinate transformation memory allocation failed')
413      END IF
414
415      !--- Selects the coordinate system transformation
416      SELECT CASE (COORD_SYSTEM)
417
418        !--- CS2CS Coordinate transformation
419        CASE ('cs2cs')
420!          CALL Info('GridDataMapper', 'Applies cs2cs coordinate transformation between the Elmer and NetCDF values!')
421
422          !-- Gathers the coordinate information
423          hasZcoord = 0
424          IF ( size(INPUT,1) .GE. 3 ) THEN
425            hasZcoord = 1
426            coord(1:3) = INPUT(1:3)
427          ELSE
428            coord(1:2) = INPUT(1:2)
429          END IF
430
431          !--- DEBUG printout
432!          WRITE (*,*) 'Coordinates ', coord
433
434          !--- Picks up the constant data from the Elmer Solver parameters
435          elmer = GetString(GetSolverParams(SOLVER),"CS2CS Elmer Projection", found)
436          IF ( .NOT. found ) THEN
437            CALL Fatal('GridDataMapper',&
438  'CS2CS Transformation did not find Elmer projection information "CS2CS Elmer Projection" from the Solver Input File')
439          END IF
440
441          netcdf = GetString(GetSolverParams(SOLVER), "CS2CS NetCDF Projection", found)
442          IF ( .NOT. found ) THEN
443            CALL Fatal('GridDataMapper',&
444  'CS2CS Transformation did not find NetCDF projection information "CS2CS NetCDF Projection" from the Solver Input File')
445          END IF
446
447          ! //C_NULL_CHAR's terminate the given strings with nulls to enable C compatibility
448          IF ( GetLogical(GetSolverParams(SOLVER), "CS2CS Is Input Radians", found) .AND. found ) THEN
449            CALL cs2cs_transform( coord, hasZcoord, 1, elmer//C_NULL_CHAR, netcdf//C_NULL_CHAR, res) ! True; is in radians
450          ELSE
451            CALL cs2cs_transform( coord, hasZcoord, 0, elmer//C_NULL_CHAR, netcdf//C_NULL_CHAR, res) ! False; is in degrees by default
452          END IF
453
454          !--- Sends the result as output
455          IF ( size(output,1) .GE. 3 ) THEN
456            output(1:3) = res(1:3)
457          ELSE
458            output(1:2) = res(1:2)
459          END IF
460
461          !--- DEBUG printout
462!          WRITE (*,*) 'Result ', res, ' to out ', output
463
464        CASE ('cylindrical')
465!          CALL Info('GridDataMapper','Applies cylindrical coordinate transformation to cartesian coordinates!')
466
467          !--- Transforms 3D Elmer grid points to cylindrical coordinates (phi,r,z)
468          IF ( size(INPUT,1) .GE. 3) THEN
469            output(1) = atan2( INPUT(2), INPUT(1) ) ! phi angle value
470            output(2) = sqrt(INPUT(1)**2 + INPUT(2)**2) ! radius from the center of cylinder
471            output(3) = INPUT(3) ! Height from zero level
472          ELSE
473            CALL Fatal('GridDataMapper','Cylindrical coordinate transformation requires at least three dimensional Elmer grid.')
474          END IF
475
476        !--- In default case, no coordinate transformation is applied
477        CASE DEFAULT
478!          WRITE (Message,'(A,A15,A)') 'No coordinate transformation applied: Unknown coordinate system "',&
479!                coord_system, '". Check Solver Input File and the variable "Coordinate System"'
480!          CALL Warn('GridDataMapper', Message)
481          output(:) = INPUT(:)
482      END SELECT
483
484    END FUNCTION
485
486    !------------------ ScaleMeshPoint() ------------------------
487    !--- Takes an Elmer mesh point and moves and scales it within the NetCDF grid
488    !--- Assumed that Elmer mesh and NetCDF grid should be 1:1, but aren't still completely matched
489    !--- NOTE: Can be optimized by calculating move(:) and scales(:) before interpolation (constant over a mesh/grid combo)
490    FUNCTION ScaleMeshPoint(X,X0,X1,X0E,X1E) RESULT( Xf )
491    !------------------------------------------------------------
492      USE Messages
493      USE DefUtils, ONLY: dp
494      IMPLICIT NONE
495      REAL(KIND=dp), INTENT(IN) :: X(:), &! The input Elmer point
496                           X0(:), X1(:), & ! The limiting values (points) of NetCDF grid
497                           X0E(:), X1E(:) ! The limiting values (points) of Elmer bounding box
498      REAL(KIND=dp), ALLOCATABLE :: Xf(:), & ! Scaled value; the output
499                       move(:), & ! Moves the Elmer min value to the NetCDF min value
500                       scales(:) ! Scales the grids to same value range (NetCDF constant, Elmer varies)
501      INTEGER :: alloc_stat ! For allocation
502
503      !--- Initial checks and allocations
504
505      ! All sizes are the same
506      IF ( .NOT. ( (size(X) .EQ. size(X0))   .AND. (size(X0) .EQ. size(X1)) .AND. &
507                   (size(X1) .EQ. size(X0E)) .AND. (size(X0E) .EQ. size(X1E)) ) ) THEN
508        CALL Fatal( 'GridDataMapper', 'Scaling input point sizes do not match!')
509      END IF
510      ALLOCATE ( Xf(size(X)), move(size(X)), scales(size(X)), STAT = alloc_stat )
511      IF ( alloc_stat .NE. 0 ) THEN
512        CALL Fatal('GridDataMapper','Memory ran out during scaling')
513      END IF
514
515      Xf = 0
516      move = 0
517      scales = 0
518      !--- Calculates the modifications
519
520      ! First the scaling to same size (Eq. a( X1E(1)-X0E(1) ) = (X1(1)-X0(1)) ; ranges over a dimension are same. Solved for a, 1 if equal)
521      scales(:) = (X1(:)-X0(:))/(X1E(:)-X0E(:)) ! Note: "/" and "*" elementwise operations for arrays in Fortran
522
523      ! Second the vector to reach X0 from the scaled X0E (wherever it is)
524      move(:) = X0(:) - scales(:)*X0E(:) ! zero, if equal
525
526      !--- Applies the modification
527      Xf(:) = scales(:)*X(:) + move(:)
528
529    END FUNCTION ScaleMeshPoint
530
531    !------------------ GetScalar() -------------------------------
532    !--- Gets a scalar value from NetCDF
533    SUBROUTINE GetScalar( NCID, VAR_ID, GRID, TIME, TIME_IND, DIM_LENS, scalar )
534    !--------------------------------------------------------------
535      USE NetCDFGeneralUtils, ONLY: TimeType_t, GetFromNetCDF
536      USE NetCDFGridUtils, ONLY: UniformGrid_t
537      USE DefUtils, ONLY: dp
538      IMPLICIT NONE
539
540      !------------------------------------------------------------------------------
541      ! ARGUMENTS
542      !------------------------------------------------------------------------------
543      INTEGER, INTENT(IN) :: NCID, VAR_ID, TIME_IND, DIM_LENS(:)
544      TYPE(UniformGrid_t), INTENT(IN) :: GRID
545      TYPE(TimeType_t), INTENT(IN) :: TIME
546      REAL(KIND=dp), INTENT(OUT) :: scalar
547
548      !------------------------------------------------------------------------------
549      ! VARIABLES
550      !------------------------------------------------------------------------------
551      REAL(KIND=dp), ALLOCATABLE :: data(:)
552      INTEGER, ALLOCATABLE :: singleton(:)
553      INTEGER :: alloc_stat
554
555      !------------------------------------------------------------------------------
556      ! Basic checks and data access with the constant values defined in the Grid
557      !------------------------------------------------------------------------------
558      ALLOCATE ( singleton(size(DIM_LENS)), STAT = alloc_stat )
559      IF ( alloc_stat .NE. 0 ) THEN
560        CALL Fatal('GridDataMapper','Memory ran out')
561      END IF
562      singleton = 1
563
564      IF ( .NOT. GRID % IS_DEF ) CALL Fatal('GridDataMapper',&
565                     'GetScalar requires a defined grid')
566      IF ( GRID % DIMS .LE. GRID % COORD_COUNT ) CALL Fatal('GridDataMapper',&
567                     'GetScalar requires constant values for accessing NetCDF')
568
569      IF ( GetFromNetCDF(NCID,VAR_ID,GRID % CONST_VALS(GRID % ACCESS_PERM(:)),&
570               TIME % low,TIME,DIM_LENS(GRID % ACCESS_PERM),data,singleton) ) THEN
571        scalar = data(1)
572      END IF
573
574    END SUBROUTINE GetScalar
575
576    !------------------ GetSolutionStencil() ----------------------
577    !--- Gets a square matrix starting from the lower left index, the size is defined by input matrix stencil
578    SUBROUTINE GetSolutionInStencil( NCID,VAR_ID,X_IND,TIME_IND,TIME,DIM_LENS,ACC_PERM,stencilLine,stencilSqr,stencilCube )
579    !--------------------------------------------------------------
580      USE NetCDFGeneralUtils, ONLY: TimeType_t, GetFromNetCDF
581      IMPLICIT NONE
582
583      !--- Arguments
584      INTEGER, INTENT(IN) :: NCID,X_IND(:),TIME_IND,DIM_LENS(:),VAR_ID,ACC_PERM(:)
585      TYPE(TimeType_t), INTENT(IN) :: TIME
586      REAL(KIND=dp), OPTIONAL, INTENT(INOUT) :: stencilLine(:),stencilSqr(:,:),stencilCube(:,:,:)
587
588      !--- Variables
589      INTEGER :: i,j,alloc_stat
590      REAL(KIND=dp), ALLOCATABLE :: data(:)
591      CHARACTER(len = 50) :: answ_format
592
593!      WRITE (*,*) 'Stencil ', stencil(:,1), ' ; ', stencil(:,2) ,' X: ', X,' Y: ', Y
594
595      !--- Checks that the input exists and is unique
596      IF ( PRESENT(stencilLine) .AND. (.NOT. (PRESENT(stencilSqr) .OR. PRESENT(stencilCube))) ) THEN !--- 1D
597
598        ! Queries the stencil from NetCDF with associated error checks
599        IF ( GetFromNetCDF(NCID,VAR_ID,X_IND(ACC_PERM(:)),&
600            TIME_IND,TIME,DIM_LENS(ACC_PERM(:)),data,SHAPE(stencilLine)) ) THEN
601
602          stencilLine = RESHAPE(data,SHAPE(stencilLine))
603          IF ( DEBUG_INTERP ) THEN
604            !------ Debug printouts -------------------------
605            WRITE (*,*) 'STENCIL LINE:'
606            WRITE (answ_format, *) '(', size(stencilLine,1),'(F10.4))'
607            WRITE (*,answ_format) stencilLine(:)
608            !------------------------------------------------
609          END IF
610        END IF
611
612      ELSE IF ( PRESENT(stencilSqr) .AND. (.NOT. (PRESENT(stencilLine) .OR. PRESENT(stencilCube))) ) THEN !--- 2D
613
614        ! Queries the stencil from NetCDF with associated error checks
615        IF ( GetFromNetCDF(NCID,VAR_ID,X_IND(ACC_PERM(:)),&
616TIME_IND,TIME,DIM_LENS(ACC_PERM(:)),data,SHAPE(stencilSqr)) ) THEN
617
618          stencilSqr = RESHAPE(data,SHAPE(stencilSqr))
619          IF ( DEBUG_INTERP ) THEN
620            !------ Debug printouts -------------------------
621            WRITE (*,*) 'STENCIL SQUARE:'
622            DO i = 1,size(stencilSqr,2)
623              WRITE (answ_format, *) '(', size(stencilSqr,1),'(F10.4))'
624              WRITE (*,answ_format) stencilSqr(:,i)
625            END DO
626            !------------------------------------------------
627          END IF
628        END IF
629
630      ELSE IF ( PRESENT(stencilCube) .AND. (.NOT. (PRESENT(stencilSqr) .OR. PRESENT(stencilLine))) ) THEN !--- 3D
631
632        ! Queries the stencil from NetCDF with associated error checks
633        IF ( GetFromNetCDF(NCID,VAR_ID,X_IND(ACC_PERM(:)),&
634TIME_IND,TIME,DIM_LENS(ACC_PERM(:)),data,SHAPE(stencilCube)) ) THEN
635
636         stencilCube = RESHAPE(data,SHAPE(stencilCube))
637          IF ( DEBUG_INTERP ) THEN
638            !------ Debug printouts -------------------------
639            WRITE (*,*) 'STENCIL CUBE:'
640            DO j = 1,size(stencilCube,3)
641              DO i = 1,size(stencilCube,2)
642                WRITE (answ_format, *) '(', size(stencilCube,1),'(F10.4))'
643                WRITE (*,answ_format) stencilCube(:,i,j)
644              END DO
645              WRITE(*,'(A)') '----'
646            END DO
647            !------------------------------------------------
648          END IF
649        END IF
650      ELSE
651        CALL Fatal('GridDataMapper','Multiple, or no, stencils given for GetSolutionInStencil()!')
652      END IF
653
654    END SUBROUTINE GetSolutionInStencil
655
656
657END MODULE NetCDFInterpolate
658