Télécharger la plaquette Cast3M


fr en

Télécharger pre61.eso

Retour à la liste

Numérotation des lignes : 

pre61

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

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