psmile_reallocate.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2010, DKRZ, Hamburg, Germany.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !
00006 ! !DESCRIPTION:
00007 !
00008 ! Module psmile_reallocate contains a C-Like realloc function for dble,
00009 ! real, and int arrays
00010 ! based on code taken from http://www.star.le.ac.uk/~cgp/f90course/f90.html
00011 ! REMARK:
00012 ! For derived data types only a shallow copying is done.
00013 !
00014 !
00015 ! !REVISION HISTORY:
00016 !
00017 !   Date      Programmer   Description
00018 ! ----------  ----------   -----------
00019 ! 13.09.10    M. Hanke     created
00020 !
00021 !----------------------------------------------------------------------
00022 !
00023 !  $Id: psmile_reallocate.F90 3054 2011-03-24 09:49:48Z hanke $
00024 !  $Author: hanke $
00025 !
00026 !----------------------------------------------------------------------
00027 
00028 module psmile_reallocate
00029 
00030    use prism_constants, only : PRISM_Error_Alloc, PRISM_Error_Dealloc
00031    use psmile, only : psmile_error, send_information, &
00032                       recv_information, send_appl_information, &
00033                       send_field_information, recv_field_information, &
00034                       ch_ptr, psmile_time_struct
00035    use psmile_user_data, only : user_grid_data, user_point_data, &
00036                                 user_mask_data, user_var_data
00037 
00038    implicit none
00039 
00040    private ! by default everything is private in this module
00041 
00042    interface psmile_realloc
00043       module procedure psmile_reallocate_dble,   &
00044                        psmile_reallocate_real,   &
00045                        psmile_reallocate_int,    &
00046                        psmile_reallocate_int_2d, &
00047                        psmile_reallocate_log,    &
00048                        psmile_reallocate_si,     &
00049                        psmile_reallocate_ri,     &
00050                        psmile_reallocate_sai,    &
00051                        psmile_reallocate_sfi,    &
00052                        psmile_reallocate_rfi,    &
00053                        psmile_reallocate_ugd,    &
00054                        psmile_reallocate_upd,    &
00055                        psmile_reallocate_umd,    &
00056                        psmile_reallocate_uvd,    &
00057                        psmile_reallocate_cp,     &
00058                        psmile_reallocate_ts
00059 
00060    end interface
00061 
00062    public :: psmile_realloc
00063 
00064    contains
00065 
00066       function psmile_reallocate_dble(p, n)
00067          double precision, pointer, dimension(:) :: p, psmile_reallocate_dble
00068          integer, intent(in) :: n
00069          integer :: nold
00070          integer, parameter :: nerrp = 2
00071          integer :: ierror, ierrp (nerrp)
00072 
00073          allocate(psmile_reallocate_dble(1:n), stat=ierror)
00074 
00075          if (ierror > 0) then
00076             ierrp (1) = ierror
00077             ierrp (2) = n
00078             ierror = PRISM_Error_Alloc
00079 
00080             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00081                   ierrp, 2, __FILE__, __LINE__ )
00082             return
00083          endif
00084 
00085          if(.not. associated(p)) return
00086          ! get old size
00087          nold = min(size(p), n)
00088          !  ... keep old values
00089          if (nold > 0 .and. n > 0) psmile_reallocate_dble(1:nold) = p(1:nold)
00090 
00091          deallocate(p, stat = ierror)
00092 
00093          if (ierror > 0) then
00094             ierrp (1) = ierror
00095             ierror = PRISM_Error_Dealloc
00096 
00097             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00098                   ierrp, 1, __FILE__, __LINE__ )
00099             return
00100          endif
00101       end function psmile_reallocate_dble
00102 
00103       function psmile_reallocate_real(p, n)
00104          real, pointer, dimension(:) :: p, psmile_reallocate_real
00105          integer, intent(in) :: n
00106          integer :: nold
00107          integer, parameter :: nerrp = 2
00108          integer :: ierror, ierrp (nerrp)
00109 
00110          allocate(psmile_reallocate_real(1:n), stat=ierror)
00111 
00112          if (ierror > 0) then
00113             ierrp (1) = ierror
00114             ierrp (2) = n
00115             ierror = PRISM_Error_Alloc
00116 
00117             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00118                   ierrp, 2, __FILE__, __LINE__ )
00119             return
00120          endif
00121 
00122          if(.not. associated(p)) return
00123          ! get old size
00124          nold = min(size(p), n)
00125          !  ... keep old values
00126          if (nold > 0 .and. n > 0) psmile_reallocate_real(1:nold) = p(1:nold)
00127 
00128          deallocate(p, stat = ierror)
00129 
00130          if (ierror > 0) then
00131             ierrp (1) = ierror
00132             ierror = PRISM_Error_Dealloc
00133 
00134             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00135                   ierrp, 1, __FILE__, __LINE__ )
00136             return
00137          endif
00138       end function psmile_reallocate_real
00139 
00140       function psmile_reallocate_int(p, n)
00141          integer, pointer, dimension(:) :: p, psmile_reallocate_int
00142          integer, intent(in) :: n
00143          integer :: nold
00144          integer, parameter :: nerrp = 2
00145          integer :: ierror, ierrp (nerrp)
00146 
00147          allocate(psmile_reallocate_int(1:n), stat=ierror)
00148 
00149          if (ierror > 0) then
00150             ierrp (1) = ierror
00151             ierrp (2) = n
00152             ierror = PRISM_Error_Alloc
00153 
00154             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00155                   ierrp, 2, __FILE__, __LINE__ )
00156             return
00157          endif
00158 
00159          if(.not. associated(p)) return
00160          ! get old size
00161          nold = min(size(p), n)
00162          !  ... keep old values
00163          if (nold > 0 .and. n > 0) psmile_reallocate_int(1:nold) = p(1:nold)
00164 
00165          deallocate(p, stat = ierror)
00166 
00167          if (ierror > 0) then
00168             ierrp (1) = ierror
00169             ierror = PRISM_Error_Dealloc
00170 
00171             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00172                   ierrp, 1, __FILE__, __LINE__ )
00173             return
00174          endif
00175       end function psmile_reallocate_int
00176 
00177       function psmile_reallocate_int_2d(p, n_2d)
00178 
00179          implicit none
00180 
00181          integer, pointer, dimension(:,:) :: p, psmile_reallocate_int_2d
00182          integer, intent(in) :: n_2d(2)
00183          integer :: nold_2d(2)
00184          integer, parameter :: nerrp = 2
00185          integer :: ierror, ierrp (nerrp)
00186 
00187          allocate(psmile_reallocate_int_2d(1:n_2d(1), 1:n_2d(2)), stat=ierror)
00188 
00189          if (ierror > 0) then
00190             ierrp (1) = ierror
00191             ierrp (2) = product(n_2d(:))
00192             ierror = PRISM_Error_Alloc
00193 
00194             call psmile_error ( ierror, 'psmile_reallocate_int_2d', &
00195                   ierrp, 2, __FILE__, __LINE__ )
00196             return
00197          endif
00198 
00199          if(.not. associated(p)) return
00200          ! get old size
00201          nold_2d(1) = min(size(p,1), n_2d(1))
00202          nold_2d(2) = min(size(p,2), n_2d(2))
00203          !  ... keep old values
00204          if (all(nold_2d(:) > 0) .and. all(n_2d(:) > 0)) &
00205             psmile_reallocate_int_2d(1:nold_2d(1), 1:nold_2d(2)) = p(1:nold_2d(1), 1:nold_2d(2))
00206 
00207          deallocate(p, stat = ierror)
00208 
00209          if (ierror > 0) then
00210             ierrp (1) = ierror
00211             ierror = PRISM_Error_Dealloc
00212 
00213             call psmile_error ( ierror, 'psmile_reallocate_int_2d', &
00214                   ierrp, 1, __FILE__, __LINE__ )
00215             return
00216          endif
00217       end function psmile_reallocate_int_2d
00218 
00219       function psmile_reallocate_log(p, n)
00220          logical, pointer, dimension(:) :: p, psmile_reallocate_log
00221          integer, intent(in) :: n
00222          integer :: nold
00223          integer, parameter :: nerrp = 2
00224          integer :: ierror, ierrp (nerrp)
00225 
00226          allocate(psmile_reallocate_log(1:n), stat=ierror)
00227 
00228          if (ierror > 0) then
00229             ierrp (1) = ierror
00230             ierrp (2) = n
00231             ierror = PRISM_Error_Alloc
00232 
00233             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00234                   ierrp, 2, __FILE__, __LINE__ )
00235             return
00236          endif
00237 
00238          if(.not. associated(p)) return
00239          ! get old size
00240          nold = min(size(p), n)
00241          !  ... keep old values
00242          if (nold > 0 .and. n > 0) psmile_reallocate_log(1:nold) = p(1:nold)
00243 
00244          deallocate(p, stat = ierror)
00245 
00246          if (ierror > 0) then
00247             ierrp (1) = ierror
00248             ierror = PRISM_Error_Dealloc
00249 
00250             call psmile_error ( ierror, 'psmile_reallocate_dble', &
00251                   ierrp, 1, __FILE__, __LINE__ )
00252             return
00253          endif
00254       end function psmile_reallocate_log
00255 
00256       function psmile_reallocate_sai(p, n)
00257          type (send_appl_information), pointer, dimension(:) :: p, psmile_reallocate_sai
00258          integer, intent(in) :: n
00259          integer :: nold
00260          integer, parameter :: nerrp = 2
00261          integer :: ierror, ierrp (nerrp)
00262 
00263          allocate(psmile_reallocate_sai(1:n), stat=ierror)
00264 
00265          if (ierror > 0) then
00266             ierrp (1) = ierror
00267             ierrp (2) = n
00268             ierror = PRISM_Error_Alloc
00269 
00270             call psmile_error ( ierror, 'psmile_reallocate_sai', &
00271                   ierrp, 2, __FILE__, __LINE__ )
00272             return
00273          endif
00274 
00275          if(.not. associated(p)) return
00276          ! get old size
00277          nold = min(size(p), n)
00278          !  ... keep old values
00279          if (nold > 0 .and. n > 0) psmile_reallocate_sai(1:nold) = p(1:nold)
00280 
00281          deallocate(p, stat = ierror)
00282 
00283          if (ierror > 0) then
00284             ierrp (1) = ierror
00285             ierror = PRISM_Error_Dealloc
00286 
00287             call psmile_error ( ierror, 'psmile_reallocate_sai', &
00288                   ierrp, 1, __FILE__, __LINE__ )
00289             return
00290          endif
00291       end function psmile_reallocate_sai
00292 
00293       function psmile_reallocate_si(p, n)
00294          type (send_information), pointer, dimension(:) :: p, psmile_reallocate_si
00295          integer, intent(in) :: n
00296          integer :: nold
00297          integer, parameter :: nerrp = 2
00298          integer :: ierror, ierrp (nerrp)
00299 
00300          allocate(psmile_reallocate_si(1:n), stat=ierror)
00301 
00302          if (ierror > 0) then
00303             ierrp (1) = ierror
00304             ierrp (2) = n
00305             ierror = PRISM_Error_Alloc
00306 
00307             call psmile_error ( ierror, 'psmile_reallocate_si', &
00308                   ierrp, 2, __FILE__, __LINE__ )
00309             return
00310          endif
00311 
00312          if(.not. associated(p)) return
00313          ! get old size
00314          nold = min(size(p), n)
00315          !  ... keep old values
00316          if (nold > 0 .and. n > 0) psmile_reallocate_si(1:nold) = p(1:nold)
00317 
00318          deallocate(p, stat = ierror)
00319 
00320          if (ierror > 0) then
00321             ierrp (1) = ierror
00322             ierror = PRISM_Error_Dealloc
00323 
00324             call psmile_error ( ierror, 'psmile_reallocate_si', &
00325                   ierrp, 1, __FILE__, __LINE__ )
00326             return
00327          endif
00328       end function psmile_reallocate_si
00329 
00330       function psmile_reallocate_ri(p, n)
00331          type (recv_information), pointer, dimension(:) :: p, psmile_reallocate_ri
00332          integer, intent(in) :: n
00333          integer :: nold
00334          integer, parameter :: nerrp = 2
00335          integer :: ierror, ierrp (nerrp)
00336 
00337          allocate(psmile_reallocate_ri(1:n), stat=ierror)
00338 
00339          if (ierror > 0) then
00340             ierrp (1) = ierror
00341             ierrp (2) = n
00342             ierror = PRISM_Error_Alloc
00343 
00344             call psmile_error ( ierror, 'psmile_reallocate_ri', &
00345                   ierrp, 2, __FILE__, __LINE__ )
00346             return
00347          endif
00348 
00349          if(.not. associated(p)) return
00350          ! get old size
00351          nold = min(size(p), n)
00352          !  ... keep old values
00353          if (nold > 0 .and. n > 0) psmile_reallocate_ri(1:nold) = p(1:nold)
00354 
00355          deallocate(p, stat = ierror)
00356 
00357          if (ierror > 0) then
00358             ierrp (1) = ierror
00359             ierror = PRISM_Error_Dealloc
00360 
00361             call psmile_error ( ierror, 'psmile_reallocate_ri', &
00362                   ierrp, 1, __FILE__, __LINE__ )
00363             return
00364          endif
00365       end function psmile_reallocate_ri
00366 
00367       function psmile_reallocate_sfi(p, n)
00368          type (send_field_information), pointer, dimension(:) :: p, psmile_reallocate_sfi
00369          integer, intent(in) :: n
00370          integer :: nold
00371          integer, parameter :: nerrp = 2
00372          integer :: ierror, ierrp (nerrp)
00373 
00374          allocate(psmile_reallocate_sfi(1:n), stat=ierror)
00375 
00376          if (ierror > 0) then
00377             ierrp (1) = ierror
00378             ierrp (2) = n
00379             ierror = PRISM_Error_Alloc
00380 
00381             call psmile_error ( ierror, 'psmile_reallocate_sfi', &
00382                   ierrp, 2, __FILE__, __LINE__ )
00383             return
00384          endif
00385 
00386          if(.not. associated(p)) return
00387          ! get old size
00388          nold = min(size(p), n)
00389          !  ... keep old values
00390          if (nold > 0 .and. n > 0) psmile_reallocate_sfi(1:nold) = p(1:nold)
00391 
00392          deallocate(p, stat = ierror)
00393 
00394          if (ierror > 0) then
00395             ierrp (1) = ierror
00396             ierror = PRISM_Error_Dealloc
00397 
00398             call psmile_error ( ierror, 'psmile_reallocate_sfi', &
00399                   ierrp, 1, __FILE__, __LINE__ )
00400             return
00401          endif
00402       end function psmile_reallocate_sfi
00403 
00404       function psmile_reallocate_rfi(p, n)
00405          type (recv_field_information), pointer, dimension(:) :: p, psmile_reallocate_rfi
00406          integer, intent(in) :: n
00407          integer :: nold
00408          integer, parameter :: nerrp = 2
00409          integer :: ierror, ierrp (nerrp)
00410 
00411          allocate(psmile_reallocate_rfi(1:n), stat=ierror)
00412 
00413          if (ierror > 0) then
00414             ierrp (1) = ierror
00415             ierrp (2) = n
00416             ierror = PRISM_Error_Alloc
00417 
00418             call psmile_error ( ierror, 'psmile_reallocate_rfi', &
00419                   ierrp, 2, __FILE__, __LINE__ )
00420             return
00421          endif
00422 
00423          if(.not. associated(p)) return
00424          ! get old size
00425          nold = min(size(p), n)
00426          !  ... keep old values
00427          if (nold > 0 .and. n > 0) psmile_reallocate_rfi(1:nold) = p(1:nold)
00428 
00429          deallocate(p, stat = ierror)
00430 
00431          if (ierror > 0) then
00432             ierrp (1) = ierror
00433             ierror = PRISM_Error_Dealloc
00434 
00435             call psmile_error ( ierror, 'psmile_reallocate_rfi', &
00436                   ierrp, 1, __FILE__, __LINE__ )
00437             return
00438          endif
00439       end function psmile_reallocate_rfi
00440 
00441       function psmile_reallocate_ugd(p, n)
00442          type (user_grid_data), pointer, dimension(:) :: p, psmile_reallocate_ugd
00443          integer, intent(in) :: n
00444          integer :: nold
00445          integer, parameter :: nerrp = 2
00446          integer :: ierror, ierrp (nerrp)
00447 
00448          allocate(psmile_reallocate_ugd(1:n), stat=ierror)
00449 
00450          if (ierror > 0) then
00451             ierrp (1) = ierror
00452             ierrp (2) = n
00453             ierror = PRISM_Error_Alloc
00454 
00455             call psmile_error ( ierror, 'psmile_reallocate_ugd', &
00456                   ierrp, 2, __FILE__, __LINE__ )
00457             return
00458          endif
00459 
00460          if(.not. associated(p)) return
00461          ! get old size
00462          nold = min(size(p), n)
00463          !  ... keep old values
00464          if (nold > 0 .and. n > 0) psmile_reallocate_ugd(1:nold) = p(1:nold)
00465 
00466          deallocate(p, stat = ierror)
00467 
00468          if (ierror > 0) then
00469             ierrp (1) = ierror
00470             ierror = PRISM_Error_Dealloc
00471 
00472             call psmile_error ( ierror, 'psmile_reallocate_ugd', &
00473                   ierrp, 1, __FILE__, __LINE__ )
00474             return
00475          endif
00476       end function psmile_reallocate_ugd
00477 
00478       function psmile_reallocate_upd(p, n)
00479          type (user_point_data), pointer, dimension(:) :: p, psmile_reallocate_upd
00480          integer, intent(in) :: n
00481          integer :: nold
00482          integer, parameter :: nerrp = 2
00483          integer :: ierror, ierrp (nerrp)
00484 
00485          allocate(psmile_reallocate_upd(1:n), stat=ierror)
00486 
00487          if (ierror > 0) then
00488             ierrp (1) = ierror
00489             ierrp (2) = n
00490             ierror = PRISM_Error_Alloc
00491 
00492             call psmile_error ( ierror, 'psmile_reallocate_upd', &
00493                   ierrp, 2, __FILE__, __LINE__ )
00494             return
00495          endif
00496 
00497          if(.not. associated(p)) return
00498          ! get old size
00499          nold = min(size(p), n)
00500          !  ... keep old values
00501          if (nold > 0 .and. n > 0) psmile_reallocate_upd(1:nold) = p(1:nold)
00502 
00503          deallocate(p, stat = ierror)
00504 
00505          if (ierror > 0) then
00506             ierrp (1) = ierror
00507             ierror = PRISM_Error_Dealloc
00508 
00509             call psmile_error ( ierror, 'psmile_reallocate_upd', &
00510                   ierrp, 1, __FILE__, __LINE__ )
00511             return
00512          endif
00513       end function psmile_reallocate_upd
00514 
00515       function psmile_reallocate_umd(p, n)
00516          type (user_mask_data), pointer, dimension(:) :: p, psmile_reallocate_umd
00517          integer, intent(in) :: n
00518          integer :: nold
00519          integer, parameter :: nerrp = 2
00520          integer :: ierror, ierrp (nerrp)
00521 
00522          allocate(psmile_reallocate_umd(1:n), stat=ierror)
00523 
00524          if (ierror > 0) then
00525             ierrp (1) = ierror
00526             ierrp (2) = n
00527             ierror = PRISM_Error_Alloc
00528 
00529             call psmile_error ( ierror, 'psmile_reallocate_umd', &
00530                   ierrp, 2, __FILE__, __LINE__ )
00531             return
00532          endif
00533 
00534          if(.not. associated(p)) return
00535          ! get old size
00536          nold = min(size(p), n)
00537          !  ... keep old values
00538          if (nold > 0 .and. n > 0) psmile_reallocate_umd(1:nold) = p(1:nold)
00539 
00540          deallocate(p, stat = ierror)
00541 
00542          if (ierror > 0) then
00543             ierrp (1) = ierror
00544             ierror = PRISM_Error_Dealloc
00545 
00546             call psmile_error ( ierror, 'psmile_reallocate_umd', &
00547                   ierrp, 1, __FILE__, __LINE__ )
00548             return
00549          endif
00550       end function psmile_reallocate_umd
00551 
00552       function psmile_reallocate_uvd(p, n)
00553          type (user_var_data), pointer, dimension(:) :: p, psmile_reallocate_uvd
00554          integer, intent(in) :: n
00555          integer :: nold
00556          integer, parameter :: nerrp = 2
00557          integer :: ierror, ierrp (nerrp)
00558 
00559          allocate(psmile_reallocate_uvd(1:n), stat=ierror)
00560 
00561          if (ierror > 0) then
00562             ierrp (1) = ierror
00563             ierrp (2) = n
00564             ierror = PRISM_Error_Alloc
00565 
00566             call psmile_error ( ierror, 'psmile_reallocate_uvd', &
00567                   ierrp, 2, __FILE__, __LINE__ )
00568             return
00569          endif
00570 
00571          if(.not. associated(p)) return
00572          ! get old size
00573          nold = min(size(p), n)
00574          !  ... keep old values
00575          if (nold > 0 .and. n > 0) psmile_reallocate_uvd(1:nold) = p(1:nold)
00576 
00577          deallocate(p, stat = ierror)
00578 
00579          if (ierror > 0) then
00580             ierrp (1) = ierror
00581             ierror = PRISM_Error_Dealloc
00582 
00583             call psmile_error ( ierror, 'psmile_reallocate_uvd', &
00584                   ierrp, 1, __FILE__, __LINE__ )
00585             return
00586          endif
00587       end function psmile_reallocate_uvd
00588 
00589       function psmile_reallocate_cp(p, n)
00590          type (ch_ptr), pointer, dimension(:) :: p, psmile_reallocate_cp
00591          integer, intent(in) :: n
00592          integer :: nold
00593          integer, parameter :: nerrp = 2
00594          integer :: ierror, ierrp (nerrp)
00595 
00596          allocate(psmile_reallocate_cp(1:n), stat=ierror)
00597 
00598          if (ierror > 0) then
00599             ierrp (1) = ierror
00600             ierrp (2) = n
00601             ierror = PRISM_Error_Alloc
00602 
00603             call psmile_error ( ierror, 'psmile_reallocate_cp', &
00604                   ierrp, 2, __FILE__, __LINE__ )
00605             return
00606          endif
00607 
00608          if(.not. associated(p)) return
00609          ! get old size
00610          nold = min(size(p), n)
00611          !  ... keep old values
00612          if (nold > 0 .and. n > 0) psmile_reallocate_cp(1:nold) = p(1:nold)
00613 
00614          deallocate(p, stat = ierror)
00615 
00616          if (ierror > 0) then
00617             ierrp (1) = ierror
00618             ierror = PRISM_Error_Dealloc
00619 
00620             call psmile_error ( ierror, 'psmile_reallocate_cp', &
00621                   ierrp, 1, __FILE__, __LINE__ )
00622             return
00623          endif
00624       end function psmile_reallocate_cp
00625 
00626       function psmile_reallocate_ts(p, n)
00627          type (psmile_time_struct), pointer, dimension(:) :: p, psmile_reallocate_ts
00628          integer, intent(in) :: n
00629          integer :: nold
00630          integer, parameter :: nerrp = 2
00631          integer :: ierror, ierrp (nerrp)
00632 
00633          allocate(psmile_reallocate_ts(1:n), stat=ierror)
00634 
00635          if (ierror > 0) then
00636             ierrp (1) = ierror
00637             ierrp (2) = n
00638             ierror = PRISM_Error_Alloc
00639 
00640             call psmile_error ( ierror, 'psmile_reallocate_ts', &
00641                   ierrp, 2, __FILE__, __LINE__ )
00642             return
00643          endif
00644 
00645          if(.not. associated(p)) return
00646          ! get old size
00647          nold = min(size(p), n)
00648          !  ... keep old values
00649          if (nold > 0 .and. n > 0) psmile_reallocate_ts(1:nold) = p(1:nold)
00650 
00651          deallocate(p, stat = ierror)
00652 
00653          if (ierror > 0) then
00654             ierrp (1) = ierror
00655             ierror = PRISM_Error_Dealloc
00656 
00657             call psmile_error ( ierror, 'psmile_reallocate_ts', &
00658                   ierrp, 1, __FILE__, __LINE__ )
00659             return
00660          endif
00661       end function psmile_reallocate_ts
00662 
00663 end module psmile_reallocate