LCOV - code coverage report
Current view: top level - src/57_iovars - m_outvars.F90 (source / functions) Coverage Total Hit
Test: coverage.info Lines: 94.1 % 136 128
Test Date: 2026-09-21 13:49:52 Functions: 100.0 % 1 1

            Line data    Source code
       1              : !!****m* ABINIT/m_outvars
       2              : !! NAME
       3              : !!  m_outvars
       4              : !!
       5              : !! FUNCTION
       6              : !!
       7              : !! COPYRIGHT
       8              : !!  Copyright (C) 1998-2026 ABINIT group (DCA, XG, GMR)
       9              : !!  This file is distributed under the terms of the
      10              : !!  GNU General Public License, see ~abinit/COPYING
      11              : !!  or http://www.gnu.org/copyleft/gpl.txt .
      12              : !!
      13              : !! SOURCE
      14              : 
      15              : #if defined HAVE_CONFIG_H
      16              : #include "config.h"
      17              : #endif
      18              : 
      19              : #include "abi_common.h"
      20              : 
      21              : module m_outvars
      22              : 
      23              :  use defs_basis
      24              :  use m_results_out
      25              :  use m_dtset
      26              :  use m_abicore
      27              :  use m_errors
      28              :  use m_xomp
      29              :  use m_xmpi
      30              :  use netcdf
      31              :  use m_outvar_a_h
      32              :  use m_outvar_i_n
      33              :  use m_outvar_o_z
      34              : 
      35              :  use m_parser,    only : ab_dimensions
      36              :  use m_nctk,      only : create_nc_file
      37              : 
      38              :  implicit none
      39              : 
      40              :  private
      41              : !!***
      42              : 
      43              :  public :: outvars
      44              : !!***
      45              : 
      46              : contains
      47              : !!***
      48              : 
      49              : !!****f* ABINIT/outvars
      50              : !! NAME
      51              : !! outvars
      52              : !!
      53              : !! FUNCTION
      54              : !! Echo variables for the ABINIT code.
      55              : !!
      56              : !! INPUTS
      57              : !!  choice= 1 if echo of preprocessed variables, 2 if echo after call driver
      58              : !!  dmatpuflag=flag controlling the use of an initial density matrix in PAW+U (max. value over datasets)
      59              : !!  dtsets(0:ndtset_alloc)=<type datafiles_type>contains all input variables
      60              : !!  iout=unit number for echoed output
      61              : !!  mxvals=maximum size of some arrays along all datasets, including:
      62              : !!         ga_n_rules =maximal value of input ga_n_rules for all the datasets
      63              : !!         gw_nqlwl   =maximal value of input gw_nqlwl for all the datasets
      64              : !!         lpawu      =maximal value of input lpawu for all the datasets
      65              : !!         mband      =maximum number of bands
      66              : !!         natom      =maximal value of input natom for all the datasets
      67              : !!         natpawu    =maximal value of number of atoms on which +U is applied for all the datasets
      68              : !!         natsph     =maximal value of input natsph for all the datasets
      69              : !!         natvshift  =maximal value of input natvshift for all the datasets
      70              : !!         nconeq     =maximal value of input nconeq for all the datasets
      71              : !!         nimage     =maximal value of input nimage for all the datasets
      72              : !!         nimfrqs    =maximal value of input cd_customnimfrqs for all the datasets
      73              : !!         nkpt       =maximal value of input nkpt for all the datasets
      74              : !!         nkptgw     =maximal value of input nkptgw for all the datasets
      75              : !!         nkpthf     =maximal value of input nkpthf for all the datasets
      76              : !!         nnos       =maximal value of input nnos for all the datasets
      77              : !!         nqptdm     =maximal value of input nqptdm for all the datasets
      78              : !!         nspinor    =maximal value of input nspinor for all the datasets
      79              : !!         nsppol     =maximal value of input nsppol for all the datasets
      80              : !!         nsym       =maximum number of symmetries
      81              : !!         ntypat     =maximum number of type of atoms
      82              : !!         nzchempot  =maximal value of input nzchempot for all the datasets
      83              : !!  ndtset=number of datasets
      84              : !!  ndtset_alloc=number of datasets, corrected for allocation of at least
      85              : !!   one data set. Use for most dimensioned arrays.
      86              : !!  npsp=number of pseudopotentials
      87              : !!  results_out(0:ndtset_alloc)=<type results_out_type>contains the results
      88              : !!   needed for outvars, including evolving variables
      89              : !!  timopt=input variable to modulate the timing
      90              : !!
      91              : !! OUTPUT
      92              : !!  Only writing
      93              : !!
      94              : !! NOTES
      95              : !! Note that this routine is called only by the processor me==0 .
      96              : !! In consequence, no use of message and wrtout routine.
      97              : !! The lines of code needed to output the defaults are preserved
      98              : !! (see last section of the routine, but are presently disabled)
      99              : !!
     100              : !! SOURCE
     101              : 
     102         4524 : subroutine outvars(choice,dmatpuflag,dtsets,filnam4,iout, mxvals,ndtset,ndtset_alloc,npsp,results_out,timopt)
     103              : 
     104              : !Arguments ------------------------------------
     105              : !scalars
     106              :  integer,intent(in) :: choice,dmatpuflag,iout
     107              :  integer,intent(in) :: ndtset,ndtset_alloc,npsp,timopt
     108              :  type(ab_dimensions),intent(in) :: mxvals
     109              :  character(len=*),intent(in) :: filnam4
     110              : !arrays
     111              :  type(dataset_type),intent(in) :: dtsets(0:ndtset_alloc)
     112              :  type(results_out_type),intent(in) :: results_out(0:ndtset_alloc)
     113              : 
     114              : !Local variables-------------------------------
     115              : !scalars
     116              :  integer,parameter :: nkpt_max=50
     117              :  integer :: first,idtset,iimage,kptopt, marr,mu,ncerr, nshiftk, prtvol_glob,max_nthreads
     118              :  integer :: rfddk,rfelfd,rfphon,rfstrs,rfmagn,rf2_dkdk,rf2_dkde
     119              :  integer :: ncid=0 ! Variables for NetCDF output
     120              :  character(len=500) :: msg
     121              :  character(len=4) :: stringimage
     122              :  type(ab_dimensions) :: multivals
     123              : !arrays
     124         4524 :  integer,allocatable :: jdtset_(:),response_(:)
     125         4524 :  character(len=8),allocatable :: strimg(:)
     126              : 
     127              : ! *************************************************************************
     128              : 
     129              :  !Set up a 'global' prtvol value
     130         4524 :  prtvol_glob=1
     131        29986 :  if(sum((dtsets(:)%prtvol)**2)==0)prtvol_glob=0
     132              : 
     133              : !###########################################################
     134              : !### 00. Echo of selected default values
     135              : 
     136         4524 :  if(choice==1)then
     137              :    max_nthreads = xomp_get_max_threads()
     138              : #ifndef HAVE_OPENMP
     139         2298 :    max_nthreads = 0 ! this value signals that OMP is not enabled in ABINIT.
     140              : #endif
     141              : 
     142              :    write(iout, '(9a)' )&
     143         2298 :      '--------------------------------------------------------------------------------',ch10,&
     144         2298 :      '------------- Echo of variables that govern the present computation ------------',ch10,&
     145         2298 :      '--------------------------------------------------------------------------------',ch10,&
     146         2298 :      '-',ch10,&
     147         4596 :      '- outvars: echo of selected default values'
     148              :    write(iout, '(3(a,i3),2a)' )&
     149         2298 :      '-   iomode0 =',dtsets(0)%iomode,' , fftalg0 =',dtsets(0)%ngfft(7),' , wfoptalg0 =',dtsets(0)%wfoptalg,ch10,&
     150         4596 :      '-'
     151              :    write(iout, '(3a,(a,i5),2a)' )&
     152         2298 :      '- outvars: echo of global parameters not present in the input file',ch10,&
     153         2298 :      '- ',' max_nthreads =',max_nthreads,ch10,&
     154         4596 :      '-'
     155              :  end if
     156              : 
     157              : !write(std_out,*) 'outvar 01'
     158              : !###########################################################
     159              : !### 01. First line indicating outvars
     160              : 
     161         4524 :  if(choice==1)then
     162         2298 :    write(iout, '(a)' )' -outvars: echo values of preprocessed input variables --------'
     163              :  else
     164         2226 :    write(iout, '(a)' )' -outvars: echo values of variables after computation  --------'
     165              :  end if
     166              : 
     167              : !###########################################################
     168              : !### 02. Open NetCDF file for export variables
     169              : 
     170              : !Wrap the netcdf OUT.nc into conditional for flexible output writing
     171         4524 :  if ( dtsets(1)%ncout == 1 ) then
     172              : 
     173              :    ! Enable netcdf output only if the number of datasets is small.
     174              :    ! otherwise v6[34] crashes with errmess:
     175              :    !    nf90_def_dim - NetCDF library returned:   NetCDF: NC_MAX_DIMS exceeded
     176              :    ! because we keep on creating dimensions in write_var_netcdf.
     177              :    ! one should use groups for this kind of operations!!
     178         4500 :    ncid = 0
     179         4500 :    if (ndtset_alloc  < 10) then
     180         4162 :      if (iout==std_out)then
     181         2081 :        write(iout,*) ch10,' These variables are accessible in NetCDF format (',trim(filnam4)//'_OUT.nc',')',ch10
     182              :      end if
     183         4162 :      call create_nc_file(trim(filnam4)//"_OUT.nc",ncid)
     184              : 
     185         4162 :      if (dtsets(1)%prtvol==-2) then
     186            2 :        if (ncid>0)then
     187            2 :         ncid=-ncid
     188              :        else
     189            0 :         ncid=-1
     190              :        end if
     191              :      end if
     192              :    else
     193          338 :      ABI_COMMENT("output of OUT.nc has been disabled. Too many datasets")
     194              :    end if
     195              :   !ncid = 0
     196              : 
     197           24 :   else if ( dtsets(1)%ncout == 0 ) then
     198           24 :    ABI_COMMENT("ncout set to 0. No OUT.nc will be printed.")
     199              :   else
     200            0 :    ABI_COMMENT("ncout value unregonized. OUT.nc will proceed will default settings.")
     201              :  end if !ncout condition
     202              : 
     203              : !###########################################################
     204              : !##1 03. Set up dimensions : determine whether these are different for different datasets.
     205              : 
     206         4524 :  multivals%ga_n_rules=0
     207         4524 :  multivals%gw_nqlwl=0
     208         4524 :  multivals%mband=0
     209         4524 :  multivals%natom=0
     210         4524 :  multivals%natpawu=0
     211         4524 :  multivals%natsph=0
     212         4524 :  multivals%natvshift=0
     213         4524 :  multivals%nberry=0
     214         4524 :  multivals%nbandhf=0
     215         4524 :  multivals%nconeq=0
     216         4524 :  multivals%nfreqsp=0
     217         4524 :  multivals%nimage=0
     218         4524 :  multivals%nimfrqs=0
     219         4524 :  multivals%nkpt=0
     220         4524 :  multivals%nkptgw=0
     221         4524 :  multivals%nkpthf=0
     222         4524 :  multivals%nnos=0
     223         4524 :  multivals%nqptdm=0
     224         4524 :  multivals%nshiftk=0
     225         4524 :  multivals%nsp=0
     226         4524 :  multivals%nspinor=0
     227         4524 :  multivals%nsppol=0
     228         4524 :  multivals%nsym=0
     229         4524 :  multivals%ntypat=0
     230         4524 :  multivals%ntypalch=0
     231         4524 :  multivals%nzchempot=0
     232              : 
     233         4524 :  if(ndtset_alloc>1)then
     234        22542 :    do idtset=1,ndtset_alloc
     235        19478 :      if(dtsets(1)%ga_n_rules/=dtsets(idtset)%ga_n_rules) multivals%ga_n_rules =1
     236        19478 :      if(dtsets(1)%gw_nqlwl /=dtsets(idtset)%gw_nqlwl ) multivals%gw_nqlwl =1
     237        19478 :      if(dtsets(1)%mband    /=dtsets(idtset)%mband    ) multivals%mband    =1
     238        19478 :      if(dtsets(1)%natom    /=dtsets(idtset)%natom    ) multivals%natom    =1
     239        19478 :      if(dtsets(1)%natpawu  /=dtsets(idtset)%natpawu  ) multivals%natpawu  =1
     240        19478 :      if(dtsets(1)%natsph   /=dtsets(idtset)%natsph   ) multivals%natsph   =1
     241        19478 :      if(dtsets(1)%natvshift/=dtsets(idtset)%natvshift) multivals%natvshift=1
     242        19478 :      if(dtsets(1)%nberry   /=dtsets(idtset)%nberry   ) multivals%nberry   =1
     243        19478 :      if(dtsets(1)%nbandhf  /=dtsets(idtset)%nbandhf  ) multivals%nbandhf  =1
     244        19478 :      if(dtsets(1)%nconeq   /=dtsets(idtset)%nconeq   ) multivals%nconeq   =1
     245        19478 :      if(dtsets(1)%nfreqsp  /=dtsets(idtset)%nfreqsp  ) multivals%nfreqsp  =1
     246        19478 :      if(dtsets(1)%nimage   /=dtsets(idtset)%nimage   ) multivals%nimage   =1
     247        19478 :      if(dtsets(1)%cd_customnimfrqs  /=dtsets(idtset)%cd_customnimfrqs  ) multivals%nimfrqs  =1
     248        19478 :      if(dtsets(1)%nkpt     /=dtsets(idtset)%nkpt     ) multivals%nkpt     =1
     249        19478 :      if(dtsets(1)%nkptgw   /=dtsets(idtset)%nkptgw   ) multivals%nkptgw   =1
     250        19478 :      if(dtsets(1)%nkpthf*dtsets(1)%usefock /=dtsets(idtset)%nkpthf*dtsets(idtset)%usefock) multivals%nkpthf=1
     251        19478 :      if(dtsets(1)%nnos     /=dtsets(idtset)%nnos     ) multivals%nnos     =1
     252        19478 :      if(dtsets(1)%nqptdm   /=dtsets(idtset)%nqptdm   ) multivals%nqptdm   =1
     253        19478 :      if(dtsets(1)%nsppol*dtsets(1)%nspinor/=dtsets(idtset)%nsppol*dtsets(idtset)%nspinor) multivals%nsp=1
     254        19478 :      if(dtsets(1)%nsppol   /=dtsets(idtset)%nsppol   ) multivals%nsppol   =1
     255        19478 :      if(dtsets(1)%nspinor  /=dtsets(idtset)%nspinor  ) multivals%nspinor  =1
     256        19478 :      if(dtsets(1)%nsym     /=dtsets(idtset)%nsym     ) multivals%nsym     =1
     257        19478 :      if(dtsets(1)%ntypat   /=dtsets(idtset)%ntypat   ) multivals%ntypat   =1
     258        19478 :      if(dtsets(1)%ntypalch /=dtsets(idtset)%ntypalch ) multivals%ntypalch =1
     259        22542 :      if(dtsets(1)%nzchempot/=dtsets(idtset)%nzchempot) multivals%nzchempot=1
     260              :    end do
     261              :  end if
     262              : 
     263              :  !write(std_out,*)' outvars : multivals%nkpthf =',multivals%nkpthf
     264              :  !write(std_out,*)' outvars : dtsets(1:ndtset_alloc)%nkpthf =',dtsets(1:ndtset_alloc)%nkpthf
     265              : 
     266         4524 :  nshiftk=1
     267        25462 :  if(sum((dtsets(1:ndtset_alloc)%kptopt)**2)/=0)then
     268              :    first=0
     269        15522 :    do idtset=1,ndtset_alloc
     270        12368 :      kptopt=dtsets(idtset)%kptopt
     271        15522 :      if(kptopt>=1)then
     272        11476 :        if(first==0)then
     273         3150 :          first=1
     274         3150 :          nshiftk=dtsets(idtset)%nshiftk
     275              :        else
     276         8326 :          if(nshiftk/=dtsets(idtset)%nshiftk)multivals%nshiftk=1
     277              :        end if
     278              :      end if
     279              :    end do
     280              :  end if
     281              : 
     282              : !###########################################################
     283              : !### 04. Determine whether each dataset is (or not) a response calculation
     284              : !## (should use optdriver, isn't it ?)
     285              : 
     286        13572 :  ABI_MALLOC(response_,(ndtset_alloc))
     287        25462 :  response_(:)=0
     288        25462 :  do idtset=1,ndtset_alloc
     289        20938 :    rfddk=dtsets(idtset)%rfddk
     290        20938 :    rfelfd=dtsets(idtset)%rfelfd
     291        20938 :    rfphon=dtsets(idtset)%rfphon
     292        20938 :    rfstrs=dtsets(idtset)%rfstrs
     293        20938 :    rfmagn=dtsets(idtset)%rfmagn
     294        20938 :    rf2_dkdk=dtsets(idtset)%rf2_dkdk
     295        20938 :    rf2_dkde=dtsets(idtset)%rf2_dkde
     296              :    if(rfddk/=0 .or. rfelfd/=0 .or. rfphon/=0 .or. rfstrs/=0 .or. &
     297        25462 :       rf2_dkdk/=0 .or. rf2_dkde/=0 .or. rfmagn/=0) response_(idtset)=1
     298              :  end do
     299              : 
     300              : !###########################################################
     301              : !### 05. Determine size of work arrays
     302              : 
     303              :  marr=max(3*mxvals%natom,&
     304              :           mxvals%natsph,&
     305              :           mxvals%natvshift*mxvals%nsppol*mxvals%natom,&
     306              :           3*mxvals%nberry,&
     307              :           mxvals%nimage,&
     308              :           3*mxvals%nkptgw,&
     309              :           3*mxvals%nkpthf,&
     310              :           mxvals%nkpt*mxvals%nsppol*mxvals%mband,&
     311              :           3*mxvals%nkpt,npsp,&
     312              :           3*mxvals%nqptdm,&
     313              :           mxvals%ntypat,&
     314              :           9*mxvals%nsym,3*8,&
     315              :           3*mxvals%natom*mxvals%nconeq,&
     316              :           mxvals%nnos,&
     317              :           3*mxvals%nqptdm,&
     318              :           3*mxvals%nzchempot*mxvals%ntypat,&
     319              :           3*mxvals%gw_nqlwl,&
     320              :           (2*mxvals%lpawu+1)**2*max(mxvals%nsppol,mxvals%nspinor)*mxvals%natpawu*dmatpuflag,&
     321              :           30 &
     322         4524 :           ) ! used by ga_rules TODO : replace with mxvals% ga_n_rules
     323              : 
     324              : !###########################################################
     325              : !### 06. Initialize strimg
     326              : 
     327        13572 :  ABI_MALLOC(strimg,(mxvals%nimage))
     328         9432 :  do iimage=1,mxvals%nimage
     329         4908 :    if(iimage<10)then
     330         4884 :      write(stringimage,'(i1)')iimage
     331           24 :    else if(iimage<100)then
     332           24 :      write(stringimage,'(i2)')iimage
     333            0 :    else if(iimage<1000)then
     334            0 :      write(stringimage,'(i3)')iimage
     335            0 :    else if(iimage<10000)then
     336            0 :      write(stringimage,'(i4)')iimage
     337              :    end if
     338         9432 :    strimg(iimage)='_'//trim(stringimage)//'img'
     339              :  end do
     340         4524 :  strimg(1)=''
     341              : 
     342              : !###########################################################
     343              : !### 07. Initialize jdtset_
     344              : 
     345        13572 :  ABI_MALLOC(jdtset_,(0:ndtset_alloc))
     346        29986 :  jdtset_(0:ndtset_alloc)=dtsets(0:ndtset_alloc)%jdtset
     347              : 
     348              : !###########################################################
     349              : !### 08. Print variables, for different ranges of names
     350              : 
     351              :  call outvar_a_h(choice,dmatpuflag,dtsets,iout,jdtset_,marr,multivals,mxvals,&
     352         4524 :                  ncid,ndtset,ndtset_alloc,results_out,strimg)
     353              : 
     354              :  call outvar_i_n(dtsets,iout,jdtset_,marr,multivals,mxvals,&
     355         4524 :                  ncid,ndtset,ndtset_alloc,npsp,prtvol_glob,response_,results_out,strimg)
     356              : 
     357              :  call outvar_o_z(choice,dtsets,iout,&
     358              :                  jdtset_,marr,multivals,mxvals,ncid,ndtset,ndtset_alloc,npsp,prtvol_glob,&
     359         4524 :                  results_out,strimg,timopt)
     360              : 
     361              : !###########################################################
     362              : !## Deallocations and cleaning
     363              : 
     364         4524 :  ABI_FREE(jdtset_)
     365         4524 :  ABI_FREE(response_)
     366         4524 :  ABI_FREE(strimg)
     367              : 
     368       366444 :  write(msg,'(a,80a)')ch10,('=',mu=1,80)
     369         4524 :  call wrtout(iout,msg)
     370              : 
     371         4524 :  if (ncid /= 0 .and. dtsets(1)%ncout == 1) then
     372         4162 :    ncerr=nf90_close(abs(ncid))
     373         4162 :    if (ncerr/=nf90_NoErr) then
     374            0 :      msg='Netcdf Error while closing the OUT.nc file: '//trim(nf90_strerror(ncerr))
     375            0 :      ABI_ERROR(msg)
     376              :    end if
     377              :  end if
     378              : 
     379         4524 : end subroutine outvars
     380              : !!***
     381              : 
     382              : end module m_outvars
     383              : !!***
        

Generated by: LCOV version 2.3-1