Télécharger la plaquette Cast3M


fr en

Télécharger enpapf.eso

Retour à la liste

Numérotation des lignes : 

enpapf

  1. C ENPAPF    SOURCE    PV090527  25/01/07    14:42:33     12115          
  2.       SUBROUTINE ENPAPF(MSOLUT,ITAB,IBBE1,IBBE2,IBBE3,IMEL,IRETOU,IFORM)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C=====================================================================
  6. C   LECTURE PAS A PAS D'UN MSOLUT: LECTURE D'UN NOUVEAU PAS
  7. C    SUR LA BANDE IORES
  8. C   APPELE PAR  : ENSOLF
  9. C   APPELLE     : LFCDIE LFCDI2 CREPO1
  10. C   ECRIT PAR   : FARVACQUE-LENA
  11. C======================================================================
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMCOORD
  16. -INC SMSOLUT
  17. -INC SMCHPOI
  18. -INC SMCHAML
  19.       SEGMENT/ITAB/(TAB(N1),ITABB(N2))
  20.       SEGMENT/ITBBE2/(ITABE2(NN))
  21.       SEGMENT/ITBBE1/(ITABE1(NN))
  22.       SEGMENT/ITBBE3/(ITABE3(3,N3))
  23.       DIMENSION ILENA(10)
  24.       DATA ZERO/0.D0/
  25. C======================================================================
  26. C
  27.       IRETOU=0
  28.       SEGACT MSOLUT
  29.       NIPO1=MSOLIS(/1)-4
  30.       SEGACT ITAB
  31.       N1=TAB(/1)
  32.       N2=ITABB(/1)
  33.       CALL LFCDI2(IORES,N1,TAB,IRETOU,IFORM)
  34.       IF(IRETOU.NE.0) GOTO 1000
  35.       CALL LFCDIE(IORES,N2,ITABB,IRETOU,IFORM)
  36.       IF(IRETOU.NE.0) GOTO 1000
  37.       IF(IIMPI.EQ.5) WRITE(IOIMP,800)(TAB(I),I=1,N1)
  38.       IF(IIMPI.EQ.5)WRITE(IOIMP,801)(ITABB(I),I=1,N2)
  39.  800  FORMAT(/'  *** TAB ',(5E12.5))
  40.  801  FORMAT(' ITABB=',3I4,' IPOS DES ENREGISTREMENTS:',12I5)
  41. C
  42.       ITBBE1=IBBE1
  43.       ITBBE2=IBBE2
  44.       ITBBE3=IBBE3
  45.       DO 25 III=1,NIPO1
  46.       NENRE=ITABB(4+III)-ITABB(3+III)
  47.       ITABE1(2*III-1)=0
  48.       IF(NENRE.EQ.0) GOTO 26
  49.       ISOLIT=MSOLIT(III+4)
  50.       IF(ISOLIT.NE.2) GOTO 200
  51. C     CHPOINT +++++++++++++++++++++++++
  52.       NSOUPO=NENRE
  53.       NAT=1
  54.       SEGINI MCHPOI
  55.       ITABE1(2*III-1)=MCHPOI
  56. C  les chpo contenus dans les objets de type solution sont diffus
  57.       JATTRI(1)=1
  58.       DO 102 I=1,NSOUPO
  59.       J=ITABE2(III)+I
  60.       NC=ITABE3(2,J)
  61.       SEGINI MSOUPO
  62.       N=ITABE3(1,J)
  63.       SEGINI MPOVAL
  64.       IPOVAL=MPOVAL
  65.       L=N*NC
  66.       CALL LFCDI2(IORES,L,VPOCHA,IRETOU,IFORM)
  67.       IF(IRETOU.NE.0) GOTO 1000
  68.       SEGDES MPOVAL,MSOUPO
  69.       IPCHP(I)=MSOUPO
  70.   102 CONTINUE
  71.       SEGDES MCHPOI
  72.       GOTO26
  73. C
  74.   200 IF(ISOLIT.NE.5) GOTO 300
  75. C     MCHAML  ++++++++++++++++++++++++++
  76.       WRITE(IOIMP,*) 'ENPAPF : ISOLIT = 5 MCHAML ==> CONTACTER SUPPORT'
  77.       N1=NENRE
  78.       L1 = 0
  79.       N3 = 6
  80.       SEGINI MCHELM
  81.       ITABE1(2*III-1)=MCHELM
  82.       DO 202 ISOU=1,N1
  83.       J=ITABE2(III)+ISOU
  84.       N2    =ITABE3(2,J)
  85.       SEGINI,MCHAML
  86.       ICHAML(ISOU) = MCHAML
  87.       N1PTEL=ITABE3(1,J)
  88.       N1EL  =ITABE3(3,J)
  89.       N2PTEL = 0
  90.       N2EL   = 0
  91.       L=N1PTEL*N1EL
  92.       DO k = 1, N2
  93.       SEGINI MELVAL
  94.       CALL LFCDI2(IORES,L,VELCHE,IRETOU,IFORM)
  95.       IF(IRETOU.NE.0) GOTO 1000
  96.       SEGDES MELVAL
  97.       IELVAL(k)=MELVAL
  98.       ENDDO
  99.       SEGDES MCHAML
  100.   202 CONTINUE
  101.       SEGDES MCHELM
  102.       GOTO 26
  103.   300 CONTINUE
  104.   26  CONTINUE
  105.   25  CONTINUE
  106. C
  107. C     CAS D UN MODE
  108. C
  109.       IF(ITYSOL.NE.'MODE    ') GOTO 12
  110.       MSOLEN=MSOLIS(4)
  111.       SEGACT MSOLEN
  112.       IPAS=ISOLEN(/1)+1
  113.       N=IPAS
  114.       SEGADJ MSOLEN
  115.       LVALM=5
  116.       NIMOD= 3
  117.       SEGINI MMODE
  118.       ISOLEN(IPAS)=MMODE
  119.       FMMODD(1)=TAB(3)
  120.       FMMODD(2)=TAB(4)
  121.       FMMODD(3)=TAB(5)
  122.       FMMODD(4)=TAB(6)
  123.       FMMODD(5)=TAB(7)
  124.       IMMODD(1)=ITABB(1)
  125.       IMMODD(2)=ITABB(2)
  126.       IMMODD(3)=ITABB(3)
  127.       SEGDES MMODE,MSOLEN
  128.       GOTO 20
  129. C
  130. C      CAS D UN DYNAMIQUE
  131. C
  132.  12   IF(ITYSOL.NE.'DYNAMIQU') GOTO 13
  133.       MSOLRE=MSOLIS(1)
  134.       SEGACT MSOLRE
  135.       IPAS=SOLRE(/1)+1
  136.       N=IPAS
  137.       SEGADJ MSOLRE
  138.       SOLRE(IPAS)=TAB(2)
  139.       SEGDES MSOLRE
  140. C     MSOLEN=MSOLIS(2)
  141. C     SEGADJ MSOLEN
  142. C     ISOLEN(IPAS)=ITABB(1)
  143. C     SEGDES MSOLEN
  144.       GOTO 20
  145.  13   CONTINUE
  146.       GOTO 20
  147. C
  148. C     DANS TOUS LES CAS
  149. C
  150.  20   CONTINUE
  151.       IF(IPAS.EQ.1) GOTO 21
  152.       IF(IMEL.EQ.0) GOTO21
  153.       ITBBE2=IMEL
  154.       NN=IPAS
  155.       SEGADJ ITBBE2
  156.       CALL CREPO1(ZERO,ZERO,ZERO,IPOIN)
  157.       ITABE2(IPAS)=IPOIN
  158.   21  CONTINUE
  159. C
  160.       DO 30 III=1,NIPO1
  161.       MSOLEN=MSOLIS(4+III)
  162.       IF(MSOLEN.EQ.0) GOTO 30
  163.       SEGACT MSOLEN
  164.       N=IPAS
  165.       SEGADJ MSOLEN
  166.       ISOLEN(IPAS)=ITABE1(2*III-1)
  167.       SEGDES MSOLEN
  168.   30  CONTINUE
  169. C
  170.  1000 CONTINUE
  171.       SEGDES MSOLUT
  172.       RETURN
  173.       END
  174.  
  175.  
  176.  
  177.  
  178.  

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