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

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