psmile_io_init_comp.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 ! !ROUTINE: PSMILE_IO_Init_Comp
00007 !
00008 ! !INTERFACE:
00009       subroutine psmile_io_init_comp (id_comp_id, ierror )
00010 
00011 ! !USES:
00012       use PSMILe, dummy_interface => PSMILE_IO_Init_Comp
00013       implicit none
00014 
00015 ! !OUTPUT PARAMETERS:
00016       integer, Intent (Out)               :: ierror
00017 
00018 ! !INPUT PARAMETERS:
00019       integer, Intent (In)                :: id_comp_id
00020 
00021 !
00022 ! !LOCAL VARIABLES
00023 !
00024        integer, parameter                 :: nerrp=3
00025        integer                            :: ierrp(nerrp)
00026 !
00027 ! !DESCRIPTION:
00028 !
00029 !  Creates a PE list for each component in order to let the MPP IO package
00030 !  distinguish model component code.
00031 !
00032 ! !REVISION HISTORY:
00033 !
00034 !   Date      Programmer    Description
00035 ! ----------  -----------   -----------
00036 ! 03.04.2003  declat        created
00037 ! 31.10.2003  vogelsang     Deduction and initialization of component PE lists
00038 !
00039 !EOP
00040 ! ---------------------------------------------------------------------
00041 !  $Id: psmile_io_init_comp.F90 2687 2010-10-28 15:15:52Z coquart $
00042 
00043    Character(len=len_cvs_string), save :: mycvs = 
00044    '$Id: psmile_io_init_comp.F90 2687 2010-10-28 15:15:52Z coquart $'
00045 
00046 #ifdef VERBOSE
00047       print *, trim(ch_id), ':  PSMILE_IO_Init_comp : start', id_comp_id, nerrp
00048 
00049       call psmile_flushstd
00050 #endif /* VERBOSE */
00051 
00052 
00053       ierror = 0
00054 #ifdef __PSMILE_WITH_IO
00055       if ( Associated (Comps) ) then
00056          if ( .not. allocated(IO_Comps_infos)) &
00057          allocate(IO_Comps_infos(1:size(Comps)),STAT=ierror)
00058          PRINT *, ' psmile_io_init_comp : ierror = ', ierror
00059          call psmile_flushstd
00060          if(ierror.ne.0) then 
00061             ierrp(1) = ierror
00062             ierrp(2) = size(Comps) 
00063             call psmile_error ( ierror, 'Allocate IO_Comps_infos', &
00064                                 ierrp, 2, __FILE__, __LINE__ )
00065          endif
00066 
00067       else
00068          call psmile_assert (__FILE__, __LINE__, &
00069                             "called before prism_init_comp")
00070       endif
00071 
00072 
00073 #ifdef VERBOSE
00074       print *, trim(ch_id), ':  PSMILE_IO_Init_comp : end'
00075 
00076       call psmile_flushstd
00077 #endif /* VERBOSE */
00078 
00079 #endif
00080 
00081       end subroutine PSMILe_IO_Init_Comp