psmile_write_1d_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_write_1d_dble
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_write_1d_dble(unit                &
00012                                      ,var                 &
00013                                      ,domain              &
00014                                      ,a                   &
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       double precision, intent(inout) :: a(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       integer, intent(out) :: ierror
00047 !
00048 ! !LOCAL VARIABLES
00049 !
00050       integer::ierrp(2)
00051 !
00052 ! !DESCRIPTION:
00053 !
00054 ! Writes a double precision non-partitioned 1d array to a file.
00055 ! The array should contain the same data on all PEs.
00056 !
00057 ! !REVISION HISTORY:
00058 !
00059 !   Date      Programmer   Description
00060 ! ----------  ----------   -----------
00061 !  09.12.03   R. Vogelsang created
00062 !
00063 !EOP
00064 !----------------------------------------------------------------------
00065 
00066       character(len=len_cvs_string),save :: mcvs = 
00067 '$Id: psmile_write_1d_dble.F90 2325 2010-04-21 15:00:07Z valcke $'
00068       
00069       ierror=0
00070 
00071 #ifdef VERBOSE
00072       print*,trim(ch_id),' :   psmile_write_1d_dble: start'
00073       call psmile_flushstd
00074 
00075 #endif
00076 
00077       if(time_used) then
00078         call mpp_write( unit,var,a(v_shape(1,1):v_shape(2,1)) &
00079                                        ,tstamp=time)
00080       else
00081         call mpp_write( unit,var,a(v_shape(1,1):v_shape(2,1))) 
00082       endif
00083 #ifdef __PSMILE_IO_SYNC
00084       call mpp_flush(unit)
00085 #endif
00086 #ifdef VERBOSE
00087       print*,trim(ch_id),' :   psmile_write_1d_dble: end'
00088       call psmile_flushstd
00089 
00090 #endif
00091 
00092 #endif
00093       end subroutine psmile_write_1d_dble