Sources Esope | Cast3M

kfanal
C KFANAL    SOURCE    NC        08/05/29    21:15:00     6112
      SUBROUTINE KFANAL (IFACFO,PSOM,KBIL,PTRA,KSYM,LIMP,LIMP2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C----------------------------------------------------------------------
C     CALCUL DES ERREURS SUR LE BILAN ET LA SYMETRIE
C     SP APPELE PAR KFN
C
C    entrée:
C     IFACFO : POINTEUR SUR L OBJET SFACFOR (SUPPOSE ACTIVE)
C                                                    ------
C     KBIL = 1 calcul des bilans
C     KSYM = 1 calcul de la symétrie
C
C     LIMP : PARAMETRE IMPRESSION GENERAL
C            SI GE.1 ON IMPRIME LES LES VALEURS GLOBALES EBL ET ESM
C     LIMP2: DETAILS
C            SI GE.2 VALEURS RELATIVE AU MAX PAR LIGNE
C            SI GE.3 TOUT Y COMPRIS LES FACTEURS DE FORME
C
C    sortie :
C     PSOM   : OBJET ASSOCIE AU BILAN
C              EBL REPRESENTE LE MAX DE L ERREUR SUR LES BILANS
C     PTRA   : OBJET ASSOCIE A LA SYMETRIE
C              ESM REPRESENTE LE MAX DE L ERREUR SUR LA SYMETRIE
C----------------------------------------------------------------------
C     FACTEURS DE FORME
C           NNBEL1 = NOMBRE DE LIGNES + 1
C           NBEL2  = NOMBRE DE COLONNES
C     LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES
C
      SEGMENT IFACFO
       INTEGER   LFACT(NNBEL1)
      ENDSEGMENT
      SEGMENT LFAC
       REAL*8    FACT(NBEL2)
      ENDSEGMENT
      POINTEUR PSUR.LFAC, PLIG.LFAC
      POINTEUR PCOL.LFAC
C----------------------------------------------------------------------
      SEGMENT,PSOM
       REAL*8    SOM(N2),EBL
      ENDSEGMENT
      SEGMENT,PTRA
       REAL*8    TRA(N2),ESM
      ENDSEGMENT
C----------------------------------------------------------------------
C
      N2 = LFACT(/1)-1
      PSUR=LFACT(N2+1)
 
      CALL UTINIV(TRA,N2)
 
C>>>  VERIFICATION DE SYMETRIE
C     ------------------------
 
      IF (KSYM.EQ.1) THEN
 
 
      DO 800 K1=1,N2
       PLIG=LFACT(K1)
C>     SEGACT PLIG
       CALL UTINIV(SOM,N2)
         DO 801 K2=1,N2
          IF (K2.NE.K1) THEN
          PCOL=LFACT(K2)
C>        SEGACT PCOL
         IF (PLIG.FACT(K2).GE.1E-6.AND.PCOL.FACT(K1).GE.1E-6) THEN
             SOM(K2) = PSUR.FACT(K1)*PLIG.FACT(K2)
             SOM(K2) = SOM(K2) - PSUR.FACT(K2)*PCOL.FACT(K1)
             SOM(K2) = SOM(K2)/PLIG.FACT(K2)/PSUR.FACT(K1)
         ENDIF
C>        SEGDES PCOL
          ENDIF
 801     CONTINUE
         CALL UTMXV(SOM,N2,TRA(K1))
         IF (LIMP2.GE.4) THEN
           WRITE(6,*) ' FIJ LIGNE ',K1
           CALL UTPRIM(PLIG.FACT,N2)
         ENDIF
         IF (LIMP2.GE.4) THEN
           WRITE(6,*) ' SYMETRIE  ',K1
           CALL UTPRIM(SOM,N2)
         ENDIF
C>       SEGDES PLIG
 800  CONTINUE
       CALL UTMXV(TRA,N2,ESM)
 
      IF (LIMP2.GE.2) THEN
       WRITE(6,*)
       WRITE(6,*) 'SYMETRIE : ECART RELATIF MAXIMAL PAR LIGNE '
       CALL UTPRIM(TRA,N2)
      ENDIF
       IF(LIMP.GE.1) THEN
        WRITE(6,1001) ESM
 1001   FORMAT(1X,'SYMETRIE : ECART RELATIF MAXIMAL GLOBAL ',E12.5)
       ENDIF
 
       ENDIF
 
 
      IF (KBIL.EQ.1) THEN
 
C
C>>>  CALCUL DES BILANS ET IMPRESSION EVENTUELLE
C     ------------------------------------------
C
      DO 500 K1 = 1,N2
      SOM(K1) = 0.
       PLIG = LFACT(K1)
C>     SEGACT PLIG
      DO 501 K2=1,N2
      SOM(K1) = SOM(K1) + PLIG.FACT(K2)
 501  CONTINUE
C>     SEGDES PLIG
 500  CONTINUE
 
      IF (LIMP2.GE.2) THEN
       WRITE(6,*)
       WRITE(6,*) 'BILAN '
       CALL UTPRIM(SOM,N2)
      ENDIF
 
      DO 502 K1 =1,N2
      SOM(K1) = SOM(K1) - 1.D0
 502  CONTINUE
      CALL UTMXV(SOM,N2,EBL)
 
      IF (LIMP.GE.1) THEN
       WRITE(6,1000) EBL
 1000  FORMAT(1X,'BILAN    : ECART MAXIMAL ',E12.5)
      ENDIF
 
      ENDIF
 
 
      RETURN
      END