Télécharger la plaquette Cast3M


fr en

Télécharger mednml.eso

Retour à la liste

Numérotation des lignes : 

mednml

  1. C MEDNML    SOURCE    OF166741  23/10/16    21:15:05     11755          
  2.  
  3.       SUBROUTINE MEDNML(INUM1, INUM2, STRING1, STRING2, ISCAN)
  4.  
  5.       IMPLICIT INTEGER(i-n)
  6.       IMPLICIT REAL*8(a-h,o-z)
  7.  
  8.       CHARACTER*(*) STRING1
  9.       CHARACTER*(*) STRING2
  10.  
  11. c* string3 doit avoir la meme longueur que STRING2...
  12. c* soit MED_NAME_SIZE = 64
  13. c*      CHARACTER*(MED_NAME_SIZE) string3
  14.       CHARACTER*(64) string3
  15.       CHARACTER*(1)   str1
  16.       EXTERNAL        LONG
  17.  
  18.       SEGMENT SLISPT
  19. c*        CHARACTER*(MED_NAME_SIZE) LISPOI(ipoi)
  20.         CHARACTER*(64) LISPOI(ipoi)
  21.       ENDSEGMENT
  22.  
  23.       str1 = '.'
  24.  
  25.       STRING2 = ' '
  26.       ISCAN  = 0
  27.  
  28.       SLISPT = 0
  29.  
  30.       IF ((INUM1 .EQ. 0) .OR. (INUM2 .EQ. 0)) RETURN
  31.  
  32.       ilon = LONG(STRING1)
  33.       IF (ilon .EQ. 0) RETURN
  34.  
  35.       ISCAN = INDEX(STRING1,str1,BACK=.TRUE.)
  36.       IF (ISCAN .EQ. 0) RETURN
  37.  
  38.       IF (INUM1 .EQ. -1) THEN
  39.         STRING2 = STRING1(ISCAN+1:ilon)
  40.         ISCAN   = LONG(STRING2)
  41.         RETURN
  42.       ENDIF
  43.       IF (INUM1 .EQ. -2) THEN
  44.         STRING2 = STRING1(1:ISCAN-1)
  45.         ISCAN   = LONG(STRING2)
  46.         RETURN
  47.       ENDIF
  48.  
  49.       ipoi = ilon
  50.       SEGINI,SLISPT
  51.  
  52.       string3 = STRING1
  53.       ic      = 0
  54.       DO ia = 1, ilon
  55.         is1 = INDEX(string3,str1)
  56.         IF (is1 .GT. 0) THEN
  57.           ic = ic + 1
  58.           SLISPT.LISPOI(ic) = string3(1:is1-1)
  59.           string3 = string3(is1+1:)
  60.         ELSE
  61.           ic = ic + 1
  62.           SLISPT.LISPOI(ic) = string3
  63.           GOTO 1
  64.         ENDIF
  65.       ENDDO
  66.  1    CONTINUE
  67.  
  68.       ia = INUM1
  69.       ib = INUM2
  70.       IF (ia .LT. 0) THEN
  71.         ia = ia + ic + 1
  72.       ENDIF
  73.       IF (ib .LT. 0) THEN
  74.         ib = ib + ic + 1
  75.       ENDIF
  76.       IF ((ia.LE.0).OR.(ib.LE.0).OR.(ia.GT.ib).OR.(ib.GT.ic)) THEN
  77.         ISCAN = 0
  78.         GOTO 99
  79.       ENDIF
  80.  
  81.       STRING2 = SLISPT.LISPOI(ia)
  82.       DO ic = ia+1, ib
  83.         string3 = SLISPT.LISPOI(ic)
  84.         ilon1   = LONG(string3)
  85.         ilon2   = LONG(STRING2)
  86.         STRING2 = STRING2(1:ilon2)//str1//string3(1:ilon1)
  87.       ENDDO
  88.       ISCAN = LONG(STRING2)
  89.  
  90.  99   continue
  91.       SEGSUP,SLISPT
  92. c      return
  93.       END
  94.  
  95.  
  96.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales