frenois.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"
#include "scrnoi_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	frenois (ikad, key0, knoise)

Function/Subroutine Documentation

frenois()

subroutine frenois	(	integer, dimension(0:*)	ikad,
		character, dimension(*)	key0,
		integer	knoise )

Definition at line 36 of file frenois.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod, ONLY: ncharline100
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "scrnoi_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IKAD(0:*),KNOISE
      CHARACTER KEY0(*)*5, KEY2*5, KEY3*5, KEY4*5, KEY5*5
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NVAR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, NBC, K, KK, IKEY
      CHARACTER(LEN=NCHARLINE100)::CARTE
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      ikey=knoise
      IF(ikad(ikey)/=ikad(ikey+1))THEN
       k=0
 1160  READ(iusc1,rec=ikad(ikey)+k, fmt='(7X,A,1X,A,1X,A,1X,A,19X,I10)',err=9990)key2,key3,key4,key5,nbc
       k=k+1
       IF(key2(1:3)=='VEL')THEN
        noisev=1
       ELSEIF(key2(1:1)=='P')THEN
        noisep=1
       ELSEIF(key2(1:3)=='ACC')THEN
        noisea=1
       ELSEIF(key2(1:4)=='CONT')THEN
        rnoi=1
       ELSE
        IF(nbc>0)THEN
c         K=K+1
         nnoise=0
         rnoi=0
         CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
         READ(iusc2,*)tnoise,dtnoise
         k=k+1
         kk=k
         DO 1300 i=1,nbc-1
          READ(iusc1,rec=ikad(ikey)+k,fmt='(a)',ERR=9990)CARTE
          K=K+1
          NNOISE=NNOISE+NVAR(CARTE)
 1300    CONTINUE
         CALL READ10(IKAD(IKEY)+KK,NBC-1,KEY0(IKEY))
         IF(KEY2(1:4)=='init')RNOI=2
        ELSE
         RNOI=1
        ENDIF
       ENDIF
       IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 1160
      ENDIF
C
      RETURN
C
 9990 CONTINUE
      CALL ANCMSG(MSGID=73,ANMODE=ANINFO,
     .            C1=KEY0(IKEY))
      CALL ARRET(0)