Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / datfile_fordiachro.f90
1 !     ######spl
2       SUBROUTINE DATFILE_FORDIACHRO
3 !     #############################
4 !
5 !!****  *DATFILE_FORDIACHRO* - Recupere la date du run du graphique et l'inscrit sur
6 !                   le dessin ainsi que le nom du fichier traite
7 !!
8 !!    PURPOSE
9 !!    -------
10 !
11 !
12 !!**  METHOD
13 !!    ------
14 !!     
15 !!
16 !!    EXTERNAL
17 !!    --------
18 !!      None
19 !!
20 !!    IMPLICIT ARGUMENTS
21 !!    ------------------
22 !!
23 !!      None
24 !!
25 !!    AUTHOR
26 !!    ------
27 !!      
28 !!      J. Duron    * Laboratoire d'Aerologie *
29 !!
30 !!    MODIFICATIONS
31 !!    -------------
32 !!      Original       19/09/95
33 !-------------------------------------------------------------------------------
34 !
35 !*       0.    DECLARATIONS
36 !              ------------
37 !
38 USE MODD_OUT
39 USE MODD_FILES_DIACHRO
40 USE MODD_RESOLVCAR
41 USE MODD_TYPE_AND_LH
42 USE MODD_ALLOC_FORDIACHRO
43 !
44 IMPLICIT NONE
45 !
46 !*       0.1  dummy argument
47 !
48 !          
49 !
50 !
51 !*       0.1  local variables
52 !          
53 !
54 CHARACTER(LEN=8) :: YTIM8, YTEM8
55 CHARACTER(LEN=9) :: YTEM9
56 #if defined(HPPA)
57 CHARACTER(LEN=9) :: YDAT8
58 #else
59 #if defined(LINUX) || defined (O2000) 
60 CHARACTER(LEN=9) :: YDAT8
61 CHARACTER(LEN=10) :: YTIM10
62 #else
63 #if defined(VPP)
64 CHARACTER(LEN=8) :: YDAT8
65 #endif
66 #endif
67 #endif
68 INTEGER          :: J, JM, ID
69 INTEGER,DIMENSION(3) :: ITIM
70 REAL             :: ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT
71 !-------------------------------------------------------------------------------
72 #if defined(HPPA)
73 CALL DATE(YDAT8)
74 CALL TIME(YTIM8)
75 #else
76 #if defined(LINUX) || defined (O2000) 
77 CALL DATE_AND_TIME(YDAT8,YTIM10)
78 #else
79 #if defined(VPP)
80 CALL ITIME(ITIM)
81 YTIM8='        '
82 WRITE(YTIM8,'(I2,I2,I2)')ITIM
83 CALL DATE_AND_TIME(YDAT8,YTIM8)
84 YTEM8='        '
85 #endif
86 #endif
87 #endif
88
89 !!!!!!!!!!! Date
90 YTEM9='        '
91 #if defined(HPPA)
92 YTEM9(1:2)=YDAT8(1:2)
93 #else
94 #if defined(LINUX) || defined (O2000) 
95 YTEM9(1:2)=YDAT8(7:8)
96 #else
97 #if defined(VPP)
98 YTEM8(1:2)=YDAT8(7:8)
99 YTEM8(4:5)=YDAT8(4:5)
100 #endif
101 #endif
102 #endif
103 YTEM9(3:3)='/'
104 #if defined(HPPA)
105 YTEM9(4:6)=YDAT8(4:6)
106 #else
107 #if defined(LINUX) || defined (O2000) 
108 YTEM9(4:5)=YDAT8(5:6)
109 #else
110 #if defined(VPP)
111 YTEM8(3:3)='/'
112 YTEM8(6:6)='/'
113 #endif
114 #endif
115 #endif
116
117 #if defined(HPPA)
118 YTEM9(7:7)='/'
119 #else
120 #if defined(LINUX) || defined (O2000) 
121 YTEM9(6:6)='/'
122 #else
123 #if defined(VPP)
124 YTEM8(7:8)=YDAT8(1:2)
125 #endif
126 #endif
127 #endif
128 #if defined(HPPA)
129 YTEM9(8:9)=YDAT8(8:9)
130 #else
131 #if defined(LINUX) 
132 YTEM9(7:8)=YDAT8(3:4)
133 YTEM9(9:9)='/'
134 #if defined (O2000) 
135 YTEM9(7:8)=YDAT8(1:2)
136 YTEM9(9:9)='/'
137 #endif
138 #endif
139 #endif
140 #if defined(VPP)
141 YDAT8=YTEM8
142 #else
143 #if defined(HPPA)
144 YDAT8=YTEM9(1:9)
145 #else
146 YDAT8=YTEM9(1:8)
147 #endif
148 #endif
149
150 !!!!!!!!!!! Time
151 YTEM8='        '
152 #if defined(HPPA)
153 YTEM8(1:2)=YTIM8(1:2)
154 #else
155 #if defined(LINUX) || defined (O2000) 
156 YTEM8(1:2)=YTIM10(1:2)
157 #else
158 #if defined(VPP)
159 YTEM8(4:5)=YTIM8(3:4)
160 #endif
161 #endif
162 #endif
163 YTEM8(3:3)='H'
164
165 #if defined(HPPA)
166 YTEM8(4:5)=YTIM8(4:5)
167 #else
168 #if defined(LINUX) || defined (O2000) 
169 YTEM8(4:5)=YTIM10(3:4)
170 #else
171 #if defined(VPP)
172 YTEM8(7:8)=YTIM8(5:6)
173 #endif
174 #endif
175 #endif
176 YTEM8(6:6)='M'
177
178 #if defined(HPPA)
179 YTEM8(7:8)=YTIM8(7:8)
180 #else
181 #if defined(LINUX) || defined (O2000) 
182 YTEM8(7:8)=YTIM10(5:6)
183 #endif
184 #endif
185
186 YTIM8=YTEM8
187 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
188 CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
189 #if defined(HPPA)
190 CALL PLCHHQ(0.80,0.99,YDAT8,.008,0.,-1.)
191 #else
192 #if defined(LINUX) || defined (O2000) 
193 CALL PLCHHQ(0.80,0.99,YDAT8(1:LEN_TRIM(YDAT8)),.008,0.,-1.)
194 #else
195 #if defined(VPP)
196 CALL PLCHHQ(0.78,0.99,YDAT8,.008,0.,-1.)
197 #endif
198 #endif
199 #endif
200 #if defined(HPPA)
201 CALL PLCHHQ(0.99,0.99,YTIM8,.008,0.,+1.)
202 #else
203 #if defined(LINUX) || defined (O2000) 
204 CALL PLCHHQ(0.99,0.99,YTIM8(1:LEN_TRIM(YTIM8)),.008,0.,+1.)
205 #else
206 #if defined(VPP)
207 CALL PLCHHQ(0.90,0.99,YTIM8,.008,0.,-1.)
208 #endif
209 #endif
210 #endif
211 !
212 ! Modifs for diachro
213 !
214 DO J=1,NBFILES
215   IF(NUMFILES(J) == NUMFILECUR)THEN
216     JM=J
217     EXIT
218   ENDIF
219 ENDDO
220 #if defined(HPPA)
221 CALL PLCHHQ(0.80,.97,CFILEDIAS(JM),.008,0.,-1.)
222 #else
223 #if defined(LINUX) || defined (O2000) 
224 CALL PLCHHQ(0.80,.97,CFILEDIAS(JM)(1:LEN_TRIM(CFILEDIAS(JM))),.008,0.,-1.)
225 #else
226 #if defined(VPP)
227 CALL PLCHHQ(0.78,.97,CFILEDIAS(JM),.008,0.,-1.)
228 #endif
229 #endif
230 #endif
231 IF(ALLOCATED(XVAR))THEN
232 IF(SIZE(XVAR,6) > 1 )THEN
233   CALL PLCHHQ(0.99,.95,CGROUP(1:LEN_TRIM(CGROUP)),.008,0.,+1.)
234 ENDIF
235 ENDIF
236 IF(CTYPE == 'MASK')THEN
237   CALL PLCHHQ(0.99,.95,CGROUP(1:LEN_TRIM(CGROUP)),.008,0.,+1.)
238 ENDIF
239 CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
240 RETURN
241 END SUBROUTINE DATFILE_FORDIACHRO