Esope source files

   1 : C CREPO2    SOURCE    CHAT      05/01/12    22:29:54     5004           
   2 : 
   3 : C-----------------------------------------------------------------------
   4 : C                             C R E P O 2
   5 : C                             -----------
   6 : C
   7 : C  Fonction :
   8 : C  ----------
   9 : C    Creation d'un POINT (equivalent au sous-programme CREPOI sans
  10 : C    les lectures et ecritures) en donnant egalement la densite
  11 : C    associee au point a creer.
  12 : C
  13 : C  Mode d'appel :
  14 : C  --------------
  14 : C    CALL CREPO2 (R1,R2,R3,DENS, IPOIN)
  15 : C
  16 : C  Parametres :   (E)=Entree  (S)=Sortie
  17 : C  ------------
  18 : C    R1      REEL DP   (E)  1ere coordonnee du point
  19 : C    R2      REEL DP   (E)  2e coordonnee du point (si IDIM=2 ou 3)
  20 : C    R3      REEL DP   (E)  3e coordonnee du point (si IDIM=3)
  21 : C    DENS    REEL DP   (E)  densite du point a creer
  22 : C    IPOIN   ENTIER    (S)  numero du point cree (dans SMCOORD)
  23 : C
  24 : C  Auteur, date de creation :
  25 : C  --------------------------
  26 : C    PASCAL MANIGOT     19 AVRIL 1985
  27 : C    10/2003 : Modifications pour traiter le cas IDIM=1
  28 : C
  29 : C  Langage : FORTRAN77 + ESOPE
  30 : C-----------------------------------------------------------------------
  31 : 
  32 :       SUBROUTINE CREPO2 (R1,R2,R3,DENS, IPOIN)
  33 : 
  34 :       IMPLICIT INTEGER(I-N)
  35 :       IMPLICIT REAL*8 (A-H,O-Z)
  36 : 
  37 : -INC CCOPTIO
  38 : -INC SMCOORD
  39 : 
  40 :       IF ((IDIM.LT.1).OR.(IDIM.GT.3)) THEN
  40 :         CALL ERREUR (219)
  41 :         RETURN
  42 :       END IF
  43 : 
  44 :       idimp1=IDIM+1
  45 :       NBPTS=XCOOR(/1)/idimp1+1
  46 :       SEGADJ MCOORD
  47 :       IPoin=(NBPTS-1)*idimp1
  48 :       XCOOR(IPoin+1)=R1
  49 :       IF (IDIM.GE.2) XCOOR(IPoin+2)=R2
  50 :       IF (IDIM.GE.3) XCOOR(IPoin+3)=R3
  51 :       XCOOR(IPoin+idimp1)=DENS
  52 :       IPOIN=NBPTS
  53 : 
  54 :       RETURN
  55 :       END
  56 : 
  57 :  
  58 :