Sources Esope | Cast3M

devso2
C DEVSO2    SOURCE    CB215821  20/11/25    13:25:08     10792          
      SUBROUTINE DEVSO2(ITRES)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Remplissage des CHPOINTs/LISTREELS resultats.                  *
*     Sauvegarde des variables necessaires a une reprise de calcul   *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
* es  ITRES   Segment de sauvegarde des resultats                    *
*                                                                    *
*     Auteur, date de creation:                                      *
*                                                                    *
*     Denis ROBERT-MOUGIN, le 1er juin 1989.                         *
*                                                                    *
*--------------------------------------------------------------------*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMCHPOI
-INC SMLREEL
*
      SEGMENT,MTRES
         REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
         REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
         REAL*8 XMREP(NLIAB,4,IDIMB)
         INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP)
         INTEGER ILIRES(NRESLI,NCRES)
         INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
         INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
         INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
         INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
         INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
         INTEGER ILPOLA(NLIAA,2)
      ENDSEGMENT
*
      MTRES = ITRES
      NRES  = XRES(/1)
      NREP  = XREP(/1)
      NCRES = XRES(/2)
      NPRES = XRES(/3)
      NLIAB = XMREP(/1)
      IDIMB = XMREP(/3)
*
*     Boucle sur les variables demandees, pour tous les pas
*     de sortie:
*
      IRE2 = 0
      IRE2PO = 0
      IRE2LI = 0
      DO 10 IRES=1,8
c     -- cas pas de sortie --
         IF (ICHRES(IRES).EQ.0) GOTO 10
         IRE2 = IRE2 + 1
c     -- cas CHPOINT --
         IF(ICHRES(IRES).EQ.1) THEN
           IRE2PO = IRE2PO + 1
           DO 20 IPAS=1,NPRES
               MCHPOI = IPORES(IRE2PO,IPAS)
               NSOUPO = IPCHP(/1)
               DO 30 ISOUPO=1,NSOUPO
                  MSOUPO = IPCHP(ISOUPO)
                  MPOVAL = IPOVAL
                  N1 = VPOCHA(/1)
                  NC = VPOCHA(/2)
                  INCO = 0
                  DO 40 J=1,N1
                     DO 50 I=1,NC
                        INCO = INCO + 1
                        VPOCHA(J,I) = XRES(IRE2,INCO,IPAS)
 50                  CONTINUE
 40               CONTINUE
                  SEGDES,MPOVAL,MSOUPO
 30            CONTINUE
               SEGDES,MCHPOI
 20        CONTINUE
c     -- cas LISTREEL --
         ELSEIF(ICHRES(IRES).EQ.2) THEN
           IRE2LI = IRE2LI + 1
           DO 21 INCO=1,NCRES
             JG=NPRES
             SEGINI,MLREEL
             KLREEL = MLREEL
             ILIRES(IRE2LI,INCO) = KLREEL
             DO IPAS=1,NPRES
               PROG(IPAS)=XRES(IRE2,INCO,IPAS)
             ENDDO
             SEGDES,MLREEL
 21        CONTINUE
         ENDIF
 10   CONTINUE
*
*     Cas des CHPOINTs destines a la reprise de calcul:
*
      DO 100 IREP=1,NREP
         MCHPOI = IPOREP(IREP)
         NSOUPO = IPCHP(/1)
         DO 110 ISOUPO=1,NSOUPO
            MSOUPO = IPCHP(ISOUPO)
            MPOVAL = IPOVAL
            N1 = VPOCHA(/1)
            NC = VPOCHA(/2)
            INCO = 0
            DO 120 J=1,N1
               DO 130 I=1,NC
                  INCO = INCO + 1
                  VPOCHA(J,I) = XREP(IREP,INCO)
 130              CONTINUE
*              end do
 120           CONTINUE
*           end do
            SEGDES,MPOVAL,MSOUPO
 110        CONTINUE
*        end do
         SEGDES,MCHPOI
 100     CONTINUE
*     end do
*
*     Cas des variables de liaison necessaires a la reprise de calcul
*
      IF (NLIAB.NE.0) THEN
         IDIM1 = IDIM + 1
         DO 200 I = 1,NLIAB
            ITYP = IMREP(I,1)
            IF (ITYP.EQ.3  .OR. ITYP.EQ.4  .OR. ITYP.EQ.5  .OR.
     &          ITYP.EQ.6  .OR.
     &          ITYP.EQ.13 .or. ityp.eq.-13 .or. ityp.eq.113
     &         .OR. ITYP.EQ.14 .OR. ITYP.EQ.23 .OR.
     &          ITYP.EQ.24 .OR. ITYP.EQ.33 .OR. ITYP.EQ.34) THEN
               DO 210 II = 1,3
                  NUMPO = IPPREP(I,II)
                  XCOOR(NUMPO * IDIM1) = 0.D0
                  DO 210 ID = 1,IDIM
                     XCOOR((NUMPO - 1) * IDIM1 + ID) = XMREP(I,II,ID)
 210                 CONTINUE
*              end do
            ELSE IF (ITYP.EQ.7) THEN
               DO 220 II = 1,3
                  NUMPO = IPPREP(I,II)
                  XCOOR(NUMPO * IDIM1) = 0.D0
                  XCOOR((NUMPO - 1) * IDIM1 + 1) = XMREP(I,II,1)
 220              CONTINUE
*              end do
            ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
               DO 230 II = 1,4
                  NUMPO = IPPREP(I,II)
                  XCOOR(NUMPO * IDIM1) = 0.D0
                  DO 230 ID = 1,IDIM
                     XCOOR((NUMPO - 1) * IDIM1 + ID) = XMREP(I,II,ID)
 230                 CONTINUE
*              end do
 
            ENDIF
 200        CONTINUE
*        end do
      ENDIF
*
      END