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    OF166741  25/11/04    21:15:36     12349          
  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)THEN
  161.              passe1 =EPINF(IC)
  162.           ELSE
  163.              passe1= epin0(ic) + defp(IC)
  164.           ENDIF
  165.           GOTO 120
  166. C
  167.   98      CONTINUE
  168.           passe1 = exova1(ic)
  169. C         GOTO 120
  170. *
  171.  120      CONTINUE
  172.  
  173.           if (typree) then
  174.             IBMN=MIN(IB,VELCHE(/2))
  175.             IGMN=MIN(IGAU,VELCHE(/1))
  176.             VELCHE(IGMN,IBMN)=passe1
  177.           else
  178.             iptz = int(passe1)
  179.             IGMN = IELCHE(/1)
  180.             IBMN = IELCHE(/2)
  181. *           kich un cas particulier --- plus difficile traiter cas general
  182.             if (iptz.eq.0 .and. IGMN.eq.1 .and. IBMN.eq.1) then
  183.               segsup melval
  184.               indec = -1
  185.               pilobl(ic,mran) = 0
  186.             else
  187.               IGMN = MIN(IGAU,IGMN)
  188.               IBMN = MIN(IB  ,IBMN)
  189.               IELCHE(IGMN,IBMN) = iptz
  190.             endif
  191.           endif
  192. C
  193.  100    CONTINUE
  194.  101    CONTINUE
  195. C       ---------------------------------------------------------------
  196. C       COMPOSANTES FACULTATIVES
  197. C
  198. *       if (mfac.le.0) goto 301
  199. * mran doit correspondre a indeso, indice du deche resultat
  200.         do 200 ic = 1,mfac
  201.           if (pilfac(ic,mran).gt.0) then
  202.             deche = pilfac(ic,mran)
  203.  
  204. C           Pour optimisation COMPARE_STRING
  205.             MOdec=condec
  206.             MOmod=conmod
  207.             if (MOdec.ne.MOmod) goto 200
  208. C           Cas des MELVALS d'entree
  209.             IF(ieldec .LT. 0)GOTO 200
  210.             melval =ABS(ieldec)
  211.           else
  212.             goto 200
  213.           endif
  214. *
  215. *       AIGUILLAGE SUIVANT MOT CLE
  216. *
  217.         GOTO ( 201,202,201,201,201,206, 207,299,299,210,211,
  218.      & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino
  219.         if (ino.gt.nmot) goto 298
  220. *
  221.  299      CONTINUE
  222. C
  223. C         Pas de composantes pour ce champ
  224.           RETURN
  225. C
  226.   201     CONTINUE
  227.           passe1 = scalf(mobl+ic)
  228.           GOTO 320
  229. C
  230.   202     CONTINUE
  231.           GOTO 320
  232. C
  233.   206     CONTINUE
  234.           passe1 = deplf(mobl+ic)
  235.           GOTO 320
  236. C
  237.   207     CONTINUE
  238.           passe1 = forcf(mobl+ic)
  239.           GOTO 320
  240. C
  241.   210     CONTINUE
  242.           passe1 = gradf(mobl+ic)
  243.           GOTO 320
  244. C
  245.   211     CONTINUE
  246.           passe1 = SIGF(mobl+ic)
  247.           GOTO 320
  248. C
  249.   212     CONTINUE
  250.           passe1 = epstf(mobl+ic)
  251.           GOTO 320
  252. C
  253.   213     CONTINUE
  254.           passe1 = xmatf(mobl+ic)
  255.           GOTO 320
  256. C
  257.   214     CONTINUE
  258.           passe1 = xcarbf(mobl+ic)
  259. c stockage du pas de temps optimal
  260.  
  261.         IF ( INPLAS .EQ. 17 .OR.
  262.      2   ( INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR.
  263.      4     INPLAS .EQ. 61 .OR. INPLAS .EQ. 53 .OR.
  264.      1     INPLAS .EQ. 65 .OR. INPLAS .EQ. 29 .OR.
  265.      1     INPLAS .EQ. 142 .OR.
  266.      2     INPLAS .EQ. 44 .OR. INPLAS .EQ. 45 .OR.
  267.      9     INPLAS .EQ. 76 .OR. INPLAS .EQ. 77  .OR.
  268.      9     INPLAS .EQ. 70 .OR. INPLAS .EQ. 165) THEN
  269.  
  270. C Remarque :
  271. C Le vecteur comcar est rempli par COMVAL : on note le nom de la
  272. C composante lors du premier passage (pour le premier point de Gauss
  273. C du premier element) en recopiant le nom que l'on trouve dans lesobl
  274. C (composante obligatoire) ou lesfac (composante facultative).
  275. C Les vecteurs lesobl et lesfac ont ete remplis par COMOU2 qui pour les
  276. C caracteristiques geometriques a appele IDCARB : en aucun cas on ne
  277. C trouve 'DTOPTI' parmi la liste des composantes geometriques reconnues.
  278. C Qui plus est elle constituerait une exception car 6 caracteres au lieu
  279. C des 4 habituels.
  280. C
  281. C Conclusion : LE TEST CI-DESSOUS if (comcar(mobl+ic).eq.'DTOPTI')
  282. C N'EST JAMAIS SATISFAIT, il n'y a pas stockage du pas de temps optimal.
  283. C
  284. C De plus, on n'a pas trouve de composante 'DTOPTI' ou 'DTOP' dans
  285. C aucune des routines IDxxxx, donc on peut dire que 'DTOPTI' n'est
  286. C une composante d'aucun champ de type connu.
  287. C En particulier, 'DTOPTI' n'est pas une composante materielle ou une
  288. C variable interne reconnue d'un quelconque modele.
  289. C
  290.             MOT8 = comcar(mobl+ic)
  291.             if (MOT8.eq.'DTOPTI  ') then
  292.          TMOY = xecou.TSOM/NCOMP
  293.          NMOY = NSOM/NCOMP
  294.          IF (IIMPI.GE.1) THEN
  295.          WRITE(IOIMP,*)' NBRE DE SS PAS : MOYENNE ',NMOY,
  296.      1                    ' MAX ',NINCMA
  297.             IF (NINV.NE.0) THEN
  298.             WRITE(IOIMP,*)' NBRE D"INVERSION ',NINV,'/',NCOMP
  299.             END IF
  300.          ENDIF
  301.          TECAR = SQRT(ABS(xecou.TCAR/NCOMP - TMOY*TMOY))
  302.          xecou.DTOPTI = MAX(TMOY-TECAR*0.5D0,xecou.DTOPTI)
  303.          passe1=xecou.dtopti
  304.  
  305.             endif
  306.           ENDIF
  307.           GOTO 320
  308. C
  309.   215     CONTINUE
  310.           passe1 = turef(mobl+ic)
  311.           GOTO 320
  312. C
  313.   216     CONTINUE
  314.           passe1 = prinf(mobl+ic)
  315.           GOTO 320
  316. C
  317.   217     CONTINUE
  318.           passe1 = mahof(mobl+ic)
  319.           GOTO 320
  320. C
  321.   218     CONTINUE
  322.           passe1 = hotaf(mobl+ic)
  323.           GOTO 320
  324. C
  325.   220     CONTINUE
  326.           passe1 = VARF(mobl+ic)
  327.           GOTO 320
  328. C
  329.   221     CONTINUE
  330.           passe1 = graff(mobl+ic)
  331.           GOTO 320
  332. C
  333.   223     CONTINUE
  334.           passe1 = rhasf(mobl+ic)
  335.           GOTO 320
  336. C
  337.   224     CONTINUE
  338.           IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
  339.      &      .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66)THEN
  340.             passe1 =EPINF(mobl+ic)
  341.           ELSE
  342.             passe1=epin0(mobl+ic) + defp(mobl+ic)
  343.           ENDIF
  344.           GOTO 320
  345. C
  346.   298     CONTINUE
  347.           passe1 =exova1(mobl + ic)
  348.           GOTO 320
  349. C
  350.   320     CONTINUE
  351.  
  352.           if (typree) then
  353.             IBMN=MIN(IB,VELCHE(/2))
  354.             IGMN=MIN(IGAU,VELCHE(/1))
  355.             VELCHE(IGMN,IBMN) = passe1
  356.           else
  357.             iptz = int(passe1)
  358.             IBMN = IELCHE(/2)
  359.             IGMN = IELCHE(/1)
  360. *           kich un cas particulier --- plus difficile traiter cas general
  361.             if (iptz.eq.0 .and. IGMN.eq.1 .and. IBMN.eq.1) then
  362.               segsup melval
  363.               indec = -1
  364.               pilfac(ic,mran) = 0
  365.             else
  366.               IGMN = MIN(IGAU,IGMN)
  367.               IBMN = MIN(IB  ,IBMN)
  368.               IELCHE(IGMN,IBMN) = iptz
  369.             endif
  370.           endif
  371. C
  372.  200    CONTINUE
  373.  301    CONTINUE
  374. C----------------------------------------------------------------------
  375. C
  376.  1000 CONTINUE
  377.  
  378. C      RETURN
  379.       END
  380.  
  381.  
  382.  

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