Sources Esope | Cast3M

pquel
C PQUEL     SOURCE    PV        20/03/24    21:20:19     10554          
C  CE SOUS-PROGRAMME RAMENE UN PLAN SUR DES COORDONNEES INTRINSEQUES
C
      SUBROUTINE PQUEL(IOP,FER,XPROJ,NDEB,NUMNP)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
      SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER
      SEGMENT XPROJ(IDIM+1,IMAX)
      IF (IOP.EQ.2) GOTO 100
      IMCT=MAI(ITOUR+1)
      INCT=MAI(1)+1
      IMAX=(IMCT**2)/5+10
      CALL LIRENT(IMAX,0,IRETOU)
      IF (IRETOU.NE.0) IMAX=MAX(1,IMAX)
      NDEB=IMCT+1
      SEGINI XPROJ
      SEGACT MCOORD
      DO 40 I=INCT,IMCT
      II=NFI(I)
      NFI(I)=I
      IREF=II*(IDIM+1)-IDIM
      XPROJ(1,I)=XCOOR(IREF)
      XPROJ(2,I)=XCOOR(IREF+1)
      XPROJ(3,I)=XCOOR(IREF+IDIM)
      IF (IDIM.EQ.3) XPROJ(4,I)=XCOOR(IREF+2)
  40  CONTINUE
C    SI LA DENSITE LOCALE N'EST PAS DEFINIE IL FAUT LE FAIRE
      DO 41 IT=1,ITOUR
      II1=MAI(IT-1+1)+1
      II2=MAI(IT+1)
      IAP=II2
      DO 41 I=II1,II2
      IF (XPROJ(3,I).NE.0) GOTO 41
      XPROJ(3,I)=SQRT((XPROJ(1,I)-XPROJ(1,IAP))**2+(XPROJ(2,I)-XPROJ(2,
     # IAP))**2)
      IAP=I
  41  CONTINUE
      RETURN
 100  CONTINUE
C  ON RECONSTITUE LE MAILLAGE
      SEGACT MCOORD*mod
      IF (NDEB.GT.NUMNP) GOTO 111
      NBPTA=nbpts
      NBPTS=NBPTA+NUMNP-NDEB+1
      SEGADJ MCOORD
      DO 110 I=NDEB,NUMNP
      XCOOR(NBPTA*(IDIM+1)+1)=XPROJ(1,I)
      XCOOR(NBPTA*(IDIM+1)+2)=XPROJ(2,I)
      XCOOR((NBPTA+1)*(IDIM+1))=XPROJ(3,I)
      IF (IDIM.GE.3)
     #XCOOR(NBPTA*(IDIM+1)+3)=XPROJ(4,I)
      NBPTA=NBPTA+1
 110  CONTINUE
 111  CONTINUE
      SEGSUP XPROJ
      RETURN
      END