psmile_io_init_pelist.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_pelist
00007 !
00008 ! !INTERFACE:
00009       subroutine psmile_io_init_pelist (id_comp_id, comp_info, ierror )
00010 
00011 ! !USES:
00012       use PSMILe, dummy_interface => PSMILE_IO_Init_pelist
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       Type (Enddef_comp), Intent (In)     :: comp_info 
00022 
00023 !
00024 ! !LOCAL VARIABLES
00025 !
00026        integer, parameter                 :: nerrp=3
00027        integer                            :: ierrp(nerrp)
00028        integer                            :: act_size
00029        integer                            :: i
00030 !
00031 ! !DESCRIPTION:
00032 !
00033 !  Creates a PE list for each component in order to let the MPP IO package
00034 !  distinguish model component code.
00035 !
00036 ! !REVISION HISTORY:
00037 !
00038 !   Date      Programmer    Description
00039 ! ----------  -----------   -----------
00040 ! 03.04.2003  declat        created
00041 ! 31.10.2003  vogelsang     Deduction and initialization of component PE lists
00042 ! 19.08.2010  latour        Get pelist from comp_info structure for all PEs in comp.
00043 !
00044 !EOP
00045 ! ---------------------------------------------------------------------
00046 !  $Id: psmile_io_init_pelist.F90 2325 2010-04-21 15:00:07Z valcke $
00047 
00048    Character(len=len_cvs_string), save :: mycvs = 
00049    '$Id: psmile_io_init_pelist.F90 2325 2010-04-21 15:00:07Z valcke $'
00050 
00051 #ifdef VERBOSE
00052       print *, trim(ch_id), ':  PSMILE_IO_Init_pelist : start', id_comp_id, nerrp
00053 
00054       call psmile_flushstd
00055 #endif /* VERBOSE */
00056 
00057 
00058       ierror = 0
00059 
00060 #ifdef __PSMILE_WITH_IO
00061       if ( Associated (Comps) ) then
00062          if ( .not. allocated(IO_Comps_infos)) &
00063          allocate(IO_Comps_infos(1:size(Comps)),STAT=ierror)
00064          print *, ' psmile_io_init_comp -1- : ierror = ', ierror
00065          call psmile_flushstd
00066          if(ierror.ne.0) then 
00067             ierrp(1) = ierror
00068             ierrp(2) = size(Comps) 
00069             call psmile_error ( ierror, 'Allocate IO_Comps_infos', &
00070                                 ierrp, 2, __FILE__, __LINE__ )
00071          endif
00072 
00073       else
00074          call psmile_assert (__FILE__, __LINE__, &
00075                             "called before prism_init_comp")
00076       endif
00077 
00078 !  This part of the code is called by PRISM_Enddef
00079 
00080 
00081 #ifdef DEBUG
00082       PRINT *, ' PSMILE_IO_Init_pelist, id_comp_id = ', id_comp_id
00083       PRINT *, ' PSMILE_IO_Init_pelist, n_grids = ', Comps(id_comp_id)%n_grids
00084       PRINT *, ' PSMILE_IO_Init_pelist, Comps(id_comp_id)%size = ', Comps(id_comp_id)%size
00085       PRINT *, ' PSMILE_IO_Init_pelist, comp_info%Number_of_grids_vector(:)=',&
00086                comp_info%Number_of_grids_vector(:)
00087 #endif DEBUG
00088 !
00089 !  All Pes in Component : Get act_size from comp_info%number_of_grids_vector(:)
00090 !
00091          act_size = 0
00092          do i = 1, Comps(id_comp_id)%size
00093             if (comp_info%Number_of_grids_vector(i) .ne. 0 )  act_size =  act_size + 1
00094          enddo
00095          print *, ' PSMILE_IO_Init_pelist -2- : act_size = ', act_size
00096 
00097          allocate(IO_Comps_infos(id_comp_id)%pelist(1:act_size),STAT=ierror)
00098 !
00099 !  Translate all component ranks  into Application ranks and get pelist
00100 !  - pelist must be defined with same info on all component pes ; it must be dimensionned
00101 !    with the number of pes having an active grid ; it must contain the rank in the 
00102 !    application communicator Appl%comm of pes having an active grid. 
00103 !
00104          
00105          CALL psmile_io_derive_pelist(Appl%comm,id_comp_id, &
00106                          comp_info, IO_Comps_infos(id_comp_id)%pelist,ierror)
00107 
00108 #ifdef DEBUG
00109          print *, trim(ch_id), ':  PSMILE_IO_Init_pelist : ', &
00110               'id_comp_id, IO_Comps_infos(id_comp_id)%pelist',id_comp_id, &
00111               ' : ',IO_Comps_infos(id_comp_id)%pelist
00112 
00113          call psmile_flushstd
00114          print*,trim(ch_id), ':  PSMILE_IO_Init_pelist : ' &
00115               ,'calling mpp_declare_pelist'
00116          call psmile_flushstd
00117 #endif
00118          CALL mpp_declare_pelist(IO_Comps_infos(id_comp_id)%pelist(1:act_size))
00119 
00120 #ifdef DEBUG
00121          print *, trim(ch_id), ':  PSMILE_IO_Init_pelist : after mpp_declare_pelist '
00122          call psmile_flushstd
00123 #endif
00124 
00125 #ifdef VERBOSE
00126       print *, trim(ch_id), ':  PSMILE_IO_Init_pelist : end'
00127 
00128       call psmile_flushstd
00129 #endif /* VERBOSE */
00130 
00131 #endif   /*   __PSMILE_WITH_IO   */
00132 
00133       end subroutine PSMILe_IO_Init_pelist