1 : C DEPMAC SOURCE CHAT 89/06/30 21:03:30 2 : C CET INTERESSANT SOUS-PROGRAMME S'EFFORCE DE CENTRALISER LES 3 : C FONCTIONS DEPENDANTES DU MATERIEL UTILISE 4 : C VOICI LA VERSION POUR LINUX 5 : C 6 : SUBROUTINE DEPMAC 7 : implicit integer(i-n) 8 : external extint,long 9 : CHARACTER*8 USRNAM,cgibnam 10 : CHARACTER*500 cvarenv 11 : equivalence (cvarenv,ivarenv) 12 : logical ex 13 : DIMENSION EXTR(1),CBRACT(1),CARACT(1),ITTIME(6) 14 : -INC CCOPTIO 15 : character*(*) chacha 16 : REAL*8 XKT 17 : COMMON /CLGI/L6C 18 : CHARACTER*64 L6C 19 : SAVE KPREC 20 : DATA ICONT/1/ 21 : * 22 : *************************************************************************** 23 : * 24 : * INITIALISATION DU TIMER 24 : CALL TIMESPV(ITTIME) 25 : KPREC=(ITTIME(1)+ITTIME(2)) 26 : * graphiques X 27 : iogra=2 28 : * lecture de fichier automatique 29 : iolec=3 30 : * INITIALISATION NB DE ZERO CONSECUTIFS ( 48 POUR IBM RS/6000) 31 : IZROSF=48 32 : * OUVERTURE DES FICHIERS ERREURS,NOTICE,PROCEDURES 33 : cvarenv='CASTEM_ERREUR'//char(0) 34 : l=500 34 : call ooozen(ivarenv,l) 35 : if (l.eq.0) then 36 : cvarenv='/u/castem/GIBI.ERREUR' 37 : l=long(cvarenv) 38 : INQUIRE(FILE='GIBI.ERREUR',EXIST=EX) 39 : if (ex) then 40 : cvarenv='GIBI.ERREUR' 41 : l=long(cvarenv) 42 : endif 43 : endif 44 : OPEN (UNIT=35,FILE=CVARENV(1:L),STATUS='OLD',IOSTAT=IOSTAT, 45 : # FORM='FORMATTED') 46 : IF (IOSTAT.NE.0) THEN 47 : WRITE (6,FMT= 48 : # '('' ERREUR OUVERTURE DU FICHIER DE MESSAGES D''''ERREUR'')') 49 : ENDIF 50 : cvarenv='CASTEM_NOTICE'//char(0) 51 : l=500 51 : call ooozen(ivarenv,l) 52 : if (l.eq.0) then 53 : cvarenv='/u/castem/GIBI.MASTER' 54 : l=long(cvarenv) 55 : endif 56 : OPEN(UNIT=33,FILE=cvarenv(1:l),ACCESS='DIRECT', 57 : 1FORM='FORMATTED',RECL=80,STATUS='OLD',IOSTAT=IOSTAT) 58 : cvarenv='CASTEM_PROC'//char(0) 59 : l=500 59 : call ooozen(ivarenv,l) 60 : if (l.eq.0) then 61 : cvarenv='/u/castem/GIBI.PROC' 62 : l=long(cvarenv) 63 : endif 64 : OPEN(UNIT=34,FILE=cvarenv(1:l),ACCESS='DIRECT', 65 : 1FORM='FORMATTED',RECL=80,STATUS='OLD',IOSTAT=IOSTAT) 66 : OPEN(UNIT=36,FILE='UTILPROC',ACCESS='DIRECT', 67 : 1FORM='FORMATTED',RECL=80,STATUS='UNKNOWN',IOSTAT=IOSTAT) 68 : OPEN(UNIT=37,FILE='UTILNOTI',ACCESS='DIRECT', 69 : 1FORM='FORMATTED',RECL=80,STATUS='UNKNOWN',IOSTAT=IOSTAT) 70 : * INITIALISATION TABLES DE TRANSCODAGE POUR LE LGI 71 : L6C=':ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-*/()$= ,.' 72 : L6C(49:49)='#' 73 : L6C(50:50)='' 74 : L6C(51:51)='!' 75 : L6C(52:52)='%' 76 : L6C(53:53)='"' 77 : L6C(54:54)='_' 78 : L6C(55:55)='|' 79 : L6C(56:56)='&' 80 : L6C(57:57)='''' 81 : L6C(58:58)='?' 82 : L6C(59:59)='<' 83 : L6C(60:60)='>' 84 : L6C(61:61)='@' 85 : L6C(62:62)=CHAR(92) 86 : L6C(63:63)=CHAR(94) 87 : L6C(64:64)=CHAR(59) 88 : * initialisation du gestionnaire d'interruption (^C) 88 : call inthan 89 : * INITIALISATION DE L'ERREUR HANDLER SUR LE RS/6000 89 : * call signal(3,xl__trce) 89 : * call signal(4,xl__trce) 89 : * call signal(6,xl__trce) 89 : * call signal(8,xl__trce) 89 : * call signal(9,xl__trce) 89 : * call signal(10,xl__trce) 89 : * call signal(11,xl__trce) 89 : * call signal(12,xl__trce) 89 : * call signal(13,xl__trce) 89 : * call signal(15,xl__trce) 89 : * call signal(21,xl__trce) 89 : * call signal(22,xl__trce) 89 : * call signal(24,xl__trce) 89 : * call signal(25,xl__trce) 89 : * call signal(29,xl__trce) 89 : * call signal(33,xl__trce) 89 : * call signal(34,xl__trce) 89 : * call signal(36,xl__trce) 90 : RETURN 91 : * 92 : *************************************************************************** 93 : * 94 : ENTRY GIBTEM(XKT) 95 : C TEMPS DEPUIS LE DERNIER APPEL EN CENTIEMES DE SECONDE 95 : CALL TIMESPV(ITTIME) 96 : KTOT=(ITTIME(1)+ITTIME(2)) 97 : KT=KTOT-KPREC 98 : XKT=KT 99 : KPREC=KTOT 100 : RETURN 101 : ENTRY GIBTRB 102 : C TRACE BACK 103 : RETURN 104 : * 105 : *************************************************************************** 106 : * 107 : ENTRY GIBDAT(JOUR,MOIS,IANNEE) 108 : C DATE (EN ENTIERS) 108 : CALL OOOZZ1(ITTIME) 109 : JOUR=ITTIME(1) 110 : MOIS=ITTIME(2) 111 : IANNEE=ITTIME(3) 112 : RETURN 113 : ENTRY GIBECO(IECO) 114 : C TEST ENVIRONNEMENT (BATCH OU INTERACTIF) 115 : IECO=1 116 : RETURN 117 : * 118 : *************************************************************************** 119 : * 120 : * recuperer le nom utilisateur 121 : ENTRY GIBNAM(USRNAM) 122 : usrnam=cgibnam(usrnam) 123 : return 124 : * 125 : *************************************************************************** 126 : * 127 : entry prompt 128 : c prompt (si on peut le faire) 129 : write (ioimp,fmt='('' $ '',$)') 130 : return 131 : * 132 : *************************************************************************** 133 : * 134 : entry xread(chacha,lon) 135 : c pour windows lecture instruction 136 : read (ioter,fmt='(A72)') chacha 137 : lon=long(chacha) 138 : return 139 : * 140 : *************************************************************************** 141 : * 142 : C TRAITEMENT D'ERREUR IBM 143 : C ON MET SUR TOUTE ERREUR D'EXECUTION IERR A 1 144 : C ET ON POURSUIT L'EXECUTION 145 : C ON LAISSE UN MESSAGE D'ERREUR S'IMPRIMER 146 : entry errcor 147 : C points d'entree a supprimer sur RS/6000 148 : entry cp(chacha) 149 : entry cms(chacha) 150 : entry elpdyn 151 : entry elpsta 152 : * GDDM 153 : entry asdfld 154 : entry asfcol 155 : entry asftrn 156 : entry asftra 157 : entry asqmax 158 : entry fsrnit 159 : entry ascput 160 : entry asread 161 : entry asqcur 162 : entry ascget 163 : entry fsinit 164 : entry fsinn 165 : entry dsopen 166 : entry dsuse 167 : entry fsqury 168 : entry gslss 169 : entry fspcrt 170 : entry gsfld 171 : entry gsqps 172 : entry gswin 173 : entry gssati 174 : entry gsseg 175 : entry gstag 176 : entry gscm 177 : entry gscol 178 : entry gschar 179 : entry gsqcb 180 : entry gscb 181 : entry gsscls 182 : entry gsview 183 : entry gsclp 184 : entry gsuwin 185 : entry gsmix 186 : entry gsmove 187 : entry gsplne 188 : entry gsenab 189 : entry gsiloc 190 : entry gsread 191 : entry gsqcho 192 : entry gsqloc 193 : entry gspat 194 : entry gsarea 195 : entry gsenda 196 : entry gsqwin 197 : entry gsqlid 198 : entry gsidvf 199 : entry gsstfm 200 : entry gssdel 201 : entry gsqaga 202 : entry gssats 203 : entry gssave 204 : entry gscopy 205 : entry fscopy 206 : entry fscls 207 : entry gsclr 208 : entry fsfrce 209 : entry asfcur 210 : *PHIGS 211 : entry pads 212 : entry parst 213 : entry patr 214 : entry pcelst 215 : entry pclst 216 : entry pdst 217 : entry pemst 218 : entry pevmm 219 : entry pexst 220 : entry pfa 221 : entry poparf 222 : entry popph 223 : entry popst 224 : entry popwk 225 : entry ppl 226 : entry ppost 227 : entry pqdsp 228 : entry pqopst 229 : entry pqopwk 230 : entry prqlc 231 : entry prqpk 232 : entry prqst 233 : entry psans 234 : entry psatch 235 : entry pschsp 236 : entry pscr 237 : entry psdus 238 : entry psici 239 : entry psis 240 : entry psivft 241 : entry pslcm 242 : entry pspkft 243 : entry pspkid 244 : entry pspkm 245 : entry psplci 246 : entry pspmci 247 : entry psstm 248 : entry pstxci 249 : entry pstxfn 250 : entry pstxpr 251 : * entry psvis 252 : entry psvtip 253 : entry psvwi 254 : entry psvwr 255 : entry pswkv 256 : entry pswkw 257 : entry pupast 258 : entry puwk 259 : * GKS 260 : 261 : entry gacwk 262 : entry gasgwk 263 : entry gclsg 264 : entry gclwk 265 : entry gcrsg 266 : entry gdawk 267 : entry gdsg 268 : entry gfa 269 : entry ginlc 270 : entry ginsg 271 : entry gmsg 272 : entry gopks 273 : entry gopwk 274 : entry gpl 275 : entry gqchh 276 : entry gqchxp 277 : entry gqdsp 278 : entry gqops 279 : entry gqopsg 280 : entry gqopwk 281 : entry gqsga 282 : entry gqsgus 283 : entry gqwks 284 : entry grensg 285 : entry grqlc 286 : entry grqpk 287 : entry grqst 288 : entry gsasf 289 : entry gschh 290 : entry gschsp 291 : entry gschxp 292 : entry gscr 293 : entry gsds 294 : entry gsdtec 295 : entry gselnt 296 : entry gsfaci 297 : entry gsfais 298 : entry gslcm 299 : entry gspkm 300 : entry gsplci 301 : entry gspmci 302 : entry gssgt 303 : entry gsstm 304 : entry gstxci 305 : entry gstxfp 306 : entry gsvis 307 : entry gsvp 308 : entry gswkvp 309 : entry gswkwn 310 : entry gswn 311 : entry gtx 312 : entry guwk 313 : 314 : END 315 : * 316 : *************************************************************************** 317 : * 318 : * gestionnaire d'interruption (^C) 319 : subroutine extint 320 : implicit integer(i-n) 321 : -INC CCOPTIO 322 : * regenerer le signal puis positionner une erreur 322 : call inthan 323 : ierr=623 324 : end 325 : * 326 : * 327 : *************************************************************************** 328 : * 329 : * mise en place gestionnaire d'interruption (^C) 330 : subroutine inthan 331 : implicit integer(i-n) 332 : external extint 332 : call signal(2,extint) 333 : end 334 : * 335 : *************************************************************************** 336 : * 337 : * reouverture du terminal apres une interruption clavier (si necessaire) 338 : subroutine opterm(iun) 339 : implicit integer(i-n) 340 : close (unit=iun) 341 : open (unit=iun,file='/dev/tty') 342 : end 343 :
© Cast3M 2003 - All rights reserved.
Disclaimer