TABLE OF CONTENTS


ABINIT/status [ Functions ]

[ Top ] [ Functions ]

NAME

 status

FUNCTION

 Routine for description of the status of the calculation
 Eventually open the status file, write different information,
 and close the file. The output rate and shift are governed by istat

COPYRIGHT

 Copyright (C) 1998-2018 ABINIT group (XG,TD)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .
 For the initials of contributors, see ~abinit/doc/developers/contributors.txt .

INPUTS

  counter=value of the loop counter at that level
  file (optional argument)=name of the status file
  istat=gives the rate or shift of output. The status file will be opened
     and written only once every "istatr" calls.
     This variable is saved at the first call (just after the first
     call to invars0. The shift "istatshft" is saved at the second call.
     In subsequent calls, istat has no meaning.
  level=number of the level of the calling subroutine (see the description later)
  routine=string of 14 characters indicating the status inside the level

OUTPUT

  (only writing)

NOTES

 Warning : The string "routine" can have any size but
 it is truncated to a size of 14.
 because of the behaviour of some compilers, the string
 "routine" should always have 14 characters in the calling subroutine

PARENTS

      abinit,dfpt_accrho,dfpt_looppert,dfpt_rhofermi,dfpt_scfcv,dfpt_vtowfk
      dfpt_wfkfermi,dfptnl_loop,dfptnl_mv,dfptnl_resp,driver,gstate,gstateimg
      m_ab7_invars_f90,mover,nonlinear,respfn,scfcv,vtorhotf

CHILDREN

      timab

SOURCE

 48 #if defined HAVE_CONFIG_H
 49 #include "config.h"
 50 #endif
 51 
 52 #include "abi_common.h"
 53 
 54 subroutine status(counter,filstat,istat,level,routine)
 55 
 56  use defs_basis
 57  use m_errors
 58 
 59  use m_io_tools,   only : open_file
 60 
 61 !This section has been created automatically by the script Abilint (TD).
 62 !Do not modify the following lines by hand.
 63 #undef ABI_FUNC
 64 #define ABI_FUNC 'status'
 65  use interfaces_18_timing
 66 !End of the abilint section
 67 
 68  implicit none
 69 
 70 !Arguments ------------------------------------
 71 !scalars
 72  integer,intent(in) :: counter,istat,level
 73  character(len=*),intent(in) :: routine
 74  character(len=*),intent(in) :: filstat
 75 
 76 !Local variables-------------------------------
 77 !scalars
 78  integer,parameter :: mcounter=2,mlevel=120
 79  integer,save :: output_rate=1,shift_rate=1,statnu=0
 80  integer :: ilevel,temp_unit
 81  character(len=12) :: headwr
 82  character(len=500) :: message
 83 !arrays
 84  integer,save :: active(mlevel),actual_counter(mlevel,mcounter)
 85  integer,save :: ncounter(mlevel)
 86  integer,save :: list_level(29)=&
 87 &  (/1,2,3,100,101,102,110,111,112,113,114,10,11,12,13,14,15,16,17,18,20,30,31,40,41,50,51,52,90/)
 88  real(dp) :: tsec(2)
 89  character(len=20),save :: nm_levels(mlevel),nm_routine(mlevel)
 90  character(len=12),save :: nm_counter(mlevel,mcounter)
 91 
 92 !***********************************************************************
 93 
 94  if (.not.do_write_status .or. output_rate==0) return
 95 
 96  call timab(73,1,tsec)
 97 
 98 !Note : all processors have their own file, so no special
 99 !attention must be paid to the parallel case.
100 !Initialisation
101  if(statnu==0)then
102    nm_routine(:)='                  '
103    active(:)=0
104    actual_counter(:,:)=0
105 
106 !  List of names for each level
107 !  Numbers from 1 to 9 are for abinit and driver
108 !  Numbers from 100 to 120 are for optdriver=0 routines (GS)
109 !  Numbers between 10 and 19 are for optdriver=1 routines (RF)
110 !  Numbers between 20 and 29 are for optdriver=2 routines (suscep)
111 !  Numbers between 30 and 39 are for optdriver=3 routines (screening)
112 !  Numbers between 40 and 49 are for optdriver=4 routines (sigma)
113 !  Numbers between 50 and 59 are for optdriver=5 routines (nonlinear)
114 !  When you add a level number, or modify one, do not forget to change list_level
115 
116    nm_levels(1)   ='abinit              '
117    ncounter(1)=0
118    nm_counter(1,1)='            '
119 
120    nm_levels(2)   ='driver              '
121    ncounter(2)=1
122    nm_counter(2,1)='jdtset     ='
123 
124    nm_levels(3)   ='ab7_invars_load     '
125    ncounter(3)=0
126    nm_counter(3,1)='            '
127 
128 !  Optdriver=0
129    nm_levels(100)   ='gstateimg           '
130    ncounter(100)=2
131    nm_counter(100,1)='idynimage  ='
132    nm_counter(100,2)='itimimage  ='
133 
134    nm_levels(101)   ='gstate              '
135    ncounter(101)=1
136    nm_counter(101,1)='itime      ='
137 
138    nm_levels(102)   ='mover               '
139    ncounter(102)=2
140    nm_counter(102,1)='icycle     ='
141    nm_counter(102,2)='itime      ='
142 
143    nm_levels(110)   ='scfcv               '
144    ncounter(110)=1
145    nm_counter(110,1)='istep      ='
146 
147    nm_levels(111)   ='vtorho(tf)          '
148    ncounter(111)=2
149    nm_counter(111,1)='isppol     ='
150    nm_counter(111,2)='ikpt       ='
151 
152    nm_levels(112)   ='vtowfk              '
153    ncounter(112)=2
154    nm_counter(112,1)='inonsc     ='
155    nm_counter(112,2)='iband      ='
156 
157    nm_levels(113)   ='cgwf                '
158    ncounter(113)=1
159    nm_counter(113,1)='iline      ='
160 
161    nm_levels(114)   ='getghc              '
162    ncounter(114)=0
163    nm_counter(114,1)='            '
164 
165 
166 !  Optdriver=1
167    nm_levels(10)   ='respfn              '
168    ncounter(10)=0
169    nm_counter(10,1)='            '
170 
171    nm_levels(11)   ='dfpt_looppert       '
172    ncounter(11)=1
173    nm_counter(11,1)='respcase   ='
174 
175    nm_levels(12)   ='dfpt_scfcv          '
176    ncounter(12)=1
177    nm_counter(12,1)='istep      ='
178 
179    nm_levels(13)   ='dfpt_vtorho         '
180    ncounter(13)=2
181    nm_counter(13,1)='isppol     ='
182    nm_counter(13,2)='ikpt       ='
183 
184    nm_levels(14)   ='dfpt_vtowfk         '
185    ncounter(14)=2
186    nm_counter(14,1)='inonsc     ='
187    nm_counter(14,2)='iband      ='
188 
189    nm_levels(15)   ='dfpt_cgwf           '
190    ncounter(15)=1
191    nm_counter(15,1)='iline      ='
192 
193    nm_levels(16)   ='getgh1c             '
194    ncounter(16)=0
195    nm_counter(16,1)='            '
196 
197    nm_levels(17)   ='dfpt_rhofermi       '
198    ncounter(17)=2
199    nm_counter(17,1)='isppol     ='
200    nm_counter(17,2)='ikpt       ='
201 
202    nm_levels(18)   ='dfpt_wfkfermi       '
203    ncounter(18)=2
204    nm_counter(18,1)='inonsc     ='
205    nm_counter(18,2)='iband      ='
206 
207 
208 !  Optdriver=2
209    nm_levels(20)   ='suscep              '
210    ncounter(20)=0
211    nm_counter(20,1)='            '
212 
213 
214 !  Optdriver=3
215    nm_levels(30)   ='screening           '
216    ncounter(30)=1
217    nm_counter(30,1)='iqpt       ='
218 
219 !  Optdriver=4
220    nm_levels(40)   ='sigma               '
221    ncounter(40)=1
222    nm_counter(40,1)='ikpt_gw    ='
223 
224 !  Optdriver=5
225    nm_levels(50)   ='nonlinear           '
226    ncounter(50)=0
227    nm_counter(50,1)='            '
228 
229    nm_levels(51)   ='dfptnl_loop         '
230    ncounter(51)=2
231    nm_counter(51,1)='pert1case  ='
232    nm_counter(51,2)='pert3case  ='
233 
234    nm_levels(52)   ='mv_/dfptnl_resp     '
235    ncounter(52)=2
236    nm_counter(52,2)='ikpt       ='
237 
238 !  Optdriver=9
239    nm_levels(90)   ='bethe_salpether     '
240    ncounter(90)=0
241    nm_counter(90,1)='            '
242 
243    if(istat<0)then
244      write(message, '(a,i7,a,a,a,a,a)' )&
245 &     'the value of the input variable istatr is',istat,' ,',ch10,&
246 &     'while it must be a positive number.',ch10,&
247 &     'Action : change istatr in your input file.'
248      MSG_ERROR(message)
249    end if
250    output_rate=istat
251  end if
252 
253 !The true input variable "shift_rate" is only available at the second call
254  if(statnu==1)then
255    if(istat<0 .or. istat>output_rate)then
256      write(message, '(a,i7,3a,i7,2a)' )&
257 &     'the value of the input variable istatshft is',istat,' ,',ch10,&
258 &     'while it must be a positive number smaller or equal to istatr=',output_rate,ch10,&
259 &     'Action: change istatshft in your input file.'
260      MSG_ERROR(message)
261    end if
262    shift_rate=istat
263    if(shift_rate==output_rate)shift_rate=0
264 
265 !  At this second call, also feed information that the abinit routine called ab7_invars_load
266    write(unit=nm_routine(1),fmt='(a20)') 'call ab7_invars_load'
267    active(1)=1
268  end if
269 
270 !Check the value of level
271  if( minval(abs(list_level(:)-level)) /= 0)then
272    write(message, '(a,i5,3a)' )&
273 &   '  The value of level in the calling routine is',level,' ,',ch10,&
274 &   '  which is not an allowed value.'
275    MSG_BUG(message)
276  end if
277 
278 !Assign the info about the actual routine
279  write(unit=nm_routine(level),fmt='(a20)') trim(adjustl(routine))
280  if(trim(adjustl(nm_routine(level)))=='exit')then
281 !  The value 2 will be changed to 0 at the end of the routine.
282    active(level)=2
283  else if(trim(adjustl(nm_routine(level)))=='')then
284    active(level)=0
285  else
286    active(level)=1
287  end if
288 
289 !Assign the info about the actual counter
290  if(counter>=0)then
291    if(ncounter(level)==1)then
292      actual_counter(level,1)=counter
293    else if(ncounter(level)==2)then
294      actual_counter(level,2)=counter/100
295 !    The counter number 1 does not allow more than 99 passes
296      actual_counter(level,1)=counter-(counter/100)*100
297    end if
298  end if
299 
300 !============================================================
301 
302 !After treatment of present information, output of the status
303  statnu=statnu+1
304 
305 !DEBUG
306 ! write(std_out,*)' status : statnu, output_rate, shift_rate=',statnu,output_rate, shift_rate
307 ! write(std_out,*)'level,routine=',level,routine
308 ! write(std_out,*)'active(level)=',active(level)
309 ! write(std_out,*)'counter,actual_counter(level,1:2)=',counter,actual_counter(level,1:2)
310 ! write(std_out,*)'List of active levels :'
311 ! do ilevel=1,mlevel
312 !   if(active(ilevel)/=0)write(std_out,*)' Active level number=',ilevel
313 ! end do
314 !ENDDEBUG
315 
316  if(statnu > 2 )then
317    if( mod(statnu,output_rate)==shift_rate )then
318 
319      if (open_file(filstat,message,newunit=temp_unit,form='formatted',status='unknown') /= 0) then
320        MSG_ERROR(message)
321      end if
322 
323      rewind temp_unit
324      write(temp_unit,*)
325 
326      headwr='(a,i4,a,i6 )'
327      if(statnu>=100000)   headwr='(a,i4,a,i9 )'
328      if(output_rate>=1000)headwr='(a,i6,a,i6 )'
329      if(statnu>=100000 .and. output_rate>=1000)   headwr='(a,i6,a,i9 )'
330      if(statnu>=100000000)headwr='(a,i6,a,i12)'
331      write(temp_unit,headwr)' Status file, with repetition rate',output_rate,', status number',statnu
332      write(temp_unit,*)
333 
334 !    Treat every level one after the other
335      do ilevel=1,mlevel
336 !      This level must be activated in order to have a corresponding output
337        if(active(ilevel)==1 .or. active(ilevel)==2)then
338 
339          write(temp_unit,'(4a)')'  Level ',nm_levels(ilevel),' : ',adjustl(nm_routine(ilevel))
340 
341 !        Is there a counter for this level ?
342          if(ncounter(ilevel)>=1)then
343 
344            if(actual_counter(ilevel,1)>0)then
345              write(temp_unit,'(a,a,i5)')'  ',nm_counter(ilevel,1),actual_counter(ilevel,1)
346            end if
347            if(ncounter(ilevel)==2)then
348              if(actual_counter(ilevel,2)>0)then
349                write(temp_unit,'(a,a,i5)')'  ',nm_counter(ilevel,2),actual_counter(ilevel,2)
350              end if
351            end if
352 
353          end if
354        end if ! End of the check on activation of the level
355      end do ! End of the loop on the levels
356 
357      close (temp_unit)
358    end if ! End of the repetition rate check
359  end if ! statnu > 2
360 
361  if (active(level)==2)then
362    active(level)=0
363    nm_routine(level)='              '
364  end if
365 
366  call timab(73,2,tsec)
367 
368 end subroutine status