Sources Esope | Cast3M

ipmul0
C IPMUL0    SOURCE    CB215821  20/11/25    13:30:30     10792          
C-----------------------------------------------------------------------
C NOM         : IPMULI
C DESCRIPTION : Interface avec IPMUL qui peut etre appelee en parallele
C               pour un ensemble de valeurs a interpoler
C LANGAGE     : ESOPE
C AUTEUR      : Francois DI PAOLA / Clement BERTHINIER
C-----------------------------------------------------------------------
C APPELE PAR       : THREADID via IPGRIL
C APPELE           : IPMUL
C-----------------------------------------------------------------------
C ENTREES
C     ITHR   : Numero du thread
C SORTIES
C
C-----------------------------------------------------------------------
C VERSION    : v1, 05/10/2015, version initiale
C HISTORIQUE : v1, 05/10/2015, creation
C HISTORIQUE :
C HISTORIQUE :
C-----------------------------------------------------------------------
C Priere de PRENDRE LE TEMPS de completer les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C-----------------------------------------------------------------------
C REMARQUES :
C-----------------------------------------------------------------------
C
      SUBROUTINE IPMUL0(ITHR,IPARAL)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCHPOI
-INC SMLENTI
 
      SEGMENT SPARAL
        INTEGER NNN,ML1,ML2,MPV1,MPV2,MCH1,MEL2,
     &          N1EL1,N1PEL1
        INTEGER IXX(NBTHR)
      ENDSEGMENT
 
      SEGMENT SXX
        REAL*8 XX(NDIM)
      ENDSEGMENT
 
      SPARAL  = IPARAL
      SXX     = IXX(ITHR)
 
      NDIM    = SXX.XX(/1)
      NBTHR   = SPARAL.IXX(/1)
      N       = SPARAL.NNN
      MLENT1  = SPARAL.ML1
      MLENT2  = SPARAL.ML2
      MPOVA1  = SPARAL.MPV1
      MPOVA2  = SPARAL.MPV2
      MCHAM1  = SPARAL.MCH1
      MELVA2  = SPARAL.MEL2
      N1EL    = SPARAL.N1EL1
      N1PTEL  = SPARAL.N1PEL1
 
C     Utilisation du bon pointeur : MPOVAL ou MCHAML
      IF     (MPOVA1.NE.0) THEN
        MPOVA1 = MPOVA1
      ELSEIF (MCH1.NE.0) THEN
        MCHAM1 = MCH1
      ELSE
C       Ce cas ne peut en theorie pas arriver, mais ne sait on jamais
        CALL ERREUR(5)
        RETURN
      ENDIF
 
 
C     Debut du travail sur tous les points a interpoler
C     Cas des CHPOINTS
      IF (MPOVA1.NE.0) THEN
C       Boucle sur les points du sous champ d'entree ou l'on va
C       interpoler la fonction (Continue en mémoire par thread)
          IRES  = MOD(N,NBTHR)
          IF (IRES .EQ. 0) THEN
            ILON  = N / NBTHR
            IDEB  = (ithr -1)* ILON + 1
          ELSE
            IF (ithr .LE. IRES) THEN
              ILON  = (N / NBTHR) + 1
              IDEB  = (ithr -1)* ILON + 1
            ELSE
              ILON  = N / NBTHR
              IDEB  = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
            ENDIF
          ENDIF
          IFIN  = IDEB + ILON - 1
        DO J=IDEB,IFIN
C         On recupere les valeurs des coordonnes du point J et on les
C         range dans le tableau XX
          DO K =1,NDIM
            KK   = MLENT2.LECT(K)
            XX(K)= MPOVA1.VPOCHA(J,KK)
          ENDDO
C         On fait l'interpolation au point J
          CALL IPMUL(XX,NDIM,MLENT1,XVAL)
          IF (IERR.NE.0) RETURN
C         Puis on range la valeur calculee dans le champ de sortie
          MPOVA2.VPOCHA(J,1)=XVAL
        ENDDO
C       FIN Boucle sur les valeurs independantes a traiter (CHPOINT)
C
C     Cas des MCHAML
      ELSEIF (MCH1.NE.0) THEN
C       Boucle sur les elements du champ d'entree (Continue en mémoire par thread)
          N     = N1EL
          IRES  = MOD(N,NBTHR)
          IF (IRES .EQ. 0) THEN
            ILON  = N / NBTHR
            IDEB  = (ithr -1)* ILON + 1
          ELSE
            IF (ithr .LE. IRES) THEN
              ILON  = (N / NBTHR) + 1
              IDEB  = (ithr -1)* ILON + 1
            ELSE
              ILON  = N / NBTHR
              IDEB  = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
            ENDIF
          ENDIF
          IFIN  = IDEB + ILON - 1
        DO J=IDEB,IFIN
C         Boucle sur les points supports de l'element J
          DO K=1,N1PTEL
C           On recupere les valeurs des coordonnes du point K, de l'
C           element J et on les range dans le tableau XX
            DO L=1,NDIM
              LL    = MLENT2.LECT(L)
              MELVA1= MCHAM1.IELVAL(LL)
              KK    = MIN(K,N1PTEL)
              JJ    = MIN(J,N1EL)
              XX(L) = MELVA1.VELCHE(KK,JJ)
            ENDDO
C           On fait l'interpolation au point K de l'element J
            CALL IPMUL(XX,NDIM,MLENT1,XVAL)
            IF (IERR.NE.0) RETURN
C           Puis on range la valeur calculee dans le champ de sortie
            MELVA2.VELCHE(K,J)=XVAL
          ENDDO
        ENDDO
      ENDIF
 
 
      RETURN
      END