prismtrs_resize_remap_vars.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2007-2010, CERFACS, Toulouse, France.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PRISMTrs_resize_remap_vars
!
! !INTERFACE!
      subroutine prismtrs_resize_remap_vars(increment, id_epio_id, num_wts)

!-----------------------------------------------------------------------
!
!     input variables
!
!-----------------------------------------------------------------------
      USE PRISMDrv, dummy_INTERFACE => PRISMTrs_resize_remap_vars
      IMPLICIT NONE
      integer, intent(in) :: 
           increment,   ! the number of links to add(subtract) to arrays
           id_epio_id, 
           num_wts ! Number of weights for 2D conservative remapping
!
! !DESCRIPTION
!
! SUBROUTINE PRISMTrs_resize_remap_vars resizes remapping arrays by 
! increasing (decreasing) the max_links by increment. This routine
! comes from the SCRIP 1.4 library available from Los Alamos National 
! Laboratory.
!
! !REVISED HISTORY
!   Date      Programmer   Description
! ----------  ----------   -----------
! 20/03/2007  S. Valcke    Duplicated from the SCRIP library
!
! EOP
!----------------------------------------------------------------------
! $Id: prismtrs_resize_remap_vars.F90 2082 2009-10-21 13:31:19Z hanke $
! $Author: hanke $
!----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
!     local variables
!
  CHARACTER(LEN=len_cvs_string), SAVE  :: mycvs = 
     '$Id: prismtrs_resize_remap_vars.F90 2082 2009-10-21 13:31:19Z hanke $'
!-----------------------------------------------------------------------

      integer :: 
         ierr,       ! error flag
         mxlinks,    ! size of link arrays
         il_max_links_map1
      integer, dimension(:), allocatable :: 
         add1_tmp,  ! temp array for resizing address arrays
         add2_tmp  ! temp array for resizing address arrays

      double precision, dimension(:,:), allocatable :: 
         wts_tmp   ! temp array for resizing weight arrays

#ifdef VERBOSE
  PRINT *, '| | | | | | | Enter PRISMTrs_resize_remap_vars'
  call psmile_flushstd
#endif
!-----------------------------------------------------------------------
!
!     resize map 1 arrays if required.
!
!-----------------------------------------------------------------------

        !***
        !*** allocate temporaries to hold original values
        !***

        mxlinks = size(Drv_Epios(id_epio_id)%grid1_add_map1)
        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), &
                  wts_tmp(num_wts,mxlinks))

        add1_tmp = Drv_Epios(id_epio_id)%grid1_add_map1
        add2_tmp = Drv_Epios(id_epio_id)%grid2_add_map1
        wts_tmp  = Drv_Epios(id_epio_id)%wts_map1
        
        !***
        !*** deallocate originals and increment max_links then
        !*** reallocate arrays at new size
        !***

        deallocate (Drv_Epios(id_epio_id)%grid1_add_map1, &
           Drv_Epios(id_epio_id)%grid2_add_map1, &
           Drv_Epios(id_epio_id)%wts_map1)
        Drv_Epios(id_epio_id)%max_links_map1 = mxlinks + increment
        il_max_links_map1 = Drv_Epios(id_epio_id)%max_links_map1
        allocate (Drv_Epios(id_epio_id)%grid1_add_map1(il_max_links_map1), &
                  Drv_Epios(id_epio_id)%grid2_add_map1(il_max_links_map1), &
                  Drv_Epios(id_epio_id)%wts_map1(num_wts,il_max_links_map1))

        !***
        !*** restore original values from temp arrays and
        !*** deallocate temps
        !***

        mxlinks = min(mxlinks, il_max_links_map1)
        Drv_Epios(id_epio_id)%grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
        Drv_Epios(id_epio_id)%grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
        Drv_Epios(id_epio_id)%wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
        deallocate(add1_tmp, add2_tmp, wts_tmp)

#ifdef VERBOSE
  PRINT *, '| | | | | | | Quit PRISMTrs_resize_remap_vars'
  call psmile_flushstd
#endif
!-----------------------------------------------------------------------

      end subroutine prismtrs_resize_remap_vars
!-----------------------------------------------------------------------