Changeset 2908

Timestamp:

05/11/07 03:57:00 (3 years ago)

Author:

acastro

Message:

I moved the function restart_look to the states module, where
it belongs. I also collected some code that was replicated in various
places, and put it as a "restart_look_and_read" subroutine.

Location:

trunk/src

Files:

• casida.F90 (modified) (1 diff)
• em_resp.F90 (modified) (1 diff)
• opt_control_defstates.F90 (modified) (5 diffs)
• phonons_lr.F90 (modified) (1 diff)
• restart.F90 (modified) (2 diffs)
• states.F90 (modified) (2 diffs)
• td_write.F90 (modified) (1 diff)

trunk/src/casida.F90

@@ -90 +90 @@
     call write_info(1)
 
-    call restart_look(trim(tmpdir)//'restart_gs', sys%gr%m, kpoints, dim, nst, ierr)
-    if(ierr.ne.0) then
-      message(1) = 'Could not properly read wave-functions from "'//trim(tmpdir)//'restart_gs".'
-      call write_fatal(1)
-    end if
-
-    if(sys%st%d%ispin == SPINORS) then
-      message(1) = 'Linear response TDDFT ("Casida" mode) is not implemented for spinors-DFT.'
-      call write_fatal(1)
-    end if
-
-    sys%st%nst    = nst
-    sys%st%st_end = nst
-    deallocate(sys%st%eigenval, sys%st%occ)
-
-    call states_allocate_wfns(sys%st, sys%gr%m)
-
-    ALLOCATE(sys%st%eigenval(sys%st%nst, sys%st%d%nik), sys%st%nst*sys%st%d%nik)
-    ALLOCATE(sys%st%occ(sys%st%nst, sys%st%d%nik), sys%st%nst*sys%st%d%nik)
-
-    if(sys%st%d%ispin == SPINORS) then
-      ALLOCATE(sys%st%spin(3, sys%st%nst, sys%st%d%nik), sys%st%nst*sys%st%d%nik*3)
-      sys%st%spin = M_ZERO
-    end if
-    sys%st%eigenval = huge(REAL_PRECISION)
-    sys%st%occ      = M_ZERO
-
-    call restart_read(trim(tmpdir)//'restart_gs', sys%st, sys%gr, sys%geo, ierr)
+    call restart_look_and_read(trim(tmpdir)//'restart_gs', sys%st, sys%gr, sys%geo, ierr)
     if(ierr.ne.0) then
       message(1) = 'Could not properly read wave-functions from "'//trim(tmpdir)//'restart_gs".'

trunk/src/em_resp.F90

@@ -454 +454 @@
     call push_sub('em_resp.read_wfs')
 
-    call restart_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
+    call states_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
 
     if(ierr.ne.0) then

trunk/src/opt_control_defstates.F90

@@ -59 +59 @@
       !They should also be isolated and taken away, since they are repeated in several places.
       tmp_st = initial_state
-      call restart_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
-      tmp_st%nst    = nst
-      tmp_st%st_end = nst
-      deallocate(tmp_st%eigenval)
-      deallocate(tmp_st%occ)
-      call states_allocate_wfns(tmp_st, gr%m)
-      ALLOCATE(tmp_st%eigenval(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-      ALLOCATE(tmp_st%occ(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-      if(tmp_st%d%ispin == SPINORS) then
-        ALLOCATE(tmp_st%spin(3, tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik*3)
-        tmp_st%spin = M_ZERO
-      end if
-      tmp_st%eigenval = huge(REAL_PRECISION)
-      tmp_st%occ      = M_ZERO
-      call restart_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
-      
+      call restart_look_and_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
+      if(ierr.ne.0) then
+        write(message(1),'(a)') 'Could not read ground-state wavefunctions from '//trim(tmpdir)//'restart_gs.'
+        call write_fatal(1)
+      end if
       initial_state%zpsi(:, :, 1, 1) = tmp_st%zpsi(:, :, state, 1)
 
@@ -102 +91 @@
 
         tmp_st = initial_state
-        call restart_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
-        tmp_st%nst    = nst
-        tmp_st%st_end = nst
-        deallocate(tmp_st%eigenval)
-        deallocate(tmp_st%occ)
-        call states_allocate_wfns(tmp_st, gr%m)
-        ALLOCATE(tmp_st%eigenval(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-        ALLOCATE(tmp_st%occ(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-        if(tmp_st%d%ispin == SPINORS) then
-          ALLOCATE(tmp_st%spin(3, tmp_st%nst, tmp_st%d%nik), 3*tmp_st%nst*tmp_st%d%nik)
-          tmp_st%spin = M_ZERO
+        call restart_look_and_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
+        if(ierr.ne.0) then
+          write(message(1),'(a)') 'Could not read ground-state wavefunctions from '//trim(tmpdir)//'restart_gs.'
+          call write_fatal(1)
         end if
-        tmp_st%eigenval = huge(REAL_PRECISION)
-        tmp_st%occ      = M_ZERO
-        call restart_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
-
 
         no_blk = loct_parse_block_n(blk)
@@ -241 +219 @@
       call write_info(1)
       call restart_read(trim(tmpdir)//'restart_gs', target_state, gr, geo, ierr)
+      if(ierr.ne.0) then
+        write(message(1),'(a)') 'Could not read ground-state wavefunctions from '//trim(tmpdir)//'restart_gs.'
+        call write_fatal(1)
+      end if
       
     case(oct_tg_excited) 
@@ -257 +239 @@
       !TODO: The following lines of code do not look too clear, and will probably break easily.
       tmp_st = target_state
-      call restart_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
-      tmp_st%nst    = nst
-      tmp_st%st_end = nst
-      deallocate(tmp_st%eigenval)
-      deallocate(tmp_st%occ)
-      call states_allocate_wfns(tmp_st, gr%m)
-      ALLOCATE(tmp_st%eigenval(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-      ALLOCATE(tmp_st%occ(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-      if(tmp_st%d%ispin == SPINORS) then
-        ALLOCATE(tmp_st%spin(3, tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik*3)
-        tmp_st%spin = M_ZERO
-      end if
-      tmp_st%eigenval = huge(REAL_PRECISION)
-      tmp_st%occ      = M_ZERO
-      call restart_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
+      call restart_look_and_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
+      if(ierr.ne.0) then
+        write(message(1),'(a)') 'Could not read ground-state wavefunctions from '//trim(tmpdir)//'restart_gs.'
+        call write_fatal(1)
+      end if
 
       target_state%zpsi(:, :, 1, 1) = tmp_st%zpsi(:, :, state, 1)
@@ -300 +272 @@
 
         tmp_st = target_state
-        call restart_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
-        tmp_st%nst    = nst
-        tmp_st%st_end = nst
-        deallocate(tmp_st%eigenval)
-        deallocate(tmp_st%occ)
-        call states_allocate_wfns(tmp_st, gr%m)
-        ALLOCATE(tmp_st%eigenval(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-        ALLOCATE(tmp_st%occ(tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik)
-        if(tmp_st%d%ispin == SPINORS) then
-          ALLOCATE(tmp_st%spin(3, tmp_st%nst, tmp_st%d%nik), tmp_st%nst*tmp_st%d%nik*3)
-          tmp_st%spin = M_ZERO
+        call restart_look_and_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
+        if(ierr.ne.0) then
+          write(message(1),'(a)') 'Could not read ground-state wavefunctions from '//trim(tmpdir)//'restart_gs.'
+          call write_fatal(1)
         end if
-        tmp_st%eigenval = huge(REAL_PRECISION)
-        tmp_st%occ      = M_ZERO
-        call restart_read(trim(tmpdir)//'restart_gs', tmp_st, gr, geo, ierr)
 
         no_blk = loct_parse_block_n(blk)

trunk/src/phonons_lr.F90

@@ -297 +297 @@
     call push_sub('em_resp.read_wfs')
 
-    call restart_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
-
+    call states_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, ierr)
     if(ierr.ne.0) then
       message(1) = 'Could not properly read wave-functions from "'//trim(tmpdir)//'restart_gs".'

trunk/src/restart.F90

@@ -50 +50 @@
     restart_read,       &
     restart_format,     &
-    restart_look,       &
+    restart_look_and_read,   &
     drestart_write_function, &
     zrestart_write_function, &
@@ -149 +149 @@
 
   ! ---------------------------------------------------------
-  subroutine restart_look (dir, m, kpoints, dim, nst, ierr)
-    character(len=*), intent(in) :: dir
-    type(mesh_t),     intent(in) :: m
-    integer,         intent(out) :: kpoints, dim, nst, ierr
-
-    character(len=256) :: line
-    character(len=12)  :: filename
-    character(len=1)   :: char
-    integer :: iunit, iunit2, err, i, ist, idim, ik
-    FLOAT :: occ, eigenval
-
-    call push_sub('restart.restart_look')
-
-    ierr = 0
-    iunit  = io_open(trim(dir)//'/wfns', action='read', status='old', die=.false., is_tmp = .true., grp = m%mpi_grp)
-    if(iunit < 0) then
-      ierr = -1
-      return
-    end if
-    iunit2 = io_open(trim(dir)//'/occs', action='read', status='old', die=.false., is_tmp = .true., grp = m%mpi_grp)
-    if(iunit2 < 0) then
-      call io_close(iunit, grp = m%mpi_grp)
-      ierr = -1
-      return
-    end if
-
-    ! Skip two lines.
-    call iopar_read(m%mpi_grp, iunit, line, err); call iopar_read(m%mpi_grp, iunit, line, err)
-    call iopar_read(m%mpi_grp, iunit2, line, err); call iopar_read(m%mpi_grp, iunit2, line, err)
-
-    kpoints = 1
-    dim = 1
-    nst = 1
-    do
-      call iopar_read(m%mpi_grp, iunit, line, i)
-      read(line, '(a)') char
-      if(i.ne.0.or.char=='%') exit
-      read(line, *) ik, char, ist, char, idim, char, filename
-      if(ik > kpoints) kpoints = ik
-      if(idim == 2)    dim     = 2
-      if(ist>nst)      nst     = ist
-      call iopar_read(m%mpi_grp, iunit2, line, err)
-      read(line, *) occ, char, eigenval
-    end do
-
-    call io_close(iunit, grp = m%mpi_grp)
-    call io_close(iunit2, grp = m%mpi_grp)
+  subroutine restart_look_and_read(dir, st, gr, geo, ierr)
+    character(len=*),  intent(in)  :: dir
+    type(states_t), intent(inout)  :: st
+    type(grid_t),      intent(in)  :: gr
+    type(geometry_t),  intent(in)  :: geo
+    integer,           intent(out) :: ierr
+
+    integer :: kpoints, dim, nst, j
+
+    call push_sub('restart.restart_look_and_read')
+
+    call states_look(trim(tmpdir)//'restart_gs', gr%m, kpoints, dim, nst, j)
+    if(j.ne.0) then
+      ierr = j
+      call pop_sub(); return
+    end if
+
+    st%nst    = nst
+    st%st_end = nst
+    deallocate(st%eigenval, st%occ)
+
+    call states_allocate_wfns(st, gr%m)
+
+    ALLOCATE(st%eigenval(st%nst, st%d%nik), st%nst*st%d%nik)
+    ALLOCATE(st%occ(st%nst, st%d%nik), st%nst*st%d%nik)
+
+    if(st%d%ispin == SPINORS) then
+      ALLOCATE(st%spin(3, st%nst, st%d%nik), st%nst*st%d%nik*3)
+      st%spin = M_ZERO
+    end if
+    st%eigenval = huge(REAL_PRECISION)
+    st%occ      = M_ZERO
+
+    call restart_read(trim(tmpdir)//'restart_gs', st, gr, geo, ierr)
+
     call pop_sub()
-  end subroutine restart_look
+  end subroutine restart_look_and_read
+
 
   ! ---------------------------------------------------------

trunk/src/states.F90

@@ -48 +48 @@
     states_dim_t,                     &
     states_init,                      &
+    states_look,                      &
     states_read_user_def_orbitals,    &
     states_densities_init,            &
@@ -1898 +1899 @@
 
 
+  ! ---------------------------------------------------------
+  ! Reads the state stored in directory "dir", and finds out
+  ! the kpoints, dim, and nst contained in it.
+  ! ---------------------------------------------------------
+  subroutine states_look (dir, m, kpoints, dim, nst, ierr)
+    character(len=*), intent(in) :: dir
+    type(mesh_t),     intent(in) :: m
+    integer,         intent(out) :: kpoints, dim, nst, ierr
+
+    character(len=256) :: line
+    character(len=12)  :: filename
+    character(len=1)   :: char
+    integer :: iunit, iunit2, err, i, ist, idim, ik
+    FLOAT :: occ, eigenval
+
+    call push_sub('states.states_look')
+
+    ierr = 0
+    iunit  = io_open(trim(dir)//'/wfns', action='read', status='old', die=.false., is_tmp = .true., grp = m%mpi_grp)
+    if(iunit < 0) then
+      ierr = -1
+      return
+    end if
+    iunit2 = io_open(trim(dir)//'/occs', action='read', status='old', die=.false., is_tmp = .true., grp = m%mpi_grp)
+    if(iunit2 < 0) then
+      call io_close(iunit, grp = m%mpi_grp)
+      ierr = -1
+      return
+    end if
+
+    ! Skip two lines.
+    call iopar_read(m%mpi_grp, iunit, line, err); call iopar_read(m%mpi_grp, iunit, line, err)
+    call iopar_read(m%mpi_grp, iunit2, line, err); call iopar_read(m%mpi_grp, iunit2, line, err)
+
+    kpoints = 1
+    dim = 1
+    nst = 1
+    do
+      call iopar_read(m%mpi_grp, iunit, line, i)
+      read(line, '(a)') char
+      if(i.ne.0.or.char=='%') exit
+      read(line, *) ik, char, ist, char, idim, char, filename
+      if(ik > kpoints) kpoints = ik
+      if(idim == 2)    dim     = 2
+      if(ist>nst)      nst     = ist
+      call iopar_read(m%mpi_grp, iunit2, line, err)
+      read(line, *) occ, char, eigenval
+    end do
+
+    call io_close(iunit, grp = m%mpi_grp)
+    call io_close(iunit2, grp = m%mpi_grp)
+    call pop_sub()
+  end subroutine states_look
+
+
 #include "states_kpoints.F90"
 

trunk/src/td_write.F90

@@ -195 +195 @@
 !!$      nullify(w%gs_st%zpsi, w%gs_st%node, w%gs_st%occ, w%gs_st%eigenval, w%gs_st%mag)
       nullify(w%gs_st%zpsi, w%gs_st%node, w%gs_st%occ, w%gs_st%eigenval)
-      call restart_look (trim(tmpdir)//'restart_gs', gr%m, i, i, w%gs_st%nst, ierr)
+      call states_look (trim(tmpdir)//'restart_gs', gr%m, i, i, w%gs_st%nst, ierr)
 
       w%gs_st%st_start = 1