Télécharger la plaquette Cast3M


fr en

Télécharger ottofl.eso

Retour à la liste

Numérotation des lignes : 

ottofl

  1. C OTTOFL    SOURCE    CHAT      05/01/13    02:07:35     5004
  2.       SUBROUTINE OTTOFL(NCA,NN,XINVL,PENTE,SIGMA,GS,SMAX,XLTR,
  3.      &                  DFDS,DGDS,HDFDQ,XCOMP,XLAMC,PRECIE,
  4.      &                  PRECIZ,KERRE)
  5. C----------------------------------------------------------------------
  6. C
  7. C  ENTREES : NCA,NN,XINVL,PENTE,SIGMA,GS,SMAX
  8. C
  9. C  SORTIES : DFDS,DGDS,HDFDQ
  10. C
  11. C-----------------------------------------------------------------------
  12. C
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. *
  19.       PARAMETER (XZER=0.D0)
  20. *
  21.       DIMENSION NN(*),DFDS(6,*),DGDS(6,*),HDFDQ(*)
  22.       DIMENSION XINVL(3),PENTE(*),SIGMA(*),GS(*),XLTR(*)
  23.       DIMENSION SS(6)
  24.       DIMENSION SMAX(*),XCOMP(*)
  25.       DIMENSION IV1(3),IV2(3)
  26.  
  27.       DIMENSION DFF(6),DGG(6)
  28. *
  29.       DATA IV1/4,4,5/
  30.       DATA IV2/5,6,6/
  31. *
  32.       KERRE=0
  33. *
  34. *
  35.       DO IC=1,NCA
  36.         JC=NN(IC)
  37.         DO I=1,6
  38.            DFDS(I,JC)=XZER
  39.            DGDS(I,JC)=XZER
  40.         ENDDO
  41.         HDFDQ(JC)=XZER
  42. *
  43.         GO TO (1,1,1,4),JC
  44. *
  45.         KERRE=99
  46.         RETURN
  47. *
  48.  1      CONTINUE
  49. *
  50.         IC1=IV1(JC)
  51.         IC2=IV2(JC)
  52. *
  53.         IF (XINVL(JC).NE.XZER) THEN
  54.            IF(IIMPI.EQ.42) THEN
  55.              WRITE(IOIMP,77005) XINVL(JC),PENTE(JC)
  56. 77005        FORMAT(2X,'XINVL=',1PE12.5,2X,'PENTE=',1PE12.5/)
  57.            ENDIF
  58. *
  59. *
  60.            H =PENTE(JC)/XINVL(JC)
  61.            IF(IIMPI.EQ.42) THEN
  62.               WRITE(IOIMP,77009)  H
  63. 77009         FORMAT(2X,' MODULE D ECROUISSAGE H= ',1PE12.5/)
  64.            ENDIF
  65.            HDFDQ(JC)=-H
  66.            DFDS(JC,JC)=1.D0
  67.            DGDS(JC,JC)=1.D0
  68.            DGDS(IC1,JC)=SIGMA(IC1)/GS(JC)/2.D0
  69.            DGDS(IC2,JC)=SIGMA(IC2)/GS(JC)/2.D0
  70.         ENDIF
  71.         GO TO 100
  72. *
  73.  4      CONTINUE
  74.  
  75.  
  76.         CALL OTTOCP(SIGMA,FCR4,XLTR,DFF,DGG,H4,
  77.      &               PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  78.  
  79.         DO I=1,6
  80.            DFDS(I,4)=DFF(I)
  81.            DGDS(I,4)=DGG(I)
  82.         ENDDO
  83. *
  84.         HDFDQ(4)=H4
  85.  
  86.  
  87.  
  88. *
  89. *       DFDS(1,4)=0.D0
  90. *       DGDS(1,4)=0.D0
  91. *       HDFDQ(4)=0.D0
  92.         GO TO 100
  93. *
  94. 100     CONTINUE
  95.       ENDDO
  96.  
  97.       RETURN
  98.       END
  99.  
  100.  
  101.  
  102.  
  103.  

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