Télécharger la plaquette Cast3M


fr en

Télécharger sensi1.eso

Retour à la liste

Numérotation des lignes : 

sensi1

  1. C SENSI1    SOURCE    OF166741  25/02/21    21:18:31     12166          
  2. *
  3. *     BOUCLE SUR LES SOUS ZONES (1 SEUL ELEMENT PAR SOUS ZONE )
  4. *     LELEU DIDIER HAZE FREDERIC
  5. *     03/03/93
  6. *     EXTRAIT DE ADCHEL.ESO
  7. *
  8.       SUBROUTINE SENSI1(IPCHE1,IPCHE2,MTAB1)
  9. *
  10. *     ENTREE :
  11. *     --------
  12. *        IPCHE1  POINTEUR SUR LE PREMIER CHAMP (TYPE MCHAML)
  13. *        IPCHE2  POINTEUR SUR LE DEUXIEME CHAMP (TYPE MCHALM)
  14. *
  15. *     SORTIE :
  16. *     ________
  17. *
  18. *        MTAB1  POINTEUR SUR LA TABLE DERIVEES (TYPE TABLE)
  19. *                = 0  SI L OPERATION EST IMPOSSIBLE
  20. *
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26.  
  27. -INC SMCOORD
  28. -INC SMCHAML
  29. -INC SMTABLE
  30.  
  31. -INC TMPTVAL
  32.  
  33.       SEGMENT MZONG
  34.          INTEGER NZONG(0)
  35.       ENDSEGMENT
  36. *
  37.       SEGMENT MZON1
  38.          INTEGER NZON1(0)
  39.       ENDSEGMENT
  40. *
  41.       SEGMENT MZON2
  42.          INTEGER NZON2(0)
  43.       ENDSEGMENT
  44. *
  45.       SEGMENT ITAFF
  46.          INTEGER JTAFF(0)
  47.       ENDSEGMENT
  48.  
  49.       REAL*8 MOYS,A
  50.       CHARACTER*2 B
  51.       LOGICAL C
  52.  
  53.       PARAMETER ( NINF=3 )
  54.       INTEGER INFOS(NINF)
  55.       CHARACTER*72 MOT
  56.       CHARACTER*16 CONCH1,CONCH2
  57. *
  58.       A=0.D0
  59.       B='  '
  60.       C=.FALSE.
  61.       IOBIN=0
  62.       IVALRE=0
  63.       IB=0
  64.  
  65.       MCHEL1=IPCHE1
  66.       MCHEL2=IPCHE2
  67.       SEGACT MCHEL1
  68.       SEGACT MCHEL2
  69. *
  70.       L1=MCHEL1.TITCHE(/1)
  71.       MOT=MCHEL1.TITCHE
  72.       IF (MOT.EQ.'NOEUD'.OR.MOT.EQ.'GRAVITE'.OR.MOT.EQ.'RIGIDITE'.
  73.      &    OR.MOT.EQ.'MASSE'.OR.MOT.EQ.'STRESSES'.
  74.      &    OR.MOT.EQ.'SCALAIRE') THEN
  75.          MOT=MCHEL2.TITCHE
  76.          L1=MCHEL2.TITCHE(/1)
  77.       ENDIF
  78.       N3=MCHEL1.INFCHE(/2)
  79.       NSOUS1=MCHEL1.ICHAML(/1)
  80.       NSOUS2=MCHEL2.ICHAML(/1)
  81. *
  82. * QUELLES BIJECTIONS ENTRE LES SOUS PAQUETS  SI OUI TRAITEMENT AMELIORE
  83. *
  84. *
  85.       SEGINI ITAFF
  86.       DO 17 ISOUS1=1,NSOUS1
  87.          IPMAI1 = MCHEL1.IMACHE(ISOUS1)
  88.          CONCH1  = MCHEL1.CONCHE(ISOUS1)
  89.          DO 18 ISOUS2=1,NSOUS2
  90.             ISOUS=ISOUS2
  91.             IPMAI2= MCHEL2.IMACHE(ISOUS)
  92.             CONCH2= MCHEL2.CONCHE(ISOUS)
  93.             IF(IPMAI1.EQ.IPMAI2.AND.CONCH1.EQ.CONCH2) THEN
  94. *
  95. *              VERIFICATION POUR LES INFCHE
  96. *
  97.                CALL IDENT (IPMAI1,CONCH1,IPCHE1,IPCHE2,INFOS,IRTD)
  98.                IF (IRTD.EQ.0) GOTO 18
  99.                IMINT1=MCHEL1.INFCHE(ISOUS1,4)
  100.                IMINT2=MCHEL2.INFCHE(ISOUS2,4)
  101.                IF (IMINT1.EQ.IMINT2) GOTO 171
  102.                IMINT1=MCHEL1.INFCHE(ISOUS1,6)
  103.                IMINT2=MCHEL2.INFCHE(ISOUS2,6)
  104.                IF (IMINT1.EQ.IMINT2) GOTO 171
  105. *
  106. *              ERREUR IMPOSSIBLE D ADDITIONNER DES CHPS/ELMTS
  107. *              DE SS TYPE DIFFERENTS
  108. *
  109.                MOTERR(1:8)=MCHEL1.TITCHE
  110.                MOTERR(9:16)=MCHEL2.TITCHE
  111.                CALL ERREUR(329)
  112.                SEGDES MCHEL1,MCHEL2
  113.                SEGSUP ITAFF
  114.                IPCHAD=0
  115.                RETURN
  116.             ENDIF
  117.   18     CONTINUE
  118.          SEGSUP ITAFF
  119.          GOTO 4000
  120. *
  121.   171    CONTINUE
  122.          JTAFF(**)=MCHEL2.ICHAML(ISOUS)
  123.   17  CONTINUE
  124. *
  125. *     ON A TROUVE UNE BIJECTION   ET ON VECTORISE
  126. *
  127.       N1=NSOUS1
  128.       SEGINI MCHELM
  129.       TITCHE=MOT
  130.       IFOCHE=IFOUR
  131.        M=NSOUS1+1
  132.       SEGINI MTABLE
  133.       MLOTAB=0
  134.       DO 400 ISOUS=1,NSOUS1
  135.          IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)
  136.          CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)
  137.          DO 401 N33=1,N3
  138.             INFCHE(ISOUS,N33)=MCHEL1.INFCHE(ISOUS,N33)
  139.  401     CONTINUE
  140. *
  141.          MCHAM1=MCHEL1.ICHAML(ISOUS)
  142. *
  143.          SEGINI,MCHAML=MCHAM1
  144.          ICHAML(ISOUS)=MCHAML
  145.          IPCHA=MCHAML
  146. *
  147.          MCHAM2=JTAFF(ISOUS)
  148.          SEGACT MCHAM2
  149.          IPCHA2=MCHAM2
  150. *
  151.          CALL SENSI2 (IPCHA2,IPCHA,MOYS)
  152.          CALL ECCTAB(MTABLE,'ENTIER',ISOUS,A,B,C
  153.      &           ,IOBIN,'FLOTTANT',IB,MOYS,B,
  154.      &           C,IOBIN)
  155. *
  156.          MOYS=0.D0
  157.          IF (IPCHA.EQ.0) THEN
  158.             SEGSUP ITAFF
  159.             GOTO 9990
  160.          ENDIF
  161. *
  162.          SEGDES MCHAML,MCHAM2
  163.   400 CONTINUE
  164.       MTAB1=MTABLE
  165.       SEGDES MCHEL1,MCHEL2
  166.       SEGSUP ITAFF
  167.       SEGDES MCHELM
  168.       GOTO 666
  169. *_______________________________________________________________________
  170. *
  171. *     ON A PAS TROUVE DE BIJECTION
  172. *_______________________________________________________________________
  173. *
  174.  4000 CONTINUE
  175.       SEGINI MZONG,MZON1,MZON2
  176.       DO 500 ISOUS1=1,NSOUS1
  177.          NZONG(**)=MCHEL1.IMACHE(ISOUS1)
  178.          NZON1(**)=ISOUS1
  179.          NZON2(**)=0
  180.   500 CONTINUE
  181.       IWRN=0
  182.       DO 510 ISOUS2=1,NSOUS2
  183.          IPMAI2 = MCHEL2.IMACHE(ISOUS2)
  184.          CONCH2 = MCHEL2.CONCHE(ISOUS2)
  185.          DO 520 ISOUS1=1,NSOUS1
  186.             IPMAI1= MCHEL1.IMACHE(ISOUS1)
  187.             CONCH1= MCHEL1.CONCHE(ISOUS1)
  188.             IF(IPMAI1.EQ.IPMAI2 .AND.CONCH1.EQ.CONCH2) THEN
  189.                CALL IDENT (IPMAI1,CONCH1,IPCHE1,IPCHE2,INFOS,IRTD)
  190.                IF (IRTD.EQ.0) GOTO 520
  191. *
  192. *              VERIFICATION POUR LES MINTES
  193. *
  194.                IF ( MCHEL1.INFCHE(ISOUS1,4).EQ.
  195.      &              MCHEL2.INFCHE(ISOUS2,4) ) GOTO 530
  196. *
  197. *              ERREUR SUR LES SUPPORTS DES MCHAML
  198. *
  199.                MOTERR(1:8)=MCHEL1.TITCHE
  200.                MOTERR(9:16)=MCHEL2.TITCHE
  201.                CALL ERREUR(329)
  202.                IPCHAD=0
  203.                SEGDES MCHEL1,MCHEL2
  204.                SEGSUP MZONG,MZON1,MZON2
  205.                RETURN
  206. *
  207.             ENDIF
  208.   520    CONTINUE
  209.          IWRN=1
  210.          NZONG(**)=IPMAI2
  211.          NZON1(**)=0
  212.          NZON2(**)=ISOUS2
  213.          GOTO 510
  214. *
  215.   530    CONTINUE
  216.          NZON2(ISOUS1)=ISOUS2
  217.   510 CONTINUE
  218. *
  219. *   WARNING  LES SOUS ZONES GEOMETRIQUES NE SE CORRESPONDENT PAS 2 A 2
  220. *
  221.       IF(IWRN.EQ.1)  CALL ERREUR(103)
  222.       NSOUS=NZONG(/1)
  223.       N1=NSOUS
  224.       SEGINI MCHELM
  225.       TITCHE=MOT
  226.       IFOCHE=IFOUR
  227.       IPCHAD=MCHELM
  228. *
  229.       DO 540 ISOUS=1,NSOUS
  230.          IF(NZON1(ISOUS).NE.0.AND.NZON2(ISOUS).NE.0) GOTO 550
  231. *
  232.          IF(NZON1(ISOUS).NE.0) THEN
  233.             MCHAM1=MCHEL1.ICHAML( NZON1(ISOUS) )
  234.             SEGINI,MCHAML=MCHAM1
  235.             IMACHE(ISOUS)=NZONG(ISOUS)
  236.             CONCHE(ISOUS)=MCHEL1.CONCHE( NZON1(ISOUS) )
  237.  
  238.             DO 402 N33=1,N3
  239.                INFCHE(ISOUS,N33)=MCHEL1.INFCHE(NZON1(ISOUS),N33)
  240.  402        CONTINUE
  241. *
  242.          ENDIF
  243.          IF(NZON2(ISOUS).NE.0) THEN
  244.             MCHAM2=MCHEL2.ICHAML( NZON2(ISOUS) )
  245.             SEGINI,MCHAML=MCHAM2
  246.             IMACHE(ISOUS)=NZONG(ISOUS)
  247.             CONCHE(ISOUS)=MCHEL2.CONCHE( NZON2(ISOUS) )
  248.  
  249.             DO 403 N33=1,N3
  250.                INFCHE(ISOUS,N33)=MCHEL2.INFCHE(NZON2(ISOUS),N33)
  251.  403        CONTINUE
  252. *
  253.          ENDIF
  254.          ICHAML(ISOUS)=MCHAML
  255. *
  256.          DO 175 ICOMP=1,IELVAL(/1)
  257.             MELVA1=IELVAL(ICOMP)
  258.             SEGINI,MELVAL=MELVA1
  259.             IELVAL(ICOMP)=MELVAL
  260.             SEGDES MELVAL
  261.  175     CONTINUE
  262.          SEGDES MCHAML
  263. *
  264.          GOTO 540
  265. *
  266.   550    CONTINUE
  267.          MCHAM1=MCHEL1.ICHAML( NZON1(ISOUS) )
  268.          SEGINI,MCHAML=MCHAM1
  269.          IMACHE(ISOUS)=NZONG(ISOUS)
  270.          CONCHE(ISOUS)=MCHEL1.CONCHE( NZON1(ISOUS) )
  271.  
  272.          DO 404 N33=1,N3
  273.             INFCHE(ISOUS,N33)=MCHEL1.INFCHE(NZON1(ISOUS),N33)
  274.  404     CONTINUE
  275.          ICHAML(ISOUS)=MCHAML
  276.          IPCHA=MCHAML
  277.          MCHAM2=MCHEL2.ICHAML( NZON2(ISOUS) )
  278.          SEGACT MCHAM2
  279.          IPCHA2=MCHAM2
  280. *
  281.          CALL SENSI2 (IPCHA2,IPCHA,MOYS)
  282.          IF (IPCHA.EQ.0) THEN
  283.             SEGSUP MZONG,MZON1,MZON2
  284.             GOTO 9990
  285.          ENDIF
  286. *
  287.          SEGDES MCHAML,MCHAM2
  288.   540 CONTINUE
  289.       SEGDES MCHELM
  290. *
  291.       SEGSUP MZONG,MZON1,MZON2
  292.       GOTO 666
  293. *
  294.  9990 CONTINUE
  295. *
  296. *     ERREUR DANS UNE SOUS ZONE : DESACTIVATION ET RETOUR
  297. *
  298.       SEGDES MCHEL1,MCHEL2,MCHAM2
  299.       SEGSUP MCHAML,MCHELM,ITAFF
  300.       IPCHAD=0
  301.       RETURN
  302. *
  303.   666 CONTINUE
  304.       SEGDES MCHEL1,MCHEL2
  305.   777 CONTINUE
  306.  
  307.       RETURN
  308.       END
  309.  
  310.  
  311.  

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