Télécharger la plaquette Cast3M


fr en

Télécharger comsor.eso

Retour à la liste

Numérotation des lignes : 

comsor

  1. C COMSOR    SOURCE    MB234859  26/01/19    21:15:12     12454          
  2.  
  3. **********************************************************************
  4. * range les resultats du tableau wrk52 dans les melval
  5. **********************************************************************
  6.  
  7.       SUBROUTINE COMSOR(iqmod,ililuc,iwrk52,iwrk53,iwrk54,
  8.      &     ib,igau,iecou,xecou)
  9.  
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15.  
  16. -INC SMCHAML
  17. -INC SMMODEL
  18.  
  19. * segment deroulant le mcheml
  20. -INC DECHE
  21.  
  22. -INC TECOU
  23.  
  24.       CHARACTER*8  MOT8
  25.       CHARACTER*16 CFORMO
  26.       CHARACTER*(LCONMO) MOdec,MOmod
  27.       LOGICAL      BDIFF,LMELA
  28.  
  29.       imodel = iqmod
  30.       CFORMO =formod(1)
  31.       BDIFF  =CFORMO .eq. 'DIFFUSION       '
  32.       LMELA = CFORMO.eq.'MELANGE         '
  33.       liluc = ililuc
  34.       nbluc1 = liluc(/1)
  35.       wrk52 = iwrk52
  36.       wrk53 = iwrk53
  37.       wrk54 = iwrk54
  38.  
  39. *-------------------------------------------
  40. *     rearrangement pour milieu poreux
  41. *-------------------------------------------
  42.       IF (MFR.EQ.33.AND.MATE.EQ.1) THEN
  43.         ICAS=2
  44.         CALL COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,ICAS,IRETOU)
  45.       ENDIF
  46.  
  47.       DO 1000 INO = 1,NBLUC1
  48.         if (BDIFF) goto 47
  49.         if(LMELA.and.ino.eq.23) goto 47
  50. *tctc on ne garde que contraintes deformation defiela varinter
  51.         if(ino.ne.11.and.ino.ne.20.and.ino.ne.24.and.ino.ne.12.
  52.      $ and.ino.ne.13.and.ino.ne.14) go to 1000
  53.  47     continue
  54.         pilnec = liluc(ino,2)
  55.         if (pilnec.le.0) goto 1000
  56.         mran = pilobl(/2)
  57. * mran doit correspondre a indeso : indice du deche resultat
  58.         if (mran.le.0) goto 1000
  59.         mobl = pilobl(/1)
  60.         mfac = pilfac(/1)
  61.  
  62. C       ---------------------------------------------------------------
  63. C       COMPOSANTES OBLIGATOIRES
  64. C
  65.         if (mobl.le.0) goto 101
  66.         DO 100 IC = 1,MOBL
  67.           if (pilobl(ic,mran).gt.0) then
  68.             deche = pilobl(ic,mran)
  69. * on ne modifie que les champs lies au constituant
  70.  
  71. C           Pour optimisation COMPARE_STRING
  72.             MOdec=condec
  73.             MOmod=conmod
  74.             if (MOdec.ne.MOmod) goto 100
  75. C           Cas des MELVALS d'entree
  76.             IF(ieldec .LT. 0)GOTO 100
  77.             melval =ABS(ieldec)
  78.           else
  79.             goto 100
  80.           endif
  81. C
  82. C       AIGUILLAGE SUIVANT MOT CLE
  83. C
  84.         if (ino.gt.nmot) goto 98
  85.         GOTO ( 1, 2, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 17,18,
  86.      1        99,20,21,99,23,24,99) ino
  87. C
  88.   99      CONTINUE
  89. C
  90. C         Pas de composantes pour ce champ
  91.           RETURN
  92. C
  93.    1      CONTINUE
  94.           passe1 = scalf(ic)
  95.           GOTO 120
  96. C
  97.    2      CONTINUE
  98.           passe1 = tempf
  99.           GOTO 120
  100. C
  101.    6      CONTINUE
  102.           passe1 = deplf(ic)
  103.           GOTO 120
  104. C
  105.    7      CONTINUE
  106.           passe1 = forcf(ic)
  107.           GOTO 120
  108. C
  109.   10      CONTINUE
  110.           passe1 = gradf(ic)
  111.           GOTO 120
  112. C
  113.   11      CONTINUE
  114.           passe1 = SIGF(ic)
  115.           GOTO 120
  116. C
  117.   12      CONTINUE
  118.           passe1 = epstf(ic)
  119.           GOTO 120
  120. C
  121.   13      CONTINUE
  122.           passe1 = xmatf(ic)
  123.           GOTO 120
  124. C
  125.   14      CONTINUE
  126.           passe1 = xcarbf(ic)
  127.           GOTO 120
  128. C
  129.   15      CONTINUE
  130.           passe1 = turef(ic)
  131.           GOTO 120
  132. C
  133.   16      CONTINUE
  134.           passe1 = prinf(ic)
  135.           GOTO 120
  136. C
  137.   17      CONTINUE
  138.           passe1 = mahof(ic)
  139.           GOTO 120
  140. C
  141.   18      CONTINUE
  142.           passe1 = hotaf(ic)
  143.           GOTO 120
  144. C
  145.   20      CONTINUE
  146.           passe1 = VARF(ic)
  147.           GOTO 120
  148. C
  149.   21      CONTINUE
  150.           passe1 = graff(ic)
  151.           GOTO 120
  152. C
  153.   23      CONTINUE
  154.           passe1 = rhasf(ic)
  155.           GOTO 120
  156. C
  157.   24      CONTINUE
  158.           IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
  159.      &      .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66.OR.INPLAS.EQ.118
  160.      &      .OR.INPLAS.EQ.141.OR.INPLAS.EQ.176.OR.INPLAS.EQ.165
  161.      &      .OR.INPLAS.EQ.193.OR.INPLAS.EQ.194
  162.      &      .OR.INPLAS.EQ.195.OR.INPLAS.EQ.196)THEN
  163.              passe1 =EPINF(IC)
  164.           ELSE
  165.              passe1= epin0(ic) + defp(IC)
  166.           ENDIF
  167.           GOTO 120
  168. C
  169.   98      CONTINUE
  170.           passe1 = exova1(ic)
  171. C         GOTO 120
  172. *
  173.  120      CONTINUE
  174.  
  175.           if (typree) then
  176.             IBMN=MIN(IB,VELCHE(/2))
  177.             IGMN=MIN(IGAU,VELCHE(/1))
  178.             VELCHE(IGMN,IBMN)=passe1
  179.           else
  180.             iptz = int(passe1)
  181.             IGMN = IELCHE(/1)
  182.             IBMN = IELCHE(/2)
  183. *           kich un cas particulier --- plus difficile traiter cas general
  184.             if (iptz.eq.0 .and. IGMN.eq.1 .and. IBMN.eq.1) then
  185.               segsup melval
  186.               indec = -1
  187.               pilobl(ic,mran) = 0
  188.             else
  189.               IGMN = MIN(IGAU,IGMN)
  190.               IBMN = MIN(IB  ,IBMN)
  191.               IELCHE(IGMN,IBMN) = iptz
  192.             endif
  193.           endif
  194. C
  195.  100    CONTINUE
  196.  101    CONTINUE
  197. C       ---------------------------------------------------------------
  198. C       COMPOSANTES FACULTATIVES
  199. C
  200. *       if (mfac.le.0) goto 301
  201. * mran doit correspondre a indeso, indice du deche resultat
  202.         do 200 ic = 1,mfac
  203.           if (pilfac(ic,mran).gt.0) then
  204.             deche = pilfac(ic,mran)
  205.  
  206. C           Pour optimisation COMPARE_STRING
  207.             MOdec=condec
  208.             MOmod=conmod
  209.             if (MOdec.ne.MOmod) goto 200
  210. C           Cas des MELVALS d'entree
  211.             IF(ieldec .LT. 0)GOTO 200
  212.             melval =ABS(ieldec)
  213.           else
  214.             goto 200
  215.           endif
  216. *
  217. *       AIGUILLAGE SUIVANT MOT CLE
  218. *
  219.         GOTO ( 201,202,201,201,201,206, 207,299,299,210,211,
  220.      & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino
  221.         if (ino.gt.nmot) goto 298
  222. *
  223.  299      CONTINUE
  224. C
  225. C         Pas de composantes pour ce champ
  226.           RETURN
  227. C
  228.   201     CONTINUE
  229.           passe1 = scalf(mobl+ic)
  230.           GOTO 320
  231. C
  232.   202     CONTINUE
  233.           GOTO 320
  234. C
  235.   206     CONTINUE
  236.           passe1 = deplf(mobl+ic)
  237.           GOTO 320
  238. C
  239.   207     CONTINUE
  240.           passe1 = forcf(mobl+ic)
  241.           GOTO 320
  242. C
  243.   210     CONTINUE
  244.           passe1 = gradf(mobl+ic)
  245.           GOTO 320
  246. C
  247.   211     CONTINUE
  248.           passe1 = SIGF(mobl+ic)
  249.           GOTO 320
  250. C
  251.   212     CONTINUE
  252.           passe1 = epstf(mobl+ic)
  253.           GOTO 320
  254. C
  255.   213     CONTINUE
  256.           passe1 = xmatf(mobl+ic)
  257.           GOTO 320
  258. C
  259.   214     CONTINUE
  260.           passe1 = xcarbf(mobl+ic)
  261. c stockage du pas de temps optimal
  262.  
  263.         IF ( INPLAS .EQ. 17 .OR.
  264.      2   ( INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR.
  265.      4     INPLAS .EQ. 61 .OR. INPLAS .EQ. 53 .OR.
  266.      1     INPLAS .EQ. 65 .OR. INPLAS .EQ. 29 .OR.
  267.      1     INPLAS .EQ. 142 .OR.
  268.      2     INPLAS .EQ. 44 .OR. INPLAS .EQ. 45 .OR.
  269.      9     INPLAS .EQ. 76 .OR. INPLAS .EQ. 77  .OR.
  270.      9     INPLAS .EQ. 70 .OR. INPLAS .EQ. 165) THEN
  271.  
  272. C Remarque :
  273. C Le vecteur comcar est rempli par COMVAL : on note le nom de la
  274. C composante lors du premier passage (pour le premier point de Gauss
  275. C du premier element) en recopiant le nom que l'on trouve dans lesobl
  276. C (composante obligatoire) ou lesfac (composante facultative).
  277. C Les vecteurs lesobl et lesfac ont ete remplis par COMOU2 qui pour les
  278. C caracteristiques geometriques a appele IDCARB : en aucun cas on ne
  279. C trouve 'DTOPTI' parmi la liste des composantes geometriques reconnues.
  280. C Qui plus est elle constituerait une exception car 6 caracteres au lieu
  281. C des 4 habituels.
  282. C
  283. C Conclusion : LE TEST CI-DESSOUS if (comcar(mobl+ic).eq.'DTOPTI')
  284. C N'EST JAMAIS SATISFAIT, il n'y a pas stockage du pas de temps optimal.
  285. C
  286. C De plus, on n'a pas trouve de composante 'DTOPTI' ou 'DTOP' dans
  287. C aucune des routines IDxxxx, donc on peut dire que 'DTOPTI' n'est
  288. C une composante d'aucun champ de type connu.
  289. C En particulier, 'DTOPTI' n'est pas une composante materielle ou une
  290. C variable interne reconnue d'un quelconque modele.
  291. C
  292.             MOT8 = comcar(mobl+ic)
  293.             if (MOT8.eq.'DTOPTI  ') then
  294.          TMOY = xecou.TSOM/NCOMP
  295.          NMOY = NSOM/NCOMP
  296.          IF (IIMPI.GE.1) THEN
  297.          WRITE(IOIMP,*)' NBRE DE SS PAS : MOYENNE ',NMOY,
  298.      1                    ' MAX ',NINCMA
  299.             IF (NINV.NE.0) THEN
  300.             WRITE(IOIMP,*)' NBRE D"INVERSION ',NINV,'/',NCOMP
  301.             END IF
  302.          ENDIF
  303.          TECAR = SQRT(ABS(xecou.TCAR/NCOMP - TMOY*TMOY))
  304.          xecou.DTOPTI = MAX(TMOY-TECAR*0.5D0,xecou.DTOPTI)
  305.          passe1=xecou.dtopti
  306.  
  307.             endif
  308.           ENDIF
  309.           GOTO 320
  310. C
  311.   215     CONTINUE
  312.           passe1 = turef(mobl+ic)
  313.           GOTO 320
  314. C
  315.   216     CONTINUE
  316.           passe1 = prinf(mobl+ic)
  317.           GOTO 320
  318. C
  319.   217     CONTINUE
  320.           passe1 = mahof(mobl+ic)
  321.           GOTO 320
  322. C
  323.   218     CONTINUE
  324.           passe1 = hotaf(mobl+ic)
  325.           GOTO 320
  326. C
  327.   220     CONTINUE
  328.           passe1 = VARF(mobl+ic)
  329.           GOTO 320
  330. C
  331.   221     CONTINUE
  332.           passe1 = graff(mobl+ic)
  333.           GOTO 320
  334. C
  335.   223     CONTINUE
  336.           passe1 = rhasf(mobl+ic)
  337.           GOTO 320
  338. C
  339.   224     CONTINUE
  340.           IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
  341.      &      .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66)THEN
  342.             passe1 =EPINF(mobl+ic)
  343.           ELSE
  344.             passe1=epin0(mobl+ic) + defp(mobl+ic)
  345.           ENDIF
  346.           GOTO 320
  347. C
  348.   298     CONTINUE
  349.           passe1 =exova1(mobl + ic)
  350.           GOTO 320
  351. C
  352.   320     CONTINUE
  353.  
  354.           if (typree) then
  355.             IBMN=MIN(IB,VELCHE(/2))
  356.             IGMN=MIN(IGAU,VELCHE(/1))
  357.             VELCHE(IGMN,IBMN) = passe1
  358.           else
  359.             iptz = int(passe1)
  360.             IBMN = IELCHE(/2)
  361.             IGMN = IELCHE(/1)
  362. *           kich un cas particulier --- plus difficile traiter cas general
  363.             if (iptz.eq.0 .and. IGMN.eq.1 .and. IBMN.eq.1) then
  364.               segsup melval
  365.               indec = -1
  366.               pilfac(ic,mran) = 0
  367.             else
  368.               IGMN = MIN(IGAU,IGMN)
  369.               IBMN = MIN(IB  ,IBMN)
  370.               IELCHE(IGMN,IBMN) = iptz
  371.             endif
  372.           endif
  373. C
  374.  200    CONTINUE
  375.  301    CONTINUE
  376. C----------------------------------------------------------------------
  377. C
  378.  1000 CONTINUE
  379.  
  380. C      RETURN
  381.       END
  382.  
  383.  
  384.  
  385.  

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