SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/init_index

Go to the documentation of this file.
00001 SUBROUTINE INIT_INDEX_MPI(HPROGRAM,HALG,PIO_FRAC)
00002 !
00003 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NPROC, NCOMM, NINDEX, NSIZE_TASK, NSIZE, WLOG_MPI
00004 USE MODD_SURFEX_OMP, ONLY : NINDX2, NWORK, XWORK, XWORK2, NBLOCK
00005 !
00006 USE MODD_SURF_ATM_GRID_n, ONLY : CGRID, NGRID_PAR, XGRID_FULL_PAR
00007 USE MODD_SURF_ATM_n, ONLY : NDIM_FULL
00008 !
00009 USE MODI_GET_LUOUT
00010 USE MODI_SET_SURFEX_FILEIN
00011 USE MODI_INIT_IO_SURF_n
00012 USE MODI_READ_SURF
00013 USE MODI_READ_GRIDTYPE
00014 USE MODI_END_IO_SURF_n
00015 USE MODI_ABOR1_SFX
00016 USE MODI_GET_SIZES_PARALLEL
00017 USE MODI_GET_ADJACENT_MESHES
00018 USE MODI_GET_SIZE_FULL_n
00019 USE MODI_INI_DATA_COVER
00020 !
00021 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00022 USE PARKIND1  ,ONLY : JPRB
00023 !
00024 IMPLICIT NONE
00025 !
00026 #ifndef NOMPI
00027 INCLUDE "mpif.h"
00028 #endif
00029 !
00030  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
00031  CHARACTER(LEN=4), INTENT(IN) :: HALG
00032 REAL, INTENT(IN) :: PIO_FRAC
00033 !
00034 INTEGER, DIMENSION(:), ALLOCATABLE :: ILEFT   ! index of left   grid mesh 
00035 INTEGER, DIMENSION(:), ALLOCATABLE :: IRIGHT  ! index of right  grid mesh 
00036 INTEGER, DIMENSION(:), ALLOCATABLE :: ITOP    ! index of top    grid mesh 
00037 INTEGER, DIMENSION(:), ALLOCATABLE :: IBOTTOM ! index of bottom grid mesh
00038 !
00039 INTEGER :: IRESTE, INRESTE, IRANK, IPROC
00040 INTEGER :: J, I, CPT, ILUOUT
00041 INTEGER :: IRESP, INFOMPI
00042 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00043 !
00044 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI',0,ZHOOK_HANDLE)
00045 !
00046 IF ( NRANK==NPIO ) THEN
00047   !
00048   CALL GET_LUOUT(HPROGRAM,ILUOUT)
00049   !
00050   !*    1. Parameters of the grid
00051   !
00052   CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
00053   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00054   !
00055   CALL READ_SURF(HPROGRAM,'DIM_FULL  ',NDIM_FULL,IRESP,HDIR='A')
00056   NINDX2 = NDIM_FULL
00057   !
00058   CALL READ_SURF(HPROGRAM,'GRID_TYPE',CGRID,IRESP,HDIR='A')
00059   !
00060   CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NDIM_FULL,.FALSE.,HDIR='A')
00061   !
00062 !!$OMP SINGLE
00063   ALLOCATE(XGRID_FULL_PAR(NGRID_PAR))
00064 !!$OMP END SINGLE
00065   !
00066   CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NDIM_FULL,.TRUE.,&
00067                      XGRID_FULL_PAR,IRESP,HDIR='A')
00068   !
00069   !
00070   CALL END_IO_SURF_n(HPROGRAM)
00071   !
00072 ENDIF
00073 !
00074 IF (NPROC>1) THEN
00075 !$OMP SINGLE
00076 #ifndef NOMPI
00077   CALL MPI_BCAST(NDIM_FULL,KIND(NDIM_FULL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
00078 #endif
00079 !$OMP END SINGLE COPYPRIVATE(NDIM_FULL)
00080 ENDIF
00081 !
00082 !
00083 !*     3. Points by task
00084 !
00085 IF (.NOT.ALLOCATED(NINDEX)) ALLOCATE(NINDEX(NDIM_FULL))
00086 NINDEX(:) = -1
00087 !
00088 IF (HALG=='LIN ') THEN
00089   !
00090   IF (NRANK==NPIO) CALL SET_NB_POINTS_LIN(PIO_FRAC,NPROC,NPROC-1,NPIO,NDIM_FULL,NINDEX)
00091   !
00092 ELSEIF (HALG=='ADJ ' .OR. HALG=='TILA' .OR. HALG=='TILL') THEN
00093   !
00094   IF (HALG=='ADJ ' .OR. HALG=='TILA') THEN
00095     IF (NRANK==NPIO) THEN
00096       ALLOCATE(ILEFT  (NDIM_FULL))
00097       ALLOCATE(IRIGHT (NDIM_FULL))
00098       ALLOCATE(IBOTTOM(NDIM_FULL))
00099       ALLOCATE(ITOP   (NDIM_FULL))
00100       CALL GET_ADJACENT_MESHES(CGRID,NGRID_PAR,NDIM_FULL,XGRID_FULL_PAR,ILEFT,IRIGHT,ITOP,IBOTTOM)
00101     ENDIF
00102   ELSE
00103     ALLOCATE(ILEFT  (0))
00104     ALLOCATE(IRIGHT (0))
00105     ALLOCATE(IBOTTOM(0))
00106     ALLOCATE(ITOP   (0))
00107   ENDIF
00108   !
00109   IF (HALG=='ADJ ') THEN
00110     IF (NRANK==NPIO) CALL SET_NB_POINTS_ADJ(PIO_FRAC,NPROC,NPIO,NDIM_FULL,NDIM_FULL,ILEFT,IRIGHT,ITOP,IBOTTOM,NINDEX)
00111   ELSEIF (HALG=='TILA' .OR. HALG=='TILL') THEN
00112     IF (NRANK==NPIO) THEN
00113       CALL INI_DATA_COVER
00114       CALL SET_NB_POINTS_TIL(HPROGRAM,HALG,PIO_FRAC,NPROC,NPIO,NDIM_FULL,ILEFT,IRIGHT,ITOP,IBOTTOM,NINDEX)
00115     ENDIF
00116   ENDIF
00117   !
00118   IF (ALLOCATED(ILEFT  )) DEALLOCATE(ILEFT  )
00119   IF (ALLOCATED(IRIGHT )) DEALLOCATE(IRIGHT )
00120   IF (ALLOCATED(ITOP   )) DEALLOCATE(ITOP   )
00121   IF (ALLOCATED(IBOTTOM)) DEALLOCATE(IBOTTOM)
00122   !
00123 ELSE
00124   !
00125   CALL ABOR1_SFX("INIT_INDEX_MPI: ALG="//HALG//" not defined for the moment")
00126   !
00127 ENDIF
00128 !
00129 IF (NPROC>1) THEN
00130 !$OMP SINGLE
00131 #ifndef NOMPI   
00132   CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
00133 #endif
00134 !$OMP END SINGLE
00135 ENDIF
00136 !
00137 ALLOCATE(NSIZE_TASK(0:NPROC-1))
00138 NSIZE_TASK(:) = 0
00139 !
00140  CALL GET_SIZE_FULL_n(HPROGRAM,NDIM_FULL,NSIZE_TASK(NRANK))
00141 NINDX2 = NSIZE_TASK(NRANK)
00142 !
00143 NSIZE = 0
00144 IF (NPROC>1) THEN
00145 !$OMP SINGLE
00146   DO J=0,NPROC-1
00147 #ifndef NOMPI   
00148     CALL MPI_BCAST(NSIZE_TASK(J),KIND(NSIZE_TASK)/4,MPI_INTEGER,J,NCOMM,INFOMPI)
00149 #endif    
00150     IF ( NSIZE_TASK(J)>NSIZE ) NSIZE = NSIZE_TASK(J)
00151     CALL WLOG_MPI('SIZE_TASK ',KLOG=J,KLOG2=NSIZE_TASK(J))
00152   ENDDO
00153 !$OMP END SINGLE
00154 ELSE
00155   NSIZE = NSIZE_TASK(0)
00156 ENDIF
00157 !
00158 XGRID_FULL_PAR=>NULL()
00159 !
00160 ALLOCATE(NWORK(NSIZE))
00161 ALLOCATE(XWORK(NSIZE))
00162 ALLOCATE(XWORK2(NSIZE,10))
00163 !
00164 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI',1,ZHOOK_HANDLE)
00165 !
00166 CONTAINS
00167 !
00168 !***************************************************************
00169 !
00170 SUBROUTINE SET_NB_POINTS_LIN(PIO_FRAC,KPROC,KPROCMIN,KPIO,KSIZE,KINDEX)
00171 !
00172 IMPLICIT NONE
00173 !
00174 REAL, INTENT(IN) :: PIO_FRAC
00175 INTEGER, INTENT(IN) :: KPROC
00176 INTEGER, INTENT(IN) :: KPROCMIN
00177 INTEGER, INTENT(IN) :: KPIO
00178 INTEGER, INTENT(IN) :: KSIZE
00179 INTEGER, DIMENSION(:), INTENT(INOUT) :: KINDEX
00180 !
00181 INTEGER, DIMENSION(0:KPROC-1) :: ISIZE_TASK
00182 INTEGER :: I, J, CPT, IPROC1
00183 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00184 !
00185 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI:SET_NB_POINTS_LIN',0,ZHOOK_HANDLE)
00186 !
00187  CALL GET_SIZES_PARALLEL(PIO_FRAC,KPROC,KPIO,KSIZE,ISIZE_TASK)
00188 !
00189 IPROC1 = KPROCMIN
00190 !
00191 CPT   = 0
00192 !
00193 DO J=1,SIZE(KINDEX) ! boucle sur les points du domaine
00194   !
00195   IF (KINDEX(J)==-1) THEN ! si le point doit être affecté à cette itération
00196     CPT = CPT + 1 ! on augmente le nombre de points affectés de 1
00197     DO WHILE( CPT>ISIZE_TASK(IPROC1) ) ! si on est hors les bornes permises par le proc en cours
00198       IF ( IPROC1.GE.KPROCMIN ) THEN ! d'abord, on va de IPROCMIN à IPROC-1
00199         IPROC1 = IPROC1+1
00200         IF ( IPROC1==KPROC ) IPROC1 = KPROCMIN-1 ! une fois qu'on est à IPROC-1,
00201       ELSE                                       ! on redescend sous IPROC1
00202         IPROC1 = IPROC1-1
00203       ENDIF
00204       CPT = 1
00205     ENDDO
00206     KINDEX(J) = IPROC1
00207   ENDIF
00208   !
00209 ENDDO
00210 !
00211 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI:SET_NB_POINTS_LIN',1,ZHOOK_HANDLE)
00212 !
00213 END SUBROUTINE SET_NB_POINTS_LIN
00214 !
00215 !**************************************************************************
00216 !
00217 SUBROUTINE SET_NB_POINTS_ADJ(PIO_FRAC,KPROC,KPIO,KSIZE,KSIZE_FULL,KLEFT,KRIGHT,KTOP,KBOTTOM,KINDEX)
00218 !
00219 IMPLICIT NONE
00220 !
00221 REAL, INTENT(IN) :: PIO_FRAC
00222 INTEGER, INTENT(IN) :: KPROC
00223 INTEGER, INTENT(IN) :: KPIO
00224 INTEGER, INTENT(IN) :: KSIZE
00225 INTEGER, INTENT(IN) :: KSIZE_FULL
00226 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KLEFT
00227 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KRIGHT
00228 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KTOP 
00229 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KBOTTOM
00230 INTEGER, DIMENSION(KSIZE_FULL), INTENT(INOUT) :: KINDEX
00231 !
00232 INTEGER, DIMENSION(KSIZE_FULL) :: IPOINT
00233 INTEGER, DIMENSION(0:KPROC-1) :: ISIZE_TASK
00234 INTEGER, DIMENSION(4) :: INEAR
00235 INTEGER :: CPT_TOT, CPT_LOC, CPT_INTER, I, J, K
00236 !
00237 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00238 !
00239 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI:SET_NB_POINTS_ADJ',0,ZHOOK_HANDLE)
00240 !
00241  CALL GET_SIZES_PARALLEL(PIO_FRAC,KPROC,KPIO,KSIZE,ISIZE_TASK)
00242 !
00243 DO I=1,KPROC-1
00244   !
00245   CPT_INTER = 0
00246   CPT_LOC   = 0
00247   CPT_TOT   = 0
00248   !
00249   DO WHILE ( CPT_TOT < ISIZE_TASK(I) )
00250     !
00251     IF (CPT_LOC < 1 ) THEN ! if no free point has been found in neighbours
00252       !
00253       DO J=1,KSIZE_FULL
00254         IF ( KINDEX(J)==-1 ) THEN
00255           CPT_TOT = CPT_TOT + 1
00256           CPT_LOC = 1
00257           IPOINT(1) = J
00258           KINDEX(J) = I
00259           EXIT
00260         ENDIF
00261       ENDDO
00262       !
00263     ENDIF
00264     !
00265     IPOINT(1:CPT_LOC-CPT_INTER) = IPOINT(CPT_INTER+1:CPT_LOC)
00266     CPT_LOC   = CPT_LOC - CPT_INTER
00267     CPT_INTER = CPT_LOC
00268     !
00269     B1 : DO J=1,CPT_INTER
00270       !
00271       INEAR(1) = KBOTTOM(IPOINT(J))
00272       INEAR(2) = KLEFT  (IPOINT(J))
00273       INEAR(3) = KRIGHT (IPOINT(J)) 
00274       INEAR(4) = KTOP   (IPOINT(J))    
00275       !
00276       DO K=1,4
00277         !
00278         IF ( INEAR(K).NE.0 ) THEN
00279           IF( KINDEX(INEAR(K)).EQ.-1 ) THEN
00280             CPT_TOT = CPT_TOT + 1
00281             CPT_LOC = CPT_LOC + 1
00282             IF (CPT_TOT.GT.ISIZE_TASK(I)) EXIT B1
00283             KINDEX(INEAR(K)) = I
00284             IPOINT(CPT_LOC) = INEAR(K)
00285           ENDIF
00286         ENDIF
00287         !
00288       ENDDO
00289       !
00290     ENDDO B1
00291     !
00292   ENDDO
00293   !
00294 ENDDO
00295 !
00296 WHERE (KINDEX(:)==-1) KINDEX(:) = 0
00297 !
00298 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI:SET_NB_POINTS_ADJ',1,ZHOOK_HANDLE)
00299 !
00300 END SUBROUTINE SET_NB_POINTS_ADJ
00301 !
00302 !*****************************************************************
00303 !
00304 SUBROUTINE SET_NB_POINTS_TIL(HPROGRAM,HALG,PIO_FRAC,KPROC,KPIO,KSIZE_FULL,KLEFT,KRIGHT,KTOP,KBOTTOM,KINDEX)
00305 !
00306 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER
00307 USE MODD_DATA_COVER, ONLY : XDATA_VEGTYPE
00308 !
00309 USE MODI_AV_PGD
00310 !
00311 IMPLICIT NONE
00312 !
00313  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
00314  CHARACTER(LEN=4), INTENT(IN) :: HALG
00315 REAL, INTENT(IN) :: PIO_FRAC
00316 INTEGER, INTENT(IN) :: KPROC
00317 INTEGER, INTENT(IN) :: KPIO
00318 INTEGER, INTENT(IN) :: KSIZE_FULL
00319 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KLEFT
00320 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KRIGHT
00321 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KTOP 
00322 INTEGER, DIMENSION(KSIZE_FULL), INTENT(IN) :: KBOTTOM
00323 INTEGER, DIMENSION(KSIZE_FULL), INTENT(INOUT) :: KINDEX
00324 !
00325 REAL, DIMENSION(KSIZE_FULL) :: ZSEA
00326 REAL, DIMENSION(KSIZE_FULL) :: ZWATER
00327 REAL, DIMENSION(KSIZE_FULL) :: ZNATURE
00328 REAL, DIMENSION(KSIZE_FULL) :: ZTOWN
00329 REAL, DIMENSION(KSIZE_FULL, JPCOVER) :: ZCOVER
00330 REAL, DIMENSION(KSIZE_FULL, NVEGTYPE) :: ZVEGTYPE
00331 INTEGER, DIMENSION(KSIZE_FULL,2) :: ITYPE 
00332 INTEGER,DIMENSION(4,10) :: ITYPE0
00333 INTEGER, DIMENSION(KSIZE_FULL) :: IINDEX
00334 INTEGER, DIMENSION(0:KPROC-1) :: ISIZE_TASK
00335 INTEGER, DIMENSION(0:KPROC-1) :: INBPTS
00336 INTEGER, DIMENSION(1) :: IPROCMIN
00337 INTEGER :: IFULL, IRESP, J, I, K, JVEGTYPE, CPT, IN1, IN2
00338 LOGICAL, DIMENSION(JPCOVER) :: GCOVER
00339 LOGICAL :: GDATA_VEGTYPE
00340 !
00341 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00342 !
00343 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI:SET_NB_POINTS_TIL',0,ZHOOK_HANDLE)
00344 !
00345  CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00346 !
00347  CALL READ_SURF(HPROGRAM,'FRAC_SEA   ',ZSEA,   IRESP, HDIR='A')
00348  CALL READ_SURF(HPROGRAM,'FRAC_NATURE',ZNATURE,IRESP, HDIR='A')
00349  CALL READ_SURF(HPROGRAM,'FRAC_WATER ',ZWATER, IRESP, HDIR='A')
00350  CALL READ_SURF(HPROGRAM,'FRAC_TOWN  ',ZTOWN,  IRESP, HDIR='A')
00351 !
00352  CALL END_IO_SURF_n(HPROGRAM)
00353  CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','SURF  ','READ ')
00354  CALL READ_SURF(HPROGRAM,'L_VEGTYPE',GDATA_VEGTYPE,IRESP,HDIR='A')
00355 !
00356 IF (GDATA_VEGTYPE) THEN
00357   CALL READ_SURF(HPROGRAM,'D_VEGTYPE',ZVEGTYPE(:,:),IRESP,HDIR='A')
00358   CALL END_IO_SURF_n(HPROGRAM)
00359 ELSE
00360   CALL END_IO_SURF_n(HPROGRAM)
00361   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00362   CALL READ_SURF(HPROGRAM,'COVER_LIST',GCOVER(:),IRESP,HDIR='A')
00363   CALL READ_SURF(HPROGRAM,'COVER',ZCOVER(:,:),GCOVER,IRESP,HDIR='A')
00364   DO JVEGTYPE=1,NVEGTYPE
00365     CALL AV_PGD (ZVEGTYPE(:,JVEGTYPE),ZCOVER,XDATA_VEGTYPE(:,JVEGTYPE),'NAT','ARI')
00366   END DO
00367 ENDIF
00368 !
00369  CALL END_IO_SURF_n(HPROGRAM)
00370 !
00371 ITYPE(:,:) = 0
00372 !
00373 DO J=1,KSIZE_FULL
00374   !
00375   IF (ZSEA(J)/=0. .AND. ZNATURE(J)/=0. .AND. ZWATER(J)/=0. .AND. ZTOWN(J)/=0.) THEN ! 1 2 3 4
00376     ITYPE(J,1) = 1 
00377   ELSEIF (ZSEA(J)/=0. .AND. ZNATURE(J)/=0. .AND. ZWATER(J)/=0.) THEN ! 1 2 3
00378     ITYPE(J,1) = 2
00379   ELSEIF (ZSEA(J)/=0. .AND. ZNATURE(J)/=0. .AND. ZTOWN(J)/=0.) THEN ! 1 2 4
00380     ITYPE(J,1) = 3
00381   ELSEIF (ZSEA(J)/=0. .AND. ZWATER(J)/=0. .AND. ZTOWN(J)/=0.) THEN ! 1 3 4 
00382     ITYPE(J,1) = 4
00383   ELSEIF (ZNATURE(J)/=0. .AND. ZWATER(J)/=0. .AND. ZTOWN(J)/=0.) THEN ! 2 3 4
00384     ITYPE(J,1) = 5
00385   ELSEIF (ZSEA(J)/=0.) THEN 
00386     IF (ZNATURE(J)/=0.) THEN ! 1 2
00387       ITYPE(J,1) = 6
00388     ELSEIF (ZWATER(J)/=0.) THEN ! 1 3
00389       ITYPE(J,1) = 7
00390     ELSEIF (ZTOWN(J)/=0.) THEN ! 1 4
00391       ITYPE(J,1) = 8
00392     ELSE ! 1
00393       ITYPE(J,1) = 12
00394     ENDIF
00395   ELSEIF (ZNATURE(J)/=0.) THEN
00396     IF (ZWATER(J)/=0.) THEN ! 2 3
00397       ITYPE(J,1) = 9
00398     ELSEIF (ZTOWN(J)/=0.) THEN ! 2 4
00399       ITYPE(J,1) = 10
00400     ELSE ! 2
00401       ITYPE(J,1) = 13
00402     ENDIF
00403   ELSEIF (ZWATER(J)/=0.) THEN
00404     IF (ZTOWN(J)/=0.) THEN ! 3 4
00405       ITYPE(J,1) = 11
00406     ELSE ! 3
00407       ITYPE(J,1) = 14
00408     ENDIF
00409   ELSE ! 4
00410     ITYPE(J,1) = 15
00411   ENDIF
00412   !
00413 ENDDO
00414 !
00415 !we give numbers to the 40 types of vegtypes
00416 CPT = 0
00417 DO I = 1,SIZE(ITYPE0,1)
00418   DO J = 1,SIZE(ITYPE0,2)
00419     CPT = CPT + 1
00420     ITYPE0(I,J) = CPT
00421   ENDDO
00422 ENDDO
00423 !
00424 DO J=1,KSIZE_FULL
00425   IN1 = 0
00426   IN2 = 0
00427   DO I=1,3
00428     IF (ZVEGTYPE(J,I)/=0.) IN1 = IN1 +1
00429   ENDDO
00430   DO I=4,NVEGTYPE
00431     IF (ZVEGTYPE(J,I)/=0.) IN2 = IN2 +1
00432   ENDDO
00433   ITYPE(J,2) = ITYPE0(IN1+1,IN2+1)
00434 ENDDO
00435 !
00436 KINDEX(:) = -1
00437 !
00438 DO I = 1,15
00439   !
00440   DO J = 1,40
00441     !
00442     IINDEX(:) = -2
00443     DO K=1,KSIZE_FULL
00444       IF (ITYPE(K,1)==I .AND. ITYPE(K,2)==J) IINDEX(K) = -1
00445     ENDDO
00446     !
00447     IFULL = COUNT(IINDEX(:)==-1)
00448     !
00449     IF (IFULL.NE.0) THEN
00450       !
00451       INBPTS(:) = 0
00452       DO K=1,SIZE(KINDEX)
00453         IF (KINDEX(K)>-1) INBPTS(KINDEX(K)) = INBPTS(KINDEX(K)) + 1
00454       ENDDO
00455       IF (PIO_FRAC/=0.) THEN 
00456         INBPTS(NPIO) = NINT (INBPTS(NPIO) / PIO_FRAC)
00457         IPROCMIN = MINLOC(INBPTS(0:KPROC-1)) - 1
00458       ELSEIF (KPROC>1) THEN
00459         IPROCMIN = MINLOC(INBPTS(1:KPROC-1))
00460       ELSE
00461         IPROCMIN(:) = 0
00462       ENDIF
00463       !
00464       IF (HALG=='TILL') THEN
00465         CALL SET_NB_POINTS_LIN(PIO_FRAC,KPROC,IPROCMIN(1),KPIO,IFULL,IINDEX(:))
00466       ELSEIF (HALG=='TILA') THEN
00467         CALL SET_NB_POINTS_ADJ(PIO_FRAC,KPROC,KPIO,IFULL,KSIZE_FULL,KLEFT,KRIGHT,KTOP,KBOTTOM,IINDEX(:))
00468       ENDIF
00469       !
00470       DO K=1,KSIZE_FULL
00471         IF ( IINDEX(K)> -1 ) KINDEX(K) = IINDEX(K)
00472       ENDDO
00473       !
00474    
00475     ENDIF
00476     !
00477   ENDDO
00478   !
00479 ENDDO
00480 !
00481 IF (LHOOK) CALL DR_HOOK('INIT_INDEX_MPI:SET_NB_POINTS_TIL',1,ZHOOK_HANDLE)
00482 !
00483 END SUBROUTINE SET_NB_POINTS_TIL
00484 !
00485 !
00486 !
00487 END SUBROUTINE INIT_INDEX_MPI