psmile_io_init.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_IO_Init
00008 !
00009 ! !INTERFACE:
00010       subroutine psmile_io_init(ierror )
00011 
00012 !
00013 ! !USES:
00014       use PSMILe, dummy_interface => PSMILE_IO_Init
00015       use PSMILe_IO_Utils
00016       implicit none
00017 
00018 ! !OUTPUT PARAMETERS:
00019       integer, Intent (Out)               :: ierror
00020 
00021 !    returned error code
00022 !
00023 ! !LOCAL VARIABLES
00024 !
00025        integer::ierrp(2)
00026        integer::il_stackmax,il_stackmaxd,il_buffer(2)
00027        integer::il_unit,il_rank
00028        logical::ll_exist
00029        character(len=max_name)::mpplog
00030        namelist /mppconf/il_stackmax,il_stackmaxd
00031 
00032 
00033 !
00034 ! !DESCRIPTION:
00035 !
00036 !  Creates a communicator for the underlying file IO package.
00037 !  Initializes underlying NetCDF IO package.
00038 !
00039 ! !REVISION HISTORY:
00040 !
00041 !   Date      Programmer    Description
00042 ! ----------  -----------   -----------
00043 ! 03.04.2003  declat        created
00044 ! 31.10.2003  vogelsang     IO initialization for the application
00045 !
00046 !EOP
00047 ! ---------------------------------------------------------------------
00048 !  $Id: psmile_io_init.F90 2325 2010-04-21 15:00:07Z valcke $
00049 
00050    Character(len=len_cvs_string), save :: mycvs = 
00051    '$Id: psmile_io_init.F90 2325 2010-04-21 15:00:07Z valcke $'
00052 #ifdef __PSMILE_WITH_IO
00053 
00054 #ifdef VERBOSE
00055       print *, trim(ch_id), ':  PSMILE_IO_Init: start'
00056 
00057       call psmile_flushstd
00058 #endif /* VERBOSE */
00059 
00060       ierror = 0
00061 
00062       IO_Apps_infos%comm=MPI_COMM_NULL
00063 !
00064 !     Create a communicator which covers the application but separates the
00065 !     I/O from the rest of the data exchange library.
00066 !
00067       if ( Appl%size .gt.  0 ) then
00068          call MPI_Comm_split(Appl%comm,4711,Appl%rank,IO_apps_infos%comm &
00069                             ,ierror)
00070          if(ierror.ne.MPI_SUCCESS) &
00071          call psmile_error ( ierror, 'MPI_Comm_split', &
00072                              ierrp, 0, __FILE__, __LINE__ )
00073 
00074       else
00075          call psmile_assert (__FILE__, __LINE__, &
00076                             "PSMILe not initialized properly ")
00077       endif
00078 !
00079 !     Initialize the MPP modules
00080 !      
00081       
00082       write(mpplog,'(a,i4.4)')trim(Appl%name)//trim('.mpp.log.'),Appl%rank
00083 
00084       call mpp_init(mpp_comm=IO_apps_infos%comm,logfile=trim(mpplog))
00085 
00086 !
00087 !     Initialize the internal stack size of the MPP package
00088 !
00089       call mpi_comm_rank(IO_apps_infos%comm, il_rank, ierror)
00090 
00091       il_stackmaxd=PSMILE_IO_stackmaxd
00092       il_stackmax=PSMILE_IO_stackmax
00093 
00094       if(il_rank.eq.0) then
00095 
00096         Inquire(file='mpp.conf',exist=ll_exist)
00097 
00098         if(ll_exist) then
00099 
00100           call psmile_io_fileunit(1,il_unit,ierror)
00101           open(unit=il_unit,file='mpp.conf',form='formatted',status='old')
00102           read(il_unit,mppconf)
00103           close(il_unit)
00104 
00105         endif
00106 
00107       endif
00108 
00109       if(il_stackmaxd.le.0.or.il_stackmax.le.0) then
00110          ierrp(1)=il_stackmaxd
00111          ierrp(2)=il_stackmax
00112          call psmile_error ( ierror, 'Stack size', &
00113                              ierrp, 2, __FILE__, __LINE__ )
00114       endif
00115 
00116       il_buffer(1)=il_stackmaxd
00117       il_buffer(2)=il_stackmax
00118 
00119       call mpi_bcast(il_buffer,2,mpi_integer,0,IO_apps_infos%comm,ierror)
00120 
00121       il_stackmaxd=il_buffer(1)
00122       il_stackmax=il_buffer(2)
00123 
00124       call mpp_domains_set_stack_size(il_stackmaxd)
00125       call mpp_io_init(maxunit=PSMILE_IO_MAX_UNIT+4 &
00126                       ,maxresunit=4)
00127       call mpp_set_stack_size(il_stackmax)
00128 
00129 #ifdef VERBOSE
00130       print *, trim(ch_id), ':  PSMILE_IO_Init: end'
00131 
00132       call psmile_flushstd
00133 #endif /* VERBOSE */
00134 #endif
00135       
00136       end subroutine PSMILe_IO_Init