prismtrs_deallocate.F90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------
00002 ! Copyright 2007-2010, CERFACS, Toulouse, France.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PRISMTrs_deallocate
00008 !
00009 ! !INTERFACE
00010 subroutine prismtrs_deallocate(id_err)
00011 
00012 !
00013 ! !USES:
00014 !
00015   USE PRISMDrv, dummy_interface => PRISMTrs_deallocate
00016 
00017   IMPLICIT NONE
00018 
00019   Integer, Intent (Out) :: id_err
00020 
00021 ! !DESCRIPTION
00022 ! Routine to deallocate global array at the end of the run
00023 !
00024 ! !REVISED HISTORY
00025 !   Date      Programmer   Description
00026 ! ----------  ----------   -----------
00027 ! 02/19/2007  S. Valcke    Created
00028 !
00029 ! EOP
00030 !----------------------------------------------------------------------
00031 ! $Id: prismtrs_deallocate.F90 2082 2009-10-21 13:31:19Z hanke $
00032 ! $Author: hanke $
00033 !----------------------------------------------------------------------
00034 !
00035 ! 0. Local declarations
00036 !
00037   CHARACTER(LEN=len_cvs_string), SAVE  :: mycvs = 
00038      '$Id: prismtrs_deallocate.F90 2082 2009-10-21 13:31:19Z hanke $'
00039   INTEGER  :: ib
00040 
00041 ! ---------------------------------------------------------------------
00042 
00043 #ifdef VERBOSE
00044   PRINT *, '| | | | | Enter PRISMTrs_deallocate'
00045   call psmile_flushstd
00046 #endif
00047 
00048   id_err = 0
00049 !
00050 ! Deallocate EPIOs structure
00051   DO ib = 1, Number_of_Epios_allocated
00052     IF (ASSOCIATED(Drv_Epios(ib)%weights))             &
00053        DEALLOCATE (Drv_Epios(ib)%weights)
00054     IF (ASSOCIATED(Drv_Epios(ib)%tgt_lat_pointer_real)) &
00055        DEALLOCATE (Drv_Epios(ib)%tgt_lat_pointer_real)
00056     IF (ASSOCIATED(Drv_Epios(ib)%tgt_lon_pointer_real)) &
00057        DEALLOCATE (Drv_Epios(ib)%tgt_lon_pointer_real)
00058     IF (ASSOCIATED(Drv_Epios(ib)%tgt_z_pointer_real)) &
00059        DEALLOCATE (Drv_Epios(ib)%tgt_z_pointer_real)
00060     IF (ASSOCIATED(Drv_Epios(ib)%tgt_lat_pointer_dble)) &
00061        DEALLOCATE (Drv_Epios(ib)%tgt_lat_pointer_dble)
00062     IF (ASSOCIATED(Drv_Epios(ib)%tgt_lon_pointer_dble)) &
00063        DEALLOCATE (Drv_Epios(ib)%tgt_lon_pointer_dble)
00064     IF (ASSOCIATED(Drv_Epios(ib)%tgt_z_pointer_dble)) &
00065        DEALLOCATE (Drv_Epios(ib)%tgt_z_pointer_dble)
00066     IF (ASSOCIATED(Drv_Epios(ib)%tgt_mask_pointer)) &
00067        DEALLOCATE (Drv_Epios(ib)%tgt_mask_pointer)
00068 
00069     IF (ASSOCIATED(Drv_Epios(ib)%src_lat_pointer_real)) &
00070        DEALLOCATE (Drv_Epios(ib)%src_lat_pointer_real)
00071     IF (ASSOCIATED(Drv_Epios(ib)%src_lon_pointer_real)) &
00072        DEALLOCATE (Drv_Epios(ib)%src_lon_pointer_real)
00073     IF (ASSOCIATED(Drv_Epios(ib)%src_z_pointer_real)) &
00074        DEALLOCATE (Drv_Epios(ib)%src_z_pointer_real)
00075     IF (ASSOCIATED(Drv_Epios(ib)%src_lat_pointer_dble)) &
00076        DEALLOCATE (Drv_Epios(ib)%src_lat_pointer_dble)
00077     IF (ASSOCIATED(Drv_Epios(ib)%src_lon_pointer_dble)) &
00078        DEALLOCATE (Drv_Epios(ib)%src_lon_pointer_dble)
00079     IF (ASSOCIATED(Drv_Epios(ib)%src_z_pointer_dble)) &
00080        DEALLOCATE (Drv_Epios(ib)%src_z_pointer_dble)
00081     IF (ASSOCIATED(Drv_Epios(ib)%src_mask_pointer)) &
00082        DEALLOCATE (Drv_Epios(ib)%src_mask_pointer)
00083 
00084     IF (ASSOCIATED(Drv_Epios(ib)%index_array)) &
00085        DEALLOCATE (Drv_Epios(ib)%index_array)
00086     IF (ASSOCIATED(Drv_Epios(ib)%nbsrccells_pertgtpt)) &
00087        DEALLOCATE (Drv_Epios(ib)%nbsrccells_pertgtpt)
00088     IF (ASSOCIATED(Drv_Epios(ib)%srcepio_add)) &
00089        DEALLOCATE (Drv_Epios(ib)%srcepio_add)
00090 
00091     IF (ASSOCIATED(Drv_Epios(ib)%grid1_add_map1)) &
00092        DEALLOCATE (Drv_Epios(ib)%grid1_add_map1)
00093     IF (ASSOCIATED(Drv_Epios(ib)%grid2_add_map1)) &
00094        DEALLOCATE (Drv_Epios(ib)%grid2_add_map1)
00095     IF (ASSOCIATED(Drv_Epios(ib)%wts_map1)) &
00096        DEALLOCATE (Drv_Epios(ib)%wts_map1)
00097 
00098   ENDDO
00099   IF (ASSOCIATED(Drv_Epios)) DEALLOCATE (Drv_Epios)
00100 !
00101 ! Deallocate Exchange structure
00102   DO ib = 1, Number_of_Exchanges
00103     IF (Drv_Exchanges(ib)%trans_in_field_type == PRISM_Double_Precision) THEN
00104         IF (ASSOCIATED(Drv_Exchanges(ib)%trans_in_field_dble)) &
00105            DEALLOCATE(Drv_Exchanges(ib)%trans_in_field_dble)
00106     ELSE IF (Drv_Exchanges(ib)%trans_in_field_type == PRISM_Real) THEN
00107         IF (ASSOCIATED(Drv_Exchanges(ib)%trans_in_field_real)) &
00108            DEALLOCATE(Drv_Exchanges(ib)%trans_in_field_real)
00109     ELSE IF (Drv_Exchanges(ib)%trans_in_field_type == PRISM_Integer) THEN
00110         IF (ASSOCIATED(Drv_Exchanges(ib)%trans_in_field_int)) &
00111            DEALLOCATE(Drv_Exchanges(ib)%trans_in_field_int)
00112     ENDIF
00113   ENDDO
00114     IF (ASSOCIATED(Drv_Exchanges)) DEALLOCATE(Drv_Exchanges)
00115 !
00116 #ifdef VERBOSE
00117   PRINT *, '| | | | | Quit PRISMTrs_deallocate'
00118   call psmile_flushstd
00119 #endif
00120 END SUBROUTINE PRISMTrs_deallocate
00121 
00122 
00123 
00124 
00125 
00126 
00127