rkini3.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	rkini3 (ifunct, npc, pld, xk, ecrou, igeo, a, lscale, id, titr, nom_opt)

Function/Subroutine Documentation

rkini3()

subroutine rkini3	(	integer	ifunct,
		integer, dimension(*)	npc,
			pld,
			xk,
			ecrou,
		integer, dimension(npropgi)	igeo,
			a,
			lscale,
		integer	id,
		character(len=nchartitle)	titr,
		integer, dimension(lnopt1,*)	nom_opt )

Definition at line 33 of file rkini3.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "com04_c.inc"
#include      "param_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IFUNCT,NPC(*),IGEO(NPROPGI)
      my_real
     .   xk,ecrou,a,lscale
      my_real
     .   pld(*)
      INTEGER ID,ID1
      CHARACTER(LEN=NCHARTITLE)::TITR,TITR1
      INTEGER NOM_OPT(LNOPT1,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NPOINT, J, J1, HARD,NUMPROP
      my_real
     .   a1, b1, a2, b2, xk_ini
C=======================================================================
      numprop=igeo(1)
      xk_ini=xk
 
      IF(ifunct==0) RETURN
        npoint=(npc(ifunct+1)-npc(ifunct))/2
        DO 50 j=2,npoint
        j1=2*(j-2)
        a1=pld(npc(ifunct)+j1)
        b1=pld(npc(ifunct)+j1+1)
        a2=pld(npc(ifunct)+j1+2)
        b2=pld(npc(ifunct)+j1+3)
        xk= max(xk,lscale*(b2-b1)/(a2-a1))
  50    CONTINUE
C
        hard=ecrou
        IF(hard/=0)THEN
          IF(xk_ini<xk)THEN
            CALL fretitl2(titr1,nom_opt(lnopt1-ltitr+1,ifunct),ltitr)
            CALL ancmsg(msgid=506,
     .                  msgtype=msgwarning,
     .                  anmode=aninfo_blind_1,
     .                  i1=id,
     .                  c1=titr,
     .                  r1=xk_ini,
     .                  r2=xk,
     .                  r3=xk,
     .                  i2=npc(nfunct+ifunct+1),
     .                  c2=titr1,
     .                  prmod=msg_cumu)
          ENDIF
        ENDIF
C
      RETURN