psmile_write_1d_real.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_write_1d_dble
00008 !
00009 ! !INTERFACE:
00010 !
00011       subroutine psmile_write_1d_real(unit                &
00012                                      ,var                 &
00013                                      ,domain              &
00014                                      ,ain                 &
00015                                      ,a_shape             &
00016                                      ,v_shape             &
00017                                      ,time                &
00018                                      ,time_used           &
00019                                      ,id_blockid          &
00020                                      ,block_used          &
00021                                      ,ierror)
00022 !
00023 ! !USES:
00024 !
00025 
00026       use psmile
00027 
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       real          , intent(inout) :: ain(a_shape(1,1):a_shape(2,1)  )
00040       double precision, intent(in):: time
00041       logical,intent(in) :: time_used
00042       integer,intent(in) :: id_blockid
00043       logical,intent(in) :: block_used
00044 !
00045 ! !OUTPUT PARAMETERS:
00046 !
00047       integer, intent(out) :: ierror
00048 !
00049 ! !LOCAL VARIABLES
00050 !
00051       double precision             :: a(a_shape(1,1):a_shape(2,1)  )
00052       integer::ierrp(2)
00053 !
00054 ! !DESCRIPTION:
00055 !
00056 ! Writes a real partitioned 2d array to a file.
00057 ! Subblocks are supported.
00058 !
00059 ! !REVISION HISTORY:
00060 !
00061 !   Date      Programmer   Description
00062 ! ----------  ----------   -----------
00063 !  09.12.03   R. Vogelsang created
00064 !
00065 !EOP
00066 !----------------------------------------------------------------------
00067 
00068       character(len=len_cvs_string),save :: mcvs = 
00069 '$Id: psmile_write_1d_real.F90 2325 2010-04-21 15:00:07Z valcke $'
00070       
00071       ierror=0
00072 
00073 #ifdef VERBOSE
00074       print*,trim(ch_id),' :   psmile_write_1d_real: start'
00075       call psmile_flushstd
00076 
00077 #endif
00078 
00079       a=ain
00080       if(time_used) then
00081         call mpp_write( unit,var,a(v_shape(1,1):v_shape(2,1)) &
00082                                        ,tstamp=time)
00083       else
00084         call mpp_write( unit,var,a(v_shape(1,1):v_shape(2,1))) 
00085       endif
00086 #ifdef __PSMILE_IO_SYNC
00087       call mpp_flush(unit)
00088 #endif
00089 
00090 #ifdef VERBOSE
00091       print*,trim(ch_id),' :   psmile_write_1d_real: end'
00092       call psmile_flushstd
00093 
00094 #endif
00095 
00096 #endif
00097       end subroutine psmile_write_1d_real