Statistiques
| Révision :

root / src / Expand.f90 @ 4

Historique | Voir | Annoter | Télécharger (1,14 ko)

1 1 equemene
SUBROUTINE Expand(List,Idx,Dim)
2 1 equemene
3 1 equemene
  ! This subroutine expands a list entered in a compacted form
4 1 equemene
  ! ie 1 -10 => 1 2 3  4 5 6 7 8 9 10
5 1 equemene
6 1 equemene
  use VarTypes
7 1 equemene
8 1 equemene
  INTEGER(KINT), INTENT(IN) :: Dim
9 1 equemene
  INTEGER(KINT), INTENT(INOUT) :: List(Dim)
10 1 equemene
  INTEGER(KINT), INTENT(INOUT) :: Idx
11 1 equemene
12 1 equemene
  LOGICAL, ALLOCATABLE :: FTmp(:) ! Dim
13 1 equemene
  LOGICAL :: Debug
14 1 equemene
  INTEGER(KINT) :: i
15 1 equemene
16 1 equemene
  INTERFACE
17 1 equemene
     function valid(string) result (isValid)
18 1 equemene
       CHARACTER(*), intent(in) :: string
19 1 equemene
       logical                  :: isValid
20 1 equemene
     END function VALID
21 1 equemene
22 1 equemene
  END INTERFACE
23 1 equemene
24 1 equemene
  Debug=valid('Expand')
25 1 equemene
26 1 equemene
  Allocate(FTmp(Dim))
27 1 equemene
  FTmp=.FALSE.
28 1 equemene
29 1 equemene
  Idx=1
30 1 equemene
31 1 equemene
  DO WHILE (List(Idx).NE.0)
32 1 equemene
     If (List(Idx).LT.0) THEN
33 1 equemene
        DO I=List(Idx-1),abs(List(Idx))
34 1 equemene
           IF (.NOT.FTmp(I)) THEN
35 1 equemene
              FTmp(I)=.TRUE.
36 1 equemene
           END IF
37 1 equemene
        END DO
38 1 equemene
     ELSEIF (.NOT.FTmp(List(Idx))) THEN
39 1 equemene
        FTmp(List(Idx))=.TRUE.
40 1 equemene
     END IF
41 1 equemene
     Idx=Idx+1
42 1 equemene
  END DO
43 1 equemene
44 1 equemene
  if (debug) WRITE(*,*) "DBG Expand,  List",List
45 1 equemene
46 1 equemene
  ! We convert List into non compacted form
47 1 equemene
  Idx=1
48 1 equemene
  DO I=1,Dim
49 1 equemene
     If(Ftmp(I)) THEN
50 1 equemene
        List(Idx)=I
51 1 equemene
        Idx=Idx+1
52 1 equemene
     END IF
53 1 equemene
  END DO
54 1 equemene
  List(Idx)=0
55 1 equemene
  Idx=Idx-1
56 1 equemene
57 1 equemene
 DEALLOCATE(Ftmp)
58 1 equemene
59 1 equemene
END SUBROUTINE Expand