doc-doxygen/html/mod__prism__get__comm_8_f90_source.html

00001 MODULE mod_prism_get_comm
00002
00003   IMPLICIT NONE
00004
00005   INTERFACE prism_get_intercomm
00006
00007     MODULE PROCEDURE prism_get_intercomm_1mod
00008
00009   END INTERFACE
00010
00011   INTERFACE prism_get_intracomm
00012
00013     MODULE PROCEDURE prism_get_intracomm_1mod
00014
00015   END INTERFACE
00016 !
00017 !-----Type model to store information about models
00018 !
00019   TYPE :: model
00020     character(len=6) :: name
00021     integer          :: master_proc   !! rank of master proc in global communicator
00022   END TYPE model
00023
00024   TYPE(model), ALLOCATABLE, DIMENSION(:), PRIVATE :: coupling_models
00025
00026 CONTAINS
00027
00028   SUBROUTINE prism_get_intercomm_1mod(il_local_comm, cd_name, kinfo)
00029 !
00030 !*    *** Get_intercomm ***   PRISM 1.0
00031 !
00032 !     purpose:
00033 !     --------
00034 !        Get an intercommunicator.
00035 !
00036 !     interface:
00037 !     ----------
00038 !        il_local_comm : intercommunicator
00039 !        cd_name : name of the model to be linked with thanks to the intercommunicator
00040 !        kinfo  : exit status
00041 !
00042 !     lib mp:
00043 !     -------
00044 !        mpi-1
00045 !
00046 !     author:
00047 !     -------
00048 !        Arnaud Caubel
00049 !
00050 !     ----------------------------------------------------------------
00051 !
00052     USE mod_comprism_proto
00053     include 'mpif.h'
00054
00055 !     ----------------------------------------------------------------
00056     INTEGER (kind=ip_intwp_p)   :: il, il_local_comm, kinfo, il_local_intercomm
00057     INTEGER (kind=ip_intwp_p)   :: tag
00058     CHARACTER (len=6) :: cd_name
00059     LOGICAL :: ll_found
00060 !     ----------------------------------------------------------------
00061 !
00062 #ifdef __VERBOSE
00063    WRITE(nulprt,*)'   '
00064    WRITE(nulprt,*)'| | | Entering routine prism_get_intercomm_1mod'
00065    call flush(nulprt)
00066 #endif
00067 !
00068     ll_found= .false.
00069
00070     ALLOCATE(coupling_models(knmods))
00071     coupling_models(1)%master_proc=ig_nbr_oasis
00072     coupling_models(1)%name=TRIM(cunames(ig_nbr_oasis+1))
00073     DO il=2,knmods
00074       coupling_models(il)%master_proc= &
00075          coupling_models(il-1)%master_proc+ kbtotproc(il-1)
00076       coupling_models(il)%name= &
00077          TRIM(cunames(coupling_models(il)%master_proc+1))
00078     ENDDO
00079
00080     DO il=1,knmods
00081       IF (cd_name .EQ. coupling_models(il)%name .AND. .NOT. ll_found) THEN
00082           tag=ICHAR(TRIM(cmynam))+ICHAR(TRIM(cd_name))
00083       CALL mpi_intercomm_create(ig_local_comm, 0, MPI_COMM_WORLD, coupling_models(il)%master_proc, &
00084              tag, il_local_intercomm, kinfo)
00085           ll_found= .true.
00086       ENDIF
00087     ENDDO
00088
00089     il_local_comm = il_local_intercomm
00090
00091     IF (ll_found) THEN
00092         kinfo = CLIM_Ok
00093     ELSE
00094         kinfo = CLIM_BadName
00095     ENDIF
00096
00097     deallocate (coupling_models)
00098 !
00099 #ifdef __VERBOSE
00100    WRITE(nulprt,*)'| | | Leaving routine prism_get_intercomm_1mod'
00101    WRITE(nulprt,*)'   '
00102    call flush(nulprt)
00103 #endif
00104 !
00105   END SUBROUTINE prism_get_intercomm_1mod
00106
00107   SUBROUTINE prism_get_intracomm_1mod(il_local_comm, cd_name, kinfo)
00108 !
00109 !*    *** Get_intracomm ***   PRISM 1.0
00110 !
00111 !     purpose:
00112 !     --------
00113 !        Get an intracommunicator.
00114 !
00115 !     interface:
00116 !     ----------
00117 !        il_local_comm : intracommunicator
00118 !        cd_name : name of the model to share the communicator with
00119 !        kinfo  : exit status
00120 !
00121 !     lib mp:
00122 !     -------
00123 !        mpi-1
00124 !
00125 !     author:
00126 !     -------
00127 !        Arnaud Caubel
00128 !
00129 !     ----------------------------------------------------------------
00130 !
00131     USE mod_comprism_proto
00132     include 'mpif.h'
00133
00134 !     ----------------------------------------------------------------
00135     INTEGER (kind=ip_intwp_p)   :: il, il_local_comm, kinfo, il_local_intercomm
00136     INTEGER (kind=ip_intwp_p)   :: il_new_local_comm, tag
00137     CHARACTER (len=6) :: cd_name
00138     LOGICAL :: ll_found
00139 !     ----------------------------------------------------------------
00140 !
00141 #ifdef __VERBOSE
00142    WRITE(nulprt,*)'   '
00143    WRITE(nulprt,*)'| | | Entering routine prism_get_intracomm_1mod'
00144    call flush(nulprt)
00145 #endif
00146 !
00147     ll_found= .false.
00148
00149     ALLOCATE(coupling_models(knmods))
00150     coupling_models(1)%master_proc=ig_nbr_oasis
00151     coupling_models(1)%name=trim(cunames(ig_nbr_oasis+1))
00152     DO il=2,knmods
00153       coupling_models(il)%master_proc= &
00154          coupling_models(il-1)%master_proc+ kbtotproc(il-1)
00155       coupling_models(il)%name= &
00156          TRIM(cunames(coupling_models(il)%master_proc+1))
00157     ENDDO
00158
00159     DO il=1,knmods
00160       IF (cd_name .EQ. coupling_models(il)%name .AND. .NOT. ll_found) THEN
00161           tag=ICHAR(TRIM(cmynam))+ICHAR(TRIM(cd_name))
00162       CALL mpi_intercomm_create(ig_local_comm, 0, MPI_COMM_WORLD, coupling_models(il)%master_proc, &
00163              tag, il_local_intercomm, kinfo)
00164           CALL mpi_intercomm_merge(il_local_intercomm,.FALSE., il_new_local_comm, kinfo)
00165           ll_found= .true.
00166       ENDIF
00167     ENDDO
00168
00169     il_local_comm = il_new_local_comm
00170
00171     IF (ll_found) THEN
00172         kinfo = CLIM_Ok
00173     ELSE
00174         kinfo = CLIM_BadName
00175     ENDIF
00176
00177     deallocate (coupling_models)
00178 !
00179 #ifdef __VERBOSE
00180    WRITE(nulprt,*)'| | | Leaving routine prism_get_intracomm_1mod'
00181    WRITE(nulprt,*)'   '
00182    call flush(nulprt)
00183 #endif
00184 !
00185   END SUBROUTINE prism_get_intracomm_1mod
00186
00187 END MODULE mod_prism_get_comm