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