303 lines
10 KiB
Fortran
Executable File
303 lines
10 KiB
Fortran
Executable File
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
!
|
|
! this module contains necessary variables for remapping between
|
|
! two grids. also routines for resizing and initializing these
|
|
! variables.
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $
|
|
!
|
|
! Copyright (c) 1997, 1998 the Regents of the University of
|
|
! California.
|
|
!
|
|
! This software and ancillary information (herein called software)
|
|
! called SCRIP is made available under the terms described here.
|
|
! The software has been approved for release with associated
|
|
! LA-CC Number 98-45.
|
|
!
|
|
! Unless otherwise indicated, this software has been authored
|
|
! by an employee or employees of the University of California,
|
|
! operator of the Los Alamos National Laboratory under Contract
|
|
! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S.
|
|
! Government has rights to use, reproduce, and distribute this
|
|
! software. The public may copy and use this software without
|
|
! charge, provided that this Notice and any statement of authorship
|
|
! are reproduced on all copies. Neither the Government nor the
|
|
! University makes any warranty, express or implied, or assumes
|
|
! any liability or responsibility for the use of this software.
|
|
!
|
|
! If software is modified to produce derivative works, such modified
|
|
! software should be clearly marked, so as not to confuse it with
|
|
! the version available from Los Alamos National Laboratory.
|
|
!
|
|
!***********************************************************************
|
|
|
|
module remap_vars
|
|
|
|
use kinds_mod
|
|
use constants
|
|
use grids
|
|
|
|
implicit none
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! module variables
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
integer (kind=int_kind), parameter ::
|
|
& norm_opt_none = 1
|
|
&, norm_opt_dstarea = 2
|
|
&, norm_opt_frcarea = 3
|
|
|
|
integer (kind=int_kind), parameter ::
|
|
& map_type_conserv = 1
|
|
&, map_type_bilinear = 2
|
|
&, map_type_bicubic = 3
|
|
&, map_type_distwgt = 4
|
|
|
|
integer (kind=int_kind), save ::
|
|
& max_links_map1 ! current size of link arrays
|
|
&, num_links_map1 ! actual number of links for remapping
|
|
&, max_links_map2 ! current size of link arrays
|
|
&, num_links_map2 ! actual number of links for remapping
|
|
&, num_maps ! num of remappings for this grid pair
|
|
&, num_wts ! num of weights used in remapping
|
|
&, map_type ! identifier for remapping method
|
|
&, norm_opt ! option for normalization (conserv only)
|
|
&, resize_increment ! default amount to increase array size
|
|
|
|
integer (kind=int_kind), dimension(:), allocatable, save ::
|
|
& grid1_add_map1, ! grid1 address for each link in mapping 1
|
|
& grid2_add_map1, ! grid2 address for each link in mapping 1
|
|
& grid1_add_map2, ! grid1 address for each link in mapping 2
|
|
& grid2_add_map2 ! grid2 address for each link in mapping 2
|
|
|
|
real (kind=dbl_kind), dimension(:,:), allocatable, save ::
|
|
& wts_map1, ! map weights for each link (num_wts,max_links)
|
|
& wts_map2 ! map weights for each link (num_wts,max_links)
|
|
|
|
!***********************************************************************
|
|
|
|
contains
|
|
|
|
!***********************************************************************
|
|
|
|
subroutine init_remap_vars
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! this routine initializes some variables and provides an initial
|
|
! allocation of arrays (fairly large so frequent resizing
|
|
! unnecessary).
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! determine the number of weights
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
select case (map_type)
|
|
case(map_type_conserv)
|
|
num_wts = 3
|
|
case(map_type_bilinear)
|
|
num_wts = 1
|
|
case(map_type_bicubic)
|
|
num_wts = 4
|
|
case(map_type_distwgt)
|
|
num_wts = 1
|
|
end select
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! initialize num_links and set max_links to four times the largest
|
|
! of the destination grid sizes initially (can be changed later).
|
|
! set a default resize increment to increase the size of link
|
|
! arrays if the number of links exceeds the initial size
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
num_links_map1 = 0
|
|
max_links_map1 = 4*grid2_size
|
|
if (num_maps > 1) then
|
|
num_links_map2 = 0
|
|
max_links_map1 = max(4*grid1_size,4*grid2_size)
|
|
max_links_map2 = max_links_map1
|
|
endif
|
|
|
|
resize_increment = 0.1*max(grid1_size,grid2_size)
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! allocate address and weight arrays for mapping 1
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
allocate (grid1_add_map1(max_links_map1),
|
|
& grid2_add_map1(max_links_map1),
|
|
& wts_map1(num_wts, max_links_map1))
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! allocate address and weight arrays for mapping 2 if necessary
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
if (num_maps > 1) then
|
|
allocate (grid1_add_map2(max_links_map2),
|
|
& grid2_add_map2(max_links_map2),
|
|
& wts_map2(num_wts, max_links_map2))
|
|
endif
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
end subroutine init_remap_vars
|
|
|
|
!***********************************************************************
|
|
|
|
subroutine resize_remap_vars(nmap, increment)
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! this routine resizes remapping arrays by increasing(decreasing)
|
|
! the max_links by increment
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! input variables
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
integer (kind=int_kind), intent(in) ::
|
|
& nmap, ! identifies which mapping array to resize
|
|
& increment ! the number of links to add(subtract) to arrays
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! local variables
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
integer (kind=int_kind) ::
|
|
& ierr, ! error flag
|
|
& mxlinks ! size of link arrays
|
|
|
|
integer (kind=int_kind), dimension(:), allocatable ::
|
|
& add1_tmp, ! temp array for resizing address arrays
|
|
& add2_tmp ! temp array for resizing address arrays
|
|
|
|
real (kind=dbl_kind), dimension(:,:), allocatable ::
|
|
& wts_tmp ! temp array for resizing weight arrays
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! resize map 1 arrays if required.
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
select case (nmap)
|
|
case(1)
|
|
|
|
!***
|
|
!*** allocate temporaries to hold original values
|
|
!***
|
|
|
|
mxlinks = size(grid1_add_map1)
|
|
allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),
|
|
& wts_tmp(num_wts,mxlinks))
|
|
|
|
add1_tmp = grid1_add_map1
|
|
add2_tmp = grid2_add_map1
|
|
wts_tmp = wts_map1
|
|
|
|
!***
|
|
!*** deallocate originals and increment max_links then
|
|
!*** reallocate arrays at new size
|
|
!***
|
|
|
|
deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
|
|
max_links_map1 = mxlinks + increment
|
|
allocate (grid1_add_map1(max_links_map1),
|
|
& grid2_add_map1(max_links_map1),
|
|
& wts_map1(num_wts,max_links_map1))
|
|
|
|
!***
|
|
!*** restore original values from temp arrays and
|
|
!*** deallocate temps
|
|
!***
|
|
|
|
mxlinks = min(mxlinks, max_links_map1)
|
|
grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
|
|
grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
|
|
wts_map1 (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
|
|
deallocate(add1_tmp, add2_tmp, wts_tmp)
|
|
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! resize map 2 arrays if required.
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
case(2)
|
|
|
|
!***
|
|
!*** allocate temporaries to hold original values
|
|
!***
|
|
|
|
mxlinks = size(grid1_add_map2)
|
|
allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),
|
|
& wts_tmp(num_wts,mxlinks),stat=ierr)
|
|
if (ierr .ne. 0) then
|
|
print *,'error allocating temps in resize: ',ierr
|
|
stop
|
|
endif
|
|
|
|
add1_tmp = grid1_add_map2
|
|
add2_tmp = grid2_add_map2
|
|
wts_tmp = wts_map2
|
|
|
|
!***
|
|
!*** deallocate originals and increment max_links then
|
|
!*** reallocate arrays at new size
|
|
!***
|
|
|
|
deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
|
|
max_links_map2 = mxlinks + increment
|
|
allocate (grid1_add_map2(max_links_map2),
|
|
& grid2_add_map2(max_links_map2),
|
|
& wts_map2(num_wts,max_links_map2),stat=ierr)
|
|
if (ierr .ne. 0) then
|
|
print *,'error allocating new arrays in resize: ',ierr
|
|
stop
|
|
endif
|
|
|
|
|
|
!***
|
|
!*** restore original values from temp arrays and
|
|
!*** deallocate temps
|
|
!***
|
|
|
|
mxlinks = min(mxlinks, max_links_map2)
|
|
grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks)
|
|
grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks)
|
|
wts_map2 (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
|
|
deallocate(add1_tmp, add2_tmp, wts_tmp)
|
|
|
|
end select
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
end subroutine resize_remap_vars
|
|
|
|
!***********************************************************************
|
|
|
|
end module remap_vars
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|