Révision 9 src/Header.f90

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

  
4 4
         IMPLICIT NONE
5 5

  
6

  
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

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

  
23

  
24
         Debug=Valid("Header")
25

  
10 26
         Head1="====================================================================="
11 27
           Sep="                                                                     "
12 28

  
13
         LenS=len(String)
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)
14 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

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

  
18 63
         WRITe(*,'(A)') Head1
19
         WRITE(*,'(A)') "=" // Sep(1:Pos1) // String(1:LenS) // Sep(1:Len1) // "="
20
         WRITe(*,'(A)') Head1
21 64

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

  
71

  
22 72
       END subroutine Header

Formats disponibles : Unified diff