psmile_read_3d_dble.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_dble
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_read_3d_dble(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       double precision            , 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       integer::ierrp(2)
00055 !
00056 ! !DESCRIPTION:
00057 !
00058 ! Reads a double precision partitioned 3d array from a file.
00059 ! Subblocks are supported.
00060 !
00061 ! !REVISION HISTORY:
00062 !
00063 !   Date      Programmer   Description
00064 ! ----------  ----------   -----------
00065 !  31.12.03   R. Vogelsang created
00066 !
00067 !EOP
00068 !----------------------------------------------------------------------
00069 
00070       character(len=len_cvs_string),save :: mcvs = 
00071 '$Id: psmile_read_3d_dble.F90 2325 2010-04-21 15:00:07Z valcke $'
00072       
00073       ierror=0
00074 
00075 #ifdef VERBOSE
00076       print*,trim(ch_id),' :   psmile_read_3d_dble: start'
00077       print*,trim(ch_id),' :   psmile_read_3d_dble: size',size(a)
00078       call psmile_flushstd
00079 #endif
00080 
00081 
00082       if(domain_used) then
00083       if(block_used) then
00084       if(id_blockid.le.0) then
00085          ierror = PRISM_Error_Internal
00086          call psmile_error ( ierror, 'id_blockid <= 0! ', &
00087                              ierrp, 0, __FILE__, __LINE__ )
00088       endif
00089 
00090       if(time_used) then
00091         call mpp_read(unit,var,domain,a(v_shape(1,1):v_shape(2,1) &
00092                                              ,v_shape(1,2):v_shape(2,2) &
00093                                              ,v_shape(1,3):v_shape(2,3)) &
00094                                       ,tindex=itime,blockid=id_blockid)
00095       else
00096         call mpp_read( unit,var,domain,a(v_shape(1,1):v_shape(2,1) &
00097                                               ,v_shape(1,2):v_shape(2,2) &
00098                                               ,v_shape(1,3):v_shape(2,3))&
00099                                               ,blockid=id_blockid)
00100       endif
00101       else
00102       if(time_used) then
00103         call mpp_read(unit,var,domain,a(v_shape(1,1):v_shape(2,1) &
00104                                              ,v_shape(1,2):v_shape(2,2) &
00105                                              ,v_shape(1,3):v_shape(2,3)) &
00106                                       ,tindex=itime)
00107       else
00108         call mpp_read( unit,var,domain,a(v_shape(1,1):v_shape(2,1) &
00109                                               ,v_shape(1,2):v_shape(2,2) &
00110                                               ,v_shape(1,3):v_shape(2,3)))
00111       endif
00112       endif
00113 !
00114       else
00115 !
00116       if(block_used) then
00117       if(id_blockid.le.0) then
00118          ierror = PRISM_Error_Internal
00119          call psmile_error ( ierror, 'id_blockid <= 0! ', &
00120                              ierrp, 0, __FILE__, __LINE__ )
00121       endif
00122 
00123       if(time_used) then
00124         call mpp_read(unit,var,a(v_shape(1,1):v_shape(2,1) &
00125                                              ,v_shape(1,2):v_shape(2,2) &
00126                                              ,v_shape(1,3):v_shape(2,3)) &
00127                                       ,tindex=itime,blockid=id_blockid)
00128       else
00129         call mpp_read( unit,var,a(v_shape(1,1):v_shape(2,1) &
00130                                               ,v_shape(1,2):v_shape(2,2) &
00131                                               ,v_shape(1,3):v_shape(2,3))&
00132                                               ,blockid=id_blockid)
00133       endif
00134       else
00135       if(time_used) then
00136         call mpp_read(unit,var,a(v_shape(1,1):v_shape(2,1) &
00137                                              ,v_shape(1,2):v_shape(2,2) &
00138                                              ,v_shape(1,3):v_shape(2,3)) &
00139                                       ,tindex=itime)
00140       else
00141         call mpp_read( unit,var,a(v_shape(1,1):v_shape(2,1) &
00142                                               ,v_shape(1,2):v_shape(2,2) &
00143                                               ,v_shape(1,3):v_shape(2,3)))
00144       endif
00145       endif
00146       endif
00147 
00148 #ifdef VERBOSE
00149       print*,trim(ch_id),' :   psmile_read_3d_dble: end'
00150       call psmile_flushstd
00151 
00152 #endif
00153 #endif
00154       end subroutine psmile_read_3d_dble