! Copyright ¨2003 The Regents of the University of California. ! All Rights Reserved. ! Authors: ! Yun (Helen) He, Lawrence Berkeley National Laboratory, yhe@lbl.gov ! Chris H.Q. Ding, Lawrence Berkeley National Laboratory, chqding@lbl.gov ! THIS SOFTWARE PROGRAM AND DOCUMENTATION ARE COPYRIGHTED BY ! THE REGENTS OF THE UNIVERSITY OF CALIFORNIA. THE SOFTWARE PROGRAM ! AND DOCUMENTATION ARE SUPPLIED "AS IS", WITHOUT ANY ACCOMPANYING ! SERVICES FROM THE REGENTS. THE REGENTS DOES NOT WARRANT THAT THE ! OPERATION OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR-FREE. ! THE END-USER UNDERSTANDS THAT THE PROGRAM WAS DEVELOPED FOR ! RESEARCH PURPOSES AND IS ADVISED NOT TO RELY EXCLUSIVELY ON THE ! PROGRAM FOR ANY REASON. !--------------------------------------------------------------------- !BOI ! !TITLE: Multi Program-Components Handshaking (MPH) Utility Version 4 User's Manual ! !AUTHORS: Yun He and Chris Ding ! !AFFILIATION: Lawrence Berkeley National Laboratory (yhe@lbl.gov, chqding@lbl.gov) ! !DATE: May 23, 2003 ! !COPYRIGHT: ! MPH: A Library for Distributed Multi-Component Environment is ! Copyright (c) 2003, The Regents of the University of California, ! through Lawrence Berkeley National Laboratory (subject to receipt ! of any required approvals from the U.S. Dept. of Energy). ! All rights reserved. ! Your use of this software is pursuant to a license agreement, ! the text of which is in license.txt. If the license agreement ! is not there, or if you have questions about the license, please ! contact Berkeley Lab's Technology Transfer Department at ! TTD@lbl.gov referring to "MPH (LBNL Ref CR-1954)" ! !INTRODUCTION: ! \begin{verbatim} ! MPH Version 4 combines all features of previous MPH versions, unifies the ! interfaces, and provides more flexible components integration/execution ! modes. The major addition to MPH version 3 is multi-instance executable ! for ensemble simulation. ! ! In a distributed multi-component environment, each executable resides ! on a set of SMP nodes. Components within an executable may overlap on ! different nodes or processors. ! ! MPH Version 4 contains the following functionality: ! ! o component name registration ! o resource allocation ! o multi-component single executable, multi-component ! multi-executable, multi-instance executable for ensemble simulation. ! o inter-component communication ! o inquiry on the multi-component environment ! o standard in/out redirect ! ! Please see more information at ! http://www.nersc.gov/research/SCG/acpi/MPH ! and please list the following in your reference if useful: ! "MPH: a Library for Distributed Multi-Component Environment" ! Chris Ding and Yun He, Lawrence Berkeley Nat'l Lab Tech ! Report 47930, May 2001. ! ! Consider the entire simulation system (CCSM) consists of many ! executables, each executable containing one or more components. ! This architecture offers complete flexibility, and is consistent ! with CORBA, DCE, CCA et al. ! ! 1) Every Multi-component executable starts with ! ! mpi_exec_world = & ! MPH_components(name1='ocean', name2='atmosphere',...) ! ! You may have only one component in this executable, or up to ! 10 components in this executable. Component names are nametags ! (place holder) and are completely arbitrary. They must be ! self-consistently used, and match the "processors_map.in" ! registration file. ! ! The Multi-instance executable starts with ! mpi_local_world = MPH_multi_instance ("POP") ! There is no limit of number of instances in this executable. ! Each instance has the same prefix "POP" as specified in ! "processors_map.in" registration file. ! ! 2) Some usages: ! ! a) CCSM example. Ice & Land share one executable. ! ! coupler - one executable ! atmosphere - one executable ! ocean - one executable ! ice & land - one executable with 2 components, ! they may overlap on processors ! ! b) CCSM example. Multiple instances of atmosphere. ! ! coupler - one executable ! atmosphere - one executable of 3 components ! each is a CCM instance of a different Dycore. ! ocean - one executable ! land - one executable with 3 components for CCMs. ! each is a land model to match the CCM ! ice - one executable ! ! c) PCM example. ! ! couple - one executable ! atmosphere & land - one executable ! ocean & ice - one executable ! ! d) Ensemble example. ! POP1, POP2, POP3 - one exexutable ! notice they share the same prefix. ! ! 3) "processors_map.in" registration file ! ! The following example contains 4 executables: ! 1st executable has a single component: coupler ! 2nd executable has 3 instances: POP1, POP2, POP3 ! 3rd executable has 2 components: ice, land ! 4th executable has a single component: POP_control ! PROCESSORS_MAP ! BEGIN ! coupler ! Multi_Instance_Start ! 3 (this line is optional) ! POP1 0 2 pop1.in pop1.out alpha=3 beta=4.5 debug=on ! POP2 3 5 pop2.in pop2.out alpha=2 beta=5.43e-5 debug=off ! POP3 6 9 pop3.in pop3.out dynamics=finite_volume beta=100.10 debug=on ! Multi_Instance_End ! Multi_Comp_Start ! 2 (this line is optional) ! ice 0 2 str1 str2 ! land 3 5 str3 ! Multi_Comp_End ! POP_control ! END ! ! a) Allocation of processors for each executable is controlled ! by job launching process (different on IBM, SGI, Compaq). ! ! b) Processor ranges for each components are defined local ! to the executable. ! ! c) You could have up tp 5 strings attached for each component ! of either muti-component or muti-instance executable. ! \end{verbatim} ! \section{How to Use} ! \begin{verbatim} ! There is one source code for each executable. Users need to ! include "use MPH_module" in the application codes, and ! invoke the appropriate MPH_components function for the multi-component ! executables and MPH_multi_instance function for the multi-instance ! executbales. For example, ICE_LAND_World = MPH_components (name1="ice", ! name2="land") and POP_WORLD = MPH_multi_instance("POP"). You could use ! MPH_debug call to determine the output message amount, the ! default level is 0. "MPH_help" call provides you the available ! inquiry functions for that mode. ! ! An input file called "processors_map.in" to give detailed ! information of component nametags and processor ranges. See more ! detail about how this file looks like in Section 1. ! Each component maintains its own output in a separate file (file ! name defined by environment variable either in command line or ! in batch run script), assuming the local processor 0 of each ! component being responsible for most output, other occasional ! writes from all the components are stored in one combined standand ! output file. ! ! This is accomplished by processor rank 0 of each component call ! subroutine "MPH_redirect_output" with the model name as argument. ! IBM and SGI could do the output redirect with the help of system ! function "getenv" or "pxfgetenv". Compaq cannot do this. And ! T3E is able to get the correct output files created using ! "pxfgetenv", but only output with those "write(6,*)" could be ! redirected, but not those with "write(*,*)", since * is equal to ! unit 101, and permanently related to the non-redirectable stdout. ! \end{verbatim} ! \section{How to Compile and Run} ! \begin{verbatim} ! ! The shared "Makefile" detects the machine architecture and ! compiles appropriately for IBM, SGI and Compaq. For test case 1, ! type "make test1", and for test case 2, type "make test2". ! or "gmake ..." depends on your machine). ! ! After compile, you will have executables generated ("ice_land", ! "cpl", "pop_atm" for test1, and "ice_land", "cpl" for test2) in ! the corresponding subdirectory. Each sample subdirectoy also ! includes batch scripts and sample output. ! ! Go to that directory first (here we use test2 as an example), ! and then: ! ! 1) To run on NERSC and NCAR IBM SP interactively: ! a) % unsetenv MP_TASKS_PER_NODE ! b) % setenv ice_out_env ice.log ! % setenv land_out_env land.log ! % setenv cpl_out_env cpl.log ! c) Make sure the following command in ONE LINE: ! % poe -pgmmodel mpmd -cmdfimle tasklist -nodes 3 -procs 6 ! -stdoutmode ordered -infolevel 2 > & output & ! ! This is to run the executables listed in user supplied "tasklist" ! in the mpmd mode on total of 3 nodes and 6 procs. ! ! And "tasklist" looks like this: ! ice_land ! ice_land ! cpl ! cpl ! ice_land ! ice_land ! ! To run on IBM SP with batch script: ! % llsubmit runscript.ibm ! And "runscript.ibmc" looks like this: ! #! /usr/bin/csh -f ! # @ output = poe.stdout.$(jobid).$(stepid) ! # @ error = poe.stderr.$(jobid).$(stepid) ! # @ class = debug ! # @ job_type = parallel ! # @ task_geometry = {(0,2)(1,3)(4,5)} ! # @ total_tasks=6 ! # @ network.MPI = css0, not_shared, us ! # @ queue ! setenv MP_PGMMODEL mpmd ! setenv MP_CMDFILE tasklist ! setenv ice_out_env ice.log ! setenv land_out_env land.log ! setenv cpl_out_env cpl.log ! poe ! Again, it needs a user supplied "tasklist", and it runs in mpmd mode. ! The task_geometry keyword specifies which tasks run in the same node. ! 2) We could not run it on NERSC CRAY T3E since there is no mpmd ! mechnism. ! ! 3) To run on NCAR SGI interactively: ! a) % setenv ice_out_env ice.log ! % setenv land_out_env land.log ! % setenv cpl_out_env cpl.log ! b) % mpirun -p "[%g]" -np 4 ice_land : -np 2 cpl > output ! This is to run ice_land on 4 procs and cpl on 2 procs. ! [%g] is to print the global id as a prefix for each output line. ! ! 4) To run on NCAR Compaq with batch script: ! % prun -n6 -t runscript.dec ! ! And "runscript.dec" looks like this: ! #! /bin/csh ! if ($RMS_RANK >= 0 && $RMS_RANK <= 3) ice-land & ! if ($RMS_RANK >= 4 && $RMS_RANK <= 5) cpl & ! exit !\end{verbatim} !\section{Acknowledgement} ! MPH is developed in collaboration with Tony Craig, Brian Kauffman, ! Vince Wayland and Tom Bettge of National Center of Atmospheric Research, ! and Rob Jacobs and Jay Larson of Argonne National Laborotory. ! Vince Wayland of NCAR contributes for Makefiles on SGI and Compaq. ! Dan Anderson and Bill Celmaster of NCAR also help in the batch run ! script of Compaq. ! This work is supported by the Office of Biological and ! Environmental Research, Climate Change Prediction Program, under ! ACPI Avant Garde project, and by the Office of Computational and ! Technology Research, Division of Mathematical, Information, and ! Computational Sciences, both of the U.S. Department of ! Energy under contract number DE-AC03-76SF00098. !EOI !------------------------------------------------------------------- !------------------------------------------------------------------- !BOP ! ! !MODULE: MPH_module -- Multi Program-Components Handshaking ! ! !DESCRIPTION: ! This module multiple executables with multiple components in ! each executable. This module multiple executables with multiple ! components in. ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: module MPH_module ! !USES: implicit none include 'mpif.h' private ! except ! !PUBLIC MEMBER FUNCTIONS: public :: MPH_Multi_Instance public :: MPH_components public :: Proc_in_component public :: Proc_in_num_comps public :: MPH_global_id public :: MPH_comm_join public :: MPH_redirect_output public :: MPH_help public :: MPH_debug public :: MPH_timer public :: MPH_total_components public :: MPH_comp_name public :: MPH_comp_id public :: MPH_local_world public :: MPH_exe_id public :: MPH_total_num_exe public :: MPH_num_comps public :: MPH_local_proc_id public :: MPH_local_totProcs public :: MPH_global_proc_id public :: MPH_global_totProcs public :: MPH_exe_world public :: MPH_exe_low_proc_limit public :: MPH_exe_up_proc_limit public :: MPH_num_ensemble public :: MPH_num_strings public :: MPH_get_strings public :: MPH_get_argument ! !PUBLIC DATA MEMBERS: integer, public :: istatus(MPI_STATUS_SIZE), ierr integer, public :: MPH_Global_World ! total processor for the whole world ! !DEFINED PARAMETERS integer, parameter :: max_num_comps=100 ! maximum number of components integer, parameter :: maxProcs_comp=128 ! maximum number of procs per comp integer, parameter :: max_num_exes=10 ! maximum number of executables integer, parameter :: max_num_strings=5 ! maximum number of executables integer, parameter :: N_CHANNELS=10 ! number of channels for timing ! !LOCAL VARIABLES: type Acomponent character (len=80) :: name ! component name integer :: num_process ! number of processors integer :: process_list (maxProcs_comp) ! global processor_id, increasing order end type Acomponent type (Acomponent) :: components (max_num_comps) ! allocate components integer :: MPI_Acomponent integer :: local_world (max_num_comps) ! communicator for each component integer :: local_proc_id (max_num_comps) ! proc id in each component integer :: local_totProcs (max_num_comps) ! total number of processors in each component integer :: global_proc_id ! proc id in the whole world integer :: global_totProcs ! total number of processors integer :: COMM_master ! communicator for submaster of each component integer :: total_components ! total number of components character (len=80) :: component_names (max_num_comps) ! component names character (len=80) :: name (max_num_comps) ! name array used in setup integer :: comp_id (max_num_comps) ! component id of each component integer :: exe_low_proc_limit (max_num_comps) ! lower processor limit of each component ! in each executable world integer :: exe_up_proc_limit (max_num_comps) ! upper processor limit of each component ! in each executable world integer :: exe_world_proc_id (max_num_exes) ! processor id in the executable world integer :: exe_world_totProcs (max_num_exes) ! number of processors in each executable integer :: exe_world (max_num_exes) ! communicator for each executable integer :: exe_ids (max_num_comps) ! executable ids integer :: num_comps (max_num_comps) ! number of components in each executable integer :: total_num_exe ! total number of executables logical :: ensemble (max_num_comps) ! whether a comp is in ensemble integer :: exe_id ! executable id integer :: num_strings (max_num_comps) character (len=80) :: strings (max_num_comps,max_num_strings) & ! ensemble parameters integer :: debug_level = 0 ! level of debug ! .. for timer .. real (kind=8) :: init_time = -1.0 real (kind=8) :: last_time, tot_time (0:N_CHANNELS) !EOP !------------------------------------------------------------------------- interface MPH_get_argument module procedure MPH_get_argument_int module procedure MPH_get_argument_real module procedure MPH_get_argument_char module procedure MPH_get_argument_field end interface MPH_get_argument contains !========================================================================== ! integer function MPH_components(name1, name2, name3, name4, name5, ! & name6, name7, name8, name9, name10, multi, names) !========================================================================== !BOP ! ! !IROUTINE: MPH_components -- main MPH setup function ! ! !DESCRIPTION: ! This is the main function for each of the executable to call to ! setup the distributed multi-component environment. For example, ! if ocean and atmosphere sits in one executable, the source code ! will contain: ! \begin{verbatim} ! mpi_exec_world = & ! MPH_components(name1='ocean', name2='atmosphere',...) ! \end{verbatim} ! This function returns the MPI communicator of local executable world. ! !REVISION HISTORY: ! 2003-Apr-03 -- increase from 5 arguments to 10 again ! 2001-Dec-03 -- reduce from 10 arguments to 5 ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_components(name1, name2, name3, name4, name5, & name6, name7, name8, name9, name10, multi, names) ! !USES: implicit none ! !INPUT PARAMETERS: ! These are component names character(len=*),intent(in) :: name1 character(len=*),intent(in),optional :: name2, name3, name4, name5 character(len=*),intent(in),optional :: name6, name7, name8 character(len=*),intent(in),optional :: name9, name10 integer,intent(in),optional :: multi character(len=*),intent(in),optional :: names(100) ! !OUTPUT PARAMETERS: ! ! This function returns the MPI communicator of this executable ! ! world: exe_world (exe_id) ! !SEE ALSO: ! MPH_init, MPH_local, MPH_global, MPH_multi_instance ! !LOCAL VARIABLES: integer :: k !EOP !---------------------------------------------------------------------- if (present(multi)) then do k = 1, multi name(k) = trim(names(k)) enddo do k = multi+1, max_num_comps name(k) = '' enddo else name(1) = trim(name1) do k = 2, max_num_comps name(k) = '' enddo if (present(name10)) name(10) = trim(name10) if (present(name9)) name(9) = trim(name9) if (present(name8)) name(8) = trim(name8) if (present(name7)) name(7) = trim(name7) if (present(name6)) name(6) = trim(name6) if (present(name5)) name(5) = trim(name5) if (present(name4)) name(4) = trim(name4) if (present(name3)) name(3) = trim(name3) if (present(name2)) name(2) = trim(name2) endif write(*,*)'===================================' call MPH_init () call MPH_local () call MPH_global () MPH_components = exe_world (exe_id) end function MPH_components !========================================================================= ! subroutine MPH_init () !========================================================================= !BOP ! ! !IROUTINE: MPH_init -- initialize MPI and read the processors map info ! ! !DESCRIPTION: ! This routine calls mpi\_init, obtains global processor id. It ! reads and processes the ``processors\_map.in'' file. It also defines ! an MPI\_Acomponent sturcture (includes component name, number of ! processors and processor list for each component) for easy ! gather and scatter. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: subroutine MPH_init () ! !USES: implicit none ! !SEE ALSO: ! MPH_read_list, MPH_local, MPH_global ! !LOCAL VARIABLES: integer :: iblock(3), idisp(3), itype(3) !EOP !--------------------------------------------------------------------- call MPI_INIT (ierr) call MPI_COMM_DUP (MPI_COMM_WORLD, MPH_Global_World, ierr) call MPI_COMM_RANK (MPH_Global_World, global_proc_id, ierr) call MPI_COMM_SIZE (MPH_Global_World, global_totProcs, ierr) total_components = MPH_read_list("processors_map.in", & "PROCESSORS_MAP", component_names, & exe_low_proc_limit, exe_up_proc_limit, & local_totProcs, exe_ids, num_comps, total_num_exe, & ensemble, num_strings, strings) ! create a new MPI data type MPI_Acomponent write(*,*)'total_components=', total_components iblock(1) = 80 iblock(2) = 1 iblock(3) = maxProcs_comp idisp(1) = 0 idisp(2) = 80 idisp(3) = 84 itype(1) = MPI_CHARACTER itype(2) = MPI_INTEGER itype(3) = MPI_INTEGER call MPI_TYPE_STRUCT(3,iblock,idisp,itype,MPI_Acomponent,ierr) call MPI_TYPE_COMMIT (MPI_Acomponent, ierr) end subroutine MPH_init !========================================================================= ! subroutine MPH_local () !========================================================================= !BOP ! ! !IROUTINE: MPH_local -- local handshaking ! ! !DESCRIPTION: ! This routine first defines exe\_id , and creates local exe\_world ! for each executable. It then gathers gobal processor ids onto ! submaster (whose rank is 0 in exe\_world). And then it creates ! local\_world for each component within exe\_world based on its ! upper and lower processor limits. Finally it collects name, number ! of processors, and processor list of each component onto submaster of ! each executable world. ! !REVISION HISTORY: ! 2001-Dec-13 -- add warning for overlapping processors ! 2001-Nov-27 -- add local_totProcs for single component executables ! 2001-Nov-19 -- add PROTEX convention, use new MPH_read_list interface ! 2001-May-20 -- first prototype ! !INTERFACE: subroutine MPH_local () ! !USES: implicit none ! !SEE ALSO: ! MPH_init, MPH_global, MPH_find_name ! !LOCAL VARIABLES: integer :: color, key integer :: id, comp_id_end, i, k !EOP !--------------------------------------------------------------------- ! define exe_id, create exe_world for each executable comp_id(1) = MPH_find_name (name(1), component_names, & total_components) key = 0 exe_id = exe_ids (comp_id(1)) call MPI_COMM_SPLIT (MPH_Global_World, exe_id, key, & exe_world(exe_id),ierr) ! setup exe_world_proc_id, exe_world_totProcs call MPI_COMM_RANK(exe_world(exe_id), exe_world_proc_id(exe_id), & ierr) call MPI_COMM_SIZE(exe_world(exe_id), exe_world_totProcs(exe_id), & ierr) ! initialize process_list to be -1 do id = 1, total_components do i = 1, exe_world_totProcs(exe_id) components(id)%process_list(i) = -1 enddo enddo components(comp_id(1))%name = name(1) components(comp_id(1))%num_process=exe_world_totProcs(exe_id) ! gather processor ids to 0th proc in this component call MPI_GATHER (global_proc_id, 1, MPI_INTEGER, & components(comp_id(1))%process_list, 1, & MPI_INTEGER, 0, exe_world(exe_id), ierr) if (name(2) .ne. '') then ! more than one component in this executable comp_id(2) = MPH_find_name (name(2), component_names, & total_components) comp_id_end = comp_id(2) do k = 3, max_num_comps if (name(k) .ne. '') then comp_id(k) = MPH_find_name (name(k), component_names, & total_components) comp_id_end = comp_id(k) endif enddo ! create local world for each component within exe_world do id = comp_id(1), comp_id_end if (exe_low_proc_limit(id) .le. exe_world_proc_id(exe_id) & .and. exe_world_proc_id(exe_id) .le. & exe_up_proc_limit(id)) then color = 1 else color = 2 endif key = 0 call MPI_COMM_SPLIT (exe_world(exe_id), color, key, & local_world(id), ierr) call MPI_COMM_RANK(local_world(id),local_proc_id(id),ierr) enddo else ! only one component in this executable call MPI_COMM_DUP(exe_world(exe_id), local_world(comp_id(1)), & ierr) call MPI_COMM_RANK(local_world(comp_id(1)), & local_proc_id(comp_id(1)),ierr) call MPI_COMM_SIZE(local_world(comp_id(1)), & local_totProcs(comp_id(1)),ierr) exe_low_proc_limit (exe_id) = 0 exe_up_proc_limit (exe_id) = local_totProcs(comp_id(1))-1 endif ! collect name, number of processors, and processor list of each component ! onto submaster of each executable world if (exe_world_proc_id(exe_id)==0) then if (name(2) .ne. '') then components(comp_id(2))%name = name(2) components(comp_id(2))%num_process = & local_totProcs(comp_id(2)) do i = exe_low_proc_limit(comp_id(2)), & exe_up_proc_limit(comp_id(2)) components(comp_id(2))%process_list(i- & exe_low_proc_limit(comp_id(2))+1) & = components(comp_id(1))%process_list(i+1) enddo do k = 3, max_num_comps if (name(k) .ne. '') then components(comp_id(k))%name = name(k) components(comp_id(k))%num_process = & local_totProcs(comp_id(k)) do i = exe_low_proc_limit(comp_id(k)), & exe_up_proc_limit(comp_id(k)) components(comp_id(k))%process_list(i- & exe_low_proc_limit(comp_id(k))+1) & = components(comp_id(1))%process_list(i+1) enddo endif enddo components(comp_id(1))%num_process = & local_totProcs(comp_id(1)) do i = exe_low_proc_limit(comp_id(1)), & exe_up_proc_limit(comp_id(1)) components(comp_id(1))%process_list(i- & exe_low_proc_limit(comp_id(1))+1) & = components(comp_id(1))%process_list(i+1) enddo do i = exe_up_proc_limit(comp_id(1))+1, & exe_world_totProcs(exe_id) components(comp_id(1))%process_list(i+1)=-1 enddo ! check overlap in this multi-component executable do i = 1, num_comps(exe_id) do k = i+1, num_comps(exe_id) if (exe_up_proc_limit(comp_id(i)) >= & exe_low_proc_limit(comp_id(k))) then write(*,*)'warning: local procs ', & exe_low_proc_limit(comp_id(k)), ' to ', & exe_up_proc_limit(comp_id(i)), ' is overlapped in ', & 'these two components of the executable: ', & components(comp_id(i))%name, components(comp_id(k))%name endif enddo enddo endif endif end subroutine MPH_local !========================================================================= ! subroutine MPH_global () !========================================================================= !BOP ! ! !IROUTINE: MPH_global -- global handshaking ! ! !DESCRIPTION: ! This routine first creates an MPI communicator COMM\_master for all ! submasters (whose rank is 0 in the executable world). It then does ! an MPI\_allgatherv in COMM\_master to collect all the components ! information from each submaster. Then each submaster broadcasts ! AComponents to all PEs in its local exe\_world. Finally, every ! processor lists the complete info of all the components. ! ! !REVISION HISTORY: ! 2002-Apr-15 -- correct a bug in declaring sendbuf ! 2001-Dec-13 -- add warning for overlapping processors ! 2001-Nov-19 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: subroutine MPH_global () ! !USES: implicit none ! !SEE ALSO: ! MPH_init, MPH_local, MPH_debug ! !LOCAL VARIABLES: integer :: id, i, color, key type (Acomponent) :: sendbuf(max_num_comps) integer :: sendcount integer :: recvcounts(0:total_num_exe-1) integer :: displs(0:total_num_exe-1) !EOP !------------------------------------------------------------------- ! create a MPI communicator COMM_master for all submasters ! arrange the rank of the submasters in COMM_master by their exe_id ! i.e., their rank of the executables in "processors_map.in" if (exe_world_proc_id (exe_id) == 0) then color = 1 else color = 2 endif key = exe_id call MPI_COMM_SPLIT (MPH_Global_World,color,key,COMM_master,ierr) ! do a MPH_ALLGATHERV in COMM_master if (exe_world_proc_id (exe_id) == 0) then sendcount = num_comps(exe_id) displs(0) = 0 recvcounts(0) = num_comps(1) do id = 2, total_num_exe recvcounts(id-1) = num_comps(id) displs(id-1) = displs(id-2) + num_comps(id-1) enddo do i = 1, num_comps(exe_id) sendbuf(i) = components(displs(exe_id-1)+i) enddo call MPI_ALLGATHERV(sendbuf, sendcount, MPI_AComponent, & components, recvcounts, displs, MPI_AComponent, & COMM_master, ierr) endif ! submaster broadcast AComponents to all PEs in local exe_world call MPI_BCAST (components, total_components, & MPI_Acomponent, 0, exe_world(exe_id), ierr) ! everybody lists the complete info if (debug_level >= 1) then write(*,*)'global_proc_id=', global_proc_id endif if (debug_level == 2) then write(*,*)'infos I have for all proc of all components are:' do i = 1, total_components write(*,*)' ', components(i)%name write(*,*)' ', components(i)%num_process write(*,*)' ', components(i)%process_list(1: & components(i)%num_process) enddo endif ! print a warning message for overlapping processors if (Proc_in_num_comps() > 1) then write(*,*)'warning: global processor ', global_proc_id, ' & is overlapped' endif end subroutine MPH_global !========================================================================= ! logical function Proc_in_component (name, comm) !========================================================================= !BOP ! ! !IROUTINE: Proc_in_component -- check if a processor is in a component ! ! !DESCRIPTION: ! This is a logical function to check if a processor is in a component. ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: logical function Proc_in_component (name, comm) ! !USES: implicit none ! !SEE ALSO: ! MPH_find_name ! !INPUT PARAMETERS: character(len=*), intent(in) :: name ! component name ! !OUTPUT PARAMETERS: ! ! the local communicator of that component is written in comm. integer, intent(out) :: comm ! communicator for the component ! !LOCAL VARIABLES: integer :: id, i !EOP !------------------------------------------------------------------- id = MPH_find_name(name, component_names, total_components) do i = 1, components(id)%num_process if (global_proc_id == components(id)%process_list(i)) then comm = local_world (id) Proc_in_component = .true. return else continue endif enddo Proc_in_component = .false. end function Proc_in_component !========================================================================= ! integer function Proc_in_num_comps () !========================================================================= !BOP ! ! !IROUTINE: Proc_in_num_comps -- the number of components a processor is in ! ! !DESCRIPTION: ! This function returns the number of components a processor is in. ! !REVISION HISTORY: ! 2001-Dec-13 -- first prototype ! !INTERFACE: integer function Proc_in_num_comps () ! !USES: implicit none ! !SEE ALSO: ! Proc_in_component ! !LOCAL VARIABLES: integer :: id, i !EOP !------------------------------------------------------------------- Proc_in_num_comps = 0 do id = 1, total_components do i = 1, components(id)%num_process if (global_proc_id == components(id)%process_list(i)) then Proc_in_num_comps = Proc_in_num_comps + 1 endif enddo enddo end function Proc_in_num_comps !========================================================================= ! integer function MPH_global_id (cname, lid) !========================================================================= !BOP ! ! !IROUTINE: MPH_global_id -- find global processor id ! ! !DESCRIPTION: ! This function returns global processor id given the component ! name and local processor id in that component. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_global_id (cname, lid) ! !USES: implicit none ! !SEE ALSO: ! MPH_find_name ! !INPUT PARAMETERS: character(len=*), intent(in) :: cname ! component name integer, intent(in) :: lid ! local processor id in the component ! !OUTPUT PARAMETERS: ! ! This function returns global_proc_id given the component ! ! name and local_proc_id in that component. ! !LOCAL VARIABLES: integer :: temp !EOP !------------------------------------------------------------------- ! then find out the component rank temp = MPH_find_name (cname,component_names,total_components) ! process_list starts from 1, while proc rank starts from 0 MPH_global_id = components(temp) % process_list(lid+1) end function MPH_global_id !========================================================================= ! subroutine MPH_comm_join (name1, name2, comm_joined) !========================================================================= !BOP ! ! !IROUTINE: MPH_comm_join -- join two components ! ! !DESCRIPTION: ! This routine creates a joined MPI communicators for any two ! components. The order of these two components appeared in ! the subroutine parameter argumment has an effect on the ! local process id within the joined communicator. ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: subroutine MPH_comm_join (name1, name2, comm_joined) ! !USES: implicit none ! !SEE ALSO: ! MPH_find_name, Proc_in_component ! !INPUT PARAMETERS: character(len=*), intent(in) :: name1, name2 ! two component names ! !OUTPUT PARAMETERS: integer, intent(out) :: comm_joined ! joined communicator for two components ! !LOCAL VARIABLES: integer :: id1, id2 integer :: color, key logical :: con1, con2 integer :: comm1, comm2 !EOP !------------------------------------------------------------------- write(*,*)'begin of comm_join' id1 = MPH_find_name (name1,component_names,total_components) id2 = MPH_find_name (name2,component_names,total_components) write(*,*)'begin2 of comm_join' write(*,*)id1, id2 ! the order of two components does matter: first one has lower ranks ! in the new joined communicator, and second one has higher ranks. con1 = Proc_in_component (name1, comm1) con2 = Proc_in_component (name2, comm2) write(*,*)'middle of comm_join' write(*,*)con1, con2 if (con1 .or. con2) then color = 1 if (con1) then key = local_proc_id (id1) else key = global_totProcs + local_proc_id (id2) endif else color = 2 key = 0 endif write(*,*)'before comm_join, fine' call MPI_COMM_SPLIT (MPH_Global_World,color,key,comm_joined,ierr) write(*,*)'after comm_join, fine' end subroutine MPH_comm_join !========================================================================= ! subroutine MPH_redirect_output (name) !========================================================================= !BOP ! ! !IROUTINE: MPH_redirect_output -- redirect output from each component ! ! !DESCRIPTION: ! This routine redirects output to a log file defined by an environment ! variable. System functions ("getenv" for IBM and "pxfgetenv" for ! SGI and T3E) are used to retrieve the environmet variable. ! ! !REMARKS: ! In order to redirect component output to a separate file, ! a user will setup something like the following in the run script: ! setenv ice_out_env ice.log ! setenv land_out_env land.log ! setenv cpl_out_env cpl.log ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: subroutine MPH_redirect_output (name) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in) :: name ! part of the log file name ! !LOCAL VARIABLES: integer :: lenname, lenval, rcode character(len=80) :: output_name_env character(len=80) :: output_name, temp_value !EOP !------------------------------------------------------------------- output_name = ' ' output_name_env = trim (name) // "_out_env" #if (defined AIX) call getenv (trim(output_name_env), temp_value) output_name = trim (temp_value) if (len_trim(output_name) == 0) then write(*,*)'output file names not preset by env varibales' write(*,*)'so output not redirected' else open (unit=6, file=output_name, position='append') call flush_(6) endif #endif #if (defined IRIX64 || defined CRAY || defined sn6711) lenname = len_trim (output_name_env) call pxfgetenv (output_name_env,lenname,output_name,lenval,rcode) if (len_trim(output_name) == 0) then write(*,*)'output file names not preset by env varibales' write(*,*)'so output not redirected' else open (unit=6, file=output_name, position='append') call flush(6) endif #endif #if (!defined AIX && !defined IRIX64 && !defined CRAY && !defined sn6711) write(*,*) 'No implementation for this architecture' write(*,*) 'output redirect is not performed by getenv' #endif end subroutine MPH_redirect_output !========================================================================= ! integer function MPH_read_list (filename, filetag, namelist, ! & low, up, local_num, id_exe, num_comp, total_exe, ! & ensemb, num_strs, strs) !========================================================================= !BOP ! ! !IROUTINE: MPH_read_list -- read and process info from "processors_map.in" ! ! !DESCRIPTION: ! This routine reads and processes info from "processors\_map.in". ! Please see a sample input file in Introduction. ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! remove two arguments: max_num_comp, max_num_exe ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_read_list (filename, filetag, namelist, & low, up, local_num, id_exe, num_comp, total_exe, & ensemb, num_strs, strs) ! !USES: + implicit none ! !SEE ALSO: ! MPH_find_name, MPH_init ! !INPUT PARAMETERS: character(len=*), intent(in) :: filename ! the input file name character(len=*), intent(in) :: filetag ! "PROCESSORS_MAP" ! !OUTPUT PARAMETERS: character (len=80), intent(out) :: namelist(max_num_comps) ! component names integer, intent(out) :: low(max_num_comps) ! lower processor limit of each component ! in each executable world integer, intent(out) :: up(max_num_comps) ! upper processor limit of each component ! in each executable world integer, intent(out) :: local_num(max_num_comps) ! total number of processors for each component integer, intent(out) :: id_exe(max_num_comps) ! executable ids integer, intent(out) :: num_comp(max_num_comps) ! number of components in each executable integer, intent(out) :: total_exe ! total number of executables logical, intent(out) :: ensemb(max_num_comps) integer, intent(out) :: num_strs(max_num_comps) character(len=80),intent(out)::strs(max_num_comps,max_num_strings) ! !LOCAL VARIABLES: integer :: i, k, kk, ik, id, iend ! i is comp_id, id is exe_id character (len=80) :: firstline, temp, temp_char(8) logical :: in_multi, in_ensemble !EOP !------------------------------------------------------------------- open(10, file=filename, status='unknown') read(10, *, end=150) firstline if (firstline .ne. filetag) then print *, 'ERROR: filetag inconsistent', filename print *, 'ERROR: ', filetag, '!=', firstline stop endif read(10, *, end=250) temp if (temp .ne. "BEGIN") then print *, 'ERROR: no BEGIN in ', filename stop endif i = 0 id = 0 ik = 0 in_multi = .false. in_ensemble = .false. num_strs = 0 strs = "NULL" 1000 read(10,'(a80)', err= 100, end =100) temp if (iachar(temp(1:1)) .ge. iachar("0") .and. & iachar(temp(1:1)) .le. iachar("9")) goto 1000 iend = index(temp," ") k = 1 temp_char(k) = temp(1:iend-1) if (temp_char(k) .eq. "END") then goto 500 else if (temp_char(k) .eq. "Multi_Comp_Start") then in_multi = .true. id = id + 1 else if (temp_char(k) .eq. "Multi_Instance_Start") then in_multi = .true. in_ensemble = .true. id = id + 1 else if (temp_char(k) .eq. "Multi_Comp_End") then num_comp(id) = ik ik = 0 in_multi = .false. else if (temp_char(k) .eq. "Multi_Instance_End") then num_comp(id) = ik ik = 0 in_multi = .false. in_ensemble = .false. else if (in_multi) then i = i + 1 ik = ik + 1 200 k = k + 1 if (k .gt. 8) goto 300 temp = adjustl(temp(iend:80)) if (len(trim(temp)) .ne. 0) then iend = index(temp," ") if (iend .ne. 0) temp_char(k) = temp(1:iend-1) goto 200 else goto 300 endif 300 id_exe(i) = id ensemb(i) = in_ensemble namelist(i) = temp_char(1) read(temp_char(2),'(i10)') low(i) read(temp_char(3),'(i10)') up(i) local_num(i) = up(i) -low(i) + 1 num_strs(i) = k - 4 do kk = 1, num_strs(i) strs(i,kk) = temp_char(kk+3) enddo else i = i + 1 id = id + 1 id_exe(i) = id ensemb(i) = in_ensemble namelist(i) = temp_char(1) low(i) = - 1 up(i) = -1 local_num(i) = -1 num_comp(id) = 1 endif goto 1000 100 print *, 'ERROR: file read error, no END?', filename 150 print *, 'ERROR: no filetag in ', filename stop 250 print *, 'ERROR: no BEGIN in ', filename stop 500 total_exe = id MPH_read_list = i return end function MPH_read_list !========================================================================= ! integer function MPH_find_name (name, namelist, num) !========================================================================= !BOP ! ! !IROUTINE: MPH_find_name -- find name in a namelist ! ! !DESCRIPTION: ! This routine finds if a certain name exists in an array of ! namelist and returns the rank if it does or -1 if it does not. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_find_name (name, namelist, num) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in) :: name ! name to be found integer :: num ! length of namelist array character (len=80) namelist(num) ! name list array ! !OUTPUT PARAMETERS: ! ! the rank of a name in an array of namelist or -1 if not exist ! !LOCAL VARIABLES: integer :: i !EOP !------------------------------------------------------------------- do i = 1, num if (name == namelist(i)) then ! print *, i, name, namelist(i) goto 100 endif enddo ! name is not found MPH_find_name = -1 print *, "ERROR: ", name, " not found in processors_map.in" stop 100 MPH_find_name = i return end function MPH_find_name !========================================================================= ! subroutine MPH_help (arg) !========================================================================= !BOP ! ! !IROUTINE: MPH_help -- display help info ! ! !DESCRIPTION: ! This routine displays some help info for the MPH setup interface ! and some inquiry functions. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: subroutine MPH_help (arg) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in) :: arg ! either 'on' or 'off' !EOP !------------------------------------------------------------------- write(*,*)'Message from MPH_help:' if (arg .eq. 'off') then write(*,*)'off' return else if (arg .eq. 'on') then write(*,*)'default debug level=0, choose 1 or 2 for more & debug messages' write(*,*)'MPH: multiple executables with multiple components & in each executable' write(*,*)'Sample setup functions are: ' write(*,*)' ICE_LAND_World = MPH_components (name1="ice", & name2="land")' write(*,*)' CPL_World = MPH_components (name1="coupler")' write(*,*)' POP_World = MPH_multi_instance ("POP")' write(*,*)'Required input file is "processors_map.in"' write(*,*)'Subroutine call to join two communicators is:' write(*,*)' MPH_comm_join (name1,name2,comm_joined)' write(*,*)'Available inquiry functions are:' write(*,*)'(arguments are optional except for MPH_global_id)' write(*,*)' integer MPH_global_id(cname,lid)' write(*,*)' integer MPH_total_components()' write(*,*)' character (len=80) MPH_comp_name(cid)' write(*,*)' integer MPH_comp_id(cname)' write(*,*)' integer MPH_local_world(cname)' write(*,*)' integer MPH_exe_id(cname)' write(*,*)' integer MPH_total_num_exe()' write(*,*)' integer MPH_num_comps(eid)' write(*,*)' integer MPH_local_proc_id(cid)' write(*,*)' integer MPH_local_totProcs(cid)' write(*,*)' integer MPH_global_proc_id()' write(*,*)' integer MPH_global_totProcs()' write(*,*)' integer MPH_exe_world(eid)' write(*,*)' integer MPH_exe_low_proc_limit(eid)' write(*,*)' integer MPH_exe_up_proc_limit(eid)' write(*,*)' integer MPH_num_ensemble(name)' write(*,*)' integer MPH_num_strings(cname)' write(*,*)' subroutine MPH_get_strings' write(*,*)' subroutine MPH_get_argument' else write(*,*)'wrong argument for MPH_help' endif write(*,*) end subroutine MPH_help !========================================================================= ! subroutine MPH_debug (level) !========================================================================= !BOP ! ! !IROUTINE: MPH_debug -- define debug level ! ! !DESCRIPTION: ! This routine defines the debug level. The higher the level is, ! the more debug information the code will display. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: subroutine MPH_debug (level) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in) :: level ! 0 (default), 1 or 2 !EOP !------------------------------------------------------------------- debug_level = level end subroutine MPH_debug !========================================================================= ! integer function MPH_timer (flag, channel) !========================================================================= !BOP ! ! !IROUTINE: MPH_timer -- collect timing info in different channels. ! ! !DESCRIPTION: This function collects timing info in different ! channels. ! \begin{verbatim} ! Usage: ! channel 0 is the default channel, using init_time. ! --------------------------------------------------------- ! timer calls to walk-clock dclock(), and do the following: ! --------------------------------------------------------- ! flag=0 : Sets initial time; init all channels. ! flag =1 : Calculates the most recent time interval; accrues it ! to the specified channel (default 0); Returns it to ! calling process. ! flag =2 : Calculates the most recent time interval; accrues it ! to the specified channel (default 0); Returns the ! curent total time in the specified channel. ! --------------------------------------------------------- ! \end{verbatim} ! !REVISION HISTORY: ! 2001-Nov-19 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: real (kind=8) function MPH_timer (flag, channel) ! !USES: implicit none ! !INPUT PARAMETERS: integer :: flag, channel ! !OUTPUT PARAMETERS: ! ! real (kind=8) MPH_timer (flag, channel) ! !LOCAL VARIABLES: real (kind=8) :: new_time, delta_time, MPI_Wtime !EOP !------------------------------------------------------------------- new_time = MPI_Wtime() if (flag == 0) then init_time = new_time last_time = new_time tot_time = 0.0 MPH_timer = new_time - init_time else if (init_time == -1.0) then ! Error Condition MPH_timer = init_time endif ! Timer is initialized and flag != 0 delta_time = new_time - last_time last_time = new_time ! For channel=0 or other undefined channels which is treated as 0 if ( channel < 0 .or. channel > N_CHANNELS) then write(*,*) 'Timer channel is not properly specified!' endif ! channel != 0 if (flag == 1) then tot_time(channel) = tot_time(channel) + delta_time MPH_timer = delta_time else if (flag == 2) then tot_time(channel) = tot_time(channel) + delta_time MPH_timer = tot_time(channel) else ! Error Condition MPH_timer = -1.0 endif end function MPH_timer ! ---- some inquiry functions---------------------------------------------- !========================================================================= ! integer function MPH_total_components () !========================================================================= !BOP ! ! !IROUTINE: MPH_total_components -- find number of total components ! ! !DESCRIPTION: ! This function returns the number of total components. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_total_components () ! !USES: implicit none ! !OUTPUT PARAMETERS: ! ! total_components !EOP !------------------------------------------------------------------- MPH_total_components = total_components end function MPH_total_components !========================================================================= ! character (len=80) function MPH_comp_name (cid) !========================================================================= !BOP ! ! !IROUTINE: MPH_comp_name -- find component name given component id ! ! !DESCRIPTION: ! This function returns component name given component id. ! ! !REVISION HISTORY: ! 2001-Dec-13 -- use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: character (len=80) function MPH_comp_name (cid) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in), optional :: cid ! component id ! !OUTPUT PARAMETERS: ! ! component_names (cid) ! !SEE ALSO: ! MPH_find_name, MPH_comp_id ! !LOCAL VARIABLES: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cid)) then MPH_comp_name = component_names (cid) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cid is required but missing for & function MPH_comp_name(cid)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_comp_name = component_names(id) goto 100 endif enddo endif 100 return end function MPH_comp_name !========================================================================= ! integer function MPH_comp_id (cname) !========================================================================= !BOP ! ! !IROUTINE: MPH_comp_id -- find component id given component name ! !DESCRIPTION: ! This routine returns component id given component name. ! ! !REVISION HISTORY: ! 2001-Dec-13 -- use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_comp_id (cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in), optional :: cname ! component name ! !OUTPUT PARAMETERS: ! ! MPH_comp_id ! !SEE ALSO: ! MPH_find_name, MPH_comp_name, Proc_in_num_comps ! !LOCAL VARIABLES: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cname)) then MPH_comp_id = MPH_find_name (cname, component_names, & total_components) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & function MPH_comp_id(cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_comp_id = id goto 100 endif enddo endif 100 return end function MPH_comp_id !========================================================================= ! integer function MPH_local_world (cname) !========================================================================= !BOP ! ! !IROUTINE: MPH_local_world -- find local communicator given component name ! !DESCRIPTION: ! This routine returns local communicator given component name. ! ! !REVISION HISTORY: ! 2001-Dec-13 -- first prototype ! !INTERFACE: integer function MPH_local_world (cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in), optional :: cname ! component name ! !OUTPUT PARAMETERS: ! ! MPH_local_world ! !SEE ALSO: ! MPH_find_name, MPH_comp_id, Proc_in_num_comps ! !LOCAL VARIABLES: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cname)) then id = MPH_find_name (cname, component_names, & total_components) MPH_local_world = local_world(id) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & function MPH_local_world(cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_local_world = local_world(id) goto 100 endif enddo endif 100 return end function MPH_local_world !========================================================================= ! integer function MPH_exe_id (cname) !========================================================================= !BOP ! ! !IROUTINE: MPH_exe_id -- find executable id given component name ! ! !DESCRIPTION: ! This function returns the executable id given component name. ! ! !REVISION HISTORY: ! 2001-Dec-13 -- use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_exe_id (cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in), optional :: cname ! component name ! !OUTPUT PARAMETERS: ! ! exe_ids (id) ! !SEE ALSO: ! MPH_find_name, Proc_in_num_comps ! !LOCAL PARAMETERS: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cname)) then id = MPH_find_name (cname, component_names, & total_components) MPH_exe_id = exe_ids (id) else if (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & function MPH_exe_id(cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_exe_id = exe_ids (id) goto 100 endif enddo endif 100 return end function MPH_exe_id !========================================================================= ! integer function MPH_total_num_exe () !========================================================================= !BOP ! ! !IROUTINE: MPH_total_num_exe -- find total number of executables ! ! !DESCRIPTION: ! This fuction returns the total number of executables. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_total_num_exe () ! !USES: implicit none ! !OUTPUT PARAMETERS: ! ! total_num_exe !EOP !------------------------------------------------------------------- MPH_total_num_exe = total_num_exe end function MPH_total_num_exe !========================================================================= ! integer function MPH_num_comps (eid) !========================================================================= !BOP ! ! !IROUTINE: MPH_num_comps -- find number of components in an executable ! ! !DESCRIPTION: ! This fuction returns number of components in an executable ! given the executable id. ! !REVISION HISTORY: ! 2003-Apr-04 -- correct a bug for no argument ! 2001-Dec-13 -- use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_num_comps (eid) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in), optional :: eid ! executable id ! !OUTPUT PARAMETERS: ! ! num_comps (eid) ! !SEE Also: ! Proc_in_num_comps !EOP !------------------------------------------------------------------- if (present(eid)) then MPH_num_comps = num_comps (eid) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument eid is required but missing for & function MPH_num_comps(eid)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else MPH_num_comps = num_comps (exe_id) endif 100 return end function MPH_num_comps !========================================================================= ! integer function MPH_local_proc_id (cid) !========================================================================= !BOP ! ! !IROUTINE: MPH_local_proc_id -- find local processor id in a component ! ! !DESCRIPTION: ! This function returns the local processor id given component id. ! ! !REVISION HISTORY: ! 2001-Dec-13 -- use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_local_proc_id (cid) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in), optional :: cid ! component id ! !OUTPUT PARAMETERS: ! ! local_proc_id (cid) ! !SEE ALSO: ! MPH_global_proc_id, Proc_in_num_comps ! !LOCAL VARIABLES: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cid)) then MPH_local_proc_id = local_proc_id (cid) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cid is required but missing for & function MPH_local_proc_id(cid)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_local_proc_id = local_proc_id (id) goto 100 endif enddo endif 100 return end function MPH_local_proc_id !========================================================================= ! integer function MPH_local_totProcs (cid) !========================================================================= !BOP ! ! !IROUTINE: MPH_local_totProcs -- find total number of processors ! in a component. ! ! !DESCRIPTION: ! This function returns the total number of processors in a ! component given component id. ! ! !REVISION HISTORY: ! 2001-Dec-13 -- use optional argument ! 2001-Dec-13 -- use optional argument ! 2001-Nov-27 -- first prototype ! !INTERFACE: integer function MPH_local_totProcs (cid) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in), optional :: cid ! component id ! !OUTPUT PARAMETERS: ! ! local_totProcs (cid) ! !SEE ALSO: ! MPH_global_totProcs, Proc_in_num_comps ! !LOCAL VARIABLES: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cid)) then MPH_local_totProcs = local_totProcs (cid) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cid is required but missing for & function MPH_local_totProcs(cid)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_local_totProcs = local_totProcs (id) goto 100 endif enddo endif 100 return end function MPH_local_totProcs !========================================================================= ! integer function MPH_global_proc_id () !========================================================================= !BOP ! ! !IROUTINE: MPH_global_proc_id -- find global processor id ! ! !DESCRIPTION: ! This function returns the global processor id. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_global_proc_id () ! !USES: implicit none ! !OUTPUT PARAMETERS: ! ! global_proc_id ! !SEE ALSO: ! MPH_local_proc_id !EOP !------------------------------------------------------------------- MPH_global_proc_id = global_proc_id end function MPH_global_proc_id !========================================================================= ! integer function MPH_global_totProcs () !========================================================================= !BOP ! ! !IROUTINE: MPH_global_proc_id -- find total number of processors ! !DESCRIPTION: ! This function returns the total number of processors in MPH world. ! ! !REVISION HISTORY: ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_global_totProcs () ! !USES: implicit none ! !OUTPUT PARAMETERS: ! ! global_totProcs !EOP !------------------------------------------------------------------- MPH_global_totProcs = global_totProcs end function MPH_global_totProcs !========================================================================= ! integer function MPH_exe_world (eid) !========================================================================= !BOP ! ! !IROUTINE: MPH_local_world -- find local communicator of an executable ! ! !DESCRIPTION: ! This function returns the local MPI communicator of an executable ! given executable id. ! ! !REVISION HISTORY: ! 2001-Dec-13 -- change function name from MPH_local_world to MPH_exe_world, ! use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_exe_world (eid) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in), optional :: eid ! executable id ! !OUTPUT PARAMETERS: ! ! exe_world (eid) ! !SEE ALSO: ! Proc_in_num_comps !EOP !------------------------------------------------------------------- if (present(eid)) then MPH_exe_world = exe_world (eid) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument eid is required but missing for & function MPH_exe_world(eid)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else MPH_exe_world = exe_world (exe_id) endif 100 return end function MPH_exe_world !========================================================================= ! integer function MPH_exe_low_proc_limit (cid) !========================================================================= !BOP ! ! !IROUTINE: MPH_exe_low_proc_limit - find lower processor limit of a component ! ! !DESCRIPTION: ! This function returns the relative lower processor limit of a component ! in the executable world given component id. ! ! !REVISION HISTORY: ! 2002-Jun-20 -- correct the argument from eid to cid ! 2001-Dec-13 -- use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_exe_low_proc_limit (cid) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in), optional :: cid ! component id ! !OUTPUT PARAMETERS: ! ! exe_low_proc_limit (cid) ! !SEE ALSO: ! MPH_exe_up_proc_limit, Proc_in_num_comps ! !LOCAL VARIABLES: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cid)) then MPH_exe_low_proc_limit = exe_low_proc_limit (cid) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cid is required but missing for & function MPH_exe_low_proc_limit (cid)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_exe_low_proc_limit = exe_low_proc_limit (id) goto 100 endif enddo endif 100 return end function MPH_exe_low_proc_limit !========================================================================= ! integer function MPH_exe_up_proc_limit (cid) !========================================================================= !BOP ! ! !IROUTINE: MPH_exe_up_proc_limit - find upper processor limit of a component ! ! !DESCRIPTION: ! This function returns the relative upper processor limit of a component ! in the executable world given component id. ! ! !REVISION HISTORY: ! 2002-Jun-20 -- correct the argument from eid to cid ! 2001-Dec-13 -- use optional argument ! 2001-Nov-15 -- add PROTEX convention ! 2001-May-20 -- first prototype ! !INTERFACE: integer function MPH_exe_up_proc_limit (cid) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in), optional :: cid ! component id ! !OUTPUT PARAMETERS: ! ! exe_up_proc_limit (cid) ! !SEE ALSO: ! MPH_exe_low_proc_limit, Proc_in_num_comps ! !LOCAL VARIABLES: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cid)) then MPH_exe_up_proc_limit = exe_up_proc_limit (cid) elseif (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cid is required but missing for & function MPH_exe_up_proc_limit (cid)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_exe_up_proc_limit = exe_up_proc_limit (id) goto 100 endif enddo endif 100 return end function MPH_exe_up_proc_limit !========================================================================== ! integer function MPH_multi_instance (name) !========================================================================== !BOP ! ! !IROUTINE: MPH_multi_instance -- find local communicator for ensemble component ! ! !DESCRIPTION: ! This function returns the local communicator for ensemble component given ! the prefix of an ensemble component names. This is the main function ! for each of the multi-instance to call to setup the distributed multi-component ! environment. For example, if you have multiple instances of POP, namely, ! POP1, POP2, POP3, ... You will have only one source codei that contains ! \begin{verbatim} ! POP_world = MPH_multi_instance('POP') ! \end{verbatim} ! This function returns the local MPI communicator of each POP instance executable. ! !REVISION HISTORY: ! 2003-Apr-04 -- first prototype ! !INTERFACE: integer function MPH_multi_instance(name) ! !USES: implicit none ! !INPUT PARAMETERS: ! These are component names character(len=*),intent(in) :: name ! !OUTPUT PARAMETERS: ! MPH_multi_instance ! !SEE ALSO: ! MPH_num_ensemble, MPH_components ! !LOCAL VARIABLES: integer :: k, kk, comm, num_ensemble character(len=80) :: ename(max_num_comps) character(len=80) :: temp !EOP !---------------------------------------------------------------------- open(20, file='processors_map.in', status='old') num_ensemble = 0 1000 read(20, *, err=1100, end=1100) temp k = len(trim(name)) if (temp(1:k) .eq. name(1:k)) then num_ensemble = num_ensemble + 1 do kk = 1,80 if (temp(k+kk:k+kk) .eq. " ") goto 300 enddo 300 ename(num_ensemble) = temp(1:k+kk-1) endif goto 1000 1100 close(20) comm=MPH_components(name1="NULL",multi=num_ensemble,names=ename) MPH_multi_instance = MPH_local_world() end function MPH_multi_instance !========================================================================= ! integer function MPH_num_ensemble (name) !========================================================================= !BOP ! ! !IROUTINE: MPH_num_ensemble -- find number of components in an ensemble ! !DESCRIPTION: ! This fuction returns number of components in an ensemble executable ! given the prefix of an ensmeble component names. ! !REVISION HISTORY: ! 2003-Apr-07 -- first prototype ! !INTERFACE: integer function MPH_num_ensemble (name) ! !USES: implicit none ! !INPUT PARAMETERS: character (len=*), intent(in) :: name ! ensemble name ! !OUTPUT PARAMETERS: ! ! num_ensemble (name) ! !SEE ALSO: ! MPH_multi_instance ! !LOCAL PARAMETERS: integer :: k, num_ensemble, temp !EOP !------------------------------------------------------------------- temp = len(trim(name)) num_ensemble = 0 do k = 1, total_components if (component_names(k)(1:temp) .eq. trim(name) & .and. ensemble(k)) then num_ensemble = num_ensemble + 1 endif enddo MPH_num_ensemble = num_ensemble end function MPH_num_ensemble !========================================================================= ! integer function MPH_num_strings (cname) !========================================================================= !BOP ! ! !IROUTINE: MPH_num_strings -- number of strings attached for a component ! ! !DESCRIPTION: ! This function returns the number of strings attached given component name. ! ! !REVISION HISTORY: ! 2003-May-14 -- first prototype ! !INTERFACE: integer function MPH_num_strings (cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in), optional :: cname ! component name ! !OUTPUT PARAMETERS: ! ! num_strings (name) ! !SEE ALSO: ! MPH_get_strings, Proc_in_num_comps ! !LOCAL PARAMETERS: integer :: id, comm !EOP !------------------------------------------------------------------- if (present(cname)) then id = MPH_find_name (cname, component_names, & total_components) MPH_num_strings = num_strings (id) else if (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & function MPH_num_strings(cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else do id = 1, total_components if (Proc_in_component(component_names(id), comm)) then MPH_num_strings = num_strings (id) goto 100 endif enddo endif 100 return end function MPH_num_strings !========================================================================= ! subroutine MPH_get_strings (num_strs, strs, cname) !========================================================================= !BOP ! ! !IROUTINE: MPH_get_strings - get all attached strings ! ! !DESCRIPTION: ! This subroutine returns the attached strings for each component. ! ! !REVISION HISTORY: ! 2003_05_14 -- first prototype ! !INTERFACE: subroutine MPH_get_strings (num_strs, strs, cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in), optional :: cname ! !OUTPUT PARAMETERS: integer, intent(out) :: num_strs character (len=80), intent(out) :: strs(max_num_strings) ! !SEE ALSO: ! MPH_num_strings, Proc_in_num_comps ! !LOCAL VARIABLES: integer :: k, i !EOP !--------------------------------------------------------------------- ! find out k if (present(cname)) then k = MPH_comp_id(cname) num_strs = MPH_num_strings(cname) else if (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & function MPH_get_strings(num_strs, strs, cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else k = MPH_comp_id() num_strs = MPH_num_strings() endif do i = 1, num_strs strs(i) = strings(k,i) enddo end subroutine MPH_get_strings !================================================================== ! subroutine MPH_get_argument_field(field_num, field_val, cname) !================================================================== !BOP ! ! !IROUTINE: MPH_get_argument_field - get field value from string list ! ! !DESCRIPTION: ! This function returns the field value from the attached string list ! for each component. ! ! !REVISION HISTORY: ! 2003-May-20 -- first prototype ! !INTERFACE: subroutine MPH_get_argument_field(field_num, field_val, cname) ! !USES: implicit none ! !INPUT PARAMETERS: integer, intent(in) :: field_num character(len=*), intent(in), optional :: cname ! !OUTPUT PARAMETERS: character(len=80), intent(out) :: field_val ! !SEE ALSO: ! MPH_get_argument_int ! MPH_get_argument_real ! MPH_get_argument_char ! Proc_in_num_comps ! !LOCAL VARIABLES: integer :: k !EOP !--------------------------------------------------------------------- if (present(cname)) then k = MPH_comp_id(cname) else if (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & interface MPH_get_argument(field_num, field_val, cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else k = MPH_comp_id() endif field_val = strings(k,field_num) return end subroutine MPH_get_argument_field !=================================================================== ! subroutine MPH_get_argument_int(int_name, int_val, cname) !================================================================== !BOP ! ! !IROUTINE: MPH_get_argument_int - get integer value from string list ! ! !DESCRIPTION: ! This function returns the integer value from the attached string list ! for each component. ! ! !REVISION HISTORY: ! 2003-May-20 -- first prototype ! !INTERFACE: subroutine MPH_get_argument_int(int_name, int_val, cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in) :: int_name character(len=*), intent(in), optional :: cname ! !OUTPUT PARAMETERS: integer, intent(out) :: int_val ! !SEE ALSO: ! MPH_get_argument_field ! MPH_get_argument_real ! MPH_get_argument_char ! Proc_in_num_comps ! !LOCAL VARIABLES: character(len=80) :: temp integer :: k, i, num_strs, len_name, len_temp !EOP !--------------------------------------------------------------------- if (present(cname)) then k = MPH_comp_id(cname) num_strs = MPH_num_strings(cname) else if (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & interface MPH_get_argument(int_name, int_val, cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else k = MPH_comp_id() num_strs = MPH_num_strings() endif len_name = len_trim(int_name) do i = 1, num_strs temp = strings(k,i) len_temp = len_trim(temp) if (temp(1:len_name) == int_name .and. & temp(len_name+1:len_name+1) == "=" ) then read(temp(len_name+2:len_temp),*)int_val goto 100 endif enddo 100 return end subroutine MPH_get_argument_int !================================================================== ! subroutine MPH_get_argument_real(real_name, real_val, cname) !================================================================== !BOP ! ! !IROUTINE: MPH_get_argument_real - get real value from string list ! ! !DESCRIPTION: ! This function returns the real value from the attached string list ! for each component. ! ! !REVISION HISTORY: ! 2003-May-20 -- first prototype ! !INTERFACE: subroutine MPH_get_argument_real(real_name, real_val, cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in) :: real_name character(len=*), intent(in), optional :: cname ! !OUTPUT PARAMETERS: real, intent(out) :: real_val ! !SEE ALSO: ! MPH_get_argument_field ! MPH_get_argument_int ! MPH_get_argument_char ! Proc_in_num_comps ! !LOCAL VARIABLES: character(len=80) :: temp integer :: k, i, num_strs, len_name, len_temp !EOP !--------------------------------------------------------------------- if (present(cname)) then k = MPH_comp_id(cname) num_strs = MPH_num_strings(cname) else if (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & interface MPH_get_argument(real_name, real_val, cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else k = MPH_comp_id() num_strs = MPH_num_strings() endif len_name = len_trim(real_name) do i = 1, num_strs temp = strings(k,i) len_temp = len_trim(temp) if (temp(1:len_name) == real_name .and. & temp(len_name+1:len_name+1) == "=" ) then read(temp(len_name+2:len_temp),*)real_val goto 100 endif enddo 100 return end subroutine MPH_get_argument_real !================================================================== ! subroutine MPH_get_argument_char(char_name, char_val, cname) !================================================================== !BOP ! ! !IROUTINE: MPH_get_argument_char - find character value from string list ! ! !DESCRIPTION: ! This function returns the character value from the attached string list ! for each component. ! ! !REVISION HISTORY: ! 2003-May-20 -- first prototype ! !INTERFACE: subroutine MPH_get_argument_char(char_name, char_val, cname) ! !USES: implicit none ! !INPUT PARAMETERS: character(len=*), intent(in) :: char_name character(len=*), intent(in), optional :: cname ! !OUTPUT PARAMETERS: character(len=80), intent(out) :: char_val ! !SEE ALSO: ! MPH_get_argument_field ! MPH_get_argument_int ! MPH_get_argument_real ! Proc_in_num_comps ! !LOCAL VARIABLES: character(len=80) :: temp integer :: k, i, num_strs, len_name, len_temp !EOP !--------------------------------------------------------------------- if (present(cname)) then k = MPH_comp_id(cname) num_strs = MPH_num_strings(cname) else if (Proc_in_num_comps() > 1) then write(*,*)'ERROR: argument cname is required but missing for & interface MPH_get_argument(char_name, char_val, cname)' write(*,*)' due to ambiguity caused by processor overlap, & quitting...' stop else k = MPH_comp_id() num_strs = MPH_num_strings() endif len_name = len_trim(char_name) do i = 1, num_strs temp = strings(k,i) len_temp = len_trim(temp) if (temp(1:len_name) == char_name .and. & temp(len_name+1:len_name+1) == "=" ) then char_val = temp(len_name+2:len_temp) goto 100 endif enddo 100 return end subroutine MPH_get_argument_char end module MPH_module