Télécharger la plaquette Cast3M


fr en

Télécharger chame1.eso

Retour à la liste

Numérotation des lignes : 

chame1

  1. C CHAME1    SOURCE    OF166741  24/05/06    21:15:03     11082          
  2.  
  3. C____________________________________________________________________*
  4. C                                                                    *
  5. C     transformation de CHPOINT en MCHAML                            *
  6. C                                                                    *
  7. C     entrees:                                                       *
  8. C     ________                                                       *
  9. C                                                                    *
  10. C     ipmail       pointeur sur un maillage                          *
  11. C ou  ipmodl       pointeur sur un mmodel                            *
  12. C     ipchpo       pointeur sur le chpoint                           *
  13. C     cha          chaine de caractere contenant un sous type eventuel
  14. C     isup         indique le type de support demande :              *
  15. C                  1 le mchaml est laisse aux noeuds                 *
  16. C                  2 au centre de gravite                            *
  17. C                  3 aux points de gauss de la raideur               *
  18. C                  4 aux points de gauss de la masse                 *
  19. C                  5 aux points de gauss des contraintes             *
  20. C                  6 aux point de gauss de la thermique & diffusion  *
  21. C                    & metallurgie                                   *
  22. C                                                                    *
  23. C     sorties:                                                       *
  24. C     ________                                                       *
  25. C                                                                    *
  26. C     ipchel       pointeur sur le mchaml resultat                   *
  27. C                                                                    *
  28. C     Remarque : le passage du mchaml sur un autre support que les   *
  29. C     --------   noeuds n'est possible que si l'on a donne un mmodel *
  30. C                                                                    *
  31. C                le traitement d'harmoniques de fourier n'est pas    *
  32. C                implemente                                          *
  33. C                                                                    *
  34. C____________________________________________________________________*
  35. C                                                                    *
  36.       SUBROUTINE CHAME1(IPMAIL,IPMODL,IPCHPO,CHA,IPCHEL,ISUP)
  37.  
  38.       IMPLICIT INTEGER(I-N)
  39.       IMPLICIT REAL*8(A-H,O-Z)
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC CCGEOME
  44. -INC CCASSIS
  45. -INC CCPRECO
  46. C==DEB= FORMULATION HHO == Include specifique ==========================
  47. -INC CCHHOPA
  48. C==FIN= FORMULATION HHO ================================================
  49.  
  50. -INC SMCHAML
  51. -INC SMCHPOI
  52. -INC SMINTE
  53. -INC SMMODEL
  54. -INC SMELEME
  55. -INC SMCOORD
  56.  
  57.       COMMON/cham1c/IPARA1,IPARA2
  58.       EXTERNAL CHAM1I
  59.       LOGICAL  BTHRD
  60.  
  61.       SEGMENT SPARA1
  62.         INTEGER NBTHR1
  63.         INTEGER IPCH1
  64.         INTEGER IPTP1
  65.         INTEGER IPTR1
  66.       ENDSEGMENT
  67.  
  68.       SEGMENT SPARA2
  69.         INTEGER NBTHRD
  70.         INTEGER IISUP
  71.         INTEGER IPSAU
  72.         INTEGER IPMOD
  73.         INTEGER IPCHE
  74.         INTEGER IPTPR
  75.         INTEGER IPTRA
  76.       ENDSEGMENT
  77.  
  78.       SEGMENT INFO
  79.          INTEGER INFELL(JG)
  80.       ENDSEGMENT
  81.  
  82.       SEGMENT ISAUT(IVAL,NSOUS)
  83.       SEGMENT ICPR(nbpts)
  84.  
  85.       SEGMENT MTRA2
  86. C      Copie du CHPOINT dans MTRA2 pour aller plus vite ensuite
  87.        CHARACTER*(LOCOMP) INCO(N2)
  88.        REAL*8      BB(NX,N2)
  89. C        INCO  : Nom des INCONNUES du CHPOINT
  90. C        BB    : Valeurs au noeuds du MMODEL (associees au ICPR)
  91. C                NX : Nombre de noeuds differents dans le MODELE
  92. C                N2 : Nombre de composantes dans le CHPOINT
  93.       ENDSEGMENT
  94.  
  95.       CHARACTER*(*) CHA
  96.       CHARACTER*(LOCOMP) MOCOMP
  97.       CHARACTER*1 MO1,VID1
  98.  
  99. C     soutyp = sous-type du champ par element resultat
  100. C     lsouty = longueur utile de la chaine "soutyp"
  101. C
  102.       INTEGER LSOUTY
  103.       CHARACTER*72 SOUTYP
  104. C
  105.       LOGICAL ICOQ
  106. C
  107. *     write(6,*) 'chame1 ',ipmAIL,IPMODL,IPCHPO,CHA,ISUP
  108. *  preconditionnement on regarde si on a sauve le resultat
  109. *  on ne fait l'horodatage que pour le chp par mesure d'economie
  110.       ith=oothrd
  111.       call oooho1(ipmail,ihomai)
  112.       call oooho1(ipmodl,ihomod)
  113.       call oooho1(ipchpo,ihochp)
  114.       do 100 iprec=1,nprcha
  115.        if (iprma(iprec,ith).ne.ipmail) goto 100
  116.        if (iprhoa(iprec,ith).ne.ihomai) goto 100
  117.        if (iprmo(iprec,ith).ne.ipmodl) goto 100
  118.        if (iprhom(iprec,ith).ne.ihomod) goto 100
  119.        if (iprchp(iprec,ith).ne.ipchpo) goto 100
  120.        if (iprhoc(iprec,ith).ne.ihochp) goto 100
  121.        if (iprsu(iprec,ith).ne.isup  ) goto 100
  122.        if (iprcha(iprec,ith).ne.cha  ) goto 100
  123. *  preconditionnement trouve
  124.        ipchel=iprchl(iprec,ith)
  125. **     if(ith.eq.1)
  126. **   > write(6,*) ' preconditionnement trouve ',iprec,ith,ipchel
  127.        call actobj('MCHAML',ipchel,1)
  128.        return
  129.  100  continue
  130.  
  131.       IPARA1= 0
  132.       IPARA2= 0
  133.  
  134.       NT1   = 1
  135.       NT2   = 1
  136.       IOPTIM= 100
  137.  
  138.       INFO  = 0
  139.       ISUP1 = ISUP
  140.       IPCHEL= 0
  141.       NPINT = 0
  142.       VID1  =' '
  143.  
  144.       ither = 0
  145.       idiff = 0
  146.       imeta = 0
  147. C
  148. C     on cree l'objet maillage contenant tous les points du chpoint
  149. C
  150.       MCHPOI=IPCHPO
  151.       NSOUPO=IPCHP(/1)
  152. C
  153.       IF (IPMAIL.NE.0) THEN
  154.          IPT1=IPMAIL
  155.          NSOUS = MAX(1,IPT1.LISOUS(/1))
  156.          ISUP1=1
  157.       ELSE IF (IPMODL.NE.0) THEN
  158.          MMODEL = IPMODL
  159.          NSOUS  = KMODEL(/1)
  160.       ENDIF
  161. C
  162. C     initialisation du segment descripteur du champ par element
  163. C
  164.       N1=NSOUS
  165.       N3=6
  166.       MO1 = CHA(1:1)
  167.       IF (MO1.EQ.VID1) THEN
  168.          L1=8
  169.          SOUTYP=MTYPOI
  170.       ELSE
  171.          L1=LEN(CHA)
  172.          SOUTYP=CHA
  173.       ENDIF
  174.  
  175. C     Renvoi le nombre de composantes
  176.       CALL NBCOMP(MCHPOI,'CHPOINT ',N2)
  177.  
  178.       NX    =0
  179.       N2PTEL=0
  180.       N2EL  =0
  181.       ISOUSs=0
  182.  
  183. C     Dimensionnement de ISAUT
  184.       IF(IPMODL .NE. 0)THEN
  185.         IVAL=6
  186.       ELSE
  187.         IVAL=3
  188.       ENDIF
  189. C
  190.       ICOQ=.FALSE.
  191.       DO ISOUPO=1,NSOUPO
  192.         MSOUPO=IPCHP(ISOUPO)
  193.         NCOMPO=NOCOMP(/2)
  194.         DO ICO=1,NCOMPO
  195.           MOCOMP=MSOUPO.NOCOMP(ICO)
  196.           IF (MOCOMP(1:4).EQ.'TINF'.OR.MOCOMP(1:4).EQ.'TSUP') THEN
  197.             ICOQ=.TRUE.
  198.             IVAL = IVAL + 2
  199.             GOTO 1
  200.           ENDIF
  201.         ENDDO
  202.       ENDDO
  203.  1    CONTINUE
  204.  
  205.       IF(OOTHRD .NE.0) call oooprl(1)
  206.       SEGINI,ICPR,ISAUT
  207.       IF(OOTHRD .NE.0) call oooprl(0)
  208.  
  209.       DO 19 ISOUS=1,NSOUS
  210.          ISUP1 =ISUP
  211.          IPMINT=0
  212.          IF (IPMAIL.NE.0) THEN
  213.             IF (NSOUS.GT.1) THEN
  214.                IPT2=IPT1.LISOUS(ISOUS)
  215.             ELSE
  216.                IPT2=IPMAIL
  217.             ENDIF
  218.  
  219.          ELSEIF (IPMODL.NE.0) THEN
  220.             IMODEL = KMODEL(ISOUS)
  221.  
  222.             MELE=NEFMOD
  223.             IPT2 = IMAMOD
  224.  
  225. C==DEB= FORMULATION HHO ================================================
  226. C= On ne fait pas de MCHAML pour les HHO (a voir par la suite...)
  227.             IF (MELE.EQ.HHO_NUM_ELEMENT) THEN
  228.               GOTO 19
  229.             END IF
  230. C==FIN= FORMULATION HHO ================================================
  231.  
  232. c           pour les elements MULT, on autorise que les MCHAML aux noeuds
  233.             if(ISUP1.ne.1) then
  234.               if(mele.eq.22 .OR. mele.eq.259) goto 19
  235.             endif
  236.  
  237.             if (formod(1)(1:8).eq.'LIAISON ') then
  238. C             ne fait rien si le maillage de LIAISON n'appartient pas au CHPOINT
  239.  
  240.               IVAL1 = IPT2.num(1,1)
  241.               DO I=1,NSOUPO
  242.                 MSOUPO=IPCHP(I)
  243.                 MELEME=IGEOC
  244.                 do jno = 1, num(/2)
  245.                   if (num(1,jno).eq.IVAL1) goto 191
  246.                 enddo
  247.                 goto 19
  248.               ENDDO
  249.  191          CONTINUE
  250.             endif
  251.  
  252.             IMODEL = KMODEL(ISOUS)
  253.             IF(INFMOD(/1).NE.0) NPINT=INFMOD(1)
  254. C
  255. C           Changement de support si besoin selon la formulation ?
  256.             IF (ISUP1 .NE. 1) THEN
  257.               NFOR = FORMOD(/2)
  258.               CALL PLACE(FORMOD,NFOR,icont,'CONTACT         ')
  259.               CALL PLACE(FORMOD,NFOR,ichph,'CHANGEMENT_PHASE')
  260.               IF (icont.NE.0 .OR. ichph.NE.0) THEN
  261.                 ISUP1 = 1
  262.               ELSE
  263.                 CALL PLACE(FORMOD,NFOR,ither,'THERMIQUE')
  264.                 CALL PLACE(FORMOD,NFOR,idiff,'DIFFUSION')
  265.                 CALL PLACE(FORMOD,NFOR,imeta,'METALLURGIE')
  266.                 IF (ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  267.                   nmat = matmod(/2)
  268.                   CALL PLACE(matmod,nmat,iray,'RAYONNEMENT')
  269. C                 Support 6 SAUF pour le RAYONNEMENT...
  270. C                 Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  271.                   IF (iray.EQ.0) THEN
  272.                     IF (ISUP1.GT.2) ISUP1 = 6
  273.                   ENDIF
  274.                 ENDIF
  275.               ENDIF
  276.             ENDIF
  277. C
  278. C           on recupere le pointeur sur le minte correspondant a isup1
  279. C
  280.             IF (ISUP1.GT.1) THEN
  281.                MELE=NEFMOD
  282. C              cas de la THERMIQUE(sauf RAYONNEMENT) OU DIFFUSION OU METALLURGIE
  283.                IF (ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  284.                  IF ( ISUP1 .EQ. 2) THEN
  285.                    CALL TSHAPE(MELE,'GRAVITE',IPMINT)
  286. cc                 ELSE IF ( ISUP1 .EQ. 6) THEN
  287.                  ELSE
  288.                    CALL TSHAPE(MELE,'GAUSS  ',IPMINT)
  289.                  ENDIF
  290.                  IF (IERR.NE.0) RETURN
  291.                  IELE = NUMGEO(MELE)
  292.                  NBNN = NBNNE(IELE)
  293.                ELSE
  294.                  if(2+isup1.gt.infmod(/1)) then
  295.                    CALL ELQUOI(MELE,0,ISUP1,INFO,IMODEL)
  296.                    IF (IERR.NE.0) RETURN
  297.                    IPMINT=INFELL(11)
  298.                  else
  299.                    IPMINT=infmod(2+isup1)
  300.                    IELE  =INFELE(14)
  301.                    NBNN  =NBNNE(IELE)
  302.                  endif
  303.                ENDIF
  304. C
  305. C              initialisation de ipore pour milieu poreux
  306. C
  307.                IPORE=0
  308.                IF(MELE.GE.79 .AND.MELE.LE.83 ) IPORE=NBNN
  309.                IF(MELE.GE.173.AND.MELE.LE.177) IPORE=NBNN
  310.                IF(MELE.GE.178.AND.MELE.LE.182) IPORE=NBNN
  311. C              cas XFEM il faut seulement les 4 premier noeuds (support geometrique)
  312.                IF(MELE.GE.263) IPORE=NBNN
  313.  
  314.                ISAUT(4,ISOUS)=IPMINT
  315.                IF(IPORE .EQ. 0)THEN
  316.                  MINTE         =IPMINT
  317.                  ISAUT(5,ISOUS)=SHPTOT(/2)
  318.                ELSE
  319.                  ISAUT(5,ISOUS)=IPORE
  320.                ENDIF
  321.             ENDIF
  322.  
  323.             ISAUT(6,ISOUS)= ISUP1
  324. C
  325. C           Quels sont les modeles concernes par TINF et TSUP
  326.             IF (ICOQ) THEN
  327.               ISAUT(IVAL-1,ISOUS)=0
  328.               IPNOMC = 0
  329.               CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
  330.               IF (ITHER.NE.0) THEN
  331.                 IPNOMC = LNOMID(1)
  332.               ENDIF
  333.               CALL PLACE(FORMOD,NFOR,IMECA,'MECANIQUE')
  334.               IF (IMECA.NE.0) THEN
  335.                 IPNOMC = LNOMID(8)
  336.               ENDIF
  337.               IF (IPNOMC.EQ.0) GOTO 192
  338.               NOMID = IPNOMC
  339.               NCOBL = LESOBL(/2)
  340.               DO IJC = 1,NCOBL
  341.                 MOCOMP = LESOBL(IJC) 
  342.                 IF (MOCOMP(1:4).EQ.'TINF'.OR.MOCOMP(1:4).EQ.'TSUP') THEN 
  343.                   ISAUT(IVAL-1,ISOUS)=1
  344.                   GOTO 192
  345.                 ENDIF 
  346.               ENDDO
  347.  192          CONTINUE
  348.             ENDIF
  349. C
  350.          ELSE
  351.            CALL ERREUR(5)
  352.            RETURN
  353.          ENDIF
  354.  
  355.          ISOUSs=ISOUSs+1
  356.  
  357.          ISAUT(1,ISOUS) = IPT2
  358.  
  359.          NBNO = IPT2.NUM(/1)
  360.          N1EL = IPT2.NUM(/2)
  361.  
  362. C        Remplissage de l'ICPR a partir des noeuds du MMODEL
  363. C          L'utilisation d'un ICPR par MMODEL limite l'utilisation de
  364. C          memoire en parallele des les ASSISTANTS
  365.          DO IEL=1,N1EL
  366.            DO INO=1,NBNO
  367.               INOEU=IPT2.NUM(INO,IEL)
  368.               IF(ICPR(INOEU) .EQ. 0)THEN
  369.                 NX=NX+1
  370.                 ICPR(INOEU)=NX
  371.               ENDIF
  372.            ENDDO
  373.          ENDDO
  374.  
  375.          IF(IPMINT .EQ. 0)THEN
  376.            N1PTEL=NBNO
  377.          ELSE
  378.            MINTE =IPMINT
  379.            N1PTEL=SHPTOT(/3)
  380.          ENDIF
  381.  
  382.          ISAUT(2,ISOUSs) = N1EL
  383.          ISAUT(3,ISOUSs) = N1PTEL
  384.  
  385.          NT2 = MAX(NT2,N1EL*N1PTEL)
  386.  19   CONTINUE
  387.  
  388. C     Creation d'un MAXIMUM de SEGMENTS dans un LOCK
  389.       N1=ISOUSs
  390.       IF(OOTHRD .NE.0) call oooprl(1)
  391.       SEGINI,MCHELM
  392.  
  393.       TITCHE=SOUTYP
  394.       IFOCHE=IFOUR
  395.  
  396.       DO ISOUSs=1,N1
  397.         SEGINI,MCHAML
  398.         ICHAML(ISOUSs)=MCHAML
  399.         N1EL  =ISAUT(2,ISOUSs)
  400.         N1PTEL=ISAUT(3,ISOUSs)
  401.         DO ICOMP=1,N2
  402.           SEGINI,MELVAL
  403.           IELVAL(ICOMP)=MELVAL
  404.         ENDDO
  405.         IF (ISAUT(IVAL-1,ISOUSs).EQ.1) THEN
  406.           SEGINI,MELVAL
  407.           ISAUT(IVAL,ISOUSs)=MELVAL
  408.         ENDIF
  409.       ENDDO
  410.       SEGINI,MTRA2
  411.       IF(OOTHRD .NE.0) call oooprl(0)
  412.  
  413.       NCO = 0
  414.       DO ISOUPO=1,NSOUPO
  415.         MSOUPO=IPCHP(ISOUPO)
  416.         MELEME=IGEOC
  417.         NT1   =MAX(NT1,NUM(/2))
  418.         NC    =MSOUPO.NOHARM(/1)
  419.         DO 101 ICO=1,NC
  420.           MOCOMP=MSOUPO.NOCOMP(ICO)
  421.           DO K=1,NCO
  422.             IF(MOCOMP .EQ. MTRA2.INCO(K))GOTO 101
  423.           ENDDO
  424.           NCO = NCO + 1
  425.           K   = NCO
  426.           MTRA2.INCO(NCO)=MOCOMP
  427.  101    CONTINUE
  428.       ENDDO
  429.  
  430. C----------------------------------------------------------------------C
  431. C  Remplissage du MTRA2
  432. C----------------------------------------------------------------------C
  433.       NBTHR=MIN(MAX(NT1/IOPTIM,1),NBTHRS)
  434.       IF ((NBTHR .EQ. 1) .OR. (NBTHRS .EQ. 1) .OR. (OOTHRD .GT. 0)) THEN
  435. C       CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  436. C                  DEJA DANS LES ASSISTANTS
  437.         NBTHR = 1
  438.         BTHRD = .FALSE.
  439.       ELSE
  440.         BTHRD = .TRUE.
  441.         CALL THREADII
  442.       ENDIF
  443.  
  444.       IF (BTHRD) THEN
  445. C       Remplissage du 'COMMON/cham1c'
  446.         SEGINI,SPARA1
  447.         IPARA1=SPARA1
  448.         IPARA2=0
  449.  
  450.         SPARA1.NBTHR1=NBTHR
  451.         SPARA1.IPCH1 =MCHPOI
  452.         SPARA1.IPTP1 =ICPR
  453.         SPARA1.IPTR1 =MTRA2
  454.  
  455.         DO ith=2,NBTHR
  456.           CALL THREADID(ith,CHAM1i)
  457.         ENDDO
  458.         CALL CHAM1i(1)
  459.  
  460. C       Attente de la fin de tous les threads en cours de travail
  461.         DO ith=2,NBTHR
  462.           CALL THREADIF(ith)
  463.         ENDDO
  464.  
  465. C       On libère les Threads
  466.         CALL THREADIS
  467.         SEGSUP,SPARA1
  468.  
  469.       ELSE
  470. C       Appel de la SUBROUTINE qui fait le travail
  471.         ith=1
  472.         CALL CHAM11(NBTHR,ith,MCHPOI,ICPR,MTRA2)
  473.       ENDIF
  474.  
  475. C----------------------------------------------------------------------C
  476. C  Remplissage du MCHAML
  477. C----------------------------------------------------------------------C
  478.  
  479.       NBTHR=MIN(MAX(NT2/IOPTIM,1),NBTHRS)
  480.       IF ((NBTHR .EQ. 1) .OR. (NBTHRS .EQ. 1) .OR. (OOTHRD .GT. 0)) THEN
  481. C       CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  482. C                  DEJA DANS LES ASSISTANTS
  483.         NBTHR = 1
  484.         BTHRD = .FALSE.
  485.       ELSE
  486.         BTHRD = .TRUE.
  487.         CALL THREADII
  488.       ENDIF
  489.  
  490.       IF (BTHRD) THEN
  491. C       Remplissage du 'COMMON/cham1c'
  492.         SEGINI,SPARA2
  493.         IPARA1=0
  494.         IPARA2=SPARA2
  495.  
  496.         SPARA2.NBTHRD=NBTHR
  497.         SPARA2.IISUP =ISUP
  498.         SPARA2.IPSAU =ISAUT
  499.         SPARA2.IPMOD =IPMODL
  500.         SPARA2.IPCHE =MCHELM
  501.         SPARA2.IPTPR =ICPR
  502.         SPARA2.IPTRA =MTRA2
  503.  
  504.         DO ith=2,NBTHR
  505.           CALL THREADID(ith,CHAM1i)
  506.         ENDDO
  507.         CALL CHAM1i(1)
  508.  
  509. C       Attente de la fin de tous les threads en cours de travail
  510.         DO ith=2,NBTHR
  511.           CALL THREADIF(ith)
  512.         ENDDO
  513.  
  514. C       On libere les Threads
  515.         CALL THREADIS
  516.         SEGSUP,SPARA2
  517.  
  518.       ELSE
  519. C       Appel de la SUBROUTINE qui fait le travail
  520.         ith=1
  521.         CALL CHAM12(NBTHR,ith,ISUP,ISAUT,IPMODL,MCHELM,ICPR,MTRA2)
  522.       ENDIF
  523.  
  524. C     Modification pour les modeles avec TINF ou TSUP
  525.       IF (ICOQ.AND.IPMODL.NE.0) THEN
  526.         DO IJM = 1,NSOUS
  527.           IF (ISAUT(IVAL-1,IJM).EQ.2) THEN
  528.             MCHAM1=ICHAML(IJM)
  529.             DO IJC = 1,N2
  530.               MOCOMP=MCHAM1.NOMCHE(IJC)
  531.               IF (MOCOMP.EQ.'T       ') GOTO 25
  532.             ENDDO
  533.  25         CONTINUE
  534.             MCHAM1.IELVAL(IJC)=ISAUT(IVAL,IJM)
  535.           ENDIF
  536.         ENDDO
  537.       ENDIF
  538. C
  539.       SEGSUP,MTRA2,ISAUT,ICPR
  540.       IF(INFO  .NE. 0)SEGSUP,INFO
  541.  
  542.       IPCHEL=MCHELM
  543. *  preconditionnement on garde l'operation en memoire
  544.       ith=oothrd
  545.       do iprec=nprcha,2,-1
  546.       iprma(iprec,ith) =iprma(iprec-1,ith)
  547.       iprhoa(iprec,ith)=iprhoa(iprec-1,ith)
  548.       iprmo(iprec,ith) =iprmo(iprec-1,ith)
  549.       iprhom(iprec,ith)=iprhom(iprec-1,ith)
  550.       iprchp(iprec,ith)=iprchp(iprec-1,ith)
  551.       iprhoc(iprec,ith)=iprhoc(iprec-1,ith)
  552.       iprsu(iprec,ith) =iprsu(iprec-1,ith)
  553.       iprcha(iprec,ith)=iprcha(iprec-1,ith)
  554.       iprchl(iprec,ith)=iprchl(iprec-1,ith)
  555.       enddo
  556.       iprma(1,ith) =ipmail
  557.       iprhoa(1,ith)=ihomai
  558.       iprmo(1,ith) =ipmodl
  559.       iprhom(1,ith)=ihomod
  560.       iprchp(1,ith)=ipchpo
  561.       iprhoc(1,ith)=ihochp
  562.       iprsu(1,ith) =isup
  563.       iprcha(1,ith)=cha
  564.       iprchl(1,ith)=ipchel
  565. **    write(6,*) ' preconditionnement de ',ipchel
  566.  
  567.       END
  568.  
  569.  
  570.  

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