Télécharger la plaquette Cast3M


fr en

Télécharger nlovep.eso

Retour à la liste

Numérotation des lignes : 

nlovep

  1. C NLOVEP    SOURCE    MB234859  25/09/08    21:15:56     12358          
  2.       SUBROUTINE NLOVEP(IPCHCO,IPCHI,IPCHO,NLOC1,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C     VERIFICATION ET PREPARATION DU TRAVAIL SUR LA MOYENNE
  6. C                     NON LOCALE
  7. C
  8. C
  9. C    Entrees:
  10. C    --------
  11. C           IPCHCO Pointeur sur un MCHAML de Connectivite
  12. C                  (ss-type CONNECTIVITE NON LOCAL)
  13. C           IPCHI  Pointeur sur un MCHAML de ss-type indifferentt
  14. C           IPLMOT Pointeur sur un LISTMOTS de noms de composante
  15. C
  16. C   Sorties:
  17. C   --------
  18. C           IRET=1 ou 0 si OK ou non
  19. C           IPCHO  pointeur sur le champ moyenne
  20. C           NLOC1  pointeur sur l'arbre de calcul
  21. C
  22. C   Appele par: NLOCA1
  23. C   -----------
  24. C
  25. C   Appel a:
  26. C   --------
  27. C
  28. C   DOUBLO : detection de doublon
  29. C   LOADPO : lecture d'un point (pointeur --> x(3))
  30. C   ELQUOI, IDENT, KOMCHA, COPIE8, DTCHEL
  31. C
  32. C   P.PEGON 9/11/92
  33. C_______________________________________________________________________
  34. C
  35.       IMPLICIT INTEGER(I-N)
  36.       IMPLICIT REAL*8(A-H,O-Z)
  37.  
  38. -INC SMCOORD
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC SMCHAML
  42. -INC SMELEME
  43. -INC SMMODEL
  44. -INC SMLMOTS
  45. -INC SMINTE
  46.  
  47. -INC TMPTVAL
  48. *
  49.       SEGMENT NOTYPE
  50.         CHARACTER*16 TYPE (NBTYPE)
  51.       ENDSEGMENT
  52. *
  53.       SEGMENT WRK0
  54.         INTEGER IRAGNT(NSOUCO),IDUMMM(2,NSOUCO),IDUPLI(NSOUCO)
  55.       END SEGMENT
  56. *
  57.       SEGMENT NLOC1
  58.         INTEGER ILOC2(NZONEF),MOLOC2(NZONEF)
  59.       END SEGMENT
  60. *
  61.       SEGMENT NLOC2
  62.         INTEGER MPCHAM (NDOUBL)
  63.         INTEGER ILOC4  (NDOUBL)
  64.         INTEGER MODLAC,MAILEF,MINTEF
  65.         INTEGER MAILAC (NSZACC)
  66.         INTEGER MINTAC (NSZACC)
  67.         INTEGER ILOC3  (NSZACC)
  68.         INTEGER ILOC3I,ILOC3O
  69.         INTEGER MELCAR
  70.       END SEGMENT
  71. *
  72.       SEGMENT NLOC3
  73.         INTEGER     MELVAC (NCOMP)
  74.       END SEGMENT
  75. *
  76.       SEGMENT NLOC4
  77.         INTEGER JCLE
  78.         REAL*8 PT1(3),PT2(3),DISP
  79.         INTEGER MELPNI,MELPLI
  80.       END SEGMENT
  81.  
  82.       PARAMETER ( NINF=3 )
  83.       INTEGER INFOS(NINF)
  84. C
  85.       PARAMETER(NCLE=5)
  86.       CHARACTER*4 MCLE(NCLE)
  87.       DATA MCLE/'NORM','TRAN','POIN','DROI','PLAN'/
  88.  
  89.       CHARACTER*(LCONMO) CONM
  90.       LOGICAL LMASS,LCARA
  91. C
  92. C     ACTIVATION DU CHAMP DE CONNECTIVITE
  93. C
  94.       MCHELM=IPCHCO
  95.       NSOUCO=ICHAML(/1)
  96.       SEGINI,WRK0
  97. C
  98. C     ON ETABLIT LA LISTE DES MAILLAGES
  99. C     ACTIVATION DU SECOND MELVAL DU CHAMP DE CONNECTIVITE
  100. C     QUI EST LE MODELE ASSOCIE AU SS-ZONES ACCESSIBLE
  101. C     ON ETABLIT LA LISTE DE CES MODELES
  102. C     ON DESACTIVE LE MELVAL
  103. C
  104.       DO ISOUCO=1,NSOUCO
  105.         IDUMMM(1,ISOUCO)=IMACHE(ISOUCO)
  106.         MCHAML=ICHAML(ISOUCO)
  107.         IRAGNT(ISOUCO)=ISOUCO
  108.         NCOMP=IELVAL(/1)
  109.         IF(NCOMP.LT.4.OR.NCOMP.GT.6)THEN
  110.           CALL ERREUR(734)
  111.           SEGSUP,WRK0
  112.           GOTO 9999
  113.         ENDIF
  114.         IF(NOMCHE(2).NE.'PMOD')THEN
  115.           MOTERR(1:4)='PMOD'
  116.           CALL ERREUR(734)
  117.           SEGSUP,WRK0
  118.           GOTO 9999
  119.         ENDIF
  120.         IF(TYPCHE(2).NE.'POINTEURMMODEL')THEN
  121.           MOTERR(1:4)='PMOD'
  122.           MOTERR(5:12)='MODEL   '
  123.           CALL ERREUR(736)
  124.           SEGSUP,WRK0
  125.           GOTO 9999
  126.         ENDIF
  127.         MELVAL=IELVAL(2)
  128.         IDUMMM(2,ISOUCO)=IELCHE(1,1)
  129.       END DO
  130. C
  131. C     ON ORDONNE LE TABLEAU IDUMMM EN GARDANT LA TRACE DES PERMUTATIONS
  132. C     DANS IRAGNT
  133. C     ON DETECTE LES DOUBLONS:
  134. C     IDUPLI INDIQUE LE NOMBRE DE DOUBLON PAR ZONE EFFECTIVE
  135. C     IDUMMM POINTE SUR LE MAILLAGE/MODELE DE LA ZONE EFFECTIVE
  136. C
  137.       CALL DOUBLO(IDUMMM,IRAGNT,2,NSOUCO, NZONEF,IDUPLI)
  138. C
  139. C     ON REMPLIT NLOC1 ET PARTIELLEMENT NLOC2
  140. C     ON ACTIVE LES MMODEL
  141. C     ON ACTIVE LES MAILLAGES EFFECTIFS
  142. C     ON SUPRIME WRK0
  143. C
  144.       J=0
  145.       NSZACC=0
  146.       SEGINI,NLOC1
  147.       DO ISOUCF=1,NZONEF
  148.         NDOUBL=IDUPLI(ISOUCF)
  149.         SEGINI,NLOC2
  150.         ILOC2(ISOUCF)=NLOC2
  151.         MMODEL=IDUMMM(2,ISOUCF)
  152.         MODLAC=MMODEL
  153.         DO IDOUBL=1,NDOUBL
  154.           J=J+1
  155.           MPCHAM(IDOUBL)=IRAGNT(J)
  156.           ILOC4 (IDOUBL)=0
  157.         END DO
  158.         MELEME=IDUMMM(1,ISOUCF)
  159.         MAILEF=MELEME
  160.       END DO
  161.       SEGSUP,WRK0
  162. C
  163. C     ON ACTIVES LES IMODEL ET ON CONTINUE DE REMPLIR NLOC2
  164. C     (MAILLAGE ET MINTE)
  165. C     IL FAUT ACTIVER LE MINTE !!!!
  166. C     ON VERIFIE AU PASSAGE QUE LA FORMULATION DU MODELE EST
  167. C     BIEN MASSIVE ET EN FORMULATION NON-LOCALE
  168. C     ... ET QUE SOIT LES LONGUEURS CARACTERISTIQUES SUR UNE MEME
  169. C     SOUS-ZONE EFFECTIVE SONT IDENTIQUE OU QUE LE MELVAL DE LONGUEUR
  170. C     CARACTERISTIQUE EST LE MEME. POUR CELA ON ACTIVE
  171. C     ET ON DESACTIVE LE PREMIER MELVAL DU CHAMP DE CONNECTIVITE
  172. C
  173. C
  174.       LMASS=.TRUE.
  175.       LCARA=.TRUE.
  176.  
  177. *   1-ere boucle sur les zones effectives (NZONEF)
  178.  
  179.       DO ISOUCF=1,NZONEF
  180. C
  181.         NLOC2=ILOC2(ISOUCF)
  182.         ILOC3I=0
  183.         ILOC3O=0
  184.         MMODEL=MODLAC
  185.         NSZACC=KMODEL(/1)
  186. * PP 15/6/93
  187.         NDOUBL=MPCHAM(/1)
  188.         SEGADJ,NLOC2
  189.         DO ISZACC=1,NSZACC
  190.           IMODEL=KMODEL(ISZACC)
  191.           MELE=NEFMOD
  192.           MFR=NUMMFR (MELE)
  193.           IF (MFR .NE. 1) THEN
  194.             CALL ERREUR(737)
  195.             LMASS=.FALSE.
  196.           ENDIF
  197.           MAILAC(ISZACC)=IMAMOD
  198.           INLOC=0
  199.           IF(INFMOD(/1).GE.13) INLOC=-1*INFMOD(13)
  200.           IF(INLOC.EQ.0) THEN
  201.             CALL ERREUR(737)
  202.             LMASS=.FALSE.
  203.           ENDIF
  204.           minte=infmod(7)
  205.           MINTAC(ISZACC)=minte
  206.  
  207.           ILOC3 (ISZACC)=0
  208. *
  209.         END DO
  210. C
  211.         ICHAMC=MPCHAM(1)
  212.         MCHAML=ICHAML(ICHAMC)
  213.         IF(NOMCHE(1).NE.'NLAR')THEN
  214.           MOTERR(1:4)='NLAR'
  215.           CALL ERREUR(734)
  216.           LCARA=.FALSE.
  217.         ELSEIF(TYPCHE(1).NE.'REAL*8')THEN
  218.           MOTERR(1:4)='NLAR'
  219.           MOTERR(5:12)='FLOTTANT'
  220.           CALL ERREUR(736)
  221.           LCARA=.FALSE.
  222.         ENDIF
  223.         IF(LCARA)THEN
  224.           MELVAL=IELVAL(1)
  225.           MELCAR=MELVAL
  226.           IF(VELCHE(/1).EQ.1.AND.VELCHE(/2).EQ.1)THEN
  227.             XLCAR=VELCHE(1,1)
  228.           ELSE
  229.             XLCAR=0.D0
  230.           ENDIF
  231.           NDOUBL=MPCHAM(/1)
  232. C
  233.           DO IDOUBL=1,NDOUBL
  234.             ICHAMC=MPCHAM(IDOUBL)
  235.             MCHAML=ICHAML(ICHAMC)
  236.             IF(NOMCHE(1).NE.'NLAR')THEN
  237.               MOTERR(1:4)='NLAR'
  238.               CALL ERREUR(734)
  239.               LCARA=.FALSE.
  240.             ELSEIF(TYPCHE(1).NE.'REAL*8')THEN
  241.               MOTERR(1:4)='NLAR'
  242.               MOTERR(5:12)='FLOTTANT'
  243.               CALL ERREUR(736)
  244.               LCARA=.FALSE.
  245.             ENDIF
  246.             IF(LCARA)THEN
  247.               MELVAL=IELVAL(1)
  248.               IF(XLCAR.EQ.0.D0)THEN
  249.                 MELVA1=MELCAR
  250.                 IF(MELVA1.VELCHE(/1).EQ.VELCHE(/1).AND.
  251.      >             MELVA1.VELCHE(/2).EQ.VELCHE(/2))THEN
  252.                   XDIFNL=0.D0
  253.                   XMAXNL=0.D0
  254.                   DO IB=1,VELCHE(/2)
  255.                     DO IG=1,VELCHE(/1)
  256.                       XDIFNL=XDIFNL+
  257.      >                ABS(MELVA1.VELCHE(IG,IB)-VELCHE(IG,IB))
  258.                       XMAXNL=MAX(XMAXNL,MELVA1.VELCHE(IG,IB),
  259.      >                                         VELCHE(IG,IB))
  260.                     ENDDO
  261.                   ENDDO
  262.                 ELSE
  263.                   XDIFNL=1
  264.                   XMAXNL=1
  265.                 ENDIF
  266.                 IF(XMAXNL.EQ.0.D0.OR.XDIFNL.GT.XMAXNL*1.D-10)THEN
  267.                   CALL ERREUR(739)
  268.                   LCARA=.FALSE.
  269.                 ENDIF
  270. C
  271.               ELSE
  272.                 IF(XLCAR.NE.VELCHE(1,1))THEN
  273.                   CALL ERREUR(738)
  274.                   LCARA=.FALSE.
  275.                 ENDIF
  276.               ENDIF
  277.             ENDIF
  278.           END DO
  279.         ENDIF
  280.       END DO
  281. *  fin de la 1-ere boucle sur les zones effectives (NZONEF)
  282.  
  283.       IF(.NOT.LMASS) GOTO 9998
  284.       IF(.NOT.LCARA) GOTO 9998
  285. C
  286. C     ON CREE UN HEADER DE MCHAML DE CONNECTIVITE SUR LES ZONES
  287. C     EFFECTIVES
  288. C     ON CREE UN HEADER DE MODELE SUR LES ZONES EFFECTIVES QUI
  289. C     REPREND LE IMODEL ASSOCIE A LA ZONE COURANTE
  290. C
  291.       L1=TITCHE(/1)
  292.       N1=NZONEF
  293.       N3=INFCHE(/2)
  294.       SEGINI,MCHEL1
  295.       MCHEL1.TITCHE=TITCHE
  296.       MCHEL1.IFOCHE=IFOCHE
  297.       SEGINI,MMODE1
  298.  
  299. *  2-eme boucle sur les zones effectives (NZONEF)
  300.  
  301.       DO ISOUCF=1,NZONEF
  302.         NLOC2=ILOC2(ISOUCF)
  303.         ICHAMC=MPCHAM(1)
  304.         MCHAML=ICHAML(ICHAMC)
  305.         IMACHA=IMACHE(ICHAMC)
  306.         MCHEL1.IMACHE(ISOUCF)=IMACHA
  307.         MCHEL1.ICHAML(ISOUCF)=0
  308.         MMODEL=MODLAC
  309.         NSZACC=KMODEL(/1)
  310.         DO ISZACC=1,NSZACC
  311.           IMODEL=KMODEL(ISZACC)
  312.           IF (IMAMOD.EQ.IMACHA)GOTO 1
  313.         END DO
  314.         CALL ERREUR(740)
  315.         GOTO 9997
  316.  1      MINTEF=MINTAC(ISZACC)
  317.         MMODE1.KMODEL(ISOUCF)=IMODEL
  318.         MCHEL1.CONCHE(ISOUCF)=CONMOD
  319.         DO J=1,N3
  320.           MCHEL1.INFCHE(ISOUCF,J)=INFCHE(ICHAMC,J)
  321.         END DO
  322.       END DO
  323.  
  324. *  fin de la 2-eme boucle sur les zones effectives (NZONEF)
  325.  
  326. C
  327. C     PREPARATION DE NOTYPE POUR LE CHAMP A MOYENNER
  328. C
  329.       NBTYPE=1
  330.       SEGINI,NOTYPE
  331.       TYPE(1)='REAL*8'
  332. C
  333. C     ON VERIFIE LA COMPATIBILITE DES SUPPORTS GEOMETRIQUES ET
  334. C     QUE LES COMPOSANTES NECESSAIRES EXISTENT SUR TOUTES LES
  335. C     ZONE EFFECTIVES
  336. C
  337.  
  338. *  3-eme boucle sur les zones effectives (NZONEF)
  339.  
  340.       MMODEL=MMODE1
  341.       DO ISOUCF=1,NZONEF
  342.         NLOC2=ILOC2(ISOUCF)
  343.         IMODEL=KMODEL(ISOUCF)
  344.         CONM=CONMOD
  345.         IPMAIL=IMAMOD
  346.         CALL IDENT(IPMAIL,CONM,IPCHI,MCHEL1,INFOS,IRTD)
  347.         IF(IRTD .NE. 1)THEN
  348.           CALL ERREUR(741)
  349.           GOTO 9996
  350.         ENDIF
  351.  
  352. *  ON RECUPERE 'LVIA'
  353.  
  354.         MLMOTS=INFMOD(14)
  355.         SEGACT,MLMOTS
  356.         NBROBL=MOTS(/2)
  357.  
  358. *  DANS LE CAS 'SB' ON COMPLETE LE LISTMOTS SI BESOIN
  359.  
  360.  
  361. *  ON CREE LE NOMID ASSOCIE ET ON LE STOCKE DANS NLOC2
  362.  
  363.         NBRFAC=0
  364.         SEGINI,NOMID
  365.         MOMOTS=NOMID
  366.         DO IE1=1,NBROBL
  367.           LESOBL(IE1)=MOTS(IE1)
  368.         END DO
  369.         MOLOC2(ISOUCF)=MOMOTS
  370.  
  371.         INLOC=-1*INFMOD(13)
  372.         IF(INLOC.EQ.2.AND.NBROBL.EQ.1) THEN
  373.           NBROBL=15
  374.           SEGADJ, NOMID
  375.           LESOBL(2) ='SI11';
  376.           LESOBL(3) ='SI22';
  377.           LESOBL(4) ='SI33';
  378.           LESOBL(5) ='COX1';
  379.           LESOBL(6) ='COY1';
  380.           LESOBL(7) ='COZ1';
  381.           LESOBL(8) ='COX2';
  382.           LESOBL(9) ='COY2';
  383.           LESOBL(10)='COZ2';
  384.           LESOBL(11)='COX3';
  385.           LESOBL(12)='COY3';
  386.           LESOBL(13)='COZ3';
  387.           LESOBL(14)='SBFT';
  388.           LESOBL(15)='LONG';
  389.         ENDIF
  390.  
  391.  
  392. *  ON PEUT ALORS VERIFIER LA PRESENCE DES COMPOSANTES NECESSAIRES
  393.  
  394.         CALL KOMCHA(IPCHI,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  395.      >                                      INFOS,3,IVAMOT)
  396.         IF (IERR .NE. 0) THEN
  397.           CALL ERREUR(742)
  398.           GOTO 9996
  399.         ENDIF
  400.         MPTVAL=IVAMOT
  401.         NCOMP=IVAL(/1)
  402.         SEGINI,NLOC3
  403.         ILOC3I=NLOC3
  404.         DO ICOMP=1,NCOMP
  405.           MELVAC(ICOMP)=IVAL(ICOMP)
  406.         END DO
  407.         SEGSUP,MPTVAL
  408.       END DO
  409.  
  410. *  fin de la 3-eme boucle sur les zones effectives (NZONEF)
  411.  
  412. C
  413. C     ON VERIFIE QUE LES MINTE EXISTENT ET QU'ILS SONT AUX PT DE GAUSS
  414. C     POUR LE CHAMP A MOYENNER
  415. C
  416.  
  417. *  4-eme boucle sur les zones effectives (NZONEF)
  418.  
  419.       MCHEL2=IPCHI
  420.       DO ISOUCF=1,NZONEF
  421.         IMODEL=KMODEL(ISOUCF)
  422.         CONM=CONMOD
  423.         IPMAIL=IMAMOD
  424.         DO J=1,MCHEL2.CONCHE(/2)
  425.           IF((MCHEL2.CONCHE(J).EQ.CONM)
  426.      >    .AND.(MCHEL2.IMACHE(J).EQ.IPMAIL))THEN
  427.             IF((MCHEL2.INFCHE(J,4).EQ.0)
  428.      >      .OR.(MCHEL2.INFCHE(J,6).NE.5))THEN
  429.               CALL ERREUR(745)
  430.               GOTO 9996
  431.             ENDIF
  432.           ENDIF
  433.         END DO
  434.       END DO
  435.  
  436. *  fin de la 4-eme boucle sur les zones effectives (NZONEF)
  437.  
  438. C
  439. C     ON CONTINUE LA VERIFICATION DU MCHELM DES
  440. C     CONNECTIVITES
  441. C     ON CONTINUE DE REMPLIR NLOC2 ET ON CREE ET REMPLIT LES NLOC4
  442. C     PAR OUVERTURE/FERMETURE DE MELVAL
  443. C
  444.  
  445. *  5-eme boucle sur les zones effectives (NZONEF)
  446.  
  447.       DO ISOUCF=1,NZONEF
  448.         NLOC2=ILOC2(ISOUCF)
  449.         NDOUBL=MPCHAM(/1)
  450.         DO IDOUBL=1,NDOUBL
  451.           ICHAMC=MPCHAM(IDOUBL)
  452.           CONM=CONCHE(ICHAMC)
  453.           SEGINI,NLOC4
  454.           ILOC4(IDOUBL)=NLOC4
  455.           DO ICLE=1,NCLE
  456.             IF(CONM(13:16) .EQ. MCLE(ICLE))GOTO 2
  457.           END DO
  458.           CALL ERREUR(746)
  459.           GOTO 9996
  460.  2        JCLE=ICLE
  461.           MCHAML=ICHAML(ICHAMC)
  462.           NCOMP=IELVAL(/1)
  463.           GOTO (11,12,13,14,15),ICLE
  464. C      NORM
  465.  11         CONTINUE
  466.             IF(NCOMP.NE.4)GOTO 16
  467.             GOTO 17
  468. C      TRAN
  469.  12         CONTINUE
  470.             IF(NCOMP.NE.5)GOTO 16
  471.             IF (NOMCHE(5).NE.'POT1')THEN
  472.               MOTERR(1:4)='POT1'
  473.               MOTERR(13:16)='TRAN'
  474.               CALL ERREUR(743)
  475.               GOTO 9996
  476.             ENDIF
  477.             IF (TYPCHE(5).NE.'POINTEURPOINT   ')THEN
  478.               MOTERR(1:4)='POT1'
  479.               MOTERR(5:12)='POINT   '
  480.               MOTERR(13:16)='TRAN'
  481.               CALL ERREUR(744)
  482.               GOTO 9996
  483.             ENDIF
  484.             MELVAL=IELVAL(5)
  485.             JPT1=IELCHE(1,1)
  486.             CALL LOADPO(JPT1,PT1)
  487.             GOTO 17
  488. C      POIN
  489.  13         CONTINUE
  490.             IF(NCOMP.NE.5)GOTO 16
  491.             IF (NOMCHE(5).NE.'POT1')THEN
  492.               MOTERR(1:4)='POT1'
  493.               MOTERR(13:16)='POIN'
  494.               CALL ERREUR(743)
  495.               GOTO 9996
  496.             ENDIF
  497.             IF (TYPCHE(5).NE.'POINTEURPOINT   ')THEN
  498.               MOTERR(1:4)='POT1'
  499.               MOTERR(5:12)='POINT   '
  500.               MOTERR(13:16)='POIN'
  501.               CALL ERREUR(744)
  502.               GOTO 9996
  503.             ENDIF
  504.             MELVAL=IELVAL(5)
  505.             JPT1=IELCHE(1,1)
  506.             CALL LOADPO(JPT1,PT1)
  507.             GOTO 17
  508. C      DROI
  509.  14         CONTINUE
  510.             IF(NCOMP.NE.6)GOTO 16
  511.             IF (NOMCHE(5).NE.'POT1')THEN
  512.               MOTERR(1:4)='POT1'
  513.               MOTERR(13:16)='DROI'
  514.               CALL ERREUR(743)
  515.               GOTO 9996
  516.             ENDIF
  517.             IF (TYPCHE(5).NE.'POINTEURPOINT   ')THEN
  518.               MOTERR(1:4)='POT1'
  519.               MOTERR(5:12)='POINT   '
  520.               MOTERR(13:16)='DROI'
  521.               CALL ERREUR(744)
  522.               GOTO 9996
  523.             ENDIF
  524.             MELVAL=IELVAL(5)
  525.             JPT1=IELCHE(1,1)
  526.             CALL LOADPO(JPT1,PT1)
  527.             IF (NOMCHE(6).NE.'POT2')THEN
  528.               MOTERR(1:4)='POT2'
  529.               MOTERR(13:16)='DROI'
  530.               CALL ERREUR(743)
  531.               GOTO 9996
  532.             ENDIF
  533.             IF (TYPCHE(6).NE.'POINTEURPOINT   ')THEN
  534.               MOTERR(1:4)='POT2'
  535.               MOTERR(5:12)='POINT   '
  536.               MOTERR(13:16)='DROI'
  537.               CALL ERREUR(744)
  538.               GOTO 9996
  539.             ENDIF
  540.             MELVAL=IELVAL(6)
  541.             JPT2=IELCHE(1,1)
  542.             CALL LOADPO(JPT2,PT2)
  543.             GOTO 17
  544. C      PLAN
  545.  15         CONTINUE
  546.             IF(NCOMP.NE.6)GOTO 16
  547.             IF (NOMCHE(5).NE.'POT1')THEN
  548.               MOTERR(1:4)='POT1'
  549.               MOTERR(13:16)='PLAN'
  550.               CALL ERREUR(743)
  551.               GOTO 9996
  552.             ENDIF
  553.             IF (TYPCHE(5).NE.'POINTEURPOINT   ')THEN
  554.               MOTERR(1:4)='POT1'
  555.               MOTERR(5:12)='POINT   '
  556.               MOTERR(13:16)='PLAN'
  557.               CALL ERREUR(744)
  558.               GOTO 9996
  559.             ENDIF
  560.             MELVAL=IELVAL(5)
  561.             JPT1=IELCHE(1,1)
  562.             CALL LOADPO(JPT1,PT1)
  563.             IF (NOMCHE(6).NE.'DISP')THEN
  564.               MOTERR(1:4)='DISP'
  565.               MOTERR(13:16)='PLAN'
  566.               CALL ERREUR(743)
  567.               GOTO 9996
  568.             ENDIF
  569.             IF (TYPCHE(6).NE.'REAL*8')THEN
  570.               MOTERR(1:4)='DISP'
  571.               MOTERR(5:12)='FLOTTANT'
  572.               MOTERR(13:16)='PLAN'
  573.               CALL ERREUR(744)
  574.               GOTO 9996
  575.             ENDIF
  576.             MELVAL=IELVAL(6)
  577.             DISP=VELCHE(1,1)
  578.             GOTO 17
  579. C
  580.  16       CONTINUE
  581.           CALL ERREUR(734)
  582.           GOTO 9996
  583. C
  584.  17       CONTINUE
  585.           IF (NOMCHE(3).NE.'NPNI')THEN
  586.             MOTERR(1:4)='NPNI'
  587.             CALL ERREUR(734)
  588.             GOTO 9996
  589.           ENDIF
  590.           IF (TYPCHE(3).NE.'POINTEURLISTENTI')THEN
  591.             MOTERR(1:4)='NPNI'
  592.             MOTERR(5:12)='LISTENTI'
  593.             CALL ERREUR(736)
  594.             GOTO 9996
  595.           ENDIF
  596.           MELPNI=IELVAL(3)
  597.           IF (NOMCHE(4).NE.'NPLI')THEN
  598.             MOTERR(1:4)='NPLI'
  599.             CALL ERREUR(734)
  600.             GOTO 9996
  601.           ENDIF
  602.           IF (TYPCHE(4).NE.'POINTEURLISTENTI')THEN
  603.             MOTERR(1:4)='NPLI'
  604.             MOTERR(5:12)='LISTENTI'
  605.             CALL ERREUR(736)
  606.             GOTO 9996
  607.           ENDIF
  608.           MELPLI=IELVAL(4)
  609.         END DO
  610.       END DO
  611.  
  612. *  fin de la 5-eme boucle sur les zones effectives (NZONEF)
  613.  
  614. C
  615. C     ON VERIFIE QUE SUR CHAQUE SS-ZONE EFFECTIVE ON A UN ICLE=1 ET
  616. C     UN SEUL
  617. C
  618.  
  619. *  6-eme boucle sur les zones effectives (NZONEF)
  620.  
  621.       DO ISOUCF=1,NZONEF
  622.         NLOC2=ILOC2(ISOUCF)
  623.         NDOUBL=ILOC4(/1)
  624.         KCLE=0
  625.         DO IDOUBL=1,NDOUBL
  626.           NLOC4=ILOC4(IDOUBL)
  627.           IF(JCLE.EQ.1)KCLE=KCLE+1
  628.         END DO
  629.         IF(KCLE.EQ.0)THEN
  630.           CALL ERREUR(747)
  631.           GOTO 9996
  632.         ENDIF
  633.         IF(KCLE.GT.1)THEN
  634.           CALL ERREUR(748)
  635.           GOTO 9996
  636.         ENDIF
  637.       END DO
  638.  
  639. *  fin de la 6-eme boucle sur les zones effectives (NZONEF)
  640.  
  641. C
  642. C     ON COPIE LE CHAMELEM A MOYENNER
  643. C
  644.       CALL COPIE8 (IPCHI,IPCHO)
  645. C
  646. C     ON FINIT DE REMPLIR NLOC2 ET ON CREE ET REMPLIT LES NLOC3
  647. C     LES MELVAL RESULTATS DE MOYENNE CONSTANT SONT SEGADJUSTES
  648. C
  649.  
  650. *  7-eme boucle sur les zones effectives (NZONEF)
  651.  
  652.       DO ISOUCF=1,NZONEF
  653.         NLOC2=ILOC2(ISOUCF)
  654.         MOMOTS=MOLOC2(ISOUCF)
  655. C
  656.         MMODEL=MODLAC
  657.         NSZACC=KMODEL(/1)
  658.         DO ISZACC=1,NSZACC
  659.           IMODEL=KMODEL(ISZACC)
  660.           CONM=CONMOD
  661.           IPMAIL=IMAMOD
  662.           CALL IDENT(IPMAIL,CONM,IPCHI,MCHEL1,INFOS,IRTD)
  663.           CALL KOMCHA(IPCHI,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  664.      >                                      INFOS,3,IVAMOT)
  665.           MPTVAL=IVAMOT
  666.           NCOMP=IVAL(/1)
  667.           SEGINI,NLOC3
  668.           ILOC3(ISZACC)=NLOC3
  669.           DO ICOMP=1,NCOMP
  670.             MELVAC(ICOMP)=IVAL(ICOMP)
  671.           END DO
  672.           SEGSUP,MPTVAL
  673.         END DO
  674. C
  675.         IMODEL=MMODE1.KMODEL(ISOUCF)
  676.         CONM=CONMOD
  677.         IPMAIL=IMAMOD
  678.         CALL IDENT(IPMAIL,CONM,IPCHO,MCHEL1,INFOS,IRTD)
  679.         CALL KOMCHA(IPCHO,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  680.      >                                      INFOS,3,IVAMOT)
  681.         MPTVAL=IVAMOT
  682.         NCOMP=IVAL(/1)
  683.         SEGINI,NLOC3
  684.         ILOC3O=NLOC3
  685.         DO ICOMP=1,NCOMP
  686.           MELVAC(ICOMP)=IVAL(ICOMP)
  687.         END DO
  688.         SEGSUP,MPTVAL
  689. C
  690.         IPT1=IPMAIL
  691.         N1EL=IPT1.NUM(/2)
  692.         MINTE=MINTEF
  693.         N1PTEL=POIGAU(/1)
  694.         DO ICOMP=1,NCOMP
  695.           MELVAL=MELVAC(ICOMP)
  696. C    SI LE CHAMP N"EST PAS DANS SES BORNES ...
  697.           IF((VELCHE(/1).NE.N1PTEL).OR.(VELCHE(/2).NE.N1EL))THEN
  698. C    ... IL EST CONSTANT
  699.             IF((VELCHE(/1).EQ.1).AND.(VELCHE(/2).EQ.1))THEN
  700. * PP 15/6/93
  701.               N2PTEL=IELCHE(/1)
  702.               N2EL=IELCHE(/2)
  703.               SEGADJ,MELVAL
  704.               XELCHE=VELCHE(1,1)
  705.               DO I1EL=1,N1EL
  706.                 DO I1PTEL=1,N1PTEL
  707.                   VELCHE(I1PTEL,I1EL)=XELCHE
  708.                 END DO
  709.               END DO
  710. C    ... OU IL EST CONSTANT PAR ELEMENT
  711.             ELSE IF (VELCHE(/1).EQ.1)THEN
  712.               IF(VELCHE(/2).NE.N1EL)THEN
  713.                 CALL ERREUR(749)
  714.                 GOTO 9995
  715.               ENDIF
  716. * PP 15/6/93
  717.               N2PTEL=IELCHE(/1)
  718.               N2EL=IELCHE(/2)
  719.               SEGADJ MELVAL
  720.               DO I1EL=1,N1EL
  721.                 XELCHE=VELCHE(1,I1EL)
  722.                 DO I1PTEL=1,N1PTEL
  723.                    VELCHE(I1PTEL,I1EL)=XELCHE
  724.                 END DO
  725.               END DO
  726. C    ... OU IL EST ERRONE
  727.             ELSE
  728.               CALL ERREUR(750)
  729.               GOTO 9995
  730.             ENDIF
  731.           ENDIF
  732.         END DO
  733.       END DO
  734.  
  735. *  fin de la 7-eme boucle sur les zones effectives (NZONEF)
  736.  
  737.  
  738. C
  739. C     ON SORT (SANS ERREUR ???)
  740. C
  741.       DO ISOUCF=1,NZONEF
  742.         NOMID=MOLOC2(ISOUCF)
  743.         SEGSUP,NOMID
  744.       ENDDO
  745.       SEGSUP,NOTYPE
  746.       SEGSUP,MCHEL1
  747.       SEGSUP,MMODE1
  748.       IRET=1
  749.       RETURN
  750. C
  751. C     TRAITEMENT DES ERREURS
  752. C
  753. 9995  CONTINUE
  754.       CALL DTCHEL(IPCHO)
  755. 9996  CONTINUE
  756.       DO ISOUCF=1,NZONEF
  757.         NLOC2=ILOC2 (ISOUCF)
  758.         NDOUBL=ILOC4(/1)
  759.         DO IDOUBL=1,NDOUBL
  760.           IF(ILOC4(IDOUBL).NE.0)THEN
  761.             NLOC4=ILOC4(IDOUBL)
  762.             SEGSUP,NLOC4
  763.           ENDIF
  764.         END DO
  765.         NSZACC=ILOC3(/1)
  766.         DO ISZACC=1,NSZACC
  767.           IF(ILOC3(ISZACC).NE.0)THEN
  768.             NLOC3=ILOC3(ISZACC)
  769.             SEGSUP,NLOC3
  770.           END IF
  771.         END DO
  772.         IF (ILOC3O.NE.0)THEN
  773.           NLOC3=ILOC3O
  774.           SEGSUP,NLOC3
  775.         END IF
  776.         IF (ILOC3I.NE.0)THEN
  777.           NLOC3=ILOC3I
  778.           NCOMP=MELVAC(/1)
  779.           DO ICOMP=1,NCOMP
  780.             MELVAL=MELVAC (ICOMP)
  781.           END DO
  782.           SEGSUP,NLOC3
  783.         ENDIF
  784.       END DO
  785. 9997  CONTINUE
  786.       NOMID=MOMOTS
  787.       SEGSUP,NOMID,NOTYPE
  788.       SEGSUP,MCHEL1
  789.       SEGSUP,MMODE1
  790. 9998  CONTINUE
  791.       DO ISOUCF=1,NZONEF
  792.         NLOC2=ILOC2 (ISOUCF)
  793.         MELEME=MAILEF
  794.         MMODEL=MODLAC
  795.         NSZACC=KMODEL(/1)
  796.         DO ISZACC=1,NSZACC
  797.           MINTE=MINTAC(ISZACC)
  798.           IMODEL=KMODEL(ISZACC)
  799.         END DO
  800.       END DO
  801.       DO ISOUCF=1,NZONEF
  802.         NLOC2=ILOC2 (ISOUCF)
  803.         MMODEL=MODLAC
  804.         SEGSUP,NLOC2
  805.       END DO
  806.       SEGSUP,NLOC1
  807. 9999  CONTINUE
  808.       DO ISOUCO=1,NSOUCO
  809.         MCHAML=ICHAML(ISOUCO)
  810.       END DO
  811. C
  812.       IRET=0
  813.  
  814.       RETURN
  815.       END
  816.  
  817.  
  818.  
  819.  

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