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

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