psmile_read_3d_int.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, SGI Germany, Munich, Germany.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE:   psmile_read_3d_int
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_read_3d_int(unit                 &
00012                                      ,var                 &
00013                                      ,domain              &
00014                                      ,a                   &
00015                                      ,a_shape             &
00016                                      ,v_shape             &
00017                                      ,itime               &
00018                                      ,time_used           &
00019                                      ,id_blockid          &
00020                                      ,block_used          &
00021                                      ,domain_used         &
00022                                      ,ierror)
00023 !
00024 ! !USES:
00025 !
00026 
00027       use psmile
00028 #ifdef __PSMILE_WITH_IO
00029       implicit none
00030       include 'prism.inc'
00031 !
00032 ! !INPUT PARAMETERS:
00033 !
00034       integer,intent(in) :: unit
00035       Type(fieldtype),intent(in) :: var
00036       Type(domain2D),intent(inout)  :: domain
00037       integer,intent(in) :: a_shape(2,*)
00038       integer,intent(in) :: v_shape(2,*)
00039       integer            , intent(inout) :: a(a_shape(1,1):a_shape(2,1)  
00040                                        ,a_shape(1,2):a_shape(2,2)  
00041                                        ,a_shape(1,3):a_shape(2,3)) 
00042       integer , intent(in):: itime
00043       logical,intent(in) :: time_used
00044       integer,intent(in):: id_blockid
00045       logical,intent(in):: block_used
00046       logical,intent(in):: domain_used
00047 !
00048 ! !OUTPUT PARAMETERS:
00049 !
00050       integer, intent(out) :: ierror
00051 !
00052 ! !LOCAL VARIABLES:
00053 !
00054       double precision,allocatable     :: atmp(:,:,:)
00055       integer::ierrp(2)
00056 !
00057 ! !DESCRIPTION:
00058 !
00059 ! Reads a integer partitioned 3d array from a file.
00060 ! Subblocks are supported.
00061 !
00062 ! !REVISION HISTORY:
00063 !
00064 !   Date      Programmer   Description
00065 ! ----------  ----------   -----------
00066 !  31.12.03   R. Vogelsang created
00067 !  6.05.04    R. Vogelsang bugfixes a=atmp
00068 !
00069 !EOP
00070 !----------------------------------------------------------------------
00071 
00072       character(len=len_cvs_string),save :: mcvs = 
00073 '$Id: psmile_read_3d_int.F90 2325 2010-04-21 15:00:07Z valcke $'
00074       
00075       ierror=0
00076 
00077 #ifdef VERBOSE
00078       print*,trim(ch_id),' :   psmile_read_3d_int: start'
00079       print*,trim(ch_id),' :   psmile_read_3d_int: size',size(a)
00080       call psmile_flushstd
00081 #endif
00082 
00083 
00084       allocate(atmp(a_shape(1,1):a_shape(2,1)  &
00085                    ,a_shape(1,2):a_shape(2,2)  &
00086                    ,a_shape(1,3):a_shape(2,3))) 
00087 
00088       if ( ierror /= 0 ) then
00089          ierrp (1) = 1
00090          ierror = PRISM_Error_Alloc
00091          call psmile_error ( ierror, 'atmp', ierrp, 1, __FILE__, __LINE__ )
00092          return
00093       endif
00094 
00095       if(domain_used) then
00096       if(block_used) then
00097       if(id_blockid.le.0) then
00098          ierror = PRISM_Error_Internal
00099          call psmile_error ( ierror, 'id_blockid <= 0! ', &
00100                              ierrp, 0, __FILE__, __LINE__ )
00101       endif
00102 
00103       if(time_used) then
00104         call mpp_read(unit,var,domain,atmp(v_shape(1,1):v_shape(2,1) &
00105                                              ,v_shape(1,2):v_shape(2,2) &
00106                                              ,v_shape(1,3):v_shape(2,3)) &
00107                                       ,tindex=itime,blockid=id_blockid)
00108       else
00109         call mpp_read( unit,var,domain,atmp(v_shape(1,1):v_shape(2,1) &
00110                                               ,v_shape(1,2):v_shape(2,2) &
00111                                               ,v_shape(1,3):v_shape(2,3))&
00112                                               ,blockid=id_blockid)
00113       endif
00114       else
00115       if(time_used) then
00116         call mpp_read(unit,var,domain,atmp(v_shape(1,1):v_shape(2,1) &
00117                                              ,v_shape(1,2):v_shape(2,2) &
00118                                              ,v_shape(1,3):v_shape(2,3)) &
00119                                       ,tindex=itime)
00120       else
00121         call mpp_read( unit,var,domain,atmp(v_shape(1,1):v_shape(2,1) &
00122                                               ,v_shape(1,2):v_shape(2,2) &
00123                                               ,v_shape(1,3):v_shape(2,3)))
00124       endif
00125       endif
00126 !
00127       else
00128 !
00129       if(block_used) then
00130       if(id_blockid.le.0) then
00131          ierror = PRISM_Error_Internal
00132          call psmile_error ( ierror, 'id_blockid <= 0! ', &
00133                              ierrp, 0, __FILE__, __LINE__ )
00134       endif
00135 
00136       if(time_used) then
00137         call mpp_read(unit,var,atmp(v_shape(1,1):v_shape(2,1) &
00138                                              ,v_shape(1,2):v_shape(2,2) &
00139                                              ,v_shape(1,3):v_shape(2,3)) &
00140                                       ,tindex=itime,blockid=id_blockid)
00141       else
00142         call mpp_read( unit,var,atmp(v_shape(1,1):v_shape(2,1) &
00143                                               ,v_shape(1,2):v_shape(2,2) &
00144                                               ,v_shape(1,3):v_shape(2,3))&
00145                                               ,blockid=id_blockid)
00146       endif
00147       else
00148       if(time_used) then
00149         call mpp_read(unit,var,atmp(v_shape(1,1):v_shape(2,1) &
00150                                              ,v_shape(1,2):v_shape(2,2) &
00151                                              ,v_shape(1,3):v_shape(2,3)) &
00152                                       ,tindex=itime)
00153       else
00154         call mpp_read( unit,var,atmp(v_shape(1,1):v_shape(2,1) &
00155                                               ,v_shape(1,2):v_shape(2,2) &
00156                                               ,v_shape(1,3):v_shape(2,3)))
00157       endif
00158       endif
00159       endif
00160 
00161 !rv      a=atmp
00162 
00163       a(v_shape(1,1):v_shape(2,1)  &
00164        ,v_shape(1,2):v_shape(2,2)  &
00165        ,v_shape(1,3):v_shape(2,3)) = &
00166                                      atmp(v_shape(1,1):v_shape(2,1)  &
00167                                          ,v_shape(1,2):v_shape(2,2)  &
00168                                          ,v_shape(1,3):v_shape(2,3))
00169 
00170       deallocate(atmp,stat=ierror)
00171 
00172       if ( ierror /= 0 ) then
00173          ierrp (1) = 1
00174          ierror = PRISM_Error_Alloc
00175          call psmile_error ( ierror, 'deallocate(atmp)', ierrp, 1, __FILE__ &
00176                            , __LINE__ )
00177          return
00178       endif
00179 
00180 #ifdef VERBOSE
00181       print*,trim(ch_id),' :   psmile_read_3d_int: end'
00182       call psmile_flushstd
00183 
00184 #endif
00185 #endif
00186       end subroutine psmile_read_3d_int