1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE COFG(F,ngbands,ph,cb,g,gmax,dk)
   4 | 
   5 |       IMPLICIT NONE
   6 | 
   7 | !     IN
   8 |       DOM_INT  :: ngbands
   9 |       DOM_REAL :: g, gmax
  10 |       DOM_REAL :: ph(ngbands), cb(ngbands)
  11 |       DOM_REAL :: F(ngbands)
  12 | 
  13 | !     OUT
  14 |       DOM_REAL :: dk
  15 | 
  16 | !     LOCAL
  17 |       DOM_REAL :: dksup, dkinf
  18 |       DOM_REAL :: gdek, gdek_i, err, eps
  19 |       DOM_REAL :: ph_bound, cb_bound
  20 |       DOM_INT  :: i,n_it,n_itmax
  21 | 
  22 | !     -----------------------------------!
  23 | !     Limits for dichotomy (dkinf,dksup) !
  24 | !     -----------------------------------!
  25 | 
  26 |       n_itmax   = 100
  27 |       dk        = 0. 
  28 |       ph_bound  = minval(ph)
  29 |       cb_bound  = maxval(cb)
  30 |       dksup     = cb_bound
  31 |       dkinf     = 0.
  32 |       
  33 |       CALL cdss(ph_bound,cb_bound,dksup,gdek)
  34 | 
  35 |       DO WHILE (gdek.lt.g)
  36 | 
  37 |         dkinf=dksup
  38 |         dksup=dksup*10
  39 |         CALL cdss(ph_bound,cb_bound,dksup,gdek)
  40 |       ENDDO
  41 | 
  42 | !     -----------------------!
  43 | !     Dichotomy to obtain dk !
  44 | !     -----------------------!
  45 |         
  46 |       eps=gmax/10000
  47 |       err = eps + 1.
  48 |       n_it=0
  49 | 
  50 | 
  51 | !     -------------------!
  52 | !     TEST fonction gdek !
  53 | !     -------------------!
  54 | !     dk=0.00001
  55 | !     open(unit=696,file="gdek_pondere.dat")
  56 | !	DO WHILE (dk.lt.1000) 
  57 | !         gdek = 0.
  58 | !       DO i=1, ngbands 
  59 | !         IF (ph(i).gt.0.) THEN
  60 | !           CALL cdss(ph(i),cb(i),dk,gdek_i)
  61 | !	  ELSE
  62 | !           gdek_i = 1.
  63 | !         ENDIF
  64 | !         gdek = gdek + F(i)*gdek_i
  65 | !      ENDDO 
  66 | !      write(696,*)  gdek,dk
  67 | !      dk=dk*5
  68 | !      ENDDO
  69 | !      close(696)
  70 | 
  71 | 
  72 |       DO WHILE (err.gt.eps.and.n_it.lt.n_itmax)
  73 | 
  74 |         dk=(dksup+dkinf)/2.
  75 | 
  76 | !       ---------------!
  77 | !       Band groupment !
  78 | !       ---------------!
  79 |         gdek = 0.
  80 |         DO i=1, ngbands
  81 | 
  82 |           IF (ph(i).gt.0.) THEN
  83 |             CALL cdss(ph(i),cb(i),dk,gdek_i)
  84 |           ELSE
  85 |             gdek_i = 1.
  86 |           ENDIF
  87 |  
  88 |           gdek = gdek + F(i)*gdek_i
  89 | 
  90 |         ENDDO
  91 | 
  92 |         IF (gdek.lt.g) THEN
  93 |          dkinf=dk
  94 |         ELSE
  95 |          dksup=dk
  96 |         ENDIF
  97 | 
  98 |         err=abs(gdek-g)
  99 |         n_it=n_it+1
 100 | 
 101 |         IF(dksup.lt.1e-8) THEN
 102 |           err = 0.d0
 103 |           dk  = 0.d0
 104 |         ENDIF
 105 | 
 106 |       ENDDO
 107 | 
 108 | 
 109 | !     IF (n_it.eq.n_itmax) THEN
 110 | !       PRINT*, 'Dichotomy assumed to be converged after MAX iterations'
 111 | !     ENDIF
 112 | 
 113 |       END SUBROUTINE COFG