ecri2.f

Go to the documentation of this file.

!                   ****************
                    SUBROUTINE ecri2
!                   ****************
!
     &(x , i , c , nval , TYPE , canal , std , istat)
!
!***********************************************************************
! HERMES   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    WRITES OUT VALUES ACCORDING TO VARIOUS STANDARDS.
!
!note     FORMER SUBROUTINE ECRIT;
!+         NAME CHANGED BECAUSE THIS NAME EXISTS IN THE CALCIUM LIBRARY
!
!
!history  J-M HERVOUET (LNH)
!+        17/08/94
!+        V5P1
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| X              |-->| DOUBLE PRECISION ARRAY TO BE WRITTEN
!| I              |-->| INTEGER ARRAY TO BE WRITTEN
!| C              |-->| CHARACTER STRING TO BE WRITTEN
!| NVAL           |-->| NUMBER OF VALUES (INTEGER, CHARACTER, ETC.)
!|                |   | TO BE WRITTEN
!| TYPE           |-->| TYPE OF DATA : 'I' , 'CH' , 'R4' , 'R8'
!| CANAL          |-->| LOGICAL UNIT FOR WRITING
!| STD            |-->| OUTPUT STANDARD : STD , IBM OU I3E, ETC.
!| ISTAT          |<--| ERROR NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NVAL,CANAL
      DOUBLE PRECISION, INTENT(IN) :: X(*)
      INTEGER, INTENT(IN) :: I(*)
      CHARACTER(LEN=*), INTENT(IN) :: TYPE,STD,C
      INTEGER, INTENT(OUT) :: ISTAT
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER J
!
      INTRINSIC real
!
!-----------------------------------------------------------------------
!
      istat = 0
!
!-----------------------------------------------------------------------
!
      IF(std(1:3).EQ.'STD') THEN
!
        IF (TYPE(1:2).EQ.'R4') then
          WRITE(canal)(REAL(X(J)),J=1,nval)
        ELSEIF (TYPE(1:2).EQ.'R8') then
          WRITE(canal)(x(j),j=1,nval)
        ELSEIF (TYPE(1:1).EQ.'I') then
          WRITE(canal)(i(j),j=1,nval)
        ELSEIF (TYPE(1:2).EQ.'CH') then
          WRITE(canal) c(1:nval)
        ELSE
          WRITE(lu,21) TYPE
21        FORMAT(1x,'ECRI2 : UNKNOWN TYPE:',a2)
          CALL plante(1)
          stop
        ENDIF
!
      ELSE
!
        WRITE(lu,11) std
11      FORMAT(1x,'ECRI2 : UNKNOWN STANDARD:',a8)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END