1 : C NORMAT SOURCE MAGN 09/07/30 21:19:39 6458 2 : SUBROUTINE NORMAT(AMORS,AISA,ISCAL, 3 : $ NORMP,NORMD, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : NORMAT 9 : C DESCRIPTION : 10 : C 11 : C Calcul des normes primales (colonnes) et duales (lignes) 12 : C de la matrice. 13 : C 14 : C 15 : C 16 : C LANGAGE : ESOPE 17 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 18 : C mél : gounand@semt2.smts.cea.fr 19 : C******************************************************** 20 : C*********************************************************************** 21 : C SYNTAXE GIBIANE : 22 : C ENTREES : 23 : C ENTREES/SORTIES : 24 : C SORTIES : 25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 26 : C*********************************************************************** 27 : C VERSION : v1, 26/04/2003, version initiale 28 : C HISTORIQUE : v1, 26/04/2003, création 29 : C HISTORIQUE : 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCOPTIO 37 : -INC CCREEL 38 : -INC SMMATRIK 39 : POINTEUR AMORS.PMORS 40 : POINTEUR AISA.IZA 41 : POINTEUR NORMP.IZA 42 : POINTEUR NORMD.IZA 43 : * 44 : INTEGER IMPR,IRET 45 : * 46 : * Executable statements 47 : * 48 : IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans normat.eso' 49 : SEGACT AMORS 50 : SEGACT AISA 51 : NTTDDL=AMORS.IA(/1)-1 52 : NBVA=NTTDDL 53 : SEGINI NORMP 54 : SEGINI NORMD 55 : DO ITTDDL=1,NTTDDL 56 : JSTRT=AMORS.IA(ITTDDL) 57 : JSTOP=AMORS.IA(ITTDDL+1)-1 58 : DO J=JSTRT,JSTOP 59 : JTTDDL=AMORS.JA(J) 60 : VAL=AISA.A(J) 61 : IF (ISCAL.EQ.1) THEN 62 : VAL2=VAL*VAL 63 : ELSEIF (ISCAL.EQ.2) THEN 64 : VAL2=ABS(VAL) 65 : ELSE 65 : CALL ERREUR(5) 66 : GOTO 9999 67 : ENDIF 68 : NORMP.A(JTTDDL)= 69 : $ NORMP.A(JTTDDL)+VAL2 70 : NORMD.A(ITTDDL)= 71 : $ NORMD.A(ITTDDL)+VAL2 72 : ENDDO 73 : ENDDO 74 : SEGDES AISA 75 : SEGDES AMORS 76 : * Racine carrée 77 : IF (ISCAL.EQ.1) THEN 78 : DO ITTDDL=1,NTTDDL 79 : NORMP.A(ITTDDL)= 80 : $ SQRT(NORMP.A(ITTDDL)) 81 : NORMD.A(ITTDDL)= 82 : $ SQRT(NORMD.A(ITTDDL)) 83 : ENDDO 84 : ENDIF 85 : * Teste si une ligne ou une colonne de la matrice est nulle 86 : DO ITTDDL=1,NTTDDL 87 : VAL=NORMP.A(ITTDDL) 88 : IF(VAL.LE.SQRT(XPETIT)) THEN 89 : WRITE(IOIMP,*) 'La colonne ',ITTDDL, 90 : $ ' de la matrice est nulle : ', VAL 91 : GOTO 9999 92 : ENDIF 93 : ENDDO 94 : DO ITTDDL=1,NTTDDL 95 : VAL=NORMD.A(ITTDDL) 96 : IF(VAL.LE.SQRT(XPETIT)) THEN 97 : WRITE(IOIMP,*) 'La ligne ',ITTDDL, 98 : $ ' de la matrice est nulle : ', VAL 99 : GOTO 9999 100 : ENDIF 101 : ENDDO 102 : IF (IMPR.EQ.2) THEN 103 : WRITE(IOIMP,*) 'Scaling de la matrice' 104 : ELSEIF (IMPR.GE.3) THEN 105 : VMIP=NORMP.A(1) 106 : VMAP=NORMP.A(1) 107 : DO ITTDDL=2,NTTDDL 108 : VAL=NORMP.A(ITTDDL) 109 : VMIP=MIN(VMIP,VAL) 110 : VMAP=MAX(VMAP,VAL) 111 : ENDDO 112 : VMID=NORMD.A(1) 113 : VMAD=NORMD.A(1) 114 : DO ITTDDL=2,NTTDDL 115 : VAL=NORMD.A(ITTDDL) 116 : VMID=MIN(VMID,VAL) 117 : VMAD=MAX(VMAD,VAL) 118 : ENDDO 119 : WRITE(IOIMP,11) ' Scaling de la matrice : col(pri) min=', 120 : $ VMIP,' max=',VMAP 121 : WRITE(IOIMP,11) ' lig(dua) min=', 122 : $ VMID,' max=',VMAD 123 : ENDIF 124 : SEGDES NORMP 125 : SEGDES NORMD 126 : * 127 : * Normal termination 128 : * 129 : IRET=0 130 : RETURN 131 : * 132 : * Format handling 133 : * 134 : 11 FORMAT (A,D9.2,A,D9.2) 135 : * 136 : * Error handling 137 : * 138 : 9999 CONTINUE 139 : IRET=1 140 : WRITE(IOIMP,*) 'An error was detected in subroutine normat' 141 : RETURN 142 : * 143 : * End of subroutine NORMAT 144 : * 145 : END 146 : 147 : 148 : 149 :
© Cast3M 2003 - All rights reserved.
Disclaimer