1 : C PRMCP4 SOURCE CHAT 05/01/13 02:28:45 5004 2 : SUBROUTINE PRMCP4(ICMPRI,ICCPRI,NIUNIQ, 3 : $ ICOPRI, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : PRMCP4 9 : C DESCRIPTION : Construction de la liste des inconnues communes à la 10 : C matrice et au chpoint. 11 : C 12 : * Construction de ICOPRI (LISTENTI), liste des inconnues 13 : * appartenant à la fois à ICMPRI et ICCPRI 14 : C 15 : C 16 : C LANGAGE : ESOPE 17 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 18 : C mél : gounand@semt2.smts.cea.fr 19 : C*********************************************************************** 20 : C APPELES : - 21 : C APPELE PAR : PRMCP2 22 : C*********************************************************************** 23 : C ENTREES : ICMPRI, ICCPRI, NIUNIQ 24 : C ENTREES/SORTIES : - 25 : C SORTIES : ICOPRI 26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 27 : C*********************************************************************** 28 : C VERSION : v1, 18/04/2000, version initiale 29 : C HISTORIQUE : v1, 18/04/2000, création 30 : C HISTORIQUE : 31 : C HISTORIQUE : 32 : C*********************************************************************** 33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 34 : C en cas de modification de ce sous-programme afin de faciliter 35 : C la maintenance ! 36 : C*********************************************************************** 37 : -INC CCOPTIO 38 : C 39 : C**** Variables de COOPTIO 40 : C 41 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 42 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 43 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 44 : C & ,IECHO, IIMPI, IOSPI 45 : C & ,IDIM 46 : C & ,MCOORD 47 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 48 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 49 : C & ,NORINC,NORVAL,NORIND,NORVAD 50 : C & ,NUCROU, IPSAUV 51 : C 52 : -INC SMLENTI 53 : INTEGER JG 54 : POINTEUR ICMPRI.MLENTI 55 : POINTEUR ICCPRI.MLENTI 56 : POINTEUR ICOPRI.MLENTI 57 : POINTEUR MLEWRK.MLENTI 58 : POINTEUR KRPRI.MLENTI 59 : POINTEUR MLQUNF.MLENTI 60 : * Liste de MLENTI 61 : INTEGER NBMLEN 62 : SEGMENT MLENTS 63 : POINTEUR LISMLE(NBMLEN).MLENTI 64 : ENDSEGMENT 65 : POINTEUR GPMLES.MLENTS 66 : * 67 : INTEGER IMPR,IRET 68 : * 69 : INTEGER IBMLEN,IGWRK,IIUNIQ 70 : INTEGER NGWRK,NIUNIQ 71 : INTEGER NUPRI,NBPRI 72 : * 73 : * Executable statements 74 : * 75 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp4.eso' 76 : * Initialisation de la liste de MLENTI (ici, il y en a deux) 77 : NBMLEN=2 78 : SEGINI GPMLES 79 : GPMLES.LISMLE(1)=ICMPRI 80 : GPMLES.LISMLE(2)=ICCPRI 81 : * NIUNIQ est la dimension de l'espace des noms d'inconnues 82 : JG=NIUNIQ 83 : SEGINI KRPRI 84 : SEGINI MLQUNF 85 : DO 2 IBMLEN=1,NBMLEN 86 : MLEWRK=GPMLES.LISMLE(IBMLEN) 87 : SEGACT MLEWRK 88 : NGWRK=MLEWRK.LECT(/1) 89 : * 90 : ******** En general, ICMPRI peux contenir le meme nom 91 : * d'inconnue plusieurs fois. 92 : * Mais on doit conter sa contribution que une seule 93 : * fois! 94 : * C'est pur ça qu'on utilize le segment MEQUNF.LECT 95 : * 96 : DO 22 IGWRK=1,NGWRK 97 : NUPRI=MLEWRK.LECT(IGWRK) 98 : IF(MLQUNF.LECT(NUPRI) .EQ. 0)THEN 99 : MLQUNF.LECT(NUPRI) = 1 100 : KRPRI.LECT(NUPRI)=KRPRI.LECT(NUPRI)+1 101 : ENDIF 102 : 22 CONTINUE 103 : SEGDES MLEWRK 104 : DO IIUNIQ=1,NIUNIQ,1 105 : MLQUNF.LECT(IIUNIQ) = 0 106 : ENDDO 107 : 2 CONTINUE 108 : SEGSUP GPMLES 109 : JG=0 110 : SEGINI ICOPRI 111 : DO 3 IIUNIQ=1,NIUNIQ 112 : NBPRI=KRPRI.LECT(IIUNIQ) 113 : IF (NBPRI.EQ.NBMLEN) THEN 114 : ICOPRI.LECT(**)=IIUNIQ 115 : ENDIF 116 : 3 CONTINUE 117 : SEGDES ICOPRI 118 : SEGSUP KRPRI 119 : SEGSUP MLQUNF 120 : * 121 : * Normal termination 122 : * 123 : IRET=0 124 : RETURN 125 : * 126 : * Format handling 127 : * 128 : * 129 : * Error handling 130 : * 131 : 9999 CONTINUE 132 : IRET=1 133 : WRITE(IOIMP,*) 'An error was detected in subroutine prmcp4' 134 : RETURN 135 : * 136 : * End of subroutine PRMCP4 137 : * 138 : END 139 : 140 : 141 : 142 : 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer