ecri2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\ecri2.f
00002 !
00057                      SUBROUTINE ECRI2
00058 !                    ****************
00059 !
00060      &(X , I , C , NVAL , TYPE , CANAL , STD , ISTAT)
00061 !
00062 !***********************************************************************
00063 ! BIEF   V6P1                                   21/08/2010
00064 !***********************************************************************
00065 !
00066 !
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !| C              |-->| CHARACTER STRING TO BE WRITTEN
00074 !| CANAL          |-->| LOGICAL UNIT FOR WRITING
00075 !| I              |-->| INTEGER ARRAY TO BE WRITTEN
00076 !| ISTAT          |<--| ERROR NUMBER
00077 !| NVAL           |-->| NUMBER OF VALUES (INTEGER, CHARACTER, ETC.)
00078 !|                |   | TO BE WRITTEN
00079 !| STD            |-->| OUTPUT STANDARD : STD , IBM OU I3E, ETC.
00080 !| TYPE           |-->| TYPE OF DATA : 'I' , 'CH' , 'R4' , 'R8'
00081 !| X              |-->| DOUBLE PRECISION ARRAY TO BE WRITTEN
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !
00084       IMPLICIT NONE
00085       INTEGER LNG,LU
00086       COMMON/INFO/LNG,LU
00087 !
00088 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00089 !
00090       INTEGER, INTENT(IN) :: NVAL,CANAL
00091       DOUBLE PRECISION, INTENT(IN) :: X(NVAL)
00092       INTEGER, INTENT(IN) :: I(NVAL)
00093       CHARACTER*(*), INTENT(IN) :: TYPE,STD,C
00094       INTEGER, INTENT(OUT) :: ISTAT
00095 !
00096 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00097 !
00098       INTEGER J
00099 !
00100       INTRINSIC REAL
00101 !
00102 !-----------------------------------------------------------------------
00103 !
00104       ISTAT = 0
00105 !
00106 !-----------------------------------------------------------------------
00107 !
00108       IF(STD(1:3).EQ.'STD') THEN
00109 !
00110         IF (TYPE(1:2).EQ.'R4') THEN
00111           WRITE(CANAL)(REAL(X(J)),J=1,NVAL)
00112         ELSEIF (TYPE(1:2).EQ.'R8') THEN
00113           WRITE(CANAL)(X(J),J=1,NVAL)
00114         ELSEIF (TYPE(1:1).EQ.'I') THEN
00115           WRITE(CANAL)(I(J),J=1,NVAL)
00116         ELSEIF (TYPE(1:2).EQ.'CH') THEN
00117           WRITE(CANAL) C(1:NVAL)
00118         ELSE
00119           IF(LNG.EQ.1) THEN
00120             WRITE(LU,20) TYPE
00121 20          FORMAT(1X,'ECRI2 : TYPE INCONNU :',A2)
00122           ENDIF
00123           IF(LNG.EQ.2) THEN
00124             WRITE(LU,21) TYPE
00125 21          FORMAT(1X,'ECRI2 : UNKNOWN TYPE:',A2)
00126           ENDIF
00127           CALL PLANTE(0)
00128           STOP
00129         ENDIF
00130 !
00131 !-----------------------------------------------------------------------
00132 !
00133 !     ELSEIF(STD(1:3).EQ.'IBM') THEN
00134 !
00135 ! BEWARE : CRAY DOUBLE PRECISION IS NOT ENVISAGED HERE
00136 !
00137 !        IF (TYPE(1:2).EQ.'R4') THEN
00138 !           CALL ECRIBM( X , NVAL , TYPE , CANAL )
00139 !        ELSEIF (TYPE(1:2).EQ.'R8') THEN
00140 !           CALL ECRIBM( X , NVAL , TYPE , CANAL )
00141 !        ELSEIF (TYPE(1:1).EQ.'I') THEN
00142 !           CALL ECRIBM( I , NVAL , TYPE , CANAL )
00143 !        ELSEIF (TYPE(1:2).EQ.'CH') THEN
00144 !           THIS COPY APPEAR TO AVOID A BUG IN ECRIBM
00145 !           CHAINE(1:NVAL) = C(1:NVAL)
00146 !           CALL ECRIBM( CHAINE , NVAL , TYPE , CANAL )
00147 !        ELSE
00148 !           IF(LNG.EQ.1) WRITE(LU,20) TYPE
00149 !           IF(LNG.EQ.2) WRITE(LU,21) TYPE
00150 !           CALL PLANTE(0)
00151 !           STOP
00152 !        ENDIF
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156 !     ELSEIF(STD(1:3).EQ.'I3E') THEN
00157 !
00158 ! BEWARE : CRAY DOUBLE PRECISION IS NOT ENVISAGED HERE
00159 !
00160 !        IF (TYPE(1:2).EQ.'R4') THEN
00161 !           CALL ECRI3E( X , NVAL , 'F' , CANAL , ISTAT )
00162 !        ELSEIF (TYPE(1:2).EQ.'R8') THEN
00163 !           CALL ECRI3E( X , NVAL , 'F' , CANAL , ISTAT )
00164 !        ELSEIF (TYPE(1:1).EQ.'I') THEN
00165 !           CALL ECRI3E( I , NVAL , 'I' , CANAL , ISTAT )
00166 !        ELSEIF (TYPE(1:2).EQ.'CH') THEN
00167 !           CALL ECRI3E( C(1:NVAL) , NVAL , 'C' , CANAL , ISTAT )
00168 !        ELSE
00169 !           IF(LNG.EQ.1) WRITE(LU,20) TYPE
00170 !           IF(LNG.EQ.2) WRITE(LU,21) TYPE
00171 !           CALL PLANTE(0)
00172 !           STOP
00173 !        ENDIF
00174 !
00175 !-----------------------------------------------------------------------
00176 !
00177       ELSE
00178 !
00179         IF(LNG.EQ.1) THEN
00180           WRITE(LU,10) STD
00181 10        FORMAT(1X,'ECRI2 : STANDARD D''ECRITURE INCONNU :',A8)
00182         ENDIF
00183         IF(LNG.EQ.2) THEN
00184           WRITE(LU,11) STD
00185 11        FORMAT(1X,'ECRI2 : UNKNOWN STANDARD:',A8)
00186         ENDIF
00187         CALL PLANTE(1)
00188         STOP
00189 !
00190       ENDIF
00191 !
00192 !-----------------------------------------------------------------------
00193 !
00194       RETURN
00195       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0