Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / TOOL / writedir.f90
1 !###########################
2 MODULE MODI_WRITEDIR
3 !###########################
4 !
5 INTERFACE WRITEDIR
6 !
7 SUBROUTINE WRITEDIRX(KLU,PVAL)
8 INTEGER, INTENT(IN) :: KLU
9 REAL,    INTENT(IN) :: PVAL
10 END SUBROUTINE WRITEDIRX
11 !
12 SUBROUTINE WRITEDIRN(KLU,KVAL)
13 INTEGER, INTENT(IN) :: KLU
14 INTEGER, INTENT(IN) :: KVAL
15 END SUBROUTINE WRITEDIRN
16 !
17 SUBROUTINE WRITEDIRAN(KLU,KVAL)
18 INTEGER, INTENT(IN) :: KLU
19 INTEGER,DIMENSION(:), INTENT(IN) :: KVAL
20 END SUBROUTINE WRITEDIRAN
21 !
22 SUBROUTINE WRITEDIRC(KLU,HVAL)
23 INTEGER, INTENT(IN) :: KLU
24 CHARACTER(LEN=*), INTENT(IN) :: HVAL
25 END SUBROUTINE WRITEDIRC
26 !
27 END INTERFACE
28 END MODULE MODI_WRITEDIR
29 !
30 !     ###########################
31       SUBROUTINE WRITEDIRX(KLU,PVAL)
32 !     ###########################
33 !
34 IMPLICIT NONE
35 INTEGER, INTENT(IN) :: KLU
36 REAL,    INTENT(IN) :: PVAL
37 !
38 CHARACTER(LEN=80) :: YCAR80      ! String for directive written
39 CHARACTER(LEN=7)  :: YFORMOUT    ! String for format of directive written
40 !
41 YCAR80(1:LEN(YCAR80))=' '
42 WRITE(YCAR80,*)PVAL
43 YCAR80=ADJUSTL(YCAR80)
44 YFORMOUT='(A  )'
45 WRITE(YFORMOUT(3:4),'(I2.2)') MAX(LEN_TRIM(YCAR80),3) 
46 WRITE(UNIT=KLU,FMT=YFORMOUT)YCAR80(1:LEN_TRIM(YCAR80))
47 END SUBROUTINE WRITEDIRX
48 !
49 !     ###########################
50       SUBROUTINE WRITEDIRN(KLU,KVAL)
51 !     ###########################
52 !
53 IMPLICIT NONE
54 INTEGER, INTENT(IN) :: KLU
55 INTEGER, INTENT(IN) :: KVAL
56 !
57 CHARACTER(LEN=80) :: YCAR80      ! String for directive written
58 CHARACTER(LEN=7)  :: YFORMOUT    ! String for format of directive written
59 !
60 YCAR80(1:LEN(YCAR80))=' '
61 WRITE(YCAR80,*)KVAL
62 YCAR80=ADJUSTL(YCAR80)
63 YFORMOUT='(A  )'
64 WRITE(YFORMOUT(3:4),'(I2.2)') MAX(LEN_TRIM(YCAR80),3) 
65 WRITE(UNIT=KLU,FMT=YFORMOUT)YCAR80(1:LEN_TRIM(YCAR80))
66 !
67 END SUBROUTINE WRITEDIRN
68 !
69 !     ###########################
70       SUBROUTINE WRITEDIRAN(KLU,KVAL)
71 !     ###########################
72 !
73 IMPLICIT NONE
74 INTEGER, INTENT(IN) :: KLU
75 INTEGER,DIMENSION(:), INTENT(IN) :: KVAL
76 !
77 CHARACTER(LEN=80) :: YCAR80      ! String for directive written
78 !CHARACTER(LEN=7)  :: YFORMOUT    ! String for format of directive written
79 !INTEGER :: ISIZE
80 CHARACTER(LEN=15)  :: YFORMSIZE    ! String for format of directive written
81
82 !
83 WRITE(YFORMSIZE,'("(",I2,"(I4))" )') SIZE(KVAL)
84 !ISIZE=SIZE(KVAL)
85 !YFORMSIZE='(  (I3,X))'
86 !WRITE(YFORMSIZE(2:3),'(I2)')  ISIZE
87 YCAR80(1:LEN(YCAR80))=' '
88 WRITE(YCAR80,FMT=YFORMSIZE) KVAL
89 YCAR80=ADJUSTL(YCAR80)
90 !YFORMOUT='(A  )'
91 !WRITE(YFORMOUT(3:4),'(I2.2)') MAX(LEN_TRIM(YCAR80),3) 
92 WRITE(UNIT=KLU,FMT='(A)')YCAR80(1:LEN_TRIM(YCAR80))
93 !
94 END SUBROUTINE WRITEDIRAN
95 !     ###########################
96       SUBROUTINE WRITEDIRC(KLU,HVAL)
97 !     ###########################
98 !
99 IMPLICIT NONE
100 INTEGER, INTENT(IN) :: KLU
101 CHARACTER(LEN=*), INTENT(IN) :: HVAL
102 !
103 CHARACTER(LEN=80) :: YCAR80      ! String for directive written
104 CHARACTER(LEN=7)  :: YFORMOUT    ! String for format of directive written
105 !
106 YCAR80(1:LEN(YCAR80))=' '
107 WRITE(YCAR80,'(A80)')HVAL
108 YCAR80=ADJUSTL(YCAR80)
109 YFORMOUT='(A  )'
110 WRITE(YFORMOUT(3:4),'(I2.2)') MAX(LEN_TRIM(YCAR80),3) 
111 WRITE(UNIT=KLU,FMT=YFORMOUT)YCAR80(1:LEN_TRIM(YCAR80))
112 !
113 END SUBROUTINE WRITEDIRC
114