Télécharger la plaquette Cast3M


fr en

Télécharger rnkc3d.eso

Retour à la liste

Numérotation des lignes : 

rnkc3d

  1. C RNKC3D    SOURCE    FD218221  24/02/07    21:15:26     11834          
  2.         subroutine RanKinc3d(NDIMG,NTMAX,icr,idir,
  3.      #  SEFFG,EPSTG,RTG,RFG,FTHG,FT,DPFTDS,DGFTDS,ACTIFT,
  4.      #  Log_RTG,precision3d,affiche,err1)
  5.  
  6. c       criteres de rankine
  7.  
  8.         implicit real*8 (a-h,o-z)
  9.         implicit integer (i-n)
  10.  
  11.         integer NDIMG,NTMAX,icr,idir,err1
  12.         real*8 SEFFG(NDIMG),EPSTG(NDIMG),RTG(NDIMG),RFG(NDIMG)
  13.         real*8 FTHG(NDIMG)
  14.         real*8 FT(NTMAX),DPFTDS(NTMAX,NDIMG),DGFTDS(NTMAX,NDIMG)
  15.         logical ACTIFT(NTMAX),Log_RTG(NTMAX)
  16.         real*8 precision3d
  17.         logical affiche,affiche_local
  18.  
  19.         affiche_local=affiche
  20. c       affiche_local=.true.
  21.  
  22.  
  23.         if(affiche_local) then
  24.             print*,'on est dans Rankinc3d'
  25.         end if
  26.         FT(icr)=0.d0
  27.  
  28.         if(SEFFG(idir).ge.(RTG(idir)*precision3d)) then
  29. c           critere d ouverture            
  30.             FT(icr)=SEFFG(idir)-RTG(idir)
  31.             if(FT(icr).gt.precision3d*RTG(idir)) then
  32.                 if(FTHG(idir).gt.0.d0) then
  33. c                   ecoulement admissible                    
  34.                     ACTIFT(icr)=.true. 
  35.                     DPFTDS(icr,idir)=1.d0 
  36.                     DGFTDS(icr,idir)=1.d0
  37.                     Log_RTG(icr)=.false. 
  38.                 end if                    
  39.             end if
  40.         else
  41.             if(SEFFG(idir).le.(-RFG(idir)*precision3d)) then 
  42. c               critere de refermeture                 
  43.                 FT(icr)=-SEFFG(idir)-RFG(idir)
  44.                 if(FT(icr).gt.precision3d*RFG(idir) )then 
  45.                     if(FTHG(idir).lt.0.d0) then                                           
  46.                         if(EPSTG(idir).gt.precision3d) then
  47. c                           ecoulement admissible                        
  48.                             ACTIFT(icr)=.true.
  49.                             DPFTDS(icr,idir)=-1.d0 
  50.                             DGFTDS(icr,idir)=-1.d0                                
  51.                             Log_RTG(icr)=.true.                                  
  52.                         end if                              
  53.                     end if
  54.                     if(.not.ACTIFT(icr)) then
  55. c                       remise  a zero du critere pour l ordre
  56.                         FT(icr)=0.d0
  57.                     end if
  58.                 end if               
  59.             end if
  60.         end if
  61.  
  62.         if (affiche_local) then
  63.             write(*,'(2(A10,I3,1X))')
  64.      #      ' Critere: ',icr,'Direction:',idir        
  65.             write(*,'(1X,A3,I2,A2,E10.3,1X,A7,L3,1X,A8,L3)') 
  66.      #      'FT(',icr,')=',FT(icr),
  67.      #      'ACTIFT=',ACTIFT(icr),
  68.      #      'Log_RTG=',Log_RTG(icr)
  69.             write(*,'(5(A7,I2,A2,E10.3,1X))')
  70.      #      '   RTG(',icr,')=',RTG(icr),
  71.      #      '   RFG(',icr,')=',RFG(icr),
  72.      #      ' SEFFG(',icr,')=',seffg(icr),
  73.      #      '  FTHG(',icr,')=',FTHG(icr),
  74.      #      ' EPSTG(',icr,')=',EPSTG(icr)
  75.             do idir=1,ndimg
  76.                 write(*,'(2(A7,I2,I2,A2,E10.3,1X))')
  77.      #          'DPFTDS(',icr,idir,')=',DPFTDS(icr,idir),
  78.      #          'DGFTDS(',icr,idir,')=',DGFTDS(icr,idir)
  79.             end do
  80. *            read*
  81.         end if
  82.         err1=0
  83.  
  84.  
  85.         return
  86.         end
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  

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