| 1 | |
|---|
| 2 | !> OASIS partition data and methods |
|---|
| 3 | |
|---|
| 4 | MODULE mod_oasis_part |
|---|
| 5 | |
|---|
| 6 | USE mod_oasis_kinds |
|---|
| 7 | USE mod_oasis_data |
|---|
| 8 | USE mod_oasis_parameters |
|---|
| 9 | USE mod_oasis_sys |
|---|
| 10 | USE mod_oasis_mpi |
|---|
| 11 | USE mod_oasis_timer |
|---|
| 12 | USE mod_oasis_load_balancing |
|---|
| 13 | USE mod_oasis_io, only: oasis_io_varexists, oasis_io_read_avfld |
|---|
| 14 | USE mct_mod |
|---|
| 15 | |
|---|
| 16 | implicit none |
|---|
| 17 | |
|---|
| 18 | private |
|---|
| 19 | |
|---|
| 20 | !--- interfaces --- |
|---|
| 21 | public :: oasis_def_partition |
|---|
| 22 | public :: oasis_part_setup |
|---|
| 23 | public :: oasis_part_readgrid |
|---|
| 24 | public :: oasis_part_create |
|---|
| 25 | |
|---|
| 26 | !--- datatypes --- |
|---|
| 27 | public :: prism_part_type |
|---|
| 28 | |
|---|
| 29 | integer(kind=ip_intwp_p),parameter :: mpart = 100 !< maximum number of partitions allowed |
|---|
| 30 | |
|---|
| 31 | !> Partition (decomposition) data for variables |
|---|
| 32 | type prism_part_type |
|---|
| 33 | character(len=ic_lvar2):: partname !< partition name |
|---|
| 34 | type(mct_gsmap) :: gsmap !< gsmap on mpi_comm_local |
|---|
| 35 | integer(kind=ip_i4_p) :: gsize !< global size of grid |
|---|
| 36 | integer(kind=ip_i4_p) :: lsize !< local size of grid |
|---|
| 37 | integer(kind=ip_i4_p) :: nx !< global nx size |
|---|
| 38 | integer(kind=ip_i4_p) :: ny !< global ny size |
|---|
| 39 | character(len=ic_lvar) :: gridname !< grid name |
|---|
| 40 | integer(kind=ip_i4_p) :: mpicom !< mpicom for partition tasks only |
|---|
| 41 | integer(kind=ip_i4_p) :: npes !< tasks count associated with mpicom partition |
|---|
| 42 | integer(kind=ip_i4_p) :: rank !< rank of each task for mpicom partition |
|---|
| 43 | type(mct_gsmap) :: pgsmap !< same gsmap but on partition mpicom |
|---|
| 44 | logical :: indxflag !< has indx field been defined |
|---|
| 45 | logical :: maskflag !< has mask field been defined |
|---|
| 46 | logical :: areaflag !< has area field been defined |
|---|
| 47 | logical :: fracflag !< has frac field been defined |
|---|
| 48 | integer(kind=ip_i4_p),pointer :: indx(:) !< global index data |
|---|
| 49 | integer(kind=ip_i4_p),pointer :: mask(:) !< mask data |
|---|
| 50 | real (kind=ip_r8_p),pointer :: area(:) !< area data |
|---|
| 51 | real (kind=ip_r8_p),pointer :: frac(:) !< frac data |
|---|
| 52 | !--- temporary storage from def_part inputs --- |
|---|
| 53 | integer(kind=ip_i4_p) :: ig_size !< def_part setting |
|---|
| 54 | integer(kind=ip_i4_p),pointer :: kparal(:) !< def_part setting |
|---|
| 55 | end type prism_part_type |
|---|
| 56 | |
|---|
| 57 | integer(kind=ip_intwp_p),public :: prism_npart = 0 !< number of partitions defined |
|---|
| 58 | type(prism_part_type) ,public :: prism_part(mpart) !< list of defined partitions |
|---|
| 59 | |
|---|
| 60 | !--- for automatic naming of partname |
|---|
| 61 | !--- better than prism_npart, counts only unnamed parts |
|---|
| 62 | integer(kind=ip_intwp_p) :: part_name_cnt = 0 !< used to define partition names internally |
|---|
| 63 | |
|---|
| 64 | CONTAINS |
|---|
| 65 | |
|---|
| 66 | !-------------------------------------------------------------------- |
|---|
| 67 | |
|---|
| 68 | !> The OASIS user interface to define partitions |
|---|
| 69 | |
|---|
| 70 | SUBROUTINE oasis_def_partition (id_part, kparal, kinfo, ig_size, name) |
|---|
| 71 | |
|---|
| 72 | !* *** Def_partition *** PRISM 1.0 |
|---|
| 73 | ! |
|---|
| 74 | ! purpose: |
|---|
| 75 | ! -------- |
|---|
| 76 | ! define a decomposition |
|---|
| 77 | ! |
|---|
| 78 | ! interface: |
|---|
| 79 | ! ---------- |
|---|
| 80 | ! id_part : field decomposition id |
|---|
| 81 | ! kparal : type of parallel decomposition |
|---|
| 82 | ! kinfo : output status |
|---|
| 83 | ! |
|---|
| 84 | ! author: |
|---|
| 85 | ! ------- |
|---|
| 86 | ! Arnaud Caubel - FECIT |
|---|
| 87 | ! |
|---|
| 88 | ! ---------------------------------------------------------------- |
|---|
| 89 | INTEGER(kind=ip_intwp_p) ,intent(out) :: id_part !< partition id |
|---|
| 90 | INTEGER(kind=ip_intwp_p), DIMENSION(:),intent(in) :: kparal !< decomposition information |
|---|
| 91 | INTEGER(kind=ip_intwp_p), optional ,intent(out) :: kinfo !< return code |
|---|
| 92 | INTEGER(kind=ip_intwp_p), optional ,intent(in) :: ig_size !< total size of partition |
|---|
| 93 | character(len=*) , optional ,intent(in) :: name !< name of partition |
|---|
| 94 | ! ---------------------------------------------------------------- |
|---|
| 95 | integer(kind=ip_intwp_p) :: n |
|---|
| 96 | character(len=*),parameter :: subname = '(oasis_def_partition)' |
|---|
| 97 | ! ---------------------------------------------------------------- |
|---|
| 98 | |
|---|
| 99 | call oasis_debug_enter(subname) |
|---|
| 100 | |
|---|
| 101 | if (.not. oasis_coupled) then |
|---|
| 102 | call oasis_debug_exit(subname) |
|---|
| 103 | return |
|---|
| 104 | endif |
|---|
| 105 | |
|---|
| 106 | kinfo = OASIS_OK |
|---|
| 107 | |
|---|
| 108 | !----------------------------------------------- |
|---|
| 109 | !> * Increment partition number and store user values |
|---|
| 110 | !----------------------------------------------- |
|---|
| 111 | |
|---|
| 112 | call oasis_timer_start('part_definition') |
|---|
| 113 | |
|---|
| 114 | if (ET_debug) CALL oasis_lb_measure(-1,LB_PART) |
|---|
| 115 | |
|---|
| 116 | prism_npart = prism_npart + 1 |
|---|
| 117 | if (prism_npart > mpart) then |
|---|
| 118 | write(nulprt,*) subname,estr,'prism_npart too large = ',prism_npart,mpart |
|---|
| 119 | write(nulprt,*) subname,estr,'increase mpart in mod_oasis_part.F90' |
|---|
| 120 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 121 | endif |
|---|
| 122 | call oasis_part_zero(prism_part(prism_npart)) |
|---|
| 123 | id_part = prism_npart |
|---|
| 124 | |
|---|
| 125 | if (present(name)) then |
|---|
| 126 | if (len_trim(name) > len(prism_part(prism_npart)%partname)) then |
|---|
| 127 | write(nulprt,*) subname,estr,'part name too long = ',trim(name) |
|---|
| 128 | write(nulprt,*) subname,estr,'part name max length = ',len(prism_part(prism_npart)%partname) |
|---|
| 129 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 130 | endif |
|---|
| 131 | prism_part(prism_npart)%partname = trim(name) |
|---|
| 132 | else |
|---|
| 133 | part_name_cnt = part_name_cnt + 1 |
|---|
| 134 | write(prism_part(prism_npart)%partname,'(a,i6.6)') trim(compnm)//'_part',part_name_cnt |
|---|
| 135 | endif |
|---|
| 136 | |
|---|
| 137 | if (present(ig_size)) then |
|---|
| 138 | prism_part(prism_npart)%ig_size = ig_size |
|---|
| 139 | endif |
|---|
| 140 | |
|---|
| 141 | allocate(prism_part(prism_npart)%kparal(size(kparal))) |
|---|
| 142 | prism_part(prism_npart)%kparal = kparal |
|---|
| 143 | |
|---|
| 144 | if (ET_debug) CALL oasis_lb_measure(-1,LB_PART) |
|---|
| 145 | |
|---|
| 146 | call oasis_timer_stop('part_definition') |
|---|
| 147 | |
|---|
| 148 | call oasis_debug_exit(subname) |
|---|
| 149 | |
|---|
| 150 | END SUBROUTINE oasis_def_partition |
|---|
| 151 | |
|---|
| 152 | !------------------------------------------------------------ |
|---|
| 153 | |
|---|
| 154 | !> Synchronize partitions across all tasks, called at oasis enddef. |
|---|
| 155 | |
|---|
| 156 | SUBROUTINE oasis_part_setup() |
|---|
| 157 | IMPLICIT NONE |
|---|
| 158 | |
|---|
| 159 | !-------------------------------------------------------- |
|---|
| 160 | integer(kind=ip_intwp_p) :: m,n,k,p,nsegs,numel,taskid |
|---|
| 161 | INTEGER(kind=ip_intwp_p) :: icpl,ierr,ilen |
|---|
| 162 | integer(kind=ip_intwp_p),pointer :: start(:),length(:) |
|---|
| 163 | integer(kind=ip_intwp_p),pointer :: kparal(:) |
|---|
| 164 | integer(kind=ip_intwp_p) :: ig_size |
|---|
| 165 | integer(kind=ip_intwp_p) :: pcnt |
|---|
| 166 | logical :: found |
|---|
| 167 | character(len=ic_lvar2), allocatable :: pname0(:),pname(:) |
|---|
| 168 | logical, parameter :: local_timers_on = .false. |
|---|
| 169 | character(len=*),parameter :: subname = '(oasis_part_setup)' |
|---|
| 170 | !-------------------------------------------------------- |
|---|
| 171 | |
|---|
| 172 | call oasis_debug_enter(subname) |
|---|
| 173 | |
|---|
| 174 | if (local_timers_on) then |
|---|
| 175 | call oasis_timer_start('part_setup_barrier') |
|---|
| 176 | if (mpi_comm_local /= MPI_COMM_NULL) & |
|---|
| 177 | call MPI_BARRIER(mpi_comm_local, ierr) |
|---|
| 178 | call oasis_timer_stop('part_setup_barrier') |
|---|
| 179 | endif |
|---|
| 180 | if (local_timers_on) call oasis_timer_start('part_setup') |
|---|
| 181 | |
|---|
| 182 | !----------------------------------------------- |
|---|
| 183 | !> * Generate reduced partname list |
|---|
| 184 | !----------------------------------------------- |
|---|
| 185 | IF (local_timers_on) CALL oasis_timer_start('part_setup_reducelists') |
|---|
| 186 | allocate(pname0(prism_npart)) |
|---|
| 187 | do n = 1,prism_npart |
|---|
| 188 | pname0(n) = prism_part(n)%partname |
|---|
| 189 | enddo |
|---|
| 190 | call oasis_mpi_reducelists(pname0,mpi_comm_local,pcnt,pname,'part_setup',fastcheck=.true.) |
|---|
| 191 | deallocate(pname0) |
|---|
| 192 | IF (local_timers_on) CALL oasis_timer_stop('part_setup_reducelists') |
|---|
| 193 | |
|---|
| 194 | !------------------------------------------------- |
|---|
| 195 | !> * Define all partitions on all tasks |
|---|
| 196 | !------------------------------------------------- |
|---|
| 197 | |
|---|
| 198 | if (local_timers_on) then |
|---|
| 199 | call oasis_timer_start('part_setup_initgsm_barrier') |
|---|
| 200 | if (mpi_comm_local /= MPI_COMM_NULL) & |
|---|
| 201 | call MPI_BARRIER(mpi_comm_local, ierr) |
|---|
| 202 | call oasis_timer_stop('part_setup_initgsm_barrier') |
|---|
| 203 | endif |
|---|
| 204 | IF (local_timers_on) CALL oasis_timer_start('part_setup_initgsm') |
|---|
| 205 | do p = 1,pcnt |
|---|
| 206 | |
|---|
| 207 | if (local_timers_on) call oasis_timer_start('part_setup_initgsm_A') |
|---|
| 208 | !--- set m, either a prism_part that already exists |
|---|
| 209 | found = .false. |
|---|
| 210 | n = 0 |
|---|
| 211 | do while (n < prism_npart .and. .not.found) |
|---|
| 212 | n = n + 1 |
|---|
| 213 | if (prism_part(n)%partname == pname(p)) then |
|---|
| 214 | m = n |
|---|
| 215 | found = .true. |
|---|
| 216 | endif |
|---|
| 217 | enddo |
|---|
| 218 | if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_A') |
|---|
| 219 | |
|---|
| 220 | if (local_timers_on) call oasis_timer_start('part_setup_initgsm_B') |
|---|
| 221 | !--- or m is a new prism_part that must be instantiated |
|---|
| 222 | !--- and set to have no data |
|---|
| 223 | if (.not.found) then |
|---|
| 224 | prism_npart = prism_npart + 1 |
|---|
| 225 | m = prism_npart |
|---|
| 226 | call oasis_part_zero(prism_part(prism_npart)) |
|---|
| 227 | prism_part(prism_npart)%partname = pname(p) |
|---|
| 228 | allocate(prism_part(prism_npart)%kparal(3)) |
|---|
| 229 | prism_part(prism_npart)%kparal = 0 |
|---|
| 230 | endif |
|---|
| 231 | if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_B') |
|---|
| 232 | |
|---|
| 233 | !------------------------------------------------- |
|---|
| 234 | !> * Convert kparal information to data for the gsmap |
|---|
| 235 | !------------------------------------------------- |
|---|
| 236 | |
|---|
| 237 | if (local_timers_on) call oasis_timer_start('part_setup_initgsm_C') |
|---|
| 238 | allocate(kparal(size(prism_part(m)%kparal))) |
|---|
| 239 | kparal = prism_part(m)%kparal |
|---|
| 240 | ig_size = prism_part(m)%ig_size |
|---|
| 241 | |
|---|
| 242 | if (kparal(CLIM_Strategy) == CLIM_Serial) then |
|---|
| 243 | nsegs = 1 |
|---|
| 244 | allocate(start(nsegs),length(nsegs)) |
|---|
| 245 | start (1) = 1 |
|---|
| 246 | length(1) = kparal(CLIM_Length) |
|---|
| 247 | numel = nsegs |
|---|
| 248 | if (length(1) == 0) numel = 0 |
|---|
| 249 | elseif (kparal(CLIM_Strategy) == CLIM_Apple) then |
|---|
| 250 | nsegs = 1 |
|---|
| 251 | allocate(start(nsegs),length(nsegs)) |
|---|
| 252 | start (1) = kparal(CLIM_Offset) + 1 |
|---|
| 253 | length(1) = kparal(CLIM_Length) |
|---|
| 254 | numel = nsegs |
|---|
| 255 | if (length(1) == 0) numel = 0 |
|---|
| 256 | elseif (kparal(CLIM_Strategy) == CLIM_Box) then |
|---|
| 257 | nsegs = kparal(CLIM_SizeY) |
|---|
| 258 | allocate(start(nsegs),length(nsegs)) |
|---|
| 259 | do n = 1,nsegs |
|---|
| 260 | start (n) = kparal(CLIM_Offset) + (n-1)*kparal(CLIM_LdX) + 1 |
|---|
| 261 | length(n) = kparal(CLIM_SizeX) |
|---|
| 262 | enddo |
|---|
| 263 | numel = nsegs |
|---|
| 264 | if (kparal(CLIM_SizeY)*kparal(CLIM_SizeX) == 0) numel = 0 |
|---|
| 265 | elseif (kparal(CLIM_Strategy) == CLIM_Orange) then |
|---|
| 266 | nsegs = kparal(CLIM_Segments) |
|---|
| 267 | allocate(start(nsegs),length(nsegs)) |
|---|
| 268 | numel = 0 |
|---|
| 269 | DO n = 1,nsegs |
|---|
| 270 | ilen = kparal((n-1)*2 + 4) |
|---|
| 271 | IF (ilen > 0) THEN |
|---|
| 272 | numel = numel + 1 |
|---|
| 273 | start(numel) = kparal((n-1)*2 + 3) + 1 |
|---|
| 274 | length(numel) = ilen |
|---|
| 275 | ENDIF |
|---|
| 276 | ENDDO |
|---|
| 277 | elseif (kparal(CLIM_Strategy) == CLIM_Points) then |
|---|
| 278 | nsegs = kparal(CLIM_Segments) |
|---|
| 279 | allocate(start(nsegs),length(nsegs)) |
|---|
| 280 | numel = 0 |
|---|
| 281 | if (nsegs > 0) then |
|---|
| 282 | !--- initialize first segment, nsegs=1,n=1,k=3 |
|---|
| 283 | nsegs = 1 |
|---|
| 284 | n = 1 |
|---|
| 285 | k = n+2 |
|---|
| 286 | start(nsegs) = kparal(k) |
|---|
| 287 | length(nsegs) = 1 |
|---|
| 288 | !--- compute rest of segments from n=2,k=4 |
|---|
| 289 | do n = 2,kparal(CLIM_Segments) |
|---|
| 290 | k = n+2 |
|---|
| 291 | if (kparal(k)-kparal(k-1) == 1) then |
|---|
| 292 | length(nsegs) = length(nsegs) + 1 |
|---|
| 293 | else |
|---|
| 294 | nsegs = nsegs + 1 |
|---|
| 295 | start(nsegs) = kparal(k) |
|---|
| 296 | length(nsegs) = 1 |
|---|
| 297 | endif |
|---|
| 298 | enddo |
|---|
| 299 | numel = nsegs |
|---|
| 300 | endif |
|---|
| 301 | else |
|---|
| 302 | write(nulprt,*) subname,estr,'part strategy unknown in def_part = ',kparal(CLIM_Strategy) |
|---|
| 303 | write(nulprt,*) subname,estr,'strategy set in kparal array index ',CLIM_Strategy |
|---|
| 304 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 305 | endif |
|---|
| 306 | |
|---|
| 307 | IF (OASIS_debug >= 30) THEN |
|---|
| 308 | WRITE(nulprt,*) subname, ' Nsegs before calling mct_gsmap_init :',nsegs |
|---|
| 309 | WRITE(nulprt,*) subname, ' Numel before calling mct_gsmap_init :',numel |
|---|
| 310 | CALL oasis_flush(nulprt) |
|---|
| 311 | ENDIF |
|---|
| 312 | |
|---|
| 313 | if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_C') |
|---|
| 314 | |
|---|
| 315 | !------------------------------------------------- |
|---|
| 316 | !> * Initialize the local gsmap and partition gsmap |
|---|
| 317 | !------------------------------------------------- |
|---|
| 318 | |
|---|
| 319 | if (local_timers_on) call oasis_timer_start('part_setup_initgsm_D') |
|---|
| 320 | if (mpi_comm_local /= MPI_COMM_NULL) then |
|---|
| 321 | if (ig_size > 0) then |
|---|
| 322 | call mct_gsmap_init(prism_part(m)%gsmap,start,length,mpi_root_local,& |
|---|
| 323 | mpi_comm_local,compid,numel=numel,gsize=ig_size) |
|---|
| 324 | else |
|---|
| 325 | call mct_gsmap_init(prism_part(m)%gsmap,start,length,mpi_root_local,& |
|---|
| 326 | mpi_comm_local,compid,numel=numel) |
|---|
| 327 | endif |
|---|
| 328 | prism_part(m)%gsize = mct_gsmap_gsize(prism_part(m)%gsmap) |
|---|
| 329 | prism_part(m)%lsize = mct_gsmap_lsize(prism_part(m)%gsmap,mpi_comm_local) |
|---|
| 330 | icpl = MPI_UNDEFINED |
|---|
| 331 | if (numel > 0) icpl = 1 |
|---|
| 332 | CALL MPI_COMM_Split(mpi_comm_local,icpl,1,prism_part(m)%mpicom,ierr) |
|---|
| 333 | if (numel > 0) then |
|---|
| 334 | CALL MPI_Comm_Size ( prism_part(m)%mpicom, prism_part(m)%npes, ierr ) |
|---|
| 335 | CALL MPI_Comm_Rank ( prism_part(m)%mpicom, prism_part(m)%rank, ierr ) |
|---|
| 336 | if (ig_size > 0) then |
|---|
| 337 | call mct_gsmap_init(prism_part(m)%pgsmap,start,length,0, & |
|---|
| 338 | prism_part(m)%mpicom,compid,numel=numel,gsize=ig_size) |
|---|
| 339 | else |
|---|
| 340 | call mct_gsmap_init(prism_part(m)%pgsmap,start,length,0, & |
|---|
| 341 | prism_part(m)%mpicom,compid,numel=numel) |
|---|
| 342 | endif |
|---|
| 343 | else |
|---|
| 344 | ! override mpicom created by split with null |
|---|
| 345 | prism_part(m)%mpicom = MPI_COMM_NULL |
|---|
| 346 | endif |
|---|
| 347 | !else |
|---|
| 348 | !! set by default |
|---|
| 349 | ! prism_part(m)%gsize = -1 |
|---|
| 350 | ! prism_part(m)%mpicom = MPI_COMM_NULL |
|---|
| 351 | endif |
|---|
| 352 | if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_D') |
|---|
| 353 | |
|---|
| 354 | if (local_timers_on) call oasis_timer_start('part_setup_initgsm_E') |
|---|
| 355 | deallocate(start,length) |
|---|
| 356 | deallocate(kparal) |
|---|
| 357 | deallocate(prism_part(m)%kparal) |
|---|
| 358 | |
|---|
| 359 | if (OASIS_debug >= 2) then |
|---|
| 360 | call oasis_part_write(prism_part(m),m) |
|---|
| 361 | endif |
|---|
| 362 | if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_E') |
|---|
| 363 | |
|---|
| 364 | enddo ! p = 1,pcnt |
|---|
| 365 | |
|---|
| 366 | deallocate(pname) |
|---|
| 367 | |
|---|
| 368 | if (local_timers_on) call oasis_timer_stop ('part_setup_initgsm') |
|---|
| 369 | if (local_timers_on) call oasis_timer_stop('part_setup') |
|---|
| 370 | |
|---|
| 371 | call oasis_debug_exit(subname) |
|---|
| 372 | |
|---|
| 373 | END SUBROUTINE oasis_part_setup |
|---|
| 374 | !------------------------------------------------------------ |
|---|
| 375 | |
|---|
| 376 | !> Zero partition information |
|---|
| 377 | |
|---|
| 378 | SUBROUTINE oasis_part_zero(s_prism_part) |
|---|
| 379 | |
|---|
| 380 | IMPLICIT NONE |
|---|
| 381 | |
|---|
| 382 | type(prism_part_type),intent(inout) :: s_prism_part |
|---|
| 383 | !-------------------------------------------------------- |
|---|
| 384 | character(len=*),parameter :: subname = '(oasis_part_zero)' |
|---|
| 385 | !-------------------------------------------------------- |
|---|
| 386 | |
|---|
| 387 | call oasis_debug_enter(subname) |
|---|
| 388 | |
|---|
| 389 | s_prism_part%partname = trim(cspval) |
|---|
| 390 | s_prism_part%gsize = -1 |
|---|
| 391 | s_prism_part%lsize = -1 |
|---|
| 392 | s_prism_part%nx = -1 |
|---|
| 393 | s_prism_part%ny = -1 |
|---|
| 394 | s_prism_part%gridname = trim(cspval) |
|---|
| 395 | s_prism_part%mpicom = MPI_COMM_NULL |
|---|
| 396 | s_prism_part%npes = -1 |
|---|
| 397 | s_prism_part%rank = -1 |
|---|
| 398 | s_prism_part%ig_size = -1 |
|---|
| 399 | s_prism_part%indxflag = .false. |
|---|
| 400 | s_prism_part%maskflag = .false. |
|---|
| 401 | s_prism_part%areaflag = .false. |
|---|
| 402 | s_prism_part%fracflag = .false. |
|---|
| 403 | |
|---|
| 404 | call oasis_debug_exit(subname) |
|---|
| 405 | |
|---|
| 406 | END SUBROUTINE oasis_part_zero |
|---|
| 407 | !------------------------------------------------------------ |
|---|
| 408 | |
|---|
| 409 | !> Print parition information |
|---|
| 410 | |
|---|
| 411 | SUBROUTINE oasis_part_write(s_prism_part,npart) |
|---|
| 412 | |
|---|
| 413 | IMPLICIT NONE |
|---|
| 414 | |
|---|
| 415 | type(prism_part_type),intent(in) :: s_prism_part |
|---|
| 416 | integer(ip_i4_p) ,intent(in) :: npart |
|---|
| 417 | !-------------------------------------------------------- |
|---|
| 418 | character(len=*),parameter :: subname = '(oasis_part_write)' |
|---|
| 419 | !-------------------------------------------------------- |
|---|
| 420 | |
|---|
| 421 | call oasis_debug_enter(subname) |
|---|
| 422 | |
|---|
| 423 | write(nulprt,*) ' ' |
|---|
| 424 | write(nulprt,*) subname,' partnm = ',trim(s_prism_part%partname) |
|---|
| 425 | write(nulprt,*) subname,' npart = ',npart |
|---|
| 426 | write(nulprt,*) subname,' mpicom = ',s_prism_part%mpicom |
|---|
| 427 | write(nulprt,*) subname,' npes = ',s_prism_part%npes |
|---|
| 428 | write(nulprt,*) subname,' rank = ',s_prism_part%rank |
|---|
| 429 | write(nulprt,*) subname,' compid = ',s_prism_part%gsmap%comp_id |
|---|
| 430 | write(nulprt,*) subname,' ngseg = ',s_prism_part%gsmap%ngseg |
|---|
| 431 | write(nulprt,*) subname,' gsize = ',s_prism_part%gsmap%gsize |
|---|
| 432 | write(nulprt,*) subname,' lsize = ',s_prism_part%lsize |
|---|
| 433 | write(nulprt,*) subname,' indx = ',size(s_prism_part%indx) |
|---|
| 434 | if (s_prism_part%gsmap%ngseg > 10) then |
|---|
| 435 | IF (mpi_comm_local /= MPI_COMM_NULL) THEN |
|---|
| 436 | WRITE(nulprt,*) subname,' start = ',s_prism_part%gsmap%start(1:10) |
|---|
| 437 | WRITE(nulprt,*) subname,' length = ',s_prism_part%gsmap%length(1:10) |
|---|
| 438 | WRITE(nulprt,*) subname,' pe_loc = ',s_prism_part%gsmap%pe_loc(1:10) |
|---|
| 439 | ENDIF |
|---|
| 440 | IF (s_prism_part%mpicom /= MPI_COMM_NULL) THEN |
|---|
| 441 | WRITE(nulprt,*) subname,' pstart = ',s_prism_part%pgsmap%start(1:10) |
|---|
| 442 | WRITE(nulprt,*) subname,' plength= ',s_prism_part%pgsmap%length(1:10) |
|---|
| 443 | WRITE(nulprt,*) subname,' ppe_loc= ',s_prism_part%pgsmap%pe_loc(1:10) |
|---|
| 444 | ENDIF |
|---|
| 445 | else |
|---|
| 446 | IF (mpi_comm_local /= MPI_COMM_NULL) THEN |
|---|
| 447 | WRITE(nulprt,*) subname,' start = ',s_prism_part%gsmap%start |
|---|
| 448 | WRITE(nulprt,*) subname,' length = ',s_prism_part%gsmap%length |
|---|
| 449 | WRITE(nulprt,*) subname,' pe_loc = ',s_prism_part%gsmap%pe_loc |
|---|
| 450 | ENDIF |
|---|
| 451 | IF (s_prism_part%mpicom /= MPI_COMM_NULL) THEN |
|---|
| 452 | WRITE(nulprt,*) subname,' pstart = ',s_prism_part%pgsmap%start |
|---|
| 453 | WRITE(nulprt,*) subname,' plength= ',s_prism_part%pgsmap%length |
|---|
| 454 | WRITE(nulprt,*) subname,' ppe_loc= ',s_prism_part%pgsmap%pe_loc |
|---|
| 455 | ENDIF |
|---|
| 456 | endif |
|---|
| 457 | if (s_prism_part%indxflag) write(nulprt,*) subname,' indxflag = ',s_prism_part%indxflag |
|---|
| 458 | if (s_prism_part%maskflag) write(nulprt,*) subname,' maskflag = ',s_prism_part%maskflag |
|---|
| 459 | if (s_prism_part%areaflag) write(nulprt,*) subname,' areaflag = ',s_prism_part%areaflag |
|---|
| 460 | if (s_prism_part%fracflag) write(nulprt,*) subname,' fracflag = ',s_prism_part%fracflag |
|---|
| 461 | write(nulprt,*) ' ' |
|---|
| 462 | CALL oasis_flush(nulprt) |
|---|
| 463 | |
|---|
| 464 | call oasis_debug_exit(subname) |
|---|
| 465 | |
|---|
| 466 | END SUBROUTINE oasis_part_write |
|---|
| 467 | |
|---|
| 468 | !------------------------------------------------------------ |
|---|
| 469 | |
|---|
| 470 | !> Read grid data into partition |
|---|
| 471 | |
|---|
| 472 | SUBROUTINE oasis_part_readgrid() |
|---|
| 473 | IMPLICIT NONE |
|---|
| 474 | |
|---|
| 475 | !-------------------------------------------------------- |
|---|
| 476 | integer(kind=ip_intwp_p) :: m |
|---|
| 477 | integer(kind=ip_intwp_p) :: ierr |
|---|
| 478 | integer(kind=ip_intwp_p) :: lsize,kmask,karea,kfrac |
|---|
| 479 | character(len=ic_lvar) :: gridname |
|---|
| 480 | type(mct_aVect) :: avin |
|---|
| 481 | logical, parameter :: local_timers_on = .false. |
|---|
| 482 | character(len=*),parameter :: subname = '(oasis_part_readgrid)' |
|---|
| 483 | !-------------------------------------------------------- |
|---|
| 484 | |
|---|
| 485 | call oasis_debug_enter(subname) |
|---|
| 486 | |
|---|
| 487 | if (local_timers_on) then |
|---|
| 488 | call oasis_timer_start('part_readgrid_barrier') |
|---|
| 489 | if (mpi_comm_local /= MPI_COMM_NULL) & |
|---|
| 490 | call MPI_BARRIER(mpi_comm_local, ierr) |
|---|
| 491 | call oasis_timer_stop('part_readgrid_barrier') |
|---|
| 492 | endif |
|---|
| 493 | if (local_timers_on) call oasis_timer_start('part_readgrid') |
|---|
| 494 | |
|---|
| 495 | do m = 1,prism_npart |
|---|
| 496 | gridname = prism_part(m)%gridname |
|---|
| 497 | if (prism_part(m)%rank == 0 .and. OASIS_debug >= 2) write(nulprt,*) subname,m,trim(prism_part(m)%partname),' ',trim(gridname) |
|---|
| 498 | if (prism_part(m)%mpicom /= MPI_COMM_NULL) then |
|---|
| 499 | lsize = mct_gsmap_lsize(prism_part(m)%pgsmap, prism_part(m)%mpicom) |
|---|
| 500 | else |
|---|
| 501 | lsize = 0 |
|---|
| 502 | endif |
|---|
| 503 | |
|---|
| 504 | ! store indx first |
|---|
| 505 | prism_part(m)%indxflag = .true. |
|---|
| 506 | call mct_gsmap_OrderedPoints(prism_part(m)%pgsmap, prism_part(m)%rank, prism_part(m)%indx) |
|---|
| 507 | if (prism_part(m)%rank == 0 .and. OASIS_debug >= 2) then |
|---|
| 508 | write(nulprt,*) subname,' set indx ',trim(gridname),' for ',trim(prism_part(m)%partname), size(prism_part(m)%indx) |
|---|
| 509 | if (size(prism_part(m)%indx) > 0) then |
|---|
| 510 | write(nulprt,*) subname,' indx = ',prism_part(m)%indx(1:min(10,size(prism_part(m)%indx))) |
|---|
| 511 | endif |
|---|
| 512 | endif |
|---|
| 513 | |
|---|
| 514 | ! read mask, area, frac |
|---|
| 515 | call mct_avect_init(avin,iList='mask',rList='area:frac',lsize=lsize) |
|---|
| 516 | call mct_avect_zero(avin) |
|---|
| 517 | kmask = mct_aVect_indexIA(avin,'mask') |
|---|
| 518 | karea = mct_aVect_indexRA(avin,'area') |
|---|
| 519 | kfrac = mct_aVect_indexRA(avin,'frac') |
|---|
| 520 | if (oasis_io_varexists('areas.nc',trim(gridname)//'.srf')) then |
|---|
| 521 | call oasis_io_read_avfld('areas.nc',avin, & |
|---|
| 522 | prism_part(m)%pgsmap, prism_part(m)%mpicom,'area',trim(gridname)//'.srf',fldtype='real') |
|---|
| 523 | prism_part(m)%areaflag = .true. |
|---|
| 524 | allocate(prism_part(m)%area(lsize)) |
|---|
| 525 | prism_part(m)%area(:) = avin%rAttr(karea,:) |
|---|
| 526 | if (prism_part(m)%rank == 0 .and. OASIS_debug >= 2) write(nulprt,*) subname,' read area ',trim(gridname),' for ',trim(prism_part(m)%partname) ! ,minval(prism_part(m)%area),maxval(prism_part(m)%area) |
|---|
| 527 | endif |
|---|
| 528 | if (oasis_io_varexists('masks.nc',trim(gridname)//'.frc')) then |
|---|
| 529 | call oasis_io_read_avfld('masks.nc',avin, & |
|---|
| 530 | prism_part(m)%pgsmap, prism_part(m)%mpicom,'frac',trim(gridname)//'.frc',fldtype='real') |
|---|
| 531 | prism_part(m)%fracflag = .true. |
|---|
| 532 | allocate(prism_part(m)%frac(lsize)) |
|---|
| 533 | prism_part(m)%frac(:) = avin%rAttr(kfrac,:) |
|---|
| 534 | if (prism_part(m)%rank == 0 .and. OASIS_debug >= 2) write(nulprt,*) subname,' read frac ',trim(gridname),' for ',trim(prism_part(m)%partname) ! ,minval(prism_part(m)%frac),maxval(prism_part(m)%frac) |
|---|
| 535 | endif |
|---|
| 536 | if (oasis_io_varexists('masks.nc',trim(gridname)//'.msk')) then |
|---|
| 537 | call oasis_io_read_avfld('masks.nc',avin, & |
|---|
| 538 | prism_part(m)%pgsmap, prism_part(m)%mpicom,'mask',trim(gridname)//'.msk',fldtype='int') |
|---|
| 539 | prism_part(m)%maskflag = .true. |
|---|
| 540 | allocate(prism_part(m)%mask(lsize)) |
|---|
| 541 | prism_part(m)%mask(:) = avin%iAttr(kmask,:) |
|---|
| 542 | if (prism_part(m)%rank == 0 .and. OASIS_debug >= 2) write(nulprt,*) subname,' read mask ',trim(gridname),' for ',trim(prism_part(m)%partname) ! ,minval(prism_part(m)%mask),maxval(prism_part(m)%mask) |
|---|
| 543 | endif |
|---|
| 544 | call mct_avect_clean(avin) |
|---|
| 545 | enddo |
|---|
| 546 | |
|---|
| 547 | if (local_timers_on) call oasis_timer_stop('part_readgrid') |
|---|
| 548 | |
|---|
| 549 | call oasis_debug_exit(subname) |
|---|
| 550 | |
|---|
| 551 | END SUBROUTINE oasis_part_readgrid |
|---|
| 552 | |
|---|
| 553 | !------------------------------------------------------------ |
|---|
| 554 | |
|---|
| 555 | !> Create a new partition internally, needed for mapping |
|---|
| 556 | |
|---|
| 557 | SUBROUTINE oasis_part_create(id_part,TYPE,gsize,nx,ny,gridname,gscomm,mpicom,gridID) |
|---|
| 558 | |
|---|
| 559 | IMPLICIT NONE |
|---|
| 560 | |
|---|
| 561 | integer(ip_i4_p),intent(out) :: id_part !< partition id |
|---|
| 562 | character(len=*),intent(in) :: type !< type of decomposition specified |
|---|
| 563 | integer(ip_i4_p),intent(in) :: gsize !< global size of grid |
|---|
| 564 | integer(ip_i4_p),intent(in) :: nx !< global nx size |
|---|
| 565 | integer(ip_i4_p),intent(in) :: ny !< global ny size |
|---|
| 566 | character(len=*),intent(in) :: gridname !< grid name |
|---|
| 567 | integer(ip_i4_p),intent(in) :: gscomm !< global seg map communicator |
|---|
| 568 | integer(ip_i4_p),intent(in) :: mpicom !< local mpi comm |
|---|
| 569 | integer(ip_i4_p), optional :: gridID(:)!< gridcell ID |
|---|
| 570 | !-------------------------------------------------------- |
|---|
| 571 | integer(ip_i4_p) :: gsrank |
|---|
| 572 | integer(ip_i4_p) :: gssize |
|---|
| 573 | integer(ip_i4_p) :: numel |
|---|
| 574 | integer(ip_i4_p),pointer :: start(:),length(:) |
|---|
| 575 | integer(ip_i4_p),pointer :: llist(:),glist(:) |
|---|
| 576 | integer(ip_i4_p) :: pts |
|---|
| 577 | integer(ip_i4_p) :: found,foundall |
|---|
| 578 | integer(ip_i4_p) :: n |
|---|
| 579 | integer(ip_i4_p) :: ierr |
|---|
| 580 | character(len=*),parameter :: subname = '(oasis_part_create)' |
|---|
| 581 | !-------------------------------------------------------- |
|---|
| 582 | |
|---|
| 583 | call oasis_debug_enter(subname) |
|---|
| 584 | |
|---|
| 585 | if (gscomm /= MPI_COMM_NULL) then |
|---|
| 586 | call MPI_COMM_RANK(gscomm,gsrank,ierr) |
|---|
| 587 | call MPI_COMM_SIZE(gscomm,gssize,ierr) |
|---|
| 588 | else |
|---|
| 589 | gsrank = -1 |
|---|
| 590 | gssize = -1 |
|---|
| 591 | endif |
|---|
| 592 | |
|---|
| 593 | if (OASIS_debug >= 15) then |
|---|
| 594 | write(nulprt,*) subname,' called with ',gsize,nx,ny,trim(gridname) |
|---|
| 595 | write(nulprt,*) subname,' local ',gsrank,gssize |
|---|
| 596 | endif |
|---|
| 597 | |
|---|
| 598 | if ((type == 'decomp_wghtfile' .and. .not.present(gridID)) .or. & |
|---|
| 599 | (type /= 'decomp_wghtfile' .and. present(gridID))) then |
|---|
| 600 | write(nulprt,*) subname,estr,'decomp_wghtfile and gridID arguments inconsistent ',trim(type) |
|---|
| 601 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 602 | endif |
|---|
| 603 | |
|---|
| 604 | !----------------------------------------------- |
|---|
| 605 | !> * Check if an existing gsmap can be reused |
|---|
| 606 | !----------------------------------------------- |
|---|
| 607 | |
|---|
| 608 | id_part = -1 |
|---|
| 609 | found = 0 |
|---|
| 610 | n = 0 |
|---|
| 611 | do while (found == 0 .and. n < prism_npart) |
|---|
| 612 | n = n + 1 |
|---|
| 613 | if (prism_part(n)%gsize == gsize .and. & |
|---|
| 614 | trim(prism_part(n)%gridname) == trim(gridname) .and. & |
|---|
| 615 | prism_part(n)%mpicom == gscomm .and. & |
|---|
| 616 | prism_part(n)%nx == nx .and. & |
|---|
| 617 | prism_part(n)%ny == ny) then |
|---|
| 618 | id_part = n |
|---|
| 619 | found = 1 |
|---|
| 620 | endif |
|---|
| 621 | enddo |
|---|
| 622 | |
|---|
| 623 | !----------------------------------------------- |
|---|
| 624 | !> * Check that all tasks agree and if so, return with that partition id |
|---|
| 625 | !----------------------------------------------- |
|---|
| 626 | |
|---|
| 627 | foundall = -1 |
|---|
| 628 | call oasis_mpi_min(found,foundall,mpicom,string=subname//' found',all=.true.) |
|---|
| 629 | if (foundall == 1) then |
|---|
| 630 | if (OASIS_debug >= 2) then |
|---|
| 631 | write(nulprt,*) subname,' reuse part ',prism_npart,gsize |
|---|
| 632 | endif |
|---|
| 633 | call oasis_debug_exit(subname) |
|---|
| 634 | return |
|---|
| 635 | endif |
|---|
| 636 | |
|---|
| 637 | !----------------------------------------------- |
|---|
| 638 | !> * Instantiate a decomposition based on gsize and type |
|---|
| 639 | !----------------------------------------------- |
|---|
| 640 | |
|---|
| 641 | prism_npart = prism_npart + 1 |
|---|
| 642 | call oasis_part_zero(prism_part(prism_npart)) |
|---|
| 643 | |
|---|
| 644 | !----------------------------------------------- |
|---|
| 645 | !> * Create a new partition and set values |
|---|
| 646 | !----------------------------------------------- |
|---|
| 647 | |
|---|
| 648 | part_name_cnt = part_name_cnt + 1 |
|---|
| 649 | write(prism_part(prism_npart)%partname,'(a,i6.6)') trim(compnm)//'_part',part_name_cnt |
|---|
| 650 | prism_part(prism_npart)%gsize = gsize |
|---|
| 651 | prism_part(prism_npart)%nx = nx |
|---|
| 652 | prism_part(prism_npart)%ny = ny |
|---|
| 653 | prism_part(prism_npart)%gridname = trim(gridname) |
|---|
| 654 | prism_part(prism_npart)%mpicom = gscomm |
|---|
| 655 | prism_part(prism_npart)%npes = gssize |
|---|
| 656 | prism_part(prism_npart)%rank = gsrank |
|---|
| 657 | |
|---|
| 658 | allocate(start(1),length(1)) |
|---|
| 659 | start = 1 |
|---|
| 660 | length = 0 |
|---|
| 661 | numel = 0 |
|---|
| 662 | |
|---|
| 663 | if (trim(type) == 'decomp_1d') then |
|---|
| 664 | pts = 0 |
|---|
| 665 | if (gsrank >= 0) then |
|---|
| 666 | numel = 1 |
|---|
| 667 | length(1) = gsize/gssize |
|---|
| 668 | pts = gsize - length(1)*gssize |
|---|
| 669 | if (gsrank < pts) length(1) = length(1) + 1 |
|---|
| 670 | start(1) = gsize/gssize*(gsrank) + min(gsrank,pts) + 1 |
|---|
| 671 | endif |
|---|
| 672 | |
|---|
| 673 | if (OASIS_debug >= 15) then |
|---|
| 674 | write(nulprt,*) subname,trim(type),numel,start,length,pts |
|---|
| 675 | endif |
|---|
| 676 | |
|---|
| 677 | elseif (trim(type) == 'decomp_wghtfile') then |
|---|
| 678 | allocate(llist(gsize),glist(gsize)) |
|---|
| 679 | llist = -1 |
|---|
| 680 | numel = 0 |
|---|
| 681 | if (gsrank >= 0) then |
|---|
| 682 | if (OASIS_debug >= 15) then |
|---|
| 683 | write(nulprt,*) subname,' wgts1 ',size(gridID) |
|---|
| 684 | write(nulprt,*) subname,' gridID ',minval(gridID),maxval(gridID) |
|---|
| 685 | endif |
|---|
| 686 | do n = 1,size(gridID) |
|---|
| 687 | if (gridID(n) > 0 .and. gridID(n) <= gsize) then |
|---|
| 688 | numel = numel + 1 |
|---|
| 689 | llist(gridID(n)) = gsrank |
|---|
| 690 | ! elseif (gridID(n) > gsize) then |
|---|
| 691 | ! tcraig, allow > gsize and ignore it, errors trapped/ignored in map read |
|---|
| 692 | ! write(nulprt,*) subname,estr,'gridID > gsize',gridID(n),gsize |
|---|
| 693 | ! call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 694 | ! else |
|---|
| 695 | ! tcraig, allow <= 0 and ignore it, errors trapped/ignored in map read |
|---|
| 696 | ! write(nulprt,*) subname,estr,'gridID <= 0',gridID(n),gsize |
|---|
| 697 | ! call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 698 | endif |
|---|
| 699 | enddo |
|---|
| 700 | |
|---|
| 701 | ! this computes the max MPI rank that includes the gridcell |
|---|
| 702 | ! max is arbitrary but this forces each gridcell to be associated with just one rank |
|---|
| 703 | call oasis_mpi_max(llist,glist,gscomm,string=trim(subname)//' glist',all=.true.) |
|---|
| 704 | |
|---|
| 705 | deallocate(llist) |
|---|
| 706 | deallocate(start,length) |
|---|
| 707 | allocate(start(numel),length(numel)) |
|---|
| 708 | start = -1 |
|---|
| 709 | length = -1 |
|---|
| 710 | numel = 0 |
|---|
| 711 | do n = 1,gsize |
|---|
| 712 | if (glist(n) == gsrank) then |
|---|
| 713 | numel = numel + 1 |
|---|
| 714 | if (numel > size(gridID)) then |
|---|
| 715 | write(nulprt,*) subname,estr,'numel error ',numel,size(gridID) |
|---|
| 716 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 717 | endif |
|---|
| 718 | start(numel) = n |
|---|
| 719 | length(numel) = 1 |
|---|
| 720 | endif |
|---|
| 721 | enddo |
|---|
| 722 | deallocate(glist) |
|---|
| 723 | endif ! gsrank >= 0 |
|---|
| 724 | |
|---|
| 725 | if (OASIS_debug >= 15) then |
|---|
| 726 | write(nulprt,*) subname,trim(type),numel |
|---|
| 727 | call oasis_flush(nulprt) |
|---|
| 728 | endif |
|---|
| 729 | |
|---|
| 730 | else |
|---|
| 731 | write(nulprt,*) subname,estr,'type argument unknown = ',trim(type) |
|---|
| 732 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 733 | endif |
|---|
| 734 | |
|---|
| 735 | !----------------------------------------------- |
|---|
| 736 | !> * Initialize the partition gsmap and pgsmap |
|---|
| 737 | !----------------------------------------------- |
|---|
| 738 | |
|---|
| 739 | call mct_gsmap_init(prism_part(prism_npart)%gsmap,start,length,0,mpicom,compid,gsize=gsize,numel=numel) |
|---|
| 740 | if (gsrank >= 0) then |
|---|
| 741 | call mct_gsmap_init(prism_part(prism_npart)%pgsmap,start,length,0, & |
|---|
| 742 | prism_part(prism_npart)%mpicom,compid,gsize=gsize,numel=numel) |
|---|
| 743 | endif |
|---|
| 744 | deallocate(start,length) |
|---|
| 745 | if (OASIS_debug >= 2) then |
|---|
| 746 | write(nulprt,*) subname,' create new part ',prism_npart,gsize |
|---|
| 747 | call oasis_part_write(prism_part(prism_npart),prism_npart) |
|---|
| 748 | endif |
|---|
| 749 | |
|---|
| 750 | id_part = prism_npart |
|---|
| 751 | |
|---|
| 752 | call oasis_debug_exit(subname) |
|---|
| 753 | |
|---|
| 754 | END SUBROUTINE oasis_part_create |
|---|
| 755 | !------------------------------------------------------------ |
|---|
| 756 | |
|---|
| 757 | END MODULE mod_oasis_part |
|---|
