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

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