Télécharger changs.eso

Retour à la liste

Numérotation des lignes :

  1. C CHANGS SOURCE CHAT 05/01/12 21:55:38 5004
  2. C TRANSFORME LES T3 ENGENDRES PAR SURF EN T6 SUR LE PLAN LOCAL
  3. C TRANSFORME AUSSI LES Q4 EN Q8 ET LES T3 EN Q4 ET LES T3 EN Q8
  4. C
  5. SUBROUTINE CHANGS(NUMNP,NUMELG,ITY,IPT1,XPROJ,IPT5)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. -INC SMELEME
  9. SEGMENT XPROJ(N,1)
  10. -INC CCOPTIO
  11. SEGMENT NKON(IKOUR)
  12. SEGMENT KON(IKOUR,NKMAX,2)
  13. IF (IPT1.ITYPEL.EQ.ITY) RETURN
  14. IF (ITY.EQ.8) RETURN
  15. IF ((ITY.EQ.6.AND.IPT1.ITYPEL.EQ.4).OR.
  16. # (ITY.EQ.10.AND.IPT1.ITYPEL.EQ.4).OR.
  17. # (ITY.EQ.10.AND.IPT1.ITYPEL.EQ.8)) GOTO 10
  18. C ON CHANGE DES Q4 EN COUPLES DE T3
  19. NBELEM=2*NUMELG
  20. NUMELG=NBELEM
  21. NBNN=3
  22. NBSOUS=0
  23. NBREF=0
  24. SEGINI IPT2
  25. IPT2.ITYPEL=4
  26. DO 3 I=1,IPT1.NUM(/2),2
  27. J=2*I-1
  28. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  29. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  30. IPT2.NUM(3,J)=IPT1.NUM(3,I)
  31. J=J+1
  32. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  33. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  34. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  35. J=J+1
  36. IF (J.GT.IPT2.NUM(/2)) GOTO 3
  37. IPT2.NUM(1,J)=IPT1.NUM(1,I+1)
  38. IPT2.NUM(2,J)=IPT1.NUM(2,I+1)
  39. IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
  40. J=J+1
  41. IPT2.NUM(1,J)=IPT1.NUM(2,I+1)
  42. IPT2.NUM(2,J)=IPT1.NUM(3,I+1)
  43. IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
  44. 3 CONTINUE
  45. SEGSUP IPT1
  46. IPT1=IPT2
  47. IF (IPT1.ITYPEL.EQ.ITY) RETURN
  48. 10 CONTINUE
  49. C ON CHANGE LES T3 EN T6 OU LES Q4 EN Q8
  50. IKOUR=NUMNP
  51. SEGINI NKON
  52. DO 23 I=1,IKOUR
  53. 23 NKON(I)=0
  54. DO 24 I=1,IPT1.NUM(/1)
  55. DO 24 J=1,NUMELG
  56. IKL=IPT1.NUM(I,J)
  57. IF (IKL.EQ.0) GOTO 24
  58. NKON(IKL)=NKON(IKL)+1
  59. 24 CONTINUE
  60. NKMAX=0
  61. DO 25 I=1,IKOUR
  62. 25 NKMAX=MAX(NKMAX,NKON(I))
  63. 62 CONTINUE
  64. SEGINI KON
  65. DO 26 I=1,IKOUR
  66. DO 27 J=1,NKMAX
  67. KON(I,J,1)=0
  68. KON(I,J,2)=0
  69. 27 CONTINUE
  70. 26 CONTINUE
  71. IF (IPT5.EQ.0) GOTO 40
  72. SEGACT IPT5
  73. DO 31 J=1,IPT5.NUM(/2)
  74. I1=IPT5.NUM(1,J)
  75. I3=IPT5.NUM(3,J)
  76. J1=MIN(I1,I3)
  77. J3=MAX(I1,I3)
  78. ITF=0
  79. 32 ITF=ITF+1
  80. IF (ITF.GT.NKMAX) GOTO 61
  81. IF (KON(J1,ITF,1).EQ.0) GOTO 33
  82. IF (KON(J1,ITF,1).EQ.J3) GOTO 33
  83. GOTO 32
  84. 33 KON(J1,ITF,1)=J3
  85. KON(J1,ITF,2)=IPT5.NUM(2,J)
  86. 31 CONTINUE
  87. 40 CONTINUE
  88. NBELEM=NUMELG
  89. NBNN=IPT1.NUM(/1)*2
  90. NBSOUS=0
  91. NBREF=0
  92. SEGINI IPT2
  93. IPT2.ITYPEL=IPT1.ITYPEL+2
  94. NBNN1=NBNN/2
  95. DO 34 J=1,NBELEM
  96. DO 35 I=1,NBNN1
  97. IF (IPT1.NUM(I,J).EQ.0) GOTO 38
  98. IFI=I+1
  99. IF (IFI.EQ.NBNN1+1) IFI=1
  100. IF (IPT1.NUM(IFI,J).EQ.0) IFI=1
  101. IPT2.NUM(2*I-1,J)=IPT1.NUM(I,J)
  102. I1=IPT1.NUM(I,J)
  103. I2=IPT1.NUM(IFI,J)
  104. J1=MIN(I1,I2)
  105. J2=MAX(I1,I2)
  106. ITF=0
  107. 36 ITF=ITF+1
  108. IF (ITF.GT.NKMAX) GOTO 61
  109. IF (KON(J1,ITF,1).EQ.J2) GOTO 37
  110. IF (KON(J1,ITF,1).NE.0) GOTO 36
  111. KON(J1,ITF,1)=J2
  112. NUMNP=NUMNP+1
  113. IF (NUMNP.GT.XPROJ(/2)) CALL ERREUR(31)
  114. IF (IERR.NE.0) GOTO 1000
  115. XPROJ(1,NUMNP)=0.5*(XPROJ(1,I1)+XPROJ(1,I2))
  116. XPROJ(2,NUMNP)=0.5*(XPROJ(2,I1)+XPROJ(2,I2))
  117. XPROJ(3,NUMNP)=0.5*(XPROJ(3,I1)+XPROJ(3,I2))
  118. IF (XPROJ(/1).EQ.4)
  119. # XPROJ(4,NUMNP)=0.5*(XPROJ(4,I1)+XPROJ(4,I2))
  120. KON(J1,ITF,2)=NUMNP
  121. 37 IPT2.NUM(2*I,J)=KON(J1,ITF,2)
  122. GOTO 35
  123. 38 IPT2.NUM(2*I-1,J)=0
  124. IPT2.NUM(2*I,J)=0
  125. 35 CONTINUE
  126. 34 CONTINUE
  127. SEGSUP IPT1
  128. IPT1=IPT2
  129. 1000 SEGSUP KON,NKON,IPT5
  130. RETURN
  131. 61 SEGSUP KON
  132. NKMAX=NKMAX+1
  133. IF (IIMPI.NE.0) WRITE (IOIMP,2000) NKMAX
  134. 2000 FORMAT(/,' NOUVELLE VALEUR DE NKMAX TENTEE DANS CHANGS',I4)
  135. GOTO 62
  136. END
  137.  
  138.  
  139.  

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