source: vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modprocs.F90 @ 10087

Last change on this file since 10087 was 5656, checked in by timgraham, 5 years ago

Merge of AGRIF branch (branches/2014/dev_r4765_CNRS_agrif) onto the trunk

  • Property svn:keywords set to Id
File size: 8.7 KB
Line 
1module Agrif_Procs
2!
3    implicit none
4!
5    type Agrif_Proc
6        integer               :: pn       !< Proc index in coarse grid
7        integer               :: pi       !< Proc index in x-direction (informative only, could be removed)
8        integer               :: pj       !< Proc index in y-direction (informative only, could be removed)
9        integer, dimension(3) :: imin
10        integer, dimension(3) :: imax
11        integer               :: nb_seqs = 0  !< Number of integration sequences the proc is attached to.
12        integer               :: grid_id = 0  !< Grid id the proc is attached to.
13    end type Agrif_Proc
14!
15    type Agrif_Proc_p
16        type(Agrif_Proc),   pointer   :: proc => NULL()  !< Pointer to the actual proc structure
17        type(Agrif_Proc_p), pointer   :: next => NULL()  !< Next proc in the list
18    end type Agrif_Proc_p
19!
20    type Agrif_Proc_List
21        integer                       :: nitems = 0      !< Number of elements in the list
22        type(Agrif_Proc_p), pointer   :: first => NULL() !< First proc in the list
23        type(Agrif_Proc_p), pointer   :: last  => NULL() !< Last proc inserted in the list
24    end type Agrif_Proc_List
25!
26contains
27!
28!===================================================================================================
29subroutine Agrif_pl_append ( proclist, proc )
30!---------------------------------------------------------------------------------------------------
31    type(Agrif_Proc_List),     intent(inout)  :: proclist
32    type(Agrif_Proc), pointer, intent(in)     :: proc
33!
34    type(Agrif_Proc_p), pointer   :: new_pp
35!
36    allocate( new_pp )
37!
38    new_pp % proc => proc
39    new_pp % next => NULL()
40!
41    if ( associated(proclist % last) ) then
42        ! the list is not empty, let 'proc' be the next after the last (ie. the last one).
43        proclist % last % next => new_pp
44    else
45        ! the list has just been initialized. Let 'proc' be the first one.
46        proclist % first => new_pp
47    endif
48    ! anyway, for next time 'proc' will be the last one.
49    proclist % last => new_pp
50    proclist % nitems = proclist % nitems + 1
51!---------------------------------------------------------------------------------------------------
52end subroutine Agrif_pl_append
53!===================================================================================================
54!
55!===================================================================================================
56subroutine Agrif_pl_print_array ( proclist )
57!---------------------------------------------------------------------------------------------------
58    type(Agrif_Proc_List), intent(in) :: proclist
59!
60    type(Agrif_Proc_p), pointer :: pp
61    type(Agrif_Proc),   pointer :: proc
62!
63    pp => proclist % first
64!
65    write(*,'("/-------+-----+-----+------+------+------+------+------\")')
66    write(*,'("| iproc | ipx | ipy | imin | imax | jmin | jmax | grid |")')
67    write(*,'("|-------+-----+-----+------+------+------+------+------|")')
68    do while ( associated(pp) )
69        proc => pp % proc
70        write(*,'("|",i6," |",i4," |",i4," |",i5," :",i5," |",i5," :",i5," | ",i4," |")') &
71            proc % pn, proc % pi, proc % pj, proc % imin(1), proc % imax(1), proc % imin(2), proc % imax(2), &
72            proc % grid_id
73        pp => pp % next
74    enddo
75    write(*,'("\-------+-----+-----+------+------+------+------+------/")')
76!---------------------------------------------------------------------------------------------------
77end subroutine Agrif_pl_print_array
78!===================================================================================================
79!
80!===================================================================================================
81subroutine Agrif_pl_print ( proclist )
82!---------------------------------------------------------------------------------------------------
83    type(Agrif_Proc_List), intent(in) :: proclist
84!
85    type(Agrif_Proc_p), pointer :: pp
86!
87    pp => proclist % first
88    do while ( associated(pp) )
89        write(*,'(i0,",")',advance='no') pp % proc % pn
90        pp => pp % next
91    enddo
92    write(*,*)
93!---------------------------------------------------------------------------------------------------
94end subroutine Agrif_pl_print
95!===================================================================================================
96!
97!===================================================================================================
98subroutine Agrif_pl_copy ( proclist, copy )
99!
100!< Carries out a copy of 'proclist' into 'copy'
101!---------------------------------------------------------------------------------------------------
102    type(Agrif_Proc_List), intent(in)    :: proclist
103    type(Agrif_Proc_List), intent(out)   :: copy
104!
105    type(Agrif_Proc_p),    pointer    :: pp
106!
107    call Agrif_pl_clear(copy)
108!
109    pp => proclist % first
110    do while ( associated(pp) )
111        call Agrif_pl_append( copy, pp % proc )
112        pp => pp % next
113    enddo
114!---------------------------------------------------------------------------------------------------
115end subroutine Agrif_pl_copy
116!===================================================================================================
117!
118!===================================================================================================
119subroutine Agrif_pl_deep_copy ( proclist, copy )
120!
121!< Carries out a deep copy of 'proclist' into 'copy'
122!---------------------------------------------------------------------------------------------------
123    type(Agrif_Proc_List), intent(in)    :: proclist
124    type(Agrif_Proc_List), intent(out)   :: copy
125!
126    type(Agrif_Proc_p), pointer :: pp
127    type(Agrif_Proc),   pointer :: new_proc
128!
129    call Agrif_pl_clear(copy)
130!
131    pp => proclist % first
132    do while ( associated(pp) )
133        allocate( new_proc )
134        new_proc = pp % proc
135        call Agrif_pl_append( copy, new_proc )
136        pp => pp % next
137    enddo
138!---------------------------------------------------------------------------------------------------
139end subroutine Agrif_pl_deep_copy
140!===================================================================================================
141!
142!===================================================================================================
143subroutine Agrif_pl_clear ( proclist )
144!---------------------------------------------------------------------------------------------------
145    type(Agrif_Proc_List), intent(inout)  :: proclist
146!
147    type(Agrif_Proc_p), pointer    :: pp, ppd
148!
149    pp => proclist % first
150!   
151    do while( associated(pp) )
152        ppd => pp
153        pp  => pp % next
154        deallocate(ppd)
155    enddo
156   
157    proclist % first => NULL()
158    proclist % last  => NULL()
159    proclist % nitems = 0
160!---------------------------------------------------------------------------------------------------
161end subroutine Agrif_pl_clear
162!===================================================================================================
163!
164!===================================================================================================
165subroutine Agrif_pl_to_array ( proclist, procarray )
166!---------------------------------------------------------------------------------------------------
167    type(Agrif_Proc_List),                       intent(in)   :: proclist
168    type(Agrif_Proc), dimension(:), allocatable, intent(out)  :: procarray
169!
170    type(Agrif_Proc_p), pointer   :: pp
171!
172    allocate( procarray(1:proclist % nitems) )
173!
174    pp => proclist % first
175    do while ( associated(pp) )
176        procarray(pp%proc%pn+1) = pp % proc
177        pp => pp % next
178    enddo
179!---------------------------------------------------------------------------------------------------
180end subroutine Agrif_pl_to_array
181!===================================================================================================
182!
183!===================================================================================================
184function Agrif_pl_search_proc ( proclist, rank ) result ( proc )
185!---------------------------------------------------------------------------------------------------
186    type(Agrif_Proc_List), intent(in)   :: proclist
187    integer,               intent(in)   :: rank
188!
189    type(Agrif_Proc_p), pointer :: pp
190    type(Agrif_Proc),   pointer :: proc
191    logical :: found
192!
193    found = .false.
194    proc => NULL()
195    pp => proclist % first
196    do while ( .not.found .and. associated(pp) )
197        if ( pp % proc % pn == rank ) then
198            proc => pp % proc
199            return
200        else
201            pp => pp % next
202        endif
203    enddo
204!---------------------------------------------------------------------------------------------------
205end function Agrif_pl_search_proc
206!===================================================================================================
207!
208end module Agrif_Procs
Note: See TracBrowser for help on using the repository browser.