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

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