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

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