Télécharger la plaquette Cast3M


fr en

Télécharger rescha.eso

Retour à la liste

Numérotation des lignes : 

rescha

  1. C RESCHA    SOURCE    PV        19/09/12    21:15:00     10299          
  2.       SUBROUTINE RESCHA (ICOLAC,ITLACC,IMAX1,IDEB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Restauration des pointeurs issus de la pile des CHAMELEMs.     *
  8. *                                                                    *
  9. *--------------------------------------------------------------------*
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC SMCHAML
  14. -INC TMCOLAC
  15.       CHARACTER*8  MOTIP
  16.       CHARACTER*16 NOCOMP
  17. *
  18. *     Boucle sur les CHAMELEMs contenus dans la pile:
  19. *
  20.       ITLAC1 = KCOLA(1)
  21.       ITLAC3 = KCOLA(48)
  22.       DO 10 IEL =IDEB,IMAX1
  23.          MCHELM = ITLAC(IEL)
  24.          IF (MCHELM.EQ.0) GOTO 10
  25.          SEGACT,MCHELM*MOD
  26.          NSOUEL = ICHAML(/1)
  27.          N3     = INFCHE(/2)
  28.          IF (NSOUEL.EQ.0) GOTO 10
  29.          DO 20 ISOU=1,NSOUEL
  30.             MCHAML=ICHAML(ISOU)
  31.             IF (MCHAML.EQ.0) GO TO 20
  32.                SEGACT,MCHAML*MOD
  33. *
  34.                IVA = ABS(IMACHE(ISOU))
  35. *              IF(IVA.NE.0) IMACHE(ISOU) = ITLAC1.ITLAC(IVA)
  36. *    CORRECTION   MILL 3 / 9 / 92
  37.                IF(IVA.NE.0) IMACHE(ISOU) = ITLAC1.ITLAC(IVA)
  38. *               IF(IMACHE(ISOU).LT.0)
  39. *     $                       IMACHE(ISOU) = ITLAC1.ITLAC(IVA)
  40. *
  41.                IF(N3.GE.4) THEN
  42.                ITLAC2 = KCOLA(40)
  43.                IVA = ABS(INFCHE(ISOU,4))
  44. *              IF(IVA.NE.0) INFCHE(ISOU,4) = ITLAC2.ITLAC(IVA)
  45.                IF(INFCHE(ISOU,4).LT.0)
  46.      $                       INFCHE(ISOU,4) = ITLAC2.ITLAC(IVA)
  47.                ENDIF
  48. *
  49.                NCO = TYPCHE(/2)
  50.                DO 30 ICO=1,NCO
  51.                   NOCOMP = TYPCHE(ICO)
  52.                   IF (NOCOMP(1:6).NE.'REAL*8') THEN
  53.                      MOTIP(1:8)=NOCOMP(9:16)
  54.                      CALL TYPFIL(MOTIP,ITYP)
  55.                      IF(ITYP.LE.0) GO TO 30
  56.                      ITLAC2 = KCOLA(ITYP)
  57.                      MELVAL = IELVAL(ICO)
  58.                      IF (MELVAL.NE.0) THEN
  59.                         SEGACT,MELVAL*MOD
  60.                         N1 = IELCHE(/1)
  61.                         N2 = IELCHE(/2)
  62.                         DO 40 I2=1,N2
  63.                         DO 50 I1=1,N1
  64.                         IVA = ABS(IELCHE(I1,I2))
  65. *                       IF(IVA.NE.0) IELCHE(I1,I2) = ITLAC2.ITLAC(IVA)
  66.                         IF(IELCHE(I1,I2).LT.0)
  67.      $                               IELCHE(I1,I2) = ITLAC2.ITLAC(IVA)
  68.  50                     CONTINUE
  69.  40                     CONTINUE
  70.                         SEGDES,MELVAL
  71.                      ENDIF
  72.                   ELSE
  73. **                 write (6,*) ' rescha iva ',ielval(ico)
  74.                    IVA=ABS(IELVAL(ICO))
  75.                    IF (IELVAL(ICO).LT.0) IELVAL(ICO)=ITLAC3.ITLAC(IVA)
  76. **                 write (6,*) ' rescha apres ',ielval(ico)
  77.                   ENDIF
  78.  30               CONTINUE
  79.             SEGDES,MCHAML
  80.  20         CONTINUE
  81.          segdes mchelm
  82.  10     CONTINUE
  83.       RETURN
  84.       END
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  

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