1 : C CP2LR SOURCE PV 13/04/12 21:15:18 7756 2 : SUBROUTINE CP2LR(CHPOD, 3 : $ ICPRID,ICOGLO,KRIPRI,NIPRI, 4 : $ KRMPRI,NPPRI, 5 : $ LCHPOD, 6 : $ IMPR,IRET) 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : C*********************************************************************** 10 : C NOM : CP2LR 11 : C DESCRIPTION : Champoint + maillage + liste de n noms de composantes 12 : C => n listreels (1 par nom de composante) des valeurs du 13 : C champoint sur les points du maillage. 14 : C 15 : C 16 : C 17 : C LANGAGE : ESOPE 18 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 19 : C mél : gounand@semt2.smts.cea.fr 20 : C*********************************************************************** 21 : C APPELES : LICHT2 22 : C APPELES (E/S) : LIROBJ, ECROBJ, ECRCHA 23 : C APPELES (UTIL.) : EXCOMP, DTCHPO 24 : C APPELE PAR : PROMAT 25 : C*********************************************************************** 26 : C ENTREES : CHPOD, ICPRID, ICOGLO, KRIPRI, NIPRI, 27 : C KRMPRI, NPPRI 28 : C SORTIES : LCHPOD 29 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 30 : C*********************************************************************** 31 : C VERSION : v1, 10/02/2000, version initiale 32 : C HISTORIQUE : v1, 10/02/2000, création 33 : C HISTORIQUE : 34 : C HISTORIQUE : 35 : C*********************************************************************** 36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 37 : C en cas de modification de ce sous-programme afin de faciliter 38 : C la maintenance ! 39 : C*********************************************************************** 40 : -INC CCOPTIO 41 : -INC SMCHPOI 42 : POINTEUR CHPOD.MCHPOI 43 : POINTEUR XCHPOD.MCHPOI 44 : POINTEUR MPXCPD.MPOVAL 45 : -INC SMELEME 46 : POINTEUR MLXCPD.MELEME 47 : -INC SMLENTI 48 : POINTEUR ICPRID.MLENTI 49 : POINTEUR KRIPRI.MLENTI 50 : POINTEUR KRMPRI.MLENTI 51 : -INC SMLMOTS 52 : POINTEUR ICOGLO.MLMOTS 53 : -INC SMLREEL 54 : SEGMENT LLR 55 : POINTEUR LISLR(NBME).MLREEL 56 : ENDSEGMENT 57 : INTEGER NBME 58 : POINTEUR LCHPOD.LLR 59 : INTEGER JG 60 : POINTEUR SLMPD.MLREEL 61 : * 62 : INTEGER NIPRI,NPPRI 63 : INTEGER IMPR,IRET 64 : * 65 : INTEGER NIPRID,NPOCPD 66 : INTEGER IIPRID,IPOCPD,IIPRI 67 : INTEGER NULOPO 68 : CHARACTER*4 NOMI 69 : * 70 : * Executable statements 71 : * 72 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2lr.eso' 73 : * 74 : * Parcours des noms de composantes 75 : * 76 : IF (CHPOD.EQ.0) THEN 77 : LCHPOD=0 78 : ELSE 79 : SEGACT ICPRID 80 : NIPRID=ICPRID.LECT(/1) 81 : SEGACT ICOGLO 82 : SEGACT KRIPRI 83 : SEGACT KRMPRI 84 : NBME=NIPRI 85 : SEGINI LCHPOD 86 : DO 1 IIPRID=1,NIPRID 87 : IIPRI=KRIPRI.LECT(ICPRID.LECT(IIPRID)) 88 : IF (IIPRI.NE.0) THEN 89 : NOMI=ICOGLO.MOTS(ICPRID.LECT(IIPRID))(1:4) 89 : CALL ECROBJ('CHPOINT ',CHPOD) 89 : CALL ECRCHA(NOMI) 89 : CALL EXCOMP 89 : CALL LIROBJ('CHPOINT ',XCHPOD,1,IRET) 90 : IF (IRET.EQ.0) THEN 91 : WRITE(IOIMP,*) 'Erreur extraction comp.',NOMI 92 : WRITE(IOIMP,*) 'de la matrice diagonale.' 93 : GOTO 9999 94 : ENDIF 94 : CALL LICHT2(XCHPOD, 95 : $ MPXCPD,MLXCPD, 96 : $ IMPR,IRET) 97 : IF (IRET.NE.0) GOTO 9999 98 : JG=NPPRI 99 : SEGINI,SLMPD 100 : SEGACT MPXCPD 101 : SEGACT MLXCPD 102 : NPOCPD=MLXCPD.NUM(/2) 103 : DO 12 IPOCPD=1,NPOCPD 104 : NULOPO=KRMPRI.LECT(MLXCPD.NUM(1,IPOCPD)) 105 : IF (NULOPO.NE.0) THEN 106 : SLMPD.PROG(NULOPO)=MPXCPD.VPOCHA(IPOCPD,1) 107 : ENDIF 108 : 12 CONTINUE 109 : SEGDES MLXCPD 110 : SEGDES MPXCPD 111 : SEGDES SLMPD 112 : LCHPOD.LISLR(IIPRI)=SLMPD 112 : CALL DTCHPO(XCHPOD) 113 : ENDIF 114 : 1 CONTINUE 115 : SEGDES LCHPOD 116 : SEGDES KRMPRI 117 : SEGDES KRIPRI 118 : SEGDES ICOGLO 119 : SEGDES ICPRID 120 : ENDIF 121 : * 122 : * Normal termination 123 : * 124 : IRET=0 125 : RETURN 126 : * 127 : * Format handling 128 : * 129 : * 130 : * Error handling 131 : * 132 : 9999 CONTINUE 133 : IRET=1 134 : WRITE(IOIMP,*) 'An error was detected in subroutine cp2lr' 135 : RETURN 136 : * 137 : * End of subroutine CP2LR 138 : * 139 : END 140 : 141 : 142 : 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer