Télécharger la plaquette Cast3M


fr en

Télécharger pre71.eso

Retour à la liste

Numérotation des lignes : 

pre71

  1. C PRE71     SOURCE    CB215821  23/01/25    21:15:30     11573          
  2.        SUBROUTINE PRE71()
  3. C************************************************************************
  4. C
  5. C PROJET            :  CASTEM 2000
  6. C
  7. C NOM               :  PRE71
  8. C
  9. C DESCRIPTION       :  Voir PRE7
  10. C
  11. C                      GFMP, stiffened gas.
  12. C
  13. C                      2me ordre en espace
  14. C
  15. C                      Creation of the MCHAMLs IPHIF, IROF, IVITF, IPF,
  16. C                                              (IYF, IALF).
  17. C
  18. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  19. C
  20. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
  21. C
  22. C************************************************************************
  23. C
  24. C
  25. C************************************************************************
  26. C
  27. C HISTORIQUE (Anomalies et modifications éventuelles)
  28. C
  29. C HISTORIQUE :  Crée le 03.12.2010
  30. C
  31. C************************************************************************
  32. C
  33.       IMPLICIT REAL*8(A-H,O-Z)
  34.       IMPLICIT INTEGER(I-N)
  35. C
  36. C**** Les variables
  37. C
  38.       INTEGER   ICOND,  IRETOU, MMODEL, ICELL
  39.      &     , IDOMA, ICEN, IFACE, IFACEL, INORM
  40.      &     , IPHI, IGRPHI, ILIPHI
  41.      &     , IRN1, IGRRN1, ILIRN1
  42.      &     , IVN1, IGRVN1, ILIVN1
  43.      &     , IPN1, IGRPN1, ILIPN1
  44.      &     , IYC, IGRYC, ILIMYC
  45.      &     , IALC, IGRALC, ILIALC
  46.      &     , IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF
  47.      &     , NESP, I1, I2, ICEL, ICOM
  48. C
  49.       CHARACTER*(4)  NOMGRA(27),NOMLIM(9)
  50.       CHARACTER*(8) MTYPR
  51. C
  52. C**** Les Includes
  53. C
  54.  
  55. -INC PPARAM
  56. -INC CCOPTIO
  57.       INTEGER JGM, JGN
  58. -INC SMLMOTS
  59.       POINTEUR MLMCOM.MLMOTS, MLMVIT.MLMOTS, MLMTEN.MLMOTS,
  60.      &     MLMESP.MLMOTS
  61. C
  62. C**** Nom de composantes de gradients (HP. <= 9 composantes)
  63. C
  64.       DATA NOMGRA  /'P1DX','P1DY','P1DZ',
  65.      &     'P2DX','P2DY','P2DZ',
  66.      &     'P3DX','P3DY','P3DZ',
  67.      &     'P4DX','P4DY','P4DZ',
  68.      &     'P5DX','P5DY','P5DZ',
  69.      &     'P6DX','P6DY','P6DZ',
  70.      &     'P7DX','P7DY','P7DZ',
  71.      &     'P8DX','P8DY','P8DZ',
  72.      &     'P9DX','P9DY','P9DZ'/
  73. C
  74.       DATA NOMLIM  /'P1  ',
  75.      &     'P2  ',
  76.      &     'P3  ',
  77.      &     'P4  ',
  78.      &     'P5  ',
  79.      &     'P6  ',
  80.      &     'P7  ',
  81.      &     'P8  ',
  82.      &     'P9  '/
  83. C
  84. C**** Initialisation of some segment
  85. C
  86.       JGN=4
  87.       JGM=1
  88.       SEGINI MLMCOM
  89.       JGN=4
  90.       JGM=IDIM
  91.       SEGINI MLMVIT
  92.       JGN=4
  93.       JGM=IDIM*IDIM
  94.       SEGINI MLMTEN
  95. C
  96. C**** I need the LISTMOT of the species involved...
  97. C
  98.       ICOND = 1
  99.       MTYPR = 'LISTMOTS'
  100.       CALL LIROBJ(MTYPR,MLMESP,ICOND,IRETOU)
  101.       IF(IERR.NE.0)GOTO 9999
  102.       SEGACT MLMESP
  103.       NESP = MLMESP.MOTS(/2)
  104.       SEGDES MLMESP
  105. C
  106. C**** Lecture de l'objet MODELE
  107. C
  108.       ICOND = 1
  109.       MTYPR = 'MMODEL  '
  110.       CALL LIROBJ(MTYPR, MMODEL, ICOND, IRETOU)
  111.       IF(IERR.NE.0)GOTO 9999
  112.       CALL LEKMOD(MMODEL, IDOMA, ICELL)
  113.       IF(IERR.NE.0)GOTO 9999
  114. C
  115. C**** Lecture du MELEME SPG des points CENTRE.
  116. C
  117. C
  118. C     CALL LEKTAB(IDOMA,'CENTRE',IP)
  119. C
  120. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  121. C     il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  122. C     -> la correspondance global des noeuds saut!
  123. C
  124. C     On peut utilizer ACCTAB ou ACMO
  125. C
  126.       MTYPR = 'MAILLAGE'
  127.       CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  128.       IF(IERR.NE.0)GOTO 9999
  129. C
  130. C**** Lecture du MELEME 'FACE'
  131. C
  132.       MTYPR = 'MAILLAGE'
  133.       CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  134.       IF(IERR.NE.0)GOTO 9999
  135. C
  136. C**** Lecture du MELEME 'FACEL'
  137. C
  138.       MTYPR = 'MAILLAGE'
  139.       CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  140.       IF(IERR.NE.0)GOTO 9999
  141. C
  142. C**** Lecture du CHPOINT contenant les normales (tangentes)  aux faces
  143. C
  144.       IF(IDIM .EQ. 2)THEN
  145. C        Que les normales
  146.          CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  147.          IF(IERR .NE. 0) GOTO 9999
  148.          MLMVIT.MOTS(1) = 'UX  '
  149.          MLMVIT.MOTS(2) = 'UY  '
  150.          CALL QUEPO1(INORM, IFACE, MLMVIT)
  151.          IF(IERR.NE.0)GOTO 9999
  152.       ELSE
  153. C      Les normales et les tangentes
  154.          MTYPR = ' '
  155.          CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  156.          IF (MTYPR .NE. 'CHPOINT ') THEN
  157.             CALL MATRAN(IDOMA,INORM)
  158.             IF(IERR .NE. 0) GOTO 9999
  159.          ENDIF
  160.          MLMTEN.MOTS(1) = 'UX  '
  161.          MLMTEN.MOTS(2) = 'UY  '
  162.          MLMTEN.MOTS(3) = 'UZ  '
  163.          MLMTEN.MOTS(4) = 'RX  '
  164.          MLMTEN.MOTS(5) = 'RY  '
  165.          MLMTEN.MOTS(6) = 'RZ  '
  166.          MLMTEN.MOTS(7) = 'MX  '
  167.          MLMTEN.MOTS(8) = 'MY  '
  168.          MLMTEN.MOTS(9) = 'MZ  '
  169.          CALL QUEPO1(INORM, IFACE, MLMTEN)
  170.          IF(IERR.NE.0)GOTO 9999
  171.       ENDIF
  172. C
  173. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  174. C**** Lecture du CHPOINT phi = ial1  ****C
  175. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  176. C
  177. C**** IPHI
  178. C
  179.       ICOND = 1
  180.       MTYPR = 'CHPOINT '
  181.       CALL LIROBJ(MTYPR,IPHI,ICOND,IRETOU)
  182.       IF(IERR .NE. 0)GOTO 9999
  183. C     Control du CHPOINT: QUEPO1
  184.       SEGACT MLMCOM*MOD
  185.       MLMCOM.MOTS(1)='SCAL'
  186.       CALL QUEPO1(IPHI, ICEN, MLMCOM)
  187.       SEGDES MLMCOM
  188.       IF(IERR .NE. 0)THEN
  189.          GOTO 9999
  190.       ENDIF
  191. C
  192. C**** Lecture du CHPOINT IGRPHI
  193. C
  194.       ICOND = 1
  195.       MTYPR = 'CHPOINT '
  196.       CALL LIROBJ(MTYPR,IGRPHI,ICOND,IRETOU)
  197.       IF (IERR.NE.0) GOTO 9999
  198. C     Control du CHPOINT: QUEPO1
  199.       SEGACT MLMVIT*MOD
  200.       MLMVIT.MOTS(1)=NOMGRA(1)
  201.       MLMVIT.MOTS(2)=NOMGRA(2)
  202.       IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  203.       CALL QUEPO1(IGRPHI, ICEN, MLMVIT)
  204.       SEGDES MLMVIT
  205.       IF(IERR .NE. 0)THEN
  206.          GOTO 9999
  207.       ENDIF
  208. C
  209. C**** Lecture du CHPOINT ILIPHI
  210. C
  211.       ICOND = 1
  212.       MTYPR = 'CHPOINT '
  213.       CALL LIROBJ(MTYPR,ILIPHI,ICOND,IRETOU)
  214.       IF (IERR.NE.0) GOTO 9999
  215. C     Control du CHPOINT: QUEPO1
  216.       SEGACT MLMCOM*MOD
  217.       MLMCOM.MOTS(1)= NOMLIM(1)
  218.       CALL QUEPO1(ILIPHI, ICEN, MLMCOM)
  219.       SEGDES MLMCOM
  220.       IF(IERR .NE. 0)THEN
  221.          GOTO 9999
  222.       ENDIF
  223. C
  224. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  225. C**** Lecture des CHPOINTs rho       ****C
  226. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  227. C
  228. C**** RN1
  229. C
  230.       ICOND = 1
  231.       MTYPR = 'CHPOINT '
  232.       CALL LIROBJ(MTYPR,IRN1,ICOND,IRETOU)
  233.       IF(IERR .NE. 0)GOTO 9999
  234. C     Control du CHPOINT: QUEPO1
  235.       SEGACT MLMCOM*MOD
  236.       MLMCOM.MOTS(1)='SCAL'
  237.       CALL QUEPO1(IRN1, ICEN, MLMCOM)
  238.       SEGDES MLMCOM
  239.       IF(IERR .NE. 0)THEN
  240.          GOTO 9999
  241.       ENDIF
  242. C
  243. C**** Lecture du CHPOINT IGRRN1
  244. C
  245.       ICOND = 1
  246.       MTYPR = 'CHPOINT '
  247.       CALL LIROBJ(MTYPR,IGRRN1,ICOND,IRETOU)
  248.       IF (IERR.NE.0) GOTO 9999
  249. C     Control du CHPOINT: QUEPO1
  250.       SEGACT MLMVIT*MOD
  251.       MLMVIT.MOTS(1)=NOMGRA(1)
  252.       MLMVIT.MOTS(2)=NOMGRA(2)
  253.       IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  254.       CALL QUEPO1(IGRRN1, ICEN, MLMVIT)
  255.       SEGDES MLMVIT
  256.       IF(IERR .NE. 0)THEN
  257.          GOTO 9999
  258.       ENDIF
  259. C
  260. C**** Lecture du CHPOINT ILIRN1
  261. C
  262.       ICOND = 1
  263.       MTYPR = 'CHPOINT '
  264.       CALL LIROBJ(MTYPR,ILIRN1,ICOND,IRETOU)
  265.       IF (IERR.NE.0) GOTO 9999
  266. C     Control du CHPOINT: QUEPO1
  267.       SEGACT MLMCOM*MOD
  268.       MLMCOM.MOTS(1)= NOMLIM(1)
  269.       CALL QUEPO1(ILIRN1, ICEN, MLMCOM)
  270.       SEGDES MLMCOM
  271.       IF(IERR .NE. 0)THEN
  272.          GOTO 9999
  273.       ENDIF
  274. C
  275. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  276. C**** Lecture des CHPOINTs vitesse   ****C
  277. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  278. C
  279. C**** VN1
  280. C
  281.       ICOND = 1
  282.       MTYPR = 'CHPOINT '
  283.       CALL LIROBJ(MTYPR,IVN1,ICOND,IRETOU)
  284.       IF(IERR .NE. 0)GOTO 9999
  285. C     Control du CHPOINT: QUEPO1
  286.       SEGACT MLMVIT*MOD
  287.       MLMVIT.MOTS(1)='UX  '
  288.       MLMVIT.MOTS(2)='UY  '
  289.       IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ  '
  290.       CALL QUEPO1(IVN1, ICEN, MLMVIT)
  291.       SEGDES MLMVIT
  292.       IF(IERR .NE. 0)THEN
  293.          GOTO 9999
  294.       ENDIF
  295. C
  296. C**** Lecture du CHPOINT IGRVN1
  297. C
  298.       ICOND = 1
  299.       MTYPR = 'CHPOINT '
  300.       CALL LIROBJ(MTYPR,IGRVN1,ICOND,IRETOU)
  301.       IF (IERR.NE.0) GOTO 9999
  302. C     Control du CHPOINT: QUEPO1
  303.       SEGACT MLMTEN*MOD
  304.       IF (IDIM .EQ. 2)THEN
  305.          MLMTEN.MOTS(1)=NOMGRA(1)
  306.          MLMTEN.MOTS(2)=NOMGRA(2)
  307.          MLMTEN.MOTS(3)=NOMGRA(4)
  308.          MLMTEN.MOTS(4)=NOMGRA(5)
  309.       ELSEIF(IDIM .EQ. 3) THEN
  310.          MLMTEN.MOTS(1)=NOMGRA(1)
  311.          MLMTEN.MOTS(2)=NOMGRA(2)
  312.          MLMTEN.MOTS(3)=NOMGRA(3)
  313.          MLMTEN.MOTS(4)=NOMGRA(4)
  314.          MLMTEN.MOTS(5)=NOMGRA(5)
  315.          MLMTEN.MOTS(6)=NOMGRA(6)
  316.          MLMTEN.MOTS(7)=NOMGRA(7)
  317.          MLMTEN.MOTS(8)=NOMGRA(8)
  318.          MLMTEN.MOTS(9)=NOMGRA(9)
  319.       ENDIF
  320.       CALL QUEPO1(IGRVN1, ICEN, MLMTEN)
  321.       SEGDES MLMTEN
  322.       IF(IERR .NE. 0)THEN
  323.          GOTO 9999
  324.       ENDIF
  325. C
  326. C
  327. C**** Lecture du CHPOINT ILIVN1
  328. C
  329.       ICOND = 1
  330.       MTYPR = 'CHPOINT '
  331.       CALL LIROBJ(MTYPR,ILIVN1,ICOND,IRETOU)
  332.       IF (IERR.NE.0) GOTO 9999
  333. C     Control du CHPOINT: QUEPO1
  334.       SEGACT MLMVIT*MOD
  335.       MLMVIT.MOTS(1)=NOMLIM(1)
  336.       MLMVIT.MOTS(2)=NOMLIM(2)
  337.       IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMLIM(3)
  338.       CALL QUEPO1(ILIVN1, ICEN, MLMVIT)
  339.       SEGDES MLMVIT
  340.       IF(IERR .NE. 0)THEN
  341.          GOTO 9999
  342.       ENDIF
  343. C
  344. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  345. C**** Lecture des CHPOINTs P         ****C
  346. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  347. C
  348. C**** PN1
  349. C
  350.       ICOND = 1
  351.       MTYPR = 'CHPOINT '
  352.       CALL LIROBJ(MTYPR,IPN1,ICOND,IRETOU)
  353.       IF(IERR .NE. 0)GOTO 9999
  354. C     Control du CHPOINT: QUEPO1
  355.       SEGACT MLMCOM*MOD
  356.       MLMCOM.MOTS(1)='SCAL'
  357.       CALL QUEPO1(IPN1, ICEN, MLMCOM)
  358.       SEGDES MLMCOM
  359.       IF(IERR .NE. 0)THEN
  360.          GOTO 9999
  361.       ENDIF
  362. C
  363. C**** Lecture du CHPOINT IGRPN1
  364. C
  365.       ICOND = 1
  366.       MTYPR = 'CHPOINT '
  367.       CALL LIROBJ(MTYPR,IGRPN1,ICOND,IRETOU)
  368.       IF (IERR.NE.0) GOTO 9999
  369. C     Control du CHPOINT: QUEPO1
  370.       SEGACT MLMVIT*MOD
  371.       MLMVIT.MOTS(1)=NOMGRA(1)
  372.       MLMVIT.MOTS(2)=NOMGRA(2)
  373.       IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  374.       CALL QUEPO1(IGRPN1, ICEN, MLMVIT)
  375.       SEGDES MLMVIT
  376.       IF(IERR .NE. 0)THEN
  377.          GOTO 9999
  378.       ENDIF
  379. C
  380. C**** Lecture du CHPOINT ILIPN1
  381. C
  382.       ICOND = 1
  383.       MTYPR = 'CHPOINT '
  384.       CALL LIROBJ(MTYPR,ILIPN1,ICOND,IRETOU)
  385.       IF (IERR.NE.0) GOTO 9999
  386. C     Control du CHPOINT: QUEPO1
  387.       SEGACT MLMCOM*MOD
  388.       MLMCOM.MOTS(1)= NOMLIM(1)
  389.       CALL QUEPO1(ILIPN1, ICEN, MLMCOM)
  390.       SEGDES MLMCOM
  391.       IF(IERR .NE. 0)THEN
  392.          GOTO 9999
  393.       ENDIF
  394. C
  395. C**** Mass fractions and alpha
  396. C
  397.       IF (NESP .GE. 1) THEN
  398. C
  399. C****    Mass fractions
  400. C
  401.          ICOND = 1
  402.          MTYPR = 'CHPOINT '
  403.          CALL LIROBJ(MTYPR,IYC,ICOND,IRETOU)
  404.          IF (IERR.NE.0) GOTO 9999
  405. C
  406. C****    Control du CHPOINT
  407. C
  408.          CALL QUEPO1(IYC, ICEN, MLMESP)
  409.          IF(IERR .NE. 0) GOTO 9999
  410. C
  411. C****    Lecture du CHPOINT GRADYC
  412. C
  413.          MTYPR = 'CHPOINT '
  414.          ICOND = 1
  415.          CALL LIROBJ(MTYPR,IGRYC,ICOND,IRETOU)
  416.          IF (IERR.NE.0) GOTO 9999
  417. C
  418. C****    Control du CHPOINT: QUEPOI
  419. C
  420.          JGN=4
  421.          JGM=IDIM*NESP
  422.          SEGINI MLMCOM
  423. C        NESP < 10
  424.          IF(NESP .GE. 10)THEN
  425.             WRITE(IOIMP,*) 'NESP >= 10!'
  426. C
  427. C********** Message d'erreur standard
  428. C           21 2
  429. C           Données incompatibles
  430. C
  431.             CALL ERREUR(21)
  432.             GOTO 9999
  433.          ENDIF
  434. C
  435.          ICEL = 0
  436.          DO I1 =  1, NESP, 1
  437.             DO I2 = 1, IDIM
  438.                ICEL = ICEL + 1
  439.                ICOM = 3 * (I1 -1) + I2
  440.                MLMCOM.MOTS(ICEL) = NOMGRA(ICOM)
  441.             ENDDO
  442.          ENDDO
  443.          CALL QUEPO1(IGRYC, ICEN, MLMCOM)
  444.          IF(IERR .NE. 0) GOTO 9999
  445.          SEGSUP MLMCOM
  446. C
  447. C****    Lecture du CHPOINT ILIMYC
  448. C
  449.          MTYPR = 'CHPOINT '
  450.          ICOND = 1
  451.          CALL LIROBJ(MTYPR,ILIMYC,ICOND,IRETOU)
  452.          IF(IERR .NE. 0) GOTO 9999
  453. C
  454. C****    Control du CHPOINT: QUEPOI
  455. C
  456.          JGN = 4
  457.          JGM = NESP
  458.          SEGINI MLMCOM
  459.          DO I1 = 1, NESP, 1
  460.             MLMCOM.MOTS(I1)=NOMLIM(I1)
  461.          ENDDO
  462.          CALL QUEPO1(ILIMYC, ICEN, MLMCOM)
  463.          IF(IERR .NE. 0) GOTO 9999
  464.          SEGSUP MLMCOM
  465. C
  466. C******* ALPHA
  467. C
  468.          ICOND = 1
  469.          MTYPR = 'CHPOINT '
  470.          CALL LIROBJ(MTYPR,IALC,ICOND,IRETOU)
  471.          IF (IERR.NE.0) GOTO 9999
  472. C
  473. C****    Control du CHPOINT
  474. C
  475.          CALL QUEPO1(IALC, ICEN, MLMESP)
  476.          IF(IERR .NE. 0) GOTO 9999
  477. C
  478. C****    Lecture du CHPOINT GRADYC
  479. C
  480.          MTYPR = 'CHPOINT '
  481.          ICOND = 1
  482.          CALL LIROBJ(MTYPR,IGRALC,ICOND,IRETOU)
  483.          IF (IERR.NE.0) GOTO 9999
  484. C
  485. C****    Control du CHPOINT: QUEPOI
  486. C
  487.          JGN=4
  488.          JGM=IDIM*NESP
  489.          SEGINI MLMCOM
  490. C        NESP < 10
  491.          IF(NESP .GE. 10)THEN
  492.             WRITE(IOIMP,*) 'NESP >= 10!'
  493. C
  494. C********** Message d'erreur standard
  495. C           21 2
  496. C           Données incompatibles
  497. C
  498.             CALL ERREUR(21)
  499.             GOTO 9999
  500.          ENDIF
  501. C
  502.          ICEL = 0
  503.          DO I1 =  1, NESP, 1
  504.             DO I2 = 1, IDIM
  505.                ICEL = ICEL + 1
  506.                ICOM = 3 * (I1 -1) + I2
  507.                MLMCOM.MOTS(ICEL) = NOMGRA(ICOM)
  508.             ENDDO
  509.          ENDDO
  510.          CALL QUEPO1(IGRALC, ICEN, MLMCOM)
  511.          SEGSUP MLMCOM
  512.          IF(IERR .NE. 0) GOTO 9999
  513. C
  514. C****    Lecture du CHPOINT ILIALC
  515. C
  516.          MTYPR = 'CHPOINT '
  517.          ICOND = 1
  518.          CALL LIROBJ(MTYPR,ILIALC,ICOND,IRETOU)
  519.          IF(IERR .NE. 0) GOTO 9999
  520. C
  521. C****    Control du CHPOINT: QUEPOI
  522. C
  523.          JGN = 4
  524.          JGM = NESP
  525.          SEGINI MLMCOM
  526.          DO I1 = 1, NESP, 1
  527.             MLMCOM.MOTS(I1)=NOMLIM(I1)
  528.          ENDDO
  529.          CALL QUEPO1(ILIALC, ICEN, MLMCOM)
  530.          IF(IERR .NE. 0) GOTO 9999
  531.          SEGSUP MLMCOM
  532. C
  533.       ELSE
  534.          IYC = 0
  535.          IGRYC = 0
  536.          ILIMYC = 0
  537.          IALC = 0
  538.          IGRALC = 0
  539.          ILIALC = 0
  540.       ENDIF
  541. C
  542. C      WRITE(IOIMP,*) 'Fin qui'
  543. C      WRITE(IOIMP,*) IPHI, IGRPHI, ILIPHI
  544. C      WRITE(IOIMP,*) IRN1, IGRRN1, ILIRN1
  545. C      WRITE(IOIMP,*) IVN1, IGRVN1, ILIVN1
  546. C      WRITE(IOIMP,*) IPN1, IGRPN1, ILIPN1
  547. C      WRITE(IOIMP,*) IYC, IGRYC, ILIMYC
  548. C      WRITE(IOIMP,*) IALC, IGRALC, ILIALC
  549. C      WRITE(IOIMP,*) 'Fin qui'
  550. C      goto 9999
  551. C
  552.       IF(IDIM .EQ. 2)THEN
  553. C
  554. C******* Deux Dimensions, 2-eme ordre en espace, 2-eme ordre en
  555. C        temps
  556. C
  557.          CALL PRE711(NESP,MLMESP,
  558.      &        ICEN,IFACE,IFACEL,INORM,
  559.      &        IPHI, IGRPHI, ILIPHI,
  560.      &        IRN1, IGRRN1, ILIRN1,
  561.      &        IVN1, IGRVN1, ILIVN1,
  562.      &        IPN1, IGRPN1, ILIPN1,
  563.      &        IYC, IGRYC, ILIMYC,
  564.      &        IALC, IGRALC, ILIALC,
  565.      &        IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF)
  566.          IF(IERR .NE. 0) GOTO 9999
  567.       ELSE
  568. C
  569. C******* Message d'erreur standard
  570. C        251 2
  571. C        Tentative d'utilisation d'une option non implémentée
  572. C
  573.          CALL ERREUR(251)
  574. C
  575.       ENDIF
  576.       SEGSUP MLMCOM
  577.       SEGSUP MLMVIT
  578.       SEGSUP MLMTEN
  579. C
  580. C**** Ecriture de
  581. C     IPHIF, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F
  582. C
  583.       MTYPR = 'MCHAML  '
  584. C      WRITE(IOIMP,*) nesp
  585.       IF (NESP .GE. 1) THEN
  586.          CALL ACTOBJ(MTYPR,IALF,1)
  587.          CALL ACTOBJ(MTYPR,IYF,1)
  588.          CALL ECROBJ(MTYPR,IALF)
  589.          CALL ECROBJ(MTYPR,IYF)
  590.       ENDIF
  591.       CALL ACTOBJ(MTYPR,IPN1F,1)
  592.       CALL ACTOBJ(MTYPR,IVN1F,1)
  593.       CALL ACTOBJ(MTYPR,IRN1F,1)
  594.       CALL ACTOBJ(MTYPR,IPHIF,1)
  595.       CALL ECROBJ(MTYPR,IPN1F)
  596.       CALL ECROBJ(MTYPR,IVN1F)
  597.       CALL ECROBJ(MTYPR,IRN1F)
  598.       CALL ECROBJ(MTYPR,IPHIF)
  599. C
  600.  9999 CONTINUE
  601. C
  602.       RETURN
  603.       END
  604.  
  605.  

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