C SH2FNR SOURCE GOUNAND 21/06/02 21:17:37 11022 SUBROUTINE SH2FNR(MYLRF,MYPG, $ FNPG,DFNPG, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : SH2FNR C DESCRIPTION : Conversion shape.eso -> kfnref.eso C C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELES (E/S) : C APPELES (BLAS) : C APPELES (CALCUL) : C APPELE PAR : C*********************************************************************** C SYNTAXE GIBIANE : C ENTREES : C ENTREES/SORTIES : C SORTIES : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 25/10/2005, version initiale C HISTORIQUE : v1, 25/10/2005, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCGEOME -INC PPARAM -INC CCOPTIO -INC TNLIN *-INC SELREF POINTEUR MYLRF.ELREF *-INC SPOGAU POINTEUR MYPG.POGAU *-INC SMCHAEL POINTEUR FNPG.MCHEVA POINTEUR DFNPG.MCHEVA * SEGMENT/SHXX/(SHPXXX(6,NBB)*D) * INTEGER IMPR,IRET EXTERNAL SHAPE * * Executable statements * IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans sh2fnr.eso' * SEGACT MYLRF * * Conversion élément nlin -> élément castem * IF (MYLRF.NOMLRF.EQ.'H1D1PY5') THEN IELE=25 ELSEIF (MYLRF.NOMLRF.EQ.'H1D2PY13') THEN IELE=26 ELSEIF (MYLRF.NOMLRF.EQ.'H1D2PR15') THEN IELE=17 ELSEIF (MYLRF.NOMLRF.EQ.'H1D2CU20') THEN IELE=15 ELSE WRITE(IOIMP,*) 'Element ',MYLRF.NOMLRF,' inconnu' GOTO 9999 ENDIF * NDIML=MYLRF.ORDDER(/1) NDDL=MYLRF.ORDDER(/2) NBB=NDDL SEGINI,SHXX SEGACT MYPG IDIMPG=MYPG.XCOPG(/1) IF (IDIMPG.NE.NDIML) THEN WRITE(IOIMP,*) 'Erreur grave ?' GOTO 9999 ENDIF NPG=MYPG.XCOPG(/2) NBLIG=1 NBCOL=NDDL N2LIG=1 N2COL=1 NBPOI=NPG NBELM=1 SEGINI,FNPG N2COL=NDIML SEGINI,DFNPG QSI=0.D0 ETA=0.D0 DZE=0.D0 DO IPG=1,NPG IF (NDIML.GE.1) THEN QSI=MYPG.XCOPG(1,IPG) IF (NDIML.GE.2) THEN ETA=MYPG.XCOPG(2,IPG) IF (NDIML.GE.3) THEN DZE=MYPG.XCOPG(3,IPG) ENDIF ENDIF ENDIF * CALL SHAPE(QSI,ETA,DZE,IELE,SHPXXX,IRET) IF (IRET.EQ.0) THEN C ERREUR LES FONCTIONS DE FORME PAS ENCORE IMPLEMENTEES MOTERR(1:4)=NOMS(IELE) CALL ERREUR(68) GOTO 9999 ENDIF DO IDDL=1,NDDL FNPG.WELCHE(1,IDDL,1,1,IPG,1)=SHPXXX(1,IDDL) DO IDIML=1,NDIML DFNPG.WELCHE(1,IDDL,1,IDIML,IPG,1)=SHPXXX(IDIML+1,IDDL) ENDDO ENDDO ENDDO SEGSUP SHXX SEGDES DFNPG SEGDES FNPG SEGDES MYPG SEGDES MYLRF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine sh2fnr' RETURN * * End of subroutine SH2FNR * END