** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Wed, 10 Sep 2024 05:11:47 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/compon_communic/mitcplr_init1.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:38:30 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
bf4be02920 Jean*0001 !=======================================================================
                0002       subroutine MITCPLR_init1( myTypeStr, couplerFlag )
                0003       implicit none
                0004 
                0005 ! MPI variables
                0006 #include "mpif.h"
                0007 
                0008 ! Predefined constants/arrays
                0009 #include "CPLR_SIG.h"
                0010 
191b8c84d5 Jean*0011 ! Arguments
                0012       character*(*) myTypeStr
                0013       logical couplerFlag
                0014 
bf4be02920 Jean*0015 ! Functions
                0016       integer mitcplr_match_comp
191b8c84d5 Jean*0017       external mitcplr_match_comp
bf4be02920 Jean*0018 
                0019 ! Local
191b8c84d5 Jean*0020       integer myid, numprocs, ierr
bf4be02920 Jean*0021       integer n,j
                0022       integer MPI_GROUP_World
                0023       integer MPI_GROUP_Tmp
                0024       integer lenbuf
                0025       integer compind
191b8c84d5 Jean*0026       integer ibuf(MAX_IBUF)
bf4be02920 Jean*0027       character*(MAXLEN_COMP_NAME) cbuf
                0028 
                0029 !     ------------------------------------------------------------------
                0030 
                0031 ! Find-out my position (rank) in the "world" communicator
                0032       call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
                0033       if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0034      &     ' Rank = ',myid,' MPI_COMM_RANK ierr=',ierr
                0035 ! How big is the "world"?
                0036       call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
                0037       if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0038      &     ' Size = ',numprocs,' MPI_COMM_RANK ierr=',ierr
                0039       if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0040      &     ' Rank/Size = ',myid,' /',numprocs
                0041 
951926fb9b Jean*0042 !     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bf4be02920 Jean*0043 
                0044 ! Registration: collect/bcast lists of who is who
                0045 
                0046 ! Assume nothing
                0047       num_components = 0
                0048       num_coupler_procs = 0
                0049 
                0050 ! Receive a message from each of the other processes
                0051       do n=0,numprocs-1
                0052        ibuf(1)=myid
                0053        ibuf(2)=0
                0054        if ( couplerFlag ) ibuf(2)=MITCPLR_COUPLER
                0055        ibuf(3)=0
                0056        ibuf(4)=0
                0057        ibuf(5)=0
                0058        ibuf(6)=0
                0059        ibuf(7)=0
                0060        call mitcplr_char2int( myTypeStr, ibuf(8) )
                0061        lenbuf=8+MAXLEN_COMP_NAME
                0062        call MPI_Bcast(
                0063      &               ibuf, lenbuf, MPI_INTEGER,
951926fb9b Jean*0064      &               n,
bf4be02920 Jean*0065      &               MPI_COMM_WORLD, ierr )
                0066        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0067      &    ' MPI_Bcast from ',ibuf(1),ibuf(2),' ierr=',ierr
                0068        call mitcplr_int2char( ibuf(8), cbuf )
                0069        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0070      &    ' Bcast cbuf=',cbuf,'x'
                0071 
                0072        if ( ibuf(2).eq.MITCPLR_COUPLER ) then
                0073 ! If the broadcaster is the "coupler"
                0074         num_coupler_procs=num_coupler_procs + 1
                0075         rank_coupler_procs(num_coupler_procs) = ibuf(1)
                0076         coupler_Name=cbuf
                0077        else
                0078 ! If the broadcaster is a "component"
                0079         compind=mitcplr_match_comp( cbuf )
                0080         if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0081      &    ' compind=',compind
                0082         num_component_procs(compind)=num_component_procs(compind) + 1
                0083         j=num_component_procs(compind)
                0084         rank_component_procs(j,compind)=ibuf(1)
                0085        endif
                0086 
                0087       enddo
                0088 
                0089       if ( num_coupler_procs .ne. 1 ) then
191b8c84d5 Jean*0090        STOP 'MITCPLR_init1: I can only handle one coupler process'
bf4be02920 Jean*0091       endif
                0092 
                0093       do compind=1,num_components
                0094        num_compcplr_procs(compind)=num_component_procs(compind) + 1
                0095        do j=1,num_compcplr_procs(compind)
                0096         rank_compcplr_procs(j,compind)=rank_component_procs(j,compind)
                0097        enddo
                0098        j=num_compcplr_procs(compind)
                0099        rank_compcplr_procs(j,compind)=rank_coupler_procs(1)
                0100        call mitcplr_sortranks( j, rank_compcplr_procs(1,compind) )
                0101       enddo
                0102 
                0103       if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0104      &   ' coupler=',coupler_Name,
                0105      &   ( rank_coupler_procs(j),j=1,num_coupler_procs )
                0106       do n=1,num_components
                0107        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0108      &    ' component=',component_Name(n),
                0109      &    ( rank_component_procs(j,n),j=1,num_component_procs(n) )
                0110        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0111      &    ' comp+cplr=',component_Name(n),
                0112      &    ( rank_compcplr_procs(j,n),j=1,num_compcplr_procs(n) )
                0113       enddo
                0114 
951926fb9b Jean*0115 !     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bf4be02920 Jean*0116 
                0117 ! Create new groups and communicators
                0118 
                0119 ! Establish MPI_GROUP_World associated with MPI_COMM_WORLD
                0120       call MPI_Comm_group( MPI_COMM_WORLD, MPI_GROUP_World, ierr )
                0121       if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0122      &    ' MPI_Comm_group MPI_GROUP_World=',MPI_GROUP_World,
                0123      &    ' ierr=',ierr
                0124 
                0125       do n=1,num_components
                0126 
                0127 ! Create group MPI_GROUP_Tmp
                0128        call MPI_Group_incl(
                0129      &   MPI_GROUP_World,
                0130      &   num_component_procs(n),
                0131      &   rank_component_procs(1,n),
                0132      &   MPI_GROUP_Tmp,
                0133      &   ierr )
                0134        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0135      &   ' MPI_Group_incl MPI_GROUP_Tmp=',
                0136      &   MPI_GROUP_Tmp,' ierr=',ierr
                0137 
                0138 ! Create communicator MPI_COMM_component
                0139        call MPI_Comm_create(
                0140      &   MPI_COMM_WORLD,
                0141      &   MPI_GROUP_Tmp,
                0142      &   MPI_COMM_component(n),
                0143      &   ierr )
                0144        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0145      &   ' MPI_Comm_create MPI_COMM_component=',MPI_COMM_component(n),
                0146      &   ' ierr=',ierr
                0147 
                0148 ! Create group MPI_GROUP_Tmp
                0149        call MPI_Group_incl(
                0150      &   MPI_GROUP_World,
                0151      &   num_compcplr_procs(n),
                0152      &   rank_compcplr_procs(1,n),
                0153      &   MPI_GROUP_Tmp,
                0154      &   ierr )
                0155        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0156      &   ' MPI_Group_incl MPI_GROUP_Tmp=',
                0157      &   MPI_GROUP_Tmp,' ierr=',ierr
                0158 
                0159 ! Create communicator MPI_COMM_compcplr
                0160        call MPI_Comm_create(
                0161      &   MPI_COMM_WORLD,
                0162      &   MPI_GROUP_Tmp,
                0163      &   MPI_COMM_compcplr(n),
                0164      &   ierr )
                0165        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0166      &   ' MPI_Comm_create MPI_COMM_compcplr=',MPI_COMM_compcplr(n),
                0167      &   ' ierr=',ierr
                0168 
                0169       enddo
                0170 
951926fb9b Jean*0171 !     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bf4be02920 Jean*0172 
                0173       if ( couplerFlag ) then
                0174        my_component_ind=-1
                0175        MPI_COMM_mylocal=MPI_COMM_World
                0176        MPI_COMM_myglobal=MPI_COMM_World
                0177        my_component_name=coupler_Name
                0178       else
                0179        compind=mitcplr_match_comp( myTypeStr )
                0180        my_component_ind=compind
                0181        MPI_COMM_mylocal=MPI_COMM_component( compind )
                0182        MPI_COMM_myglobal=MPI_COMM_compcplr( compind )
                0183        my_component_name=component_Name( compind )
                0184       endif
                0185 
                0186       if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0187      &   ' component num=',compind,
                0188      &   ' MPI_COMM=',MPI_COMM_mylocal,MPI_COMM_myglobal
                0189 
                0190       if ( couplerFlag ) then
                0191        do n=1,num_components
                0192 ! Find-out my position (rank) in the "global" communicator
                0193         call MPI_COMM_RANK( MPI_COMM_compcplr(n), j, ierr )
                0194         if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0195      &     ' Rank = ',j,' MPI_COMM_RANK ierr=',ierr
                0196 ! How big is the "global" communicator?
                0197         call MPI_COMM_SIZE( MPI_COMM_compcplr(n), numprocs, ierr )
                0198         if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0199      &     ' Size = ',numprocs,' MPI_COMM_SIZE ierr=',ierr
                0200         if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0201      &     ' Rank/Size = ',j,' /',numprocs,
                0202      &     ' in Component =',n
                0203        enddo
                0204       else
                0205 ! Find-out my position (rank) in the "global" communicator
                0206        call MPI_COMM_RANK( MPI_COMM_myglobal, j, ierr )
                0207        if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0208      &     ' Rank = ',j,' MPI_COMM_RANK ierr=',ierr
                0209 ! How big is the "global" communicator?
                0210        call MPI_COMM_SIZE( MPI_COMM_myglobal, numprocs, ierr )
                0211        if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0212      &     ' Size = ',numprocs,' MPI_COMM_SIZE ierr=',ierr
                0213        if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
                0214      &     ' Rank/Size = ',j,' /',numprocs
                0215       endif
                0216 
                0217 ! Open log file
                0218       if ( couplerFlag ) j=myid
                0219       write(cbuf(1:MAXLEN_COMP_NAME),'(2a,i4.4,a)')
                0220      &   myTypeStr,'.',j,'.clog'
                0221       open(LogUnit,file=cbuf,status='unknown',form='formatted')
                0222       write(LogUnit,'(2a)') '========================================',
                0223      & '========================================'
                0224       write(LogUnit,*) 'This is "',myTypeStr,'"'
                0225       write(LogUnit,*) 'myid in MPI_COMM_World = ',myid
951926fb9b Jean*0226       if (.not.couplerFlag)
bf4be02920 Jean*0227      &  write(LogUnit,*) 'myid in MPI_COMM_Global = ',j
                0228 
                0229 !     ------------------------------------------------------------------
                0230       return
                0231       end
                0232 !=======================================================================
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!