C REMA SOURCE GOUNAND 05/12/21 21:36:09 5281 SUBROUTINE REMA(RE,NI,NJ, $ COPER, $ MA, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : REMA C DESCRIPTION : Implémentation d'opérations réel -> matrice 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, 27/09/2005, version initiale C HISTORIQUE : v1, 27/09/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 CCOPTIO * REAL*8 MA(NI,NJ) CHARACTER*8 COPER REAL*8 RE * INTEGER IMPR,IRET * * Executable statements * IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans rema.eso' IF (COPER.EQ.'DIAGONAL') THEN IF (NI.NE.NJ) GOTO 9998 DO IJ=1,NJ DO II=1,NI IF (II.NE.IJ) THEN MA(II,IJ)=0.D0 ELSE MA(II,IJ)=RE ENDIF ENDDO ENDDO ELSE WRITE(IOIMP,*) 'Operation ',COPER,' unknown' GOTO 9999 ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9998 CONTINUE WRITE(IOIMP,*) NI,'.NE.',NJ GOTO 9999 * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine rema' RETURN * * End of subroutine REMA * END