C TEMPOR SOURCE GOUNAND 25/10/31 21:15:03 12392 C C temps ecoule depuis le dernier appel C occupation memoire C utilisation des operateurs C SUBROUTINE TEMPOR(ITABS0,ITABSO,MDIR,IAPPEL,IELAPS,ITCPU,ITCPU0, & NACT,ILON,ith) C en entree on a les informations stockees (SAVE) par pilot C sur les operateurs C C entree C ITABS0 : date absolue depuis l'initialisation de TEMP (TEMP ZERO) C ITABSO : date absolue depuis le dernier appel a TEMP C MDIR : tableau des noms de tous les operateurs C IAPPEL : nombre d'appel a chaque operateur pour chaque ASSISTANT C IELAPS : temps total passe dans chaque operateur pour chaque ASSISTANT (pris a l'horloge "murale") C ITCPU : temps CPU passe dans chaque operateur pour chaque ASSISTANT C ITCPU0 : temps CPU global depuis le premier passage dans pilot.eso C NACT(1): nombre de segments actifs en + après l'appel a l'operateur C NACT(2): taille correspondante en MOTS C ILON : Nombre d'operateurs connus dans pilot C ith : numero du thread sur lequel est lance TEMPS C C include IMPLICIT INTEGER(I-N) IMPLICIT real*8 (a-h,o-z) -INC PPARAM -INC CCOPTIO -INC CCASSIS -INC SMTABLE POINTEUR MTAB4.MTABLE, MTAB5.MTABLE -INC SMLENTI POINTEUR MLENT4.MLENTI -INC SMLREEL C variables declarees REAL*8 XRAP INTEGER IELAPS, ITABS0, ITABSO, ITCPU, ITCPU0 INTEGER IMAX , IECCPU, IECOU0, IECOUL PARAMETER (NBMOT = 7) CHARACTER*4 MOT(NBMOT),MDIR(ILON) CHARACTER*4 MOT3(2),MOT4(4),MOT5(3) INTEGER NACT,NACTI,NTACT,OOOVAL, IAPPEL INTEGER ittime DIMENSION IAPPEL(ILON,*),IELAPS(ILON,*),ITCPU(ILON,*),NACT(2,*) DIMENSION ittime(4) CHARACTER*80 COLO80 SEGMENT ITRAV1 INTEGER IAPCUM(ILON) INTEGER IATMP(ILON) INTEGER IETMP(ILON) INTEGER ITTMP(ILON) ENDSEGMENT C C tableaux des mots-cles DATA MOT /'PLAC','NOEC','IMPR','ZERO','SGAC','HORL','CPU '/ DATA MOT3/'MAXI','SOMM'/ DATA MOT4/'APPE','HORL','CPU','EFFI'/ DATA MOT5/'OPER','PROC','BOUC'/ C C ERREUR si ith n'est pas egal a 0 (Thread 0) IF (ith .NE. 0) THEN CALL ERREUR(915) RETURN ENDIF ************************************************************************ * Travail de recuperation des valeurs ************************************************************************ SEGINI,ITRAV1 IPASS = 0 call timespv(ittime,oothrd) IECOU0 = (ittime(1) + ittime(2)) - ITABS0 IECOUL = (ittime(1) + ittime(2)) - ITABSO ITABSO = (ittime(1) + ittime(2)) C Valeurs cumulees pour le temps Elapsed et le temps CPU IECCPU = 0 DO J=1,ILON INDICE = 0 DO II=1,NBESCR + 1 INDICE = INDICE + IAPPEL(J,II) IECCPU = IECCPU + ITCPU(J,II) ENDDO IAPCUM(J)= INDICE ENDDO C Preparation pour l'appel au message d'ERREUR -259 ITCPU0 = ITCPU0 + IECCPU IF ((IECOUL / 10) .EQ. 0) THEN C Cas du tout premier appel a temps impr INTERR(1)= IECOU0 / 10 ELSE INTERR(1)= IECOUL / 10 ENDIF IF ((IECCPU / 10) .EQ. 0) THEN C Cas du tout premier appel a temps impr INTERR(2)= ITCPU0 / 10 ELSE INTERR(2)= IECCPU / 10 ENDIF ************************************************************************ * Lecture des ARGUMENTS ************************************************************************ I = 0 1 CONTINUE CALL LIRMOT(MOT,NBMOT,I,0) ************************************************************************ c pas d'option : TEMP; ************************************************************************ IF(I.EQ.0.AND.IPASS.EQ.0) THEN c Temps horloge %i1 ms / Temps CPU %i2 ms (depuis le dernier APPEL) SEGSUP,ITRAV1 CALL ERREUR(-378) RETURN ENDIF ************************************************************************ c Operateur TEMPS ************************************************************************ IF(I.GE.6.AND.IPASS.EQ.0) THEN IF (I.EQ.6) ITPS = IECOU0 / 10 IF (I.EQ.7) ITPS = ITCPU0 / 10 CALL ECRENT(ITPS) SEGSUP,ITRAV1 RETURN ENDIF C temoin de passage dans la boucle IPASS = 1 IF(I.EQ.0) THEN SEGSUP,ITRAV1 RETURN ENDIF ************************************************************************ C option 'PLAC' ************************************************************************ IF(I.EQ.1) THEN CALL ERREUR(-378) CALL OOODMP(0) ************************************************************************ C option 'NOEC' ************************************************************************ ELSEIF(I.EQ.2) THEN C Ecriture des donnees dans une TABLE avec une structure bien definie CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Table de sortie CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC M = 0 SEGINI,MTABLE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C TABLES : 'TEMPS_HORLOGE', 'TEMPS_CPU', 'TEMPS_ATTENTE', 'APPELS' CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC M = 0 SEGINI,MTAB1,MTAB2,MTAB3,MTAB4,MTAB5 COLO80 = 'TEMPS_HORLOGE' CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'TABLE',0,0.d0,'RIEN' ,.FALSE.,MTAB1) COLO80='INITIAL' CALL ECCTAB(MTAB1,'MOT ',0 ,0.d0,COLO80 ,.FALSE.,0, & 'ENTIER',IECOU0/10,0.d0,'RIEN' ,.FALSE.,0) COLO80='DERNIER_APPEL' CALL ECCTAB(MTAB1,'MOT ',0 ,0.d0,COLO80 ,.FALSE.,0, & 'ENTIER',IECOUL/10,0.d0,'RIEN' ,.FALSE.,0) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC COLO80 = 'TEMPS_CPU' CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'TABLE',0,0.d0,'RIEN' ,.FALSE.,MTAB2) COLO80='INITIAL' CALL ECCTAB(MTAB2,'MOT ',0 ,0.d0,COLO80 ,.FALSE.,0, & 'ENTIER',ITCPU0/10,0.d0,'RIEN' ,.FALSE.,0) COLO80='DERNIER_APPEL' CALL ECCTAB(MTAB2,'MOT ',0 ,0.d0,COLO80 ,.FALSE.,0, & 'ENTIER',IECCPU/10,0.d0,'RIEN' ,.FALSE.,0) COLO80 = 'TEMPS_ATTENTE' CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'TABLE',0,0.d0,'RIEN' ,.FALSE.,MTAB3) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC COLO80 = 'APPELS' CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'TABLE',0,0.d0,'RIEN' ,.FALSE.,MTAB4) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC COLO80 = 'EFFICACITE' CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'TABLE',0,0.d0,'RIEN' ,.FALSE.,MTAB5) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Remplissage des LISTENTI de valeurs DO J=1,ILON IF (IAPCUM(J) .NE. 0) THEN JG = NBESCR+1 SEGINI,MLENT1,MLENT2,MLENT3,MLENT4,MLREE1 DO II=1,NBESCR+1 MLENT1.LECT(II) = IELAPS(J,II) / 10 MLENT2.LECT(II) = ITCPU(J,II) / 10 MLENT3.LECT(II) = (IELAPS(J,II) - ITCPU(J,II) ) / 10 MLENT4.LECT(II) = IAPPEL(J,II) IVAL1=IELAPS(J,II) RVAL1 = REAL(IVAL1) IF(IVAL1 .EQ. 0)THEN RVAL1=1.D0 ENDIF XVAL1=REAL(ITCPU(J,II)) / RVAL1 MLREE1.PROG(II) = XVAL1 ENDDO C Ecriture dans les TABLES des LISTENTI de valeurs par operateur COLO80=MDIR(J) CALL ECCTAB(MTAB1,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'LISTENTI',0,0.d0,'RIEN' ,.FALSE.,MLENT1) CALL ECCTAB(MTAB2,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'LISTENTI',0,0.d0,'RIEN' ,.FALSE.,MLENT2) CALL ECCTAB(MTAB3,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'LISTENTI',0,0.d0,'RIEN' ,.FALSE.,MLENT3) CALL ECCTAB(MTAB4,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'LISTENTI',0,0.d0,'RIEN' ,.FALSE.,MLENT4) CALL ECCTAB(MTAB5,'MOT ',0,0.d0,COLO80 ,.FALSE.,0, & 'LISTREEL',0,0.d0,'RIEN' ,.FALSE.,MLREE1) SEGDES,MLENT1,MLENT2,MLENT3,MLENT4,MLREE1 ENDIF ENDDO SEGDES,MTAB1,MTAB2,MTAB3,MTAB4,MTAB5 SEGDES,MTABLE C Ecriture sur la Pile de l'objet resultat CALL ECROBJ('TABLE ',MTABLE) SEGSUP,ITRAV1 RETURN ************************************************************************ C option 'IMPR' ************************************************************************ ELSEIF(I.EQ.3) THEN C Affichage des valeurs a l'ecran C Temps dans les procedures ? CALL LIRMOT(MOT5,3,I5,0) IF (I5 .EQ. 2) THEN CALL TEMBLO(0) RETURN ELSEIF(I5 .EQ. 3) THEN CALL TEMBLO(1) RETURN ENDIF c Eventuelle option : MAXI ou SOMM pour synthetiser en 1 seul tableau I3=0 CALL LIRMOT(MOT3,2,I3,0) C****** option 'IMPR' 'MAXI' ou 'IMPR' 'SOMM' ******* IF(I3.NE.0) THEN c Eventuelle option de tri : APPE, HORL ou CPU I4=0 CALL LIRMOT(MOT4,3,I4,0) WRITE(IOIMP,*) c 'MAXI' ou 'SOMM' IF(I3.EQ.1) THEN WRITE(IOIMP,FMT='(22X,A)') 'Maxi sur les assistants :' c merge "MAXVAL" des tableaux pour devenir 1D CALL IMAX2(IAPPEL,ILON,NBESCR+1,IATMP) CALL IMAX2(IELAPS,ILON,NBESCR+1,IETMP) CALL IMAX2(ITCPU ,ILON,NBESCR+1,ITTMP) ELSE WRITE(IOIMP,FMT='(22X,A)') 'Somme sur les assistants :' c merge "SOMME" des tableaux pour devenir 1D CALL ISUM2(IAPPEL,ILON,NBESCR+1,IATMP) * pas de somme sur les elaps * CALL ISUM2(IELAPS,ILON,NBESCR+1,IETMP) CALL IMAX2(IELAPS,ILON,NBESCR+1,IETMP) CALL ISUM2(ITCPU ,ILON,NBESCR+1,ITTMP) ENDIF IF (LANGUE .EQ. 'FRAN') THEN WRITE(IOIMP,40) 'Operateur','Nombre d appels', & 'Horloge (ms)','Temps CPU (ms)' ELSE WRITE(IOIMP,40) 'Operator ','Number of Calls', & 'Elapsed (ms)','CPU Time (ms) ' ENDIF 40 FORMAT(1X,A9,3X,A16,3X,A12,3X,A14) c --- souhaite t'on un tri ? --- IF(I4.GT.0) THEN JG=ILON SEGINI,MLENTI,MLENT1 c option 'IMPR' ('MAXI' ou 'SOMM') 'APPE' IF(I4.eq.1) THEN DO I=1,ILON MLENTI.LECT(I)=IATMP(I) MLENT1.LECT(I)=I ENDDO c option 'IMPR' ('MAXI' ou 'SOMM') 'HORL' ELSEIF(I4.eq.2) THEN DO I=1,ILON MLENTI.LECT(I)=IETMP(I) MLENT1.LECT(I)=I ENDDO c option 'IMPR' ('MAXI' ou 'SOMM') 'CPU' ELSE DO I=1,ILON MLENTI.LECT(I)=ITTMP(I) MLENT1.LECT(I)=I ENDDO ENDIF c tri croissant de maniere a avoir les + grandes valeurs en bas CALL ORDO04(LECT(1),ILON,.TRUE.,MLENT1.LECT(1)) c boucle sur les operateurs DO J=1,ILON K = MLENT1.LECT(J) IF (IAPCUM(K) .NE. 0) THEN WRITE(IOIMP,41)MDIR(K),IATMP(K),(IETMP(K)/10),(ITTMP(K)/10) ENDIF ENDDO SEGSUP,MLENTI,MLENT1 c --- pas de tri : boucle sur tous les operateurs --- ELSE DO J=1,ILON IF (IAPCUM(J) .NE. 0) THEN WRITE(IOIMP,41)MDIR(J),IATMP(J),(IETMP(J)/10),(ITTMP(J)/10) ENDIF ENDDO ENDIF 41 FORMAT(2X,A4,3(3X,I12)) C****** option 'IMPR' seule ****** ELSE c Eventuelle option de restriction : APPE, HORL, CPU ou EFFI I4=0 CALL LIRMOT(MOT4,4,I4,0) IF(I4.EQ.0.OR.I4.EQ.2) THEN WRITE(IOIMP,*) IF (LANGUE .EQ. 'FRAN') THEN MOTERR(1:18)='Temps Horloge (ms)' ELSE MOTERR(1:18)='Elapsed Time (ms)' ENDIF CALL ERREUR(-258) DO J=1,ILON IF (IAPCUM(J) .NE. 0) THEN C Ecriture a l'ecran des Temps Elapsed WRITE(IOIMP,31)MDIR(J),(IELAPS(J,II) / 10,II=1,NBESCR+1) 31 FORMAT(2X,A4,65(2X,I11)) ENDIF ENDDO ENDIF IF(I4.EQ.0.OR.I4.EQ.3) THEN WRITE(IOIMP,*) IF (LANGUE .EQ. 'FRAN') THEN MOTERR(1:18)='Temps CPU (ms)' ELSE MOTERR(1:18)='CPU Time (ms)' ENDIF CALL ERREUR(-258) DO J=1,ILON IF (IAPCUM(J) .NE. 0) THEN C Ecriture a l'ecran des Temps CPU WRITE(IOIMP,32)MDIR(J),((ITCPU(J,II) / 10),II=1,NBESCR+1) 32 FORMAT(2X,A4,65(2X,I11)) ENDIF ENDDO ENDIF IF(I4.EQ.0.OR.I4.EQ.1) THEN WRITE(IOIMP,*) IF (LANGUE .EQ. 'FRAN') THEN MOTERR(1:18)='Nombre appels ' ELSE MOTERR(1:18)='Number of Calls ' ENDIF CALL ERREUR(-258) DO J=1,ILON IF (IAPCUM(J) .NE. 0) THEN C Ecriture a l'ecran des nombres d'appels WRITE(IOIMP,33)MDIR(J),(IAPPEL(J,II),II=1,NBESCR+1) 33 FORMAT(2X,A4,65(2X,I11)) ENDIF ENDDO ENDIF IF(I4.EQ.0.OR.I4.EQ.4) THEN WRITE(IOIMP,*) IF (LANGUE .EQ. 'FRAN') THEN MOTERR(1:18)='Efficacite ' ELSE MOTERR(1:18)='Efficiency ' ENDIF CALL ERREUR(-258) DO J=1,ILON IF (IAPCUM(J) .NE. 0) THEN C Ecriture a l'ecran des efficacite WRITE(IOIMP,34)MDIR(J), & (REAL(ITCPU(J,II)) / MAX(1,IELAPS(J,II)),II=1,NBESCR+1) 34 FORMAT(2X,A4,65(7X,F6.4)) ENDIF ENDDO ENDIF ENDIF WRITE(IOIMP,*) CALL ERREUR(-378) ************************************************************************ C option 'ZERO' ************************************************************************ ELSEIF(I.EQ.4) THEN ITABS0 = ittime(1) + ittime(2) ITCPU0 = 0 DO 4 J=1,ILON NACT(1,J) = 0 NACT(2,J) = 0 DO II=1,NBESCR+1 IAPPEL(J,II) = 0 IELAPS(J,II) = 0 ITCPU (J,II) = 0 ENDDO 4 CONTINUE ************************************************************************ C option 'SGAC' ************************************************************************ ELSEIF(I.EQ.5) THEN C on ecrit le nombre de segments actifs et leur taille CALL LIRMOT(MOT,5,J,0) GOTO (11,12,12,13,12,12),(J+1) C il n'y a pas d'autre options on renvoie nbre et taille des segments actifs 11 NBACTI = OOOVAL(2,3) NTACTI = OOOVAL(3,3) CALL ECRENT(NBACTI) CALL ECRENT(NTACTI) SEGSUP,ITRAV1 RETURN C il y a d'autres options on renvoie nbre et taille des segments actifs 12 CALL REFUS NBACTI = OOOVAL(2,3) NTACTI = OOOVAL(3,3) CALL ECRENT(NTACTI) CALL ECRENT(NBACTI) GOTO 1 C option SGAC IMPR statistiques relatives aux segments actifs 13 WRITE(IOIMP,*) CALL ERREUR(-308) DO 15 J =1,ILON IF (IAPCUM(J) .NE. 0) THEN NACTI = NACT(1,J) NTACT = NACT(2,J) / 1000 WRITE(IOIMP,14)MDIR(J),IAPCUM(J),NACTI,NTACT 14 FORMAT(2X,A4,7X,I6,7X,I6,7X,I6) ENDIF 15 CONTINUE ENDIF C on retourne lire d'autres options GOTO 1 END