Statistiques
| Révision :

root / src / Header.f90 @ 9

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

1
      subroutine Header(String)
2
! This short subroutine print a header in a nice way
3

    
4
         IMPLICIT NONE
5

    
6

    
7
         CHARACTER(*) :: String
8

    
9
         INTERFACE
10
            function valid(string) result (isValid)
11
              CHARACTER(*), intent(in) :: string
12
              logical                  :: isValid
13
            END function VALID
14
         END INTERFACE
15

    
16

    
17
         CHARACTER(70) :: Head1,Sep
18
         CHARACTER(70) :: String2
19
         INTEGER :: LenS,Len1,Pos1
20
         INTEGER :: I,N,Idx,PosB,PosE
21
         LOGICAL :: Debug
22

    
23

    
24
         Debug=Valid("Header")
25

    
26
         Head1="====================================================================="
27
           Sep="                                                                     "
28

    
29
           If (debug) THEN
30
              WRITe(*,'(A)') Head1
31
              WRITE(*,'(A)') "=     Entering Header.... "
32
              WRITe(*,'(A)') Head1
33
           END IF
34

    
35
         WRITe(*,'(A)') Head1
36

    
37
         LenS=len_Trim(String)
38
         DO WHILE (LenS>65)
39
            Idx=Index(String(1:65)," ",BACK=.TRUE.)
40
            If (Idx>0) THEN
41
               PosE=Idx-1
42
            ELSE 
43
               PosE=65
44
            END IF
45
            
46
            String2=AdjustL(Trim(String(1:PosE)))
47
            LenS=Len_Trim(String2)
48
 !        WRITE(*,*) "DBG Head:",LenS, String
49
            Pos1=33-Int(LenS/2)
50
            Len1=67-LenS-Pos1
51

    
52
            WRITE(*,'(A)') "=" // Sep(1:Pos1) // TRIM(String2) // Sep(1:Len1) // "="
53
            String2=String(PosE+1:)
54
            String=AdjustL(String2)
55
            LenS=Len_Trim(String)
56
      END DO
57

    
58
         Pos1=34-Int(LenS/2)
59
         Len1=67-LenS-Pos1
60
         
61
         WRITE(*,'(A)') "=" // Sep(1:Pos1) // TRIM(String) // Sep(1:Len1) // "="
62

    
63
         WRITe(*,'(A)') Head1
64

    
65
           If (debug) THEN
66
              WRITe(*,'(A)') Head1
67
              WRITE(*,'(A)') "=     Exiting Header.... "
68
              WRITe(*,'(A)') Head1
69
           END IF
70

    
71

    
72
       END subroutine Header