Download ottofl.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer