Changeset 4877 for palm/trunk/SOURCE/netcdf_data_input_mod.f90

Timestamp:

Feb 17, 2021 4:17:35 PM (4 years ago)

Author:

suehring

Message:

Bugfix in initialization of vertical surfaces with roughness and surface heat fluxes

File:

• palm/trunk/SOURCE/netcdf_data_input_mod.f90 (modified) (4 diffs)

palm/trunk/SOURCE/netcdf_data_input_mod.f90

@@ -24 +24 @@
 ! -----------------
 ! $Id$
+! Add interface for resize_array and add subroutine to resize 2d-real arrays
+!
+! 4828 2021-01-05 11:21:41Z Giersch
 ! Check if netCDF file actually exists before opening it for reading.
 !
@@ -787 +790 @@
     END INTERFACE get_attribute
 
+    INTERFACE resize_array
+       MODULE PROCEDURE resize_array_2d_int8
+       MODULE PROCEDURE resize_array_2d_int32
+       MODULE PROCEDURE resize_array_2d_real
+       MODULE PROCEDURE resize_array_3d_int8
+       MODULE PROCEDURE resize_array_3d_real
+       MODULE PROCEDURE resize_array_4d_real
+    END INTERFACE resize_array
+
 !
 !-- Public data structures
@@ -867 +879 @@
            netcdf_data_input_surface_data,                                                         &
            netcdf_data_input_topo,                                                                 &
-           open_read_file
+           open_read_file,                                                                         &
+           resize_array
 
 
@@ -3427 +3440 @@
 
  END SUBROUTINE resize_array_2d_int32
+
+!--------------------------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Resize 2D float array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg)
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE resize_array_2d_real( var, js, je, is, ie )
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  ie  !< upper index bound along x direction
+    INTEGER(iwp) ::  is  !< lower index bound along x direction
+    INTEGER(iwp) ::  je  !< upper index bound along y direction
+    INTEGER(iwp) ::  js  !< lower index bound along y direction
+
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var     !< treated variable
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_tmp !< temporary copy
+!
+!-- Allocate temporary variable
+    ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
+!
+!-- Temporary copy of the variable
+    var_tmp(js:je,is:ie) = var(js:je,is:ie)
+!
+!-- Resize the array
+    DEALLOCATE( var )
+    ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
+!
+!-- Transfer temporary copy back to original array
+    var(js:je,is:ie) = var_tmp(js:je,is:ie)
+
+ END SUBROUTINE resize_array_2d_real