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

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