source: CPL/oasis3-mct_5.0/lib/mct/testsystem/testall/m_GMAPTEST.F90 @ 6328

Last change on this file since 6328 was 6328, checked in by aclsce, 17 months ago

First import of oasis3-mct_5.0 (from oasis git server, branch OASIS3-MCT_5.0)

File size: 4.4 KB
Line 
1!
2! !INTERFACE:
3
4 module m_GMAPTEST
5!
6! !USES:
7!
8      implicit none
9
10      private   ! except
11
12! !PUBLIC MEMBER FUNCTIONS:
13
14      public :: testall
15
16    interface testall
17       module procedure testGMap_
18    end interface
19
20
21! !REVISION HISTORY:
22!EOP ___________________________________________________________________
23
24  character(len=*),parameter :: myname='m_GMAPTEST'
25
26 contains
27
28!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
29!    Math and Computer Science Division, Argonne National Laboratory   !
30!BOP -------------------------------------------------------------------
31!
32! !IROUTINE: testGMap_ - Test the functions in the AttrVect module
33!
34! !DESCRIPTION:
35! This routine writes diagnostic information about the input
36! {\tt AttrVect}. Each line of the output will be preceded by the
37! character argument {\tt identifier}. The output device is specified
38! by the integer argument {\tt device}.
39!
40! !INTERFACE:
41
42 subroutine testGMap_(GMap, identifier, mycomm, device)
43
44!
45! !USES:
46!
47      use m_GlobalMap         ! Use all of MCTWorld
48      use m_GlobalToLocal,only : GlobalToLocalIndex
49      use m_stdio
50      use m_die
51      use m_mpif90
52
53      implicit none
54
55! !INPUT PARAMETERS:
56
57      type(GlobalMap),            intent(in)  :: GMap
58      character(len=*),           intent(in)  :: identifier
59      integer, optional,          intent(in)  :: mycomm
60      integer,                    intent(in)  :: device
61
62! !REVISION HISTORY:
63!EOP ___________________________________________________________________
64
65  character(len=*),parameter :: myname_=myname//'::testGMap_'
66  integer :: i,j,k,lower,upper
67  integer :: mySize,myProc,proc,ierr
68
69  write(device,*) identifier, ":: TESTING GLOBALMAP ::"
70
71  write(device,*) identifier, ":: TYPE CHECK:"
72  write(device,*) identifier, ":: comp_id = ", GMap%comp_id
73  write(device,*) identifier, ":: gsize = ", GMap%gsize
74  write(device,*) identifier, ":: lsize = ", GMap%lsize
75
76  mySize = size(GMap%counts)
77
78  if(mySize<=0) call die(myname_,"size(GMap%counts)<=0")
79
80  if(size(GMap%counts) /= size(GMap%displs)) then
81     call die(myname_,"size(GMap%counts) /= size(GMap%displs)")
82  endif
83
84  write(device,*) identifier, ":: counts = &
85       &(associated, size, counts) ", associated(GMap%counts), &
86       size(GMap%counts), GMap%counts
87  write(device,*) identifier, ":: displs = &
88       &(associated, size, displs) ", associated(GMap%displs), &
89       size(GMap%displs), GMap%displs
90
91  write(device,*) identifier, ":: counts = ", &
92       GMap%counts
93
94  write(device,*) identifier, ":: FUNCTION CHECK:"
95  write(device,*) identifier, ":: lsize = ", lsize(GMap)
96  write(device,*) identifier, ":: gsize = ", gsize(GMap)
97  write(device,*) identifier, ":: comp_id = ",comp_id(GMap)
98
99  write(device,*) identifier, ":: Testing rank"
100  do i=0,mySize-1
101     do j=1,GMap%counts(i)
102        call rank(GMap,GMap%displs(i)+j,proc)
103        if(i/=proc) then
104           write(device,*) identifier, ":: subroutine rank failed! ", &
105                i,j,mySize,GMap%counts(i), GMap%displs(i),proc
106           call die(myname_,"subroutine rank failed!")
107        endif
108     enddo
109  enddo
110
111  write(device,*) identifier, ":: Testing bounds"
112  do i=0,mySize-1
113     call bounds(GMap,i,lower,upper)
114     if(lower/=GMap%displs(i)+1) then
115        write(device,*) identifier, ":: subroutine bounds failed! ", &
116             i, lower, GMap%displs(i)
117        call die(myname_,"subroutine bounds failed!")
118     endif
119     if(upper/=GMap%displs(i)+GMap%counts(i)) then
120        write(device,*) identifier, ":: subroutine bounds failed! ", &
121             i,upper,GMap%displs(i)+GMap%counts(i)-1
122        call die(myname_,"subroutine bounds failed!")
123     endif
124  enddo
125
126  if(present(mycomm)) then
127     j=-12345
128     k=-12345
129
130     do i=1,GMap%gsize
131        if(GlobalToLocalIndex(GMap,i,mycomm)/=-1) then
132           j=GlobalToLocalIndex(GMap,i,mycomm)
133           EXIT
134        endif
135     enddo
136
137     do i=1,GMap%gsize
138        if(GlobalToLocalIndex(GMap,i,mycomm)/=-1) then
139           k=GlobalToLocalIndex(GMap,i,mycomm)
140        endif
141     enddo
142
143     if( (j==-12345).and.(k==-12345) ) then
144        write(device,*) identifier, ":: GlobalMapToIndex :: &
145             &THIS PROCESS OWNS ZERO POINTS"
146     else
147        write(device,*) identifier, ":: GlobalMapToIndex :: &
148             &first, last indices = ", j, k
149     endif
150
151  else
152
153     write(device,*) identifier, ":: NOT TESTING GLOBALMAPTOLOCALINDEX. &
154          &PLEASE CONSULT SOURCE CODE TO ENABLE TESTING"
155
156  endif
157
158end subroutine testGMap_
159
160end module m_GMAPTEST
Note: See TracBrowser for help on using the repository browser.