TABLE OF CONTENTS
ABINIT/status [ 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