sta_txt.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	strs_txt (text, len)
subroutine	strs_txt50 (text, length)
subroutine	tab_strs_txt50 (wap0, cpt, j, sizp0, nbpline)

Function/Subroutine Documentation

strs_txt()

subroutine strs_txt	(	character*80	text,
		integer	len )

Definition at line 28 of file sta_txt.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      CHARACTER*80 TEXT
      INTEGER LEN
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER CTEXT(81),I
C
      DO 100 i=1,len
 100  ctext(i)=ichar(text(i:i))
      ctext(len+1)=0
C
      CALL write_c_c(ctext,81)
C
      RETURN

strs_txt50()

subroutine strs_txt50	(	character(len = length)	text,
		integer	length )

Definition at line 86 of file sta_txt.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LENGTH
      CHARACTER(LEN = LENGTH) :: TEXT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER TEXT_LEN
      text_len=len_trim(text)
 
      CALL write_c_c_txt(text,text_len)
C
      RETURN

tab_strs_txt50()

subroutine tab_strs_txt50	(	double precision, dimension(sizp0)	wap0,
		integer	cpt,
		integer	j,
		integer	sizp0,
		integer	nbpline )

Definition at line 126 of file sta_txt.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER CPT,J,SIZP0,NBPLINE
      double precision   
     .   WAP0(SIZP0)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      CHARACTER*100 LINE
      INTEGER I,K,K1
      INTEGER J1
C
      j1 = j
      IF (nbpline > 5)nbpline = 5
      DO k=1,cpt
        IF (mod(k,nbpline) == 0) THEN
          SELECT CASE (nbpline)
          CASE (1)
            WRITE(line,'(1P1E20.13)')(wap0(j1 + k1),k1=1,nbpline)
            CALL strs_txt50(line,20)
          CASE (2)
            WRITE(line,'(1P2E20.13)')(wap0(j1 + k1),k1=1,nbpline)
            CALL strs_txt50(line,40)
          CASE (3)
            WRITE(line,'(1P3E20.13)')(wap0(j1 + k1),k1=1,nbpline)
            CALL strs_txt50(line,60)
          CASE (4)
            WRITE(line,'(1P4E20.13)')(wap0(j1 + k1),k1=1,nbpline)
            CALL strs_txt50(line,80)
          CASE (5)
            WRITE(line,'(1P5E20.13)')(wap0(j1 + k1),k1=1,nbpline)
            CALL strs_txt50(line,100)
          END SELECT
          j1 = j1 + nbpline
        ELSEIF (k == cpt) THEN
          SELECT CASE (mod(k,nbpline))
          CASE (1)
            WRITE(line,'(1P1E20.13)')(wap0(j1 + k1),k1=1,mod(k,nbpline))
            CALL strs_txt50(line,20)
          CASE (2)
            WRITE(line,'(1P2E20.13)')(wap0(j1 + k1),k1=1,mod(k,nbpline))
            CALL strs_txt50(line,40)
          CASE (3)
            WRITE(line,'(1P3E20.13)')(wap0(j1 + k1),k1=1,mod(k,nbpline))
            CALL strs_txt50(line,60)
          CASE (4)
            WRITE(line,'(1P4E20.13)')(wap0(j1 + k1),k1=1,mod(k,nbpline))
            CALL strs_txt50(line,80)
          CASE (5)
            WRITE(line,'(1P5E20.13)')(wap0(j1 + k1),k1=1,mod(k,nbpline))
            CALL strs_txt50(line,100)
          END SELECT
        ENDIF
      ENDDO
C
      RETURN