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

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