prism_init_comp.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2007-2010, CERFACS, Toulouse, France.
00003 ! Copyright 2007-2010, SGI Germany, Munich, Germany.
00004 ! Copyright 2007-2010, NEC Europe Ltd., London, UK.
00005 ! All rights reserved. Use is subject to OASIS4 license terms.
00006 !-----------------------------------------------------------------------
00007 !BOP
00008 !
00009 ! !ROUTINE: PRISM_Init_comp
00010 !
00011 ! !INTERFACE:
00012 
00013       subroutine prism_init_comp ( comp_id, comp_name, ierror )
00014 !
00015 ! !USES:
00016 !
00017       use PRISM, dummy_interface => prism_init_comp
00018 !
00019       use PSMILe
00020       use PSMILe_smioc, only : sga_smioc_comp
00021 
00022       implicit none
00023 
00024 !
00025 ! !INPUT PARAMETERS:
00026 !
00027       character (len=*), Intent(In)       :: comp_name
00028 
00029 !     Name of the component
00030 !
00031 ! !OUTPUT PARAMETERS:
00032 !
00033       integer, Intent (Out)               :: comp_id
00034 
00035 !     Returns the handle to the component information created.
00036 
00037       integer, Intent (Out)               :: ierror
00038 
00039 !     Returns the error code of prism_init_comp;
00040 !             ierror = 0 : No error
00041 !             ierror > 0 : Severe error
00042 !
00043 ! !LOCAL VARIABLES
00044 !
00045       integer                             :: i
00046       integer, save                       :: nb_calls = 0
00047 
00048       integer, parameter                  :: nerrp = 3
00049       integer                             :: ierrp (nerrp)
00050 
00051       integer                             :: status (MPI_STATUS_SIZE)
00052 
00053 ! !DESCRIPTION:
00054 !
00055 !   Subroutine prism_init_comp initializes the environment for the component
00056 !   "comp_name". It must be called once initially by each component model
00057 !   process with the name of the component model as argument 'comp_name'.
00058 !   After calling prism_init_comp, all related SMIOC information is
00059 !   accessible by the component model.
00060 !   It calls prism_init if it it has not been called before by the same
00061 !   process returns with a warning. If prism_init_comp has been called
00062 !   before with argument 'comp_name', returns with a warning
00063 !
00064 ! !SEE ALSO:
00065 !
00066 !   prism_init, prism_initialized, prism_terminate, prism_terminated
00067 !
00068 ! !REVISION HISTORY:
00069 !   Date      Programmer   Description
00070 ! ----------  -----------  -----------
00071 ! 01.12.03    H. Ritzdorf  created
00072 ! 09.01.03    R.Vogelsang  added call to psmile_io_init_comp
00073 ! 
00074 !EOP
00075 !----------------------------------------------------------------------
00076 !
00077 ! $Id: prism_init_comp.F90 2687 2010-10-28 15:15:52Z coquart $
00078 ! $Author: coquart $
00079 !
00080   Character(len=len_cvs_string), save :: mycvs = 
00081       '$Id: prism_init_comp.F90 2687 2010-10-28 15:15:52Z coquart $'
00082 !
00083 !-----------------------------------------------------------------------
00084 
00085 #ifdef VERBOSE
00086       print 9990, trim(ch_id)
00087 #endif /* VERBOSE */
00088 !-----------------------------------------------------------------------
00089 !  1st Initialization
00090 !-----------------------------------------------------------------------
00091 
00092       ierror   = 0
00093       nb_calls = nb_calls + 1
00094 
00095 !-----------------------------------------------------------------------
00096 ! 1a) Was PRISM already initialized ?
00097 !-----------------------------------------------------------------------
00098 
00099       if ( .not. PRISM_is_initialized ) then
00100 
00101          PRISM_comp_init = .true.
00102 
00103          print *, trim(comp_name), ' *************************************************'
00104          print *, trim(comp_name), ': prism_init_comp has called prism_init with'
00105          print *, trim(comp_name), '    with ', trim(comp_name), ' as application'
00106          print *, trim(comp_name), '    name. You may need to modify your application'
00107          print *, trim(comp_name), '    code in order to call prism_init with the'
00108          print *, trim(comp_name), '    appropriate application name explicitly'
00109          print *, trim(comp_name), '    before any call to prism_init_comp is done.'
00110          print *, trim(comp_name), ' *************************************************'
00111 
00112          call prism_init (trim(comp_name), ierror)
00113          if (ierror > 0) return
00114 
00115       endif
00116 
00117 !-----------------------------------------------------------------------
00118 ! 3rd Get handle Id
00119 !-----------------------------------------------------------------------
00120 
00121       call psmile_get_comp_handle (comp_id, comp_name, ierror)
00122       if (ierror > 0) return
00123 
00124 !-----------------------------------------------------------------------
00125 ! 4th Initialize data for the component
00126 !-----------------------------------------------------------------------
00127 
00128       Comps(comp_id)%comp_name = trim(comp_name)
00129 
00130       Comps(comp_id)%n_grids = 0
00131 
00132 !-----------------------------------------------------------------------
00133 ! 5th Get global component Id
00134 !    Component names are sent to the driver and the global component ids
00135 !    are received from the driver
00136 !-----------------------------------------------------------------------
00137 
00138       if ( Appl%stand_alone ) then
00139 
00140          Comps(comp_id)%global_comp_id = comp_id
00141 
00142       else
00143 
00144          call MPI_Send (Comps(comp_id)%comp_name, max_name, MPI_CHARACTER, &
00145                         PRISMdrv_root, 1, comm_global, ierror)
00146 #ifdef DEBUG
00147          print 9970, trim(ch_id), 'sent ', &
00148                   trim(Comps(comp_id)%comp_name)
00149          call psmile_flushstd()
00150 #endif
00151 
00152          if (ierror /= MPI_SUCCESS) THEN
00153             ierrp (1) = ierror
00154             ierrp (2) = PRISMdrv_root
00155             ierrp (3) = 1
00156             ierror = PRISM_Error_Send
00157 
00158             call psmile_error (ierror, 'MPI_Send', &
00159                  ierrp, 3, __FILE__, __LINE__ )
00160             return
00161          endif
00162 !
00163          call MPI_Recv (i, 1, MPI_INTEGER, PRISMdrv_root, 2, comm_global, &
00164               status, ierror)
00165 
00166          if (ierror /= MPI_SUCCESS) THEN
00167             ierrp (1) = ierror
00168             ierrp (2) = PRISMdrv_root
00169             ierrp (3) = 2
00170             ierror = PRISM_Error_Recv
00171 
00172             call psmile_error (ierror, 'MPI_Recv', &
00173                  ierrp, 3, __FILE__, __LINE__ )
00174             return
00175          endif
00176 
00177          Comps(comp_id)%global_comp_id = i
00178 
00179       endif
00180 !
00181 
00182 #ifdef DEBUG
00183       print 9971, trim(ch_id), 'local comp id: ', &
00184                comp_id
00185       print 9971, trim(ch_id), 'received global id: ', &
00186                Comps(comp_id)%global_comp_id
00187       call psmile_flushstd()
00188 #endif
00189 
00190 !-----------------------------------------------------------------------
00191 ! 6th Get size and rank in component communicators
00192 !-----------------------------------------------------------------------
00193 
00194       call MPI_Comm_rank (Comps(comp_id)%comm, Comps(comp_id)%rank, ierror)
00195       if (ierror /= MPI_SUCCESS) then
00196          ierrp (1) = ierror
00197          ierror = PRISM_Error_MPI
00198 
00199          call psmile_error ( ierror, 'MPI_Comm_rank', &
00200                              ierrp, 1, __FILE__, __LINE__ )
00201          return
00202       endif
00203 !
00204       call MPI_Comm_size (Comps(comp_id)%comm, Comps(comp_id)%size, ierror)
00205       if (ierror /= MPI_SUCCESS) then
00206          ierrp (1) = ierror
00207          ierror = PRISM_Error_MPI
00208 
00209          call psmile_error ( ierror, 'MPI_Comm_size', &
00210                              ierrp, 1, __FILE__, __LINE__ )
00211          return
00212       endif
00213 
00214 !-----------------------------------------------------------------------
00215 ! 7th Initialize the rest with the last call to
00216 !         prism_init_comp on this processor. This solution is
00217 !         not very elegant but doing it in a cleaner way way
00218 !         requires substantial restructuring of the Driver.
00219 !         rr, Nov 16, 2004 
00220 !-----------------------------------------------------------------------
00221 
00222       if ( nb_calls == PRISM_noCompsPerProc ) then
00223 
00224          nullify (sga_smioc_comp)
00225 
00226          allocate(sga_smioc_comp(Number_of_Comps_allocated), stat=ierror )
00227          if (ierror > 0) then
00228             ierrp (1) = ierror
00229             ierrp (2) = 1
00230             ierror = 13
00231             call psmile_error ( ierror, 'sga_smioc_comp', &
00232                   ierrp, 2, __FILE__, __LINE__ )
00233             return
00234          endif
00235          do i = 1, Number_of_Comps_allocated
00236             nullify(sga_smioc_comp(i)%iga_smioc_unitsets)
00237             nullify(sga_smioc_comp(i)%sga_smioc_grids)
00238             nullify(sga_smioc_comp(i)%sga_smioc_transi)
00239             nullify(sga_smioc_comp(i)%sga_smioc_persis)
00240          enddo
00241 
00242          do i = 1, PRISM_noCompsPerProc
00243  
00244    !--------------------------------------------------------------------
00245    ! 7a  Get all component specific SMIOC information
00246    !--------------------------------------------------------------------
00247 
00248          call psmile_smioc_init(Comps(i)%comp_name, i, ierror)
00249 
00250    !--------------------------------------------------------------------
00251    ! 7b Initialize PRISM I/O Library for this component
00252    !--------------------------------------------------------------------
00253 
00254 #ifdef __PSMILE_WITH_IO
00255          call psmile_io_init_comp (i, ierror)
00256          if (ierror /= 0) return
00257 #endif
00258          enddo
00259 
00260       endif ! PRISM_noCompsPerProc
00261 
00262 !-----------------------------------------------------------------------
00263 ! 8th Epilogue
00264 !-----------------------------------------------------------------------
00265 
00266 #ifdef VERBOSE
00267       print 9980, trim(ch_id), ierror
00268 #endif /* VERBOSE */
00269 !
00270 9990 format (1x, a, 'prism_init_comp: start')
00271 9980 format (1x, a, 'prism_init_comp: eof ierror =', i5)
00272 9970 format (1x, a, 'prism_init_comp: ', a, a)
00273 9971 format (1x, a, 'prism_init_comp: ', a, i5)
00274       end subroutine prism_init_comp