!
!***********************************************************************
!
      module Coupling_transform_cfg_LSLScjj
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      use Coupling_constants
      use Coupling_structures
      use Coupling_data
      use Coupling_inside_shell
!-----------------------------------------------
!   R o u t i n e s
!-----------------------------------------------
      public  :: main_cfg_lslscjj
      public  :: count_nr_of_csfs_LScjj
      public  :: delete_cfg_expansions
      private :: form_list_nomach_csfs
      private :: form_csfs_LScjj
      private :: matrix_LS_LScjj
      private :: dotransform_LSLScjj
      private :: print_cfg_LSLScjj
      private :: equivalent_LSLScjj
!-----------------------------------------------
!   D e f i n i t i o n s
!-----------------------------------------------
      type::Ji_lists
         integer::nr_of_csf !serial number of csf_LS in csfs_LS
         type(list),dimension(:),pointer::Ji !i=1..nr_of_subc
      end type Ji_lists
!
      type:: cfg_Ji_lists
         integer::nr_of_subc
         integer::nr_of_nomach_csfs
         type(Ji_lists),dimension(:),pointer::csfs_Ji !i=1..nr_of_nomach_csfs
      end type cfg_Ji_lists
!
      type(expansion), public :: expansion_cfg_LS
      type(expansion), public :: expansion_cfg_LScjj
!
      type(list), private ::nomach_csfs_ls
      type(cfg_Ji_lists), private::cfg_Ji_structure
!-----------------------------------------------
!
contains
!
!***********************************************************************
!                                                                      *
      subroutine main_cfg_lslscjj(print_level)
!                                                                      *
!     This is managerial subroutine                                    *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
      implicit none
      integer, intent(in) :: print_level
      integer::error
      integer::itype
      expansion_cfg_LScjj%nr_of_state=expansion_cfg_LS%nr_of_state
      call form_list_nomach_csfs
      itype=0
      call form_csfs_LScjj(itype)
      call dotransform_LSLScjj
      if(print_level.gt.1) call print_cfg_LSLScjj(2) ! 2-means print LS and LScjj expansions
      deallocate(nomach_csfs_ls%items, STAT = error)
      end subroutine main_cfg_lslscjj
!
!***********************************************************************
!                                                                      *
      subroutine count_nr_of_csfs_LScjj(nr_of_csfs)
!                                                                      *
!     This subroutine counts the number of oneconfigurational          *
!     expansion in LScjj coupling                                         *
!     (corresponding to the one in the JJ coupling "expansion_cfg_LS") *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
      implicit none
      integer, intent(out):: nr_of_csfs
      integer::error
      integer::itype
      if(expansion_cfg_LS%csfs(1)%nosubc.lt.2) then
         write(*,*)                                                    &
           'ERROR at subroutine count_nr_of_csfs_LScjj: nosubc.lt.2'
         write(*,*)                                                    &
           '(you can not use LScjj coupling with less than 2 subshells)'
         write(*,*)'program is terminated'
         stop
      end if
      expansion_cfg_LScjj%nr_of_state=expansion_cfg_LS%nr_of_state
      call form_list_nomach_csfs
      itype=1
      call form_csfs_LScjj(itype)
      nr_of_csfs = expansion_cfg_LScjj%size
      if(associated(nomach_csfs_ls%items))                             &
                             deallocate(nomach_csfs_ls%items,STAT=error)
      end subroutine count_nr_of_csfs_LScjj
!
!***********************************************************************
!                                                                      *
      subroutine delete_cfg_expansions
!                                                                      *
!     This subroutine deallocates the arrays of                        *
!     oneconfigurational expansions "expansion_cfg_LScjj" and             *
!     "expansion_cfg_LS"                                               *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
      integer::icsf
!
!write(iwrite_log,'(6x,a21)') 'delete_cfg_expansions'
!
!delete expansion_cfg_LScjj
      if(associated(expansion_cfg_LScjj%coeffs))                       &
                                    deallocate(expansion_cfg_LScjj%csfs)
      if(associated(expansion_cfg_LScjj%csfs)) then
         do icsf=1, expansion_cfg_LScjj%size
            if(associated(expansion_cfg_LScjj%csfs(icsf)%subc_cfg))    &
                     deallocate(expansion_cfg_LScjj%csfs(icsf)%subc_cfg)
            if(associated(expansion_cfg_LScjj%csfs(icsf)%subc))        &
                         deallocate(expansion_cfg_LScjj%csfs(icsf)%subc)
            if(associated(expansion_cfg_LScjj%csfs(icsf)%iM1))         &
                          deallocate(expansion_cfg_LScjj%csfs(icsf)%iM1)
            if(associated(expansion_cfg_LScjj%csfs(icsf)%iM2))         &
                          deallocate(expansion_cfg_LScjj%csfs(icsf)%iM2)
            if(associated(expansion_cfg_LScjj%csfs(icsf)%iJ))          &
                           deallocate(expansion_cfg_LScjj%csfs(icsf)%iJ)
         end do
         deallocate(expansion_cfg_LScjj%csfs)
      end if
      expansion_cfg_LScjj%size=0
      expansion_cfg_LScjj%nr_of_state=0
!
!delete expansion_cfg_LS
      if(associated(expansion_cfg_LS%coeffs))                          &
                                       deallocate(expansion_cfg_LS%csfs)
      if(associated(expansion_cfg_LS%csfs)) then
         do icsf=1, expansion_cfg_LS%size
            if(associated(expansion_cfg_LS%csfs(icsf)%subc_cfg))       &
                        deallocate(expansion_cfg_LS%csfs(icsf)%subc_cfg)
            if(associated(expansion_cfg_LS%csfs(icsf)%subc))           &
                            deallocate(expansion_cfg_LS%csfs(icsf)%subc)
            if(associated(expansion_cfg_LS%csfs(icsf)%iM1))            &
                             deallocate(expansion_cfg_LS%csfs(icsf)%iM1)
            if(associated(expansion_cfg_LS%csfs(icsf)%iM2))            &
                             deallocate(expansion_cfg_LS%csfs(icsf)%iM2)
            if(associated(expansion_cfg_LS%csfs(icsf)%iJ))            &
                             deallocate(expansion_cfg_LS%csfs(icsf)%iJ)
         end do
         deallocate(expansion_cfg_LS%csfs)
      end if
      expansion_cfg_LS%size=0
      expansion_cfg_LS%nr_of_state=0
!
!write(iwrite_log,'(6x,a25)') 'end delete_cfg_expansions'
!
      end subroutine delete_cfg_expansions
!
!***********************************************************************
!                                                                      *
      function equivalent_LSLScjj(csf1, csf2)   result(rez)
!                                                                      *
!     This function defines the "equivalency" of                       *
!     two csfs in LS coupling for the formation of LScjj csfs          *
!     (for notion of the "equivalency" see the                         *
!     description in the program)                                      *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
      implicit none
      type(csf_LS) :: csf1, csf2
      logical :: rez
      integer::isubc
      rez = .true.
      if(csf1%nosubc.lt.2.or.csf2%nosubc.lt.2) then
         write(*,*)'ERROR at subroutine equivalent_LSLScjj: ',         &
                   'csf1%nosubc.lt.2.or.csf2%nosubc.lt.2'
         write(*,*)'(you can not use LScjj coupling with less than 2 ',&
                   'subshells)'
         write(*,*)'program will be terminated'
         stop
      end if
      if(csf1%nosubc.eq.csf2%nosubc) then
         do isubc=1,csf1%nosubc
            if(.not.csf1%subc_cfg(isubc)==csf2%subc_cfg(isubc)) then
               rez=.false.
               exit
            else if(.not.csf1%subc(isubc)==csf2%subc(isubc)) then
               if(isubc /= 2) rez=.false.
               exit
            end if
         end do
      else
         rez=.false.
      end if
      end function equivalent_LSLScjj
!
!***********************************************************************
!                                                                      *
      subroutine form_list_nomach_csfs
!                                                                      *
!     This subroutine form the list of serial numbers                  *
!     in "expansion_cfg_LS" of "nonequivalent" LS coupling csfs        *
!     (for notion of the "equivalency" see the                         *
!     description in the program)                                      *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
      implicit none
      integer:: inomach_counter
      integer, dimension(:), pointer :: temp_list
      integer::icsf_LS, inew
      logical:: new_csf
!
      inomach_counter=0
      allocate(temp_list(expansion_cfg_LS%size))
!
      do icsf_LS=1,expansion_cfg_LS%size,1
         new_csf = .true.
         do inew = 1, inomach_counter, 1
            if(equivalent_LSLScjj(expansion_cfg_LS%csfs(icsf_LS),      &
              expansion_cfg_LS%csfs(temp_list(inew)))) new_csf = .false.
         end do
         if(new_csf) then
            inomach_counter = inomach_counter + 1
            if(inomach_counter.gt.expansion_cfg_LS%size) then
               write(*,*) 'stop at subroutine define_nomach: ',        &
                  'inomach_counter.gt.expansion_cfg_LS%size'
               stop
            end if
            temp_list(inomach_counter)= icsf_LS
         end if
      end do
!
      nomach_csfs_LS%list_size = inomach_counter
!
      allocate(nomach_csfs_LS%items(nomach_csfs_LS%list_size))
!
      do icsf_LS=1, nomach_csfs_LS%list_size, 1
         nomach_csfs_LS%items(icsf_LS) = temp_list(icsf_LS)
      end do
!
      deallocate(temp_list)
!----- print down data -----------
!write(iwrite_log, *)'Nonmaching csfs_LS:'
!write(iwrite_log, *)'       Nr.   icsf_nr '
!do icsf_LS=1, nomach_csfs_LS%list_size, 1
!	 write(iwrite_log, '(4x,i3,2x,i3)') icsf_LS, nomach_csfs_LS%items(icsf_LS)
!end do !icsf_LS
!write(iwrite_log, *)'  '
!
      end subroutine form_list_nomach_csfs
!
!***********************************************************************
!                                                                      *
      subroutine form_csfs_LScjj(itype)
!                                                                      *
!     This subroutine forms the oneconfigurational                     *
!     expansion in LScjj coupling "expansion_cfg_LScjj",               *
!     correponding to the one in LS coupling "expansion_cfg_LS"        *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                last update: February 2020   *
!                                                                      *
!***********************************************************************
      implicit none
!type(cfg_Ji_lists),intent(in)::cfg_Ji_structure
      integer:: itype !defines the type of execution
                      !itype=1 - to find the number
                      !of csfs_LScjj only,
                      !itype.ne.1 - perform full
                      !calculation
!GG!      real(kind=dp) :: coef
      integer :: inr_of_csfs_LScjj   !, icsf_nr
      integer :: icsf_LS, icsf_LScjj
      integer :: J_1, J_1_min, J_1_max
      integer :: J_2, J_2_min, J_2_max
      integer :: inosubc, isubc, isubc_aviable
      integer :: icsf, icsf_nr, ITTK
      integer :: I, N1_MAX, N1_big, N2_big, number_1, number_2
      integer :: I_Count, iterm_1, iterm_2, N1_big_jj, N2_big_jj
      integer :: iJ_total, Q_Term, Nr_Term
      type(subshell_term), dimension(1:63)  :: jj_1_term, jj_2_term
!
      isubc_aviable = 2
      if(expansion_cfg_LS%csfs(1)%nosubc.gt.isubc_aviable) then
         write(*,*) "is available =",isubc_aviable," we have =",       &
            expansion_cfg_LS%csfs(1)%nosubc
         write(*,*) 'STOP at subroutine define_number_of_csfs_LScjj ', &
            'module transform_lscjj: cfg_Ji_structure%nr_of_subc.gt.', &
            'isubc_aviable'
         stop
      end if
!
!write(*,*) '      subroutine form_csfs_LScjj'
      iJ_total=states%states(expansion_cfg_LS%nr_of_state)%J
!
      call define_number_of_csfs_LScjj(inr_of_csfs_LScjj)
!
      expansion_cfg_LScjj%size=inr_of_csfs_LScjj
      if(itype.ne.1) then
         allocate(expansion_cfg_LScjj%csfs(expansion_cfg_LScjj%size))
         allocate(expansion_cfg_LScjj%coeffs(expansion_cfg_LScjj%size))
         icsf_LScjj=0
         do icsf_LS=1, nomach_csfs_ls%list_size,1
            icsf_nr = nomach_csfs_ls%items(icsf_LS)
           if(expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il == 3 .and. &
             expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big>=3) then
             Nr_Term = expansion_cfg_LS%csfs(icsf_nr)%subc(2)%inr
             Q_Term = gettermLSQ(                                      &
             expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il,            &
             expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big,Nr_term,&
             expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iL,                &
             expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iS)
           else
             Q_Term =                                                  &
                    2*expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il+1- &
                    expansion_cfg_LS%csfs(icsf_nr)%subc(2)%inr
             Nr_Term = 0
           end if
           inosubc = expansion_cfg_LS%csfs(icsf_nr)%nosubc
           N1_MAX=2*expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il
           if (N1_MAX == 0) then
              N1_big = 0
              N2_big = expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big
              I_Count = 1
           else if(expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big   &
                                                        <= N1_MAX) then
              N1_big = expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big
              N2_big= 0
              I_Count = N1_big + 1
           else
              N1_big=N1_MAX
              N2_big=                                                  &
                expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big-N1_big
              I_Count=                                                 &
                2*expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il+2      &
                -N2_big+1
           end if
           J_1_min = iabs(                                             &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iL-               &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iS)
           J_1_max =                                                   &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iL+               &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iS
           do J_1 = J_1_min, J_1_max, 2
              J_2_min = iabs(J_1 - iJ_total)
              J_2_max = J_1 + iJ_total
              do J_2 = J_2_min, J_2_max, 2
                 do I = 1,I_Count,1
                    if (N1_big-I+1 .ge. 0) then
                      if(I == 1) then
                        if (N1_MAX /= 0) then
                           N1_big_jj = N1_big
                           call gettermjj(                      &
                           2*expansion_cfg_LS%csfs(icsf_nr)%    &
                           subc_cfg(2)%il-1,N1_big_jj,jj_1_term,&
                           number_1)
                        else
                           N1_big_jj = 0
                           number_1 = 1
                           jj_1_term(1)%j = 0
                           jj_1_term(1)%Q = 0
                           jj_1_term(1)%subshellJ = 0
                        end if
                        N2_big_jj = N2_big
                        call gettermjj(                        &
                        2*expansion_cfg_LS%csfs(icsf_nr)%      &
                        subc_cfg(2)%il+1,N2_big_jj,jj_2_term,  &
                        number_2)
                      else
                        N1_big_jj = N1_big-I+1
                        N2_big_jj = N2_big+I-1
                        call gettermjj(                        &
                        2*expansion_cfg_LS%csfs(icsf_nr)%      &
                        subc_cfg(2)%il-1,N1_big_jj,jj_1_term,  &
                        number_1)
                        call gettermjj(                        &
                        2*expansion_cfg_LS%csfs(icsf_nr)%      &
                        subc_cfg(2)%il+1,N2_big_jj,jj_2_term,  &
                        number_2)
                      end if
                      do iterm_1 = 1,number_1
                        do iterm_2 = 1,number_2
                          if(ITTK(                              &
                                  2*jj_1_term(iterm_1)%subshellJ,     &
                                  2*jj_2_term(iterm_2)%subshellJ,     &
                                  2*J_2) == 0) cycle
!GG!                     coef = coefLSjj(                                  &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il,    &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big,&
!GG!                     Nr_Term,                                          &
!GG!                     Q_Term,                                           &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iL,        &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iS,        &
!GG!                     J_2,                                              &
!GG!                     jj_1_term(iterm_1)%j,                             &
!GG!                     N1_big_jj,                                        &
!GG!                     jj_1_term(iterm_1)%Q,                             &
!GG!                     jj_1_term(iterm_1)%subshellJ,                     &
!GG!                     jj_2_term(iterm_2)%j,                             &
!GG!                     jj_2_term(iterm_2)%Q,                             &
!GG!                     jj_2_term(iterm_2)%subshellJ)
!GG!                          if (coef == ZERO_dp) cycle
                          icsf_LScjj = icsf_LScjj + 1
                          expansion_cfg_LScjj%csfs(icsf_LScjj)%nosubc= &
                                                                inosubc
                          allocate(expansion_cfg_LScjj%csfs(icsf_LScjj)%&
                          subc_cfg(expansion_cfg_LScjj%csfs(icsf_LScjj)%&
                                                                nosubc))
                          allocate(expansion_cfg_LScjj%csfs(icsf_LScjj)%&
                          subc(expansion_cfg_LScjj%csfs(icsf_LScjj)%   &
                                                               nosubc))
                          allocate(expansion_cfg_LScjj%csfs(icsf_LScjj)%&
                          iM1(expansion_cfg_LScjj%csfs(icsf_LScjj)%    &
                                                               nosubc))
                          allocate(expansion_cfg_LScjj%csfs(icsf_LScjj)%&
                          iM2(expansion_cfg_LScjj%csfs(icsf_LScjj)% &
                                                                nosubc))
                          allocate(expansion_cfg_LScjj%csfs(icsf_LScjj)%&
                          iJ(expansion_cfg_LScjj%csfs(icsf_LScjj)%nosubc))
                          do isubc=1,expansion_cfg_LScjj%csfs( &
                                                    icsf_LScjj)%nosubc,1
                             expansion_cfg_LScjj%csfs(icsf_LScjj)%    &
                             subc_cfg(isubc) = expansion_cfg_LS%csfs( &
                                       icsf_nr)%subc_cfg(isubc)
                             expansion_cfg_LScjj%csfs(icsf_LScjj)%    &
                             subc(isubc) = expansion_cfg_LS%csfs(     &
                                   icsf_nr)%subc(isubc)
                             if(isubc == 1) then
                               expansion_cfg_LScjj%csfs(icsf_LScjj)%  &
                                                             iJ(1)=J_1
                             else if(isubc == 2) then
                               expansion_cfg_LScjj%csfs(icsf_LScjj)%  &
                                                     iM1(1) = N1_big_jj
                               expansion_cfg_LScjj%csfs(icsf_LScjj)%  &
                                                     iM2(1) = N2_big_jj
                               expansion_cfg_LScjj%csfs(icsf_LScjj)%  &
                                     iM1(2) = iterm_1
                               expansion_cfg_LScjj%csfs(icsf_LScjj)%  &
                                     iM2(2) = iterm_2
                               expansion_cfg_LScjj%csfs(icsf_LScjj)%  &
                                                            iJ(2)=J_2
                             end if
                          end do
                        end do
                      end do
                    end if
                 end do
              end do
           end do
         end do
!
      end if
!
!write(*,*) '      end subroutine form_csfs_LScjj'
!write(iwrite_log,*) '      end subroutine form_csfs_LScjj'
!
      contains
!
!***********************************************************************
!                                                                      *
         subroutine  define_number_of_csfs_LScjj(irez)
!                                                                      *
!     This subroutine defines the number of csfs in LScjj coupling     *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                last update: February 2020   *
!                                                                      *
!***********************************************************************
         implicit none
         integer, intent(out)::irez
!GG!         real(kind=dp) :: coef
         integer :: J_1, J_1_min, J_1_max
         integer :: J_2, J_2_min, J_2_max
         integer :: isubc_aviable
         integer :: icsf, icsf_nr, ITTK
         integer :: I, N1_MAX, N1_big, N2_big, number_1, number_2
         integer :: I_Count, iterm_1, iterm_2, N1_big_jj, N2_big_jj
         integer :: Q_Term, Nr_Term
         type(subshell_term), dimension(1:63)  :: jj_1_term, jj_2_term
!
         isubc_aviable = 2
         if(expansion_cfg_LS%csfs(1)%nosubc .gt. isubc_aviable) then
           write(*,*)'STOP at subroutine define_number_of_csfs_LScjj ',&
              'module transform_lsjj: cfg_Ji_structure%nr_of_subc.gt.',&
              'isubc_aviable'
           stop
         end if
         irez=0
         do icsf=1, nomach_csfs_ls%list_size,1
            icsf_nr = nomach_csfs_ls%items(icsf)
           if(expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il == 3 .and. &
             expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big>=3) then
             Nr_Term = expansion_cfg_LS%csfs(icsf_nr)%subc(2)%inr
             Q_Term = gettermLSQ(                                      &
             expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il,            &
             expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big,Nr_term,&
             expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iL,                &
             expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iS)
           else
             Q_Term =                                                  &
                    2*expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il+1- &
                    expansion_cfg_LS%csfs(icsf_nr)%subc(2)%inr
             Nr_Term = 0
           end if
           N1_MAX=2*expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il
           if (N1_MAX == 0) then
              N1_big = 0
              N2_big = expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big
              I_Count = 1
           else if(expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big   &
                                                        <= N1_MAX) then
              N1_big = expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big
              N2_big= 0
              I_Count = N1_big + 1
           else
              N1_big=N1_MAX
              N2_big=                                                  &
                expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big-N1_big
              I_Count=                                                 &
                2*expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il+2      &
                -N2_big+1
           end if
           J_1_min = iabs(                                             &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iL-               &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iS)
           J_1_max =                                                   &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iL+               &
              expansion_cfg_LS%csfs(icsf_nr)%subc(1)%iS
           do J_1 = J_1_min, J_1_max, 2
              J_2_min = iabs(J_1 - iJ_total)
              J_2_max = J_1 + iJ_total
              do J_2 = J_2_min, J_2_max, 2
                 do I = 1,I_Count,1
                    if (N1_big-I+1 .ge. 0) then
                       if(I == 1) then
                          if (N1_MAX /= 0) then
                             N1_big_jj = N1_big
                             call gettermjj(                      &
                             2*expansion_cfg_LS%csfs(icsf_nr)%    &
                             subc_cfg(2)%il-1,N1_big_jj,jj_1_term,&
                             number_1)
                          else
                             N1_big_jj = 0
                             number_1 = 1
                             jj_1_term(1)%j = 0
                             jj_1_term(1)%Q = 0
                             jj_1_term(1)%subshellJ = 0
                          end if
                          N2_big_jj = N2_big
                          call gettermjj(                        &
                          2*expansion_cfg_LS%csfs(icsf_nr)%      &
                          subc_cfg(2)%il+1,N2_big_jj,jj_2_term,  &
                          number_2)
                       else
                          N1_big_jj = N1_big-I+1
                          N2_big_jj = N2_big+I-1
                          call gettermjj(                        &
                          2*expansion_cfg_LS%csfs(icsf_nr)%      &
                          subc_cfg(2)%il-1,N1_big_jj,jj_1_term,  &
                          number_1)
                          call gettermjj(                        &
                          2*expansion_cfg_LS%csfs(icsf_nr)%      &
                          subc_cfg(2)%il+1,N2_big_jj,jj_2_term,  &
                          number_2)
                       end if
                       do iterm_1 = 1,number_1
                         do iterm_2 = 1,number_2
                           if(ITTK(                              &
                                   2*jj_1_term(iterm_1)%subshellJ,     &
                                   2*jj_2_term(iterm_2)%subshellJ,     &
                                   2*J_2) == 0) cycle
!GG!                     coef = coefLSjj(                                  &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%il,    &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc_cfg(2)%iN_big,&
!GG!                     Nr_Term,                                          &
!GG!                     Q_Term,                                           &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iL,        &
!GG!                     expansion_cfg_LS%csfs(icsf_nr)%subc(2)%iS,        &
!GG!                     J_2,                                              &
!GG!                     jj_1_term(iterm_1)%j,                             &
!GG!                     N1_big_jj,                                        &
!GG!                     jj_1_term(iterm_1)%Q,                             &
!GG!                     jj_1_term(iterm_1)%subshellJ,                     &
!GG!                     jj_2_term(iterm_2)%j,                             &
!GG!                     jj_2_term(iterm_2)%Q,                             &
!GG!                     jj_2_term(iterm_2)%subshellJ)
!GG!                           if (coef /= ZERO_dp) irez = irez + 1
                           irez = irez + 1
                         end do
                       end do
                    end if
                 end do
              end do
           end do
         end do
         end subroutine  define_number_of_csfs_LScjj
      end subroutine form_csfs_LScjj
!
!***********************************************************************
!                                                                      *
      subroutine matrix_LS_LScjj(icsf_LS,icsf_LScjj,rez)
!                                                                      *
!     This subroutine calculates the transformation                    *
!     matrix element between two csfs  (in LS and LScjj couplings)     *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                last update: February 2020   *
!                                                                      *
!***********************************************************************
      implicit none
      integer,intent(in):: icsf_LS,icsf_LScjj
      real(kind=dp),intent(out)::rez
      real(kind=dp) :: rez_1, rez_2
      integer :: L12,IS12,L3,IS3,L,IS,J_1,J_2,J
      integer :: nosubc, N1, N2, number_1, number_2, num_1, num_2
      integer :: Q_Term, Nr_Term
      type(subshell_term), dimension(1:63)  :: jj_1_term, jj_2_term
      nosubc=expansion_cfg_LS%csfs(1)%nosubc
      rez = ZERO_dp
      if(equivalent_LSLScjj(expansion_cfg_LS%csfs(icsf_LS),            &
         expansion_cfg_LScjj%csfs(icsf_LScjj))) then
         L3   = expansion_cfg_LS%csfs(icsf_LS)%subc(2)%iL
         IS3  = expansion_cfg_LS%csfs(icsf_LS)%subc(2)%iS
         L12  = expansion_cfg_LS%csfs(icsf_LS)%iM1(1)
         IS12 = expansion_cfg_LS%csfs(icsf_LS)%iM2(1)
         L    = expansion_cfg_LS%csfs(icsf_LS)%iM1(2)
         iS   = expansion_cfg_LS%csfs(icsf_LS)%iM2(2)
         J_1  = expansion_cfg_LScjj%csfs(icsf_LScjj)%iJ(1)
         J_2  = expansion_cfg_LScjj%csfs(icsf_LScjj)%iJ(2)
         J    = states%states(expansion_cfg_LS%nr_of_state)%J
         N1   = expansion_cfg_LScjj%csfs(icsf_LScjj)%iM1(1)
         N2   = expansion_cfg_LScjj%csfs(icsf_LScjj)%iM2(1)
         number_1 = expansion_cfg_LScjj%csfs(icsf_LScjj)%iM1(2)
         number_2 = expansion_cfg_LScjj%csfs(icsf_LScjj)%iM2(2)
         if(expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%il == 3 .and. &
           expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%iN_big>=3) then
           Nr_Term = expansion_cfg_LS%csfs(icsf_LS)%subc(2)%inr
           Q_Term = gettermLSQ(                                      &
           expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%il,            &
           expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%iN_big,Nr_term,&
           expansion_cfg_LS%csfs(icsf_LS)%subc(2)%iL,                &
           expansion_cfg_LS%csfs(icsf_LS)%subc(2)%iS)
         else
            Q_Term =                                                 &
                   2*expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%il+1-&
                   expansion_cfg_LS%csfs(icsf_LS)%subc(2)%inr
            Nr_Term = 0
         end if
         if (expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%il /= 0) then
            call gettermjj                                             &
               (2*expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%il-1,     &
               N1,jj_1_term, num_1)
         else
            jj_1_term(1)%j = 0
            jj_1_term(1)%Q = 0
            jj_1_term(1)%subshellJ = 0
         end if
         call gettermjj                                                &
            (2*expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%il+1,        &
            N2,jj_2_term,num_2)
         rez_1 = coefLSjj(                                         &
                 expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%il,    &
                 expansion_cfg_LS%csfs(icsf_LS)%subc_cfg(2)%iN_big,&
                 Nr_Term,                                          &
                 Q_Term,                                           &
                 expansion_cfg_LS%csfs(icsf_LS)%subc(2)%iL,        &
                 expansion_cfg_LS%csfs(icsf_LS)%subc(2)%iS,        &
                 J_2,                                              &
                 jj_1_term(number_1)%j,                            &
                 N1,                                               &
                 jj_1_term(number_1)%Q,                            &
                 jj_1_term(number_1)%subshellJ,                    &
                 jj_2_term(number_2)%j,                            &
                 jj_2_term(number_2)%Q,                            &
                 jj_2_term(number_2)%subshellJ)
         call LScjjPER(L12,IS12,L3,IS3,L,IS,J_1,J_2,J,rez_2)
         rez = rez_1 * rez_2
      end if
      end subroutine matrix_LS_LScjj
!
!***********************************************************************
!                                                                      *
      subroutine dotransform_LSLScjj
!                                                                      *
!     This subroutine calculates the weights of the                    *
!     expansions in the LScjj coupling                                 *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
      implicit none
      real(kind=dp)::coeff_LScjj,coeff_LS, melement, sum_of_state
      integer::icsf_LS,icsf_LScjj
      melement=0.
      sum_of_state = 0.
      do icsf_LScjj=1,expansion_cfg_LScjj%size
         coeff_LScjj = 0.
         do icsf_LS=1, expansion_cfg_LS%size
            call matrix_LS_LScjj(icsf_LS,icsf_LScjj,melement)
            coeff_LS=expansion_cfg_LS%coeffs(icsf_LS)
            coeff_LScjj = coeff_LScjj + coeff_LS*melement
         end do
         if((dabs(coeff_LScjj)-dp_coeff_precision).gt.ONE_dp) then
         write(*,*)'possible error at subroutine dotransform_LSLScjj:',&
               ' coeff_LScjj=',coeff_LScjj
            write(iwrite_log,*)'possible error at subroutine ',        &
               'dotransform_LSLScjj: coeff_LScjj=',coeff_LScjj
         end if
         expansion_cfg_LScjj%coeffs(icsf_LScjj)= coeff_LScjj
         sum_of_state = sum_of_state + coeff_LScjj*coeff_LScjj
      end do
      if((sum_of_state-TWO_dp*dp_coeff_precision).gt.ONE_dp) then
        write(*,*)'possible error at subroutine dotransform_LSLScjj: ',&
            'sum_of_state=',sum_of_state
         write(iwrite_log,*)'possible error at subroutine ',           &
            'dotransform_LSLScjj: sum_of_state=',sum_of_state
      end if
      end subroutine dotransform_LSLScjj
!
!***********************************************************************
!                                                                      *
      subroutine print_cfg_LSLScjj(itype)
!                                                                      *
!     This subroutine prints the oneconfigurational                    *
!     expansions to the unit "iwrite_cfg_expansions_LScjj"             *
!     (see module "Coupling_constants")                                *
!                                                                      *
!     Written by G. Gaigalas,                                          *
!     NIST                                     last update: Oct 2015   *
!                                                                      *
!***********************************************************************
      implicit none
      integer, intent(in) :: itype
      integer             :: icsf, isubc, j
      character(len=1)    :: CVAL
      character(len=4)    :: JVAL
      character(len=2) :: LSJVAL
      integer          :: num_1, num_2, number_1, number_2
      type(subshell_term), dimension(1:63)  :: jj_1_term, jj_2_term
!
!     LS - Coupling
!
      if(itype.gt.0) then
         write(iwrite_cfg_expansions_LScjj,*)  &
         '-------------------------------------'
         write(iwrite_cfg_expansions_LScjj,*)  &
         'state Nr.',expansion_cfg_LS%nr_of_state
         write(iwrite_cfg_expansions_LScjj,'(3x,a3,a4,a9,3x,f15.8)')   &
         'J =', JVAL(states%states(expansion_cfg_LS%nr_of_state)%J),   &
         ' Energy =',states%states(expansion_cfg_LS%nr_of_state)%energy
         write(iwrite_cfg_expansions_LScjj,'(3x,a29,i2)')              &
         'expansion size (LS coupling): ', expansion_cfg_LS%size
         write(iwrite_cfg_expansions_LScjj,*)''
         if(associated(expansion_cfg_LS%csfs)) then
            do icsf=1,expansion_cfg_LS%size
               if(associated(expansion_cfg_LS%csfs(icsf)%subc_cfg)) then
               if(icsf ==1)write(iwrite_cfg_expansions_LScjj,*)'csf Nr.'
                  if(expansion_cfg_LS%csfs(icsf)%nosubc == 1) then
                     write(iwrite_cfg_expansions_LScjj,                &
                     '(1x,i5,3x,i2,a1,"(",i1,")",6x,a6,f10.7)') icsf,  &
                     expansion_cfg_LS%csfs(icsf)%subc_cfg(1)%in,       &
                    CVAL(1,expansion_cfg_LS%csfs(icsf)%subc_cfg(1)%il),&
                     expansion_cfg_LS%csfs(icsf)%subc_cfg(1)%iN_big,   &
                     'coeff:',expansion_cfg_LS%coeffs(icsf)
                  else if (expansion_cfg_LS%csfs(icsf)%nosubc == 2) then
                     write(iwrite_cfg_expansions_LScjj,                &
                     '(1x,i5,3x,2(i2,a1,"(",i1,")"),6x,a6,f10.7)')icsf,&
                     (expansion_cfg_LS%csfs(icsf)%subc_cfg(j)%in,      &
                    CVAL(1,expansion_cfg_LS%csfs(icsf)%subc_cfg(j)%il),&
                     expansion_cfg_LS%csfs(icsf)%subc_cfg(j)%iN_big,   &
                     j=1,2),                                           &
                     'coeff:',expansion_cfg_LS%coeffs(icsf)
                  else
                    STOP &
              'To many coupled shells in Coupling_transform_cfg_LSLScjj'
                  end if
               else
                  write(iwrite_cfg_expansions_LScjj,'(9x,a51)')   &
                  'expansion_cfg_LS%csfs(icsf)%subc_cfg NOT associated'
               end if
               if(associated(expansion_cfg_LS%csfs(icsf)%subc)  &
               .and.associated(expansion_cfg_LS%csfs(icsf)%iM1) &
               .and.associated(expansion_cfg_LS%csfs(icsf)%iM2)) then
                  if(expansion_cfg_LS%csfs(icsf)%nosubc == 1) then
                     write(iwrite_cfg_expansions_LScjj,                &
                     '(13x,i2,a1,i1)')                                 &
                     expansion_cfg_LS%csfs(icsf)%subc(1)%iS+1,         &
                     CVAL(2,expansion_cfg_LS%csfs(icsf)%subc(1)%iL),   &
                     expansion_cfg_LS%csfs(icsf)%subc(1)%inr
                  else if (expansion_cfg_LS%csfs(icsf)%nosubc == 2) then
                     write(iwrite_cfg_expansions_LScjj,                &
                     '(12x,7(1x,i2,a1,i1))')                           &
                     (expansion_cfg_LS%csfs(icsf)%subc(j)%iS+1,        &
                      CVAL(2,expansion_cfg_LS%csfs(icsf)%subc(j)%iL),&
                      expansion_cfg_LS%csfs(icsf)%subc(j)%inr,       &
                      j=1,2),                                        &
                      expansion_cfg_LS%csfs(icsf)%iM2(2)+1,          &
                      CVAL(2,expansion_cfg_LS%csfs(icsf)%iM1(2))
                  end if
               else
                   write(iwrite_cfg_expansions_LScjj,'(9x,a63)') &
       'expansion_cfg_LS%csfs(icsf)%subc (or iM1 or iM2) NOT associated'
               end if
               write(iwrite_cfg_expansions_LScjj,*)' '
            end do
         else
            write(iwrite_cfg_expansions_LScjj,*) &
            'expansion_cfg_LS%csfs NOT associated'
         end if
      end if
!
!     LScjj - Coupling
!
      if(itype.gt.1) then
         write(iwrite_cfg_expansions_LScjj,*) &
         '-------------------------------------'
         write(iwrite_cfg_expansions_LScjj,*) &
         'state Nr.',expansion_cfg_LScjj%nr_of_state
         write(iwrite_cfg_expansions_LScjj,'(3x,a3,a4,a9,3x,f15.8)')    &
         'J =', JVAL(states%states(expansion_cfg_LScjj%nr_of_state)%J), &
         ' Energy =',states%states(expansion_cfg_LScjj%nr_of_state)%energy
         write(iwrite_cfg_expansions_LScjj,'(3x,a29,i2)')               &
         'expansion size (LScjj coupling): ', expansion_cfg_LScjj%size
         write(iwrite_cfg_expansions_LScjj,*)''
         if(associated(expansion_cfg_LScjj%csfs)) then
            do icsf=1,expansion_cfg_LScjj%size
               if(associated(expansion_cfg_LScjj%csfs(icsf)%subc_cfg)) then
                  if(icsf ==1)                                         &
                           write(iwrite_cfg_expansions_LScjj,*)'csf Nr.'
                  if(expansion_cfg_LS%csfs(icsf)%nosubc == 2) then
                     number_1 = expansion_cfg_LScjj%csfs(icsf)%iM1(2)
                     number_2 = expansion_cfg_LScjj%csfs(icsf)%iM2(2)
                     if(expansion_cfg_LScjj%csfs(icsf)%subc_cfg(2)%il  &
                                                             /=0 ) then
                       call gettermjj(2*expansion_cfg_LScjj%csfs(icsf)%&
                       subc_cfg(2)%il -1,expansion_cfg_LScjj%         &
                       csfs(icsf)%iM1(1),jj_1_term,num_1)
                     else
                       jj_1_term(number_1)%j = -1
                       jj_1_term(number_1)%subshellJ = 0
                       jj_1_term(number_1)%nu  = 0
                     end if
                     call gettermjj(2*expansion_cfg_LScjj%csfs(icsf)%  &
                     subc_cfg(2)%il+1,expansion_cfg_LScjj%csfs(icsf)%  &
                     iM2(1),jj_2_term,num_2)
                     write(iwrite_cfg_expansions_LScjj,                &
                     '(1x,i5,3x,i2,a1,"(",i1,")",2x,                   &
                     2(i2,a2,"(",i1,")"),6x,a6,f10.7)')icsf,           &
                     expansion_cfg_LScjj%csfs(icsf)%subc_cfg(1)%in,    &
                     CVAL(1,expansion_cfg_LScjj%csfs(icsf)%subc_cfg(1)%&
                     il),                                              &
                     expansion_cfg_LScjj%csfs(icsf)%subc_cfg(1)%iN_big,&
                     expansion_cfg_LScjj%csfs(icsf)%subc_cfg(2)%in,    &
                     LSJVAL(expansion_cfg_LScjj%csfs(icsf)%subc_cfg(2)%&
                     il,jj_1_term(number_1)%j),                        &
                     expansion_cfg_LScjj%csfs(icsf)%iM1(1),            &
                     expansion_cfg_LScjj%csfs(icsf)%subc_cfg(2)%in,    &
                     LSJVAL(expansion_cfg_LScjj%csfs(icsf)%subc_cfg(2)%&
                     il,jj_2_term(number_2)%j),                        &
                     expansion_cfg_LScjj%csfs(icsf)%iM2(1),            &
                     'coeff:',expansion_cfg_LScjj%coeffs(icsf)
                  else
                     write(iwrite_cfg_expansions_LScjj,'(9x,a51)') &
                'expansion_cfg_LScjj%csfs(icsf)%subc_cfg NOT associated'
                  end if

                  if(associated(expansion_cfg_LScjj%csfs(icsf)%subc)   &
                   .and.associated(expansion_cfg_LScjj%csfs(icsf)%iM1) &
                   .and.associated(expansion_cfg_LScjj%csfs(icsf)%iM2))&
                                                                    then
                     if(expansion_cfg_LS%csfs(icsf)%nosubc == 2) then
                        write(iwrite_cfg_expansions_LScjj,             &
                        '(13x,i2,a1,i1,2(a4,i2,1x)," [",a4,","a4,      &
                        " ]")')                                        &
                       expansion_cfg_LScjj%csfs(icsf)%subc(1)%iS+1,    &
                       CVAL(2,expansion_cfg_LScjj%csfs(icsf)%subc(1)%  &
                       iL),expansion_cfg_LScjj%csfs(icsf)%subc(1)%inr, &
                       JVAL(jj_1_term(number_1)%subshellJ),            &
                       jj_1_term(number_1)%nu,                         &
                       JVAL(jj_2_term(number_2)%subshellJ),            &
                       jj_2_term(number_2)%nu,                         &
                       JVAL(expansion_cfg_LScjj%csfs(icsf)%iJ(1)),     &
                       JVAL(expansion_cfg_LScjj%csfs(icsf)%iJ(2))
                     end if
                  else
                     write(iwrite_cfg_expansions_LScjj,'(9x,a63)')     &
         'expansion_cfg_LScjj%csfs%subc (or iM1 or iM2) NOT associated'
                  end if
               end if
                  write(iwrite_cfg_expansions_LScjj,*)' '
            end do
         else
            write(iwrite_cfg_expansions_LScjj,*) &
            'expansion_cfg_LScjj%csfs NOT associated'
         end if
            write(iwrite_cfg_expansions_LScjj,*) &
            '-------------------------------------'
      end if
      end subroutine print_cfg_LSLScjj
!
      end module Coupling_transform_cfg_LSLScjj


MODULE module_input_gocart_dms
    USE module_io_domain
    USE module_domain
    USE module_driver_constants
    USE module_state_description
    USE module_configure
    USE module_date_time
    USE module_wrf_error
    USE module_timing
    USE module_data_radm2
    USE module_aerosols_sorgam
    USE module_get_file_names
CONTAINS
SUBROUTINE input_ext_chem_gocart_dms (grid)
   IMPLICIT NONE
   TYPE(domain) :: grid
   INTEGER :: i,j,n,numfil,status,system
   INTEGER :: ids, ide, jds, jde, kds, kde, &
              ims, ime, jms, jme, kms, kme, &
              ips, ipe, jps, jpe, kps, kpe
   REAL, ALLOCATABLE, DIMENSION(:,:) :: tmp
      PARAMETER(numfil=19)
   CHARACTER (LEN=80) :: message
   TYPE (grid_config_rec_type) :: config_flags
      CHARACTER*100 onefil
       CALL get_ijk_from_grid ( grid , &
                                 ids, ide, jds, jde, kds, kde, &
                                 ims, ime, jms, jme, kms, kme, &
                                 ips, ipe, jps, jpe, kps, kpe )
     WRITE( message , FMT='(A,4I5)' ) ' DIMS: ',ids,ide-1,jds,jde-1
     CALL wrf_message ( message )
     ALLOCATE( tmp(ids:ide-1,jds:jde-1) )
     OPEN(19,FILE='wrf_gocart_dms.txt',FORM='FORMATTED')
     READ(19,'(12E15.5)') tmp
     grid%dms_0(ids:ide-1,jds:jde-1) = tmp
     CLOSE(19)
      DEALLOCATE( tmp )
END SUBROUTINE input_ext_chem_gocart_dms
END MODULE module_input_gocart_dms


C    @(#)postbus.f	20.6 7/18/96
      subroutine postbus(record)

      include 'ipfinc/postdta.inc'
      include 'ipfinc/pfstates.inc'

      character record*(*)
      character busnm*8, name*13, name2*15 ,bushape*2,
     1          fmtnam*80, avolt*6, aiang*4,
     2          fmtpqld*30, apqload*20

*23456789112345678921234567893123456789412345678951234567896123456789712
      data fmtnam(1:72)/
     1'(''[[ '',''('',a13,'')'','' ('',i3,1x,a4,'')'',t72,'' ]'',2(f7.2,
     2'' cmtr''),i2,'' ]'')'/
      data fmtpqld(1:24) /'('' (['',i6,'' ('',i6,'')])'')'/
*      12345678911234567892123456789312345678941234567895123456789612345

*************** debug stuff *******************
*     print 9951
*9951 format(' entering postbus')
*     print 9901, record
*9901 format(' in postbus:'a)
*     print 9901, text
*     print 9901, fmtnam
*************** debug stuff *******************

         namary = ' '
         busary = ' '
         genary = ' '
         reaary = ' '
         flgary = ' '
         apqload = ' '
         apqsum = ' '
         psumflo = 0.0
         qsumflo = 0.0

***** read bus record from coordinate file *************
      read (text,111) kdspflg, busnm, buskv, name, kvf, xb, yb,
     1xn, yn, anggn, angcp,               bushape, busscale
  111 format(bz,1x,i1,a8,f4.0,a8,i1,4f6.2,2f3.0,a2, f4.2)
      if (bsopnam .eq. 2) then
         name = busnm(1:8) //' '//text(11:14)
      elseif (bsopnam .eq. 3) then
         name = busnm(1:8)
      endif

***** if there are no name coordinate, offset name near bus symbol
      if (xn .eq. 0.0 .and. yn .eq. 0.0) then
         xn = xb + 0.38
         yn = yb + 0.45
      endif

******keep voltage printing indicator within bounds
      if (kvf .lt. 1 .or. kvf .gt. 6) kvf = 1

      if (kdspflg .eq. 0 .and. kotgflg .eq. 0) then
******** read bus record from powerflow file *************
         if (ostates .lt. 5) record(21:141) = ' '
         read (record, 121) pgen, qgen, volt, ang,
     1   pload, qload, bused, bmax
  121    format(t21, 8f15.7)

         if (dgoptyp .eq. 5) then
             volt = buskv * 1.001
             pgen = 1.0
             bused = 1.0
         endif

******** add overvoltage flag sometime ******************
         puvolt = volt/buskv

         write (busary, 201) xb, yb, bushape, busscale, puvolt, buskv
  201    format('[ ', 2(f6.2, ' cmtr '), ' (',a2, ') ', f7.2, f7.3, f6.1
     1   , ' ]')

         ipgen = sign ((abs(pgen) + 0.5), pgen)
         iqgen = sign ((abs(qgen) + 0.5), qgen)
         write (genary, 221) anggn, ipgen, iqgen
  221    format('[ ', f5.1, ' (',i5, ')', ' (',i5, ')', ' ]')

         ibused = sign ((abs(bused) + 0.5), bused)
*        iabused = iabs(ibused)
         iabused =      ibused
         ibmax = sign ((abs(bmax) + 0.5), bmax)
*        iabmax = iabs(ibmax)
         iabmax =      ibmax
         if ( ibused .eq. 0 .and. ibmax .ne. 0) ibused = ibmax
         if (vaopdif .eq. 1) then    ! get reactor/capacitor symbol for difference
*           iabused = ibused
*           iabmax = ibmax
            if (record(141:141) .eq. '+') then
               ibused = 1.0
            else
               ibused = -1.0
            endif
         endif
         write (reaary, 241) angcp, ibused, iabmax, iabused
  241    format('[ ', f5.1, 1x, i5, ' (',i5, ')', ' (',i5, ')', ' ]')

         ivolt =  sign ((abs(volt) + 0.5), volt)
         fvolt = abs(volt)
         if (bsopang .eq. 1) then
             iang = sign ((abs(ang) + 0.5), ang)
             write(aiang, 243) iang
  243        format(i4)
         else
             aiang = ' '
         endif
******** adjust the format for more compact variables **********

************ debug stuff **********************
*     print 9923, bsopvlt
*9923 format( ' in postbus bsopvlt = ',i5)
************ debug stuff **********************
         if (bsopvlt .eq. 1 .and. fvolt .ge. 69.0) then
            lognum = alog10(amax1((abs(volt)+0.5),1.0)) + 1.0
            if (volt .lt. 0.0) lognum = lognum + 1

************ debug stuff **********************
*     print 9921, lognum
************ debug stuff **********************
            write (fmtnam(25:26), 251) lognum
  251       format('i',i1)
         elseif (bsopvlt .eq. 1 .and. fvolt .lt. 69.0) then
            write (avolt, 253) fvolt
  253       format(f4.1)
            fmtnam(25:26) = 'a4'
         else
            write (avolt, 255) puvolt
  255       format(f6.3)
            fmtnam(25:26) = 'a6'
         endif
*****THE ENCLOSED LOGIC IS NOT CURRENTLY USED
*        lognum = alog10(amax1((abs(ang)+0.5),1.0)) + 1.0
************ debug stuff **********************
*     print 9921, lognum
************ debug stuff **********************
*        if (ang .lt. 0.0 ) lognum = lognum + 1
************ debug stuff **********************
*     print 9921, lognum
************ debug stuff **********************
*        write (fmtnam(31:32), 251) lognum
************ debug stuff **********************
*****THE ENCLOSED LOGIC IS NOT CURRENTLY USED
*     print 9901, fmtnam
*     print 9921, lognum
*9921 format('lognum = :', i5)
************ debug stuff **********************
         if (bsopvlt .eq. 1 .and. fvolt .ge. 69.0) then
            write (namary, fmtnam) name, ivolt, aiang, xn, yn, kvf
         else
            write (namary, fmtnam) name, avolt, aiang, xn, yn, kvf
         endif
         if (bsoplod .eq. 1 .and.
     1       (abs(pload) .gt. 0.5 .or. abs(qload) .gt. 0.5)) then

             ipload = sign ((abs(pload) + 0.5), pload)
             lognum = alog10(amax1((abs(pload)+0.5),1.0)) + 1.0
             if (pload .lt. 0.0) lognum = lognum + 1
             if (lognum .gt. 6) then
                 apqload = '(******)'
                 go to 270
             endif
             write (fmtpqld( 9: 9), 261) lognum
  261        format(i1)

             iqload = sign ((abs(qload) + 0.5), qload)
             lognum = alog10(amax1((abs(qload)+0.5),1.0)) + 1.0
             if (qload .lt. 0.0) lognum = lognum + 1
             if (lognum .gt. 6) then
                 apqload = '(******)'
                 go to 270
             endif
             write (fmtpqld(17:17), 261) lognum
************ debug stuff **********************
*     print 9931, fmtpqld
*9931 format(' fmtpqld: ',a)
************ debug stuff **********************
             write(apqload, fmtpqld) ipload, iqload
************ debug stuff **********************
*     print 9941, pload, qload, ipload, iqload, apqload
*9941 format(' pload,qload, ipload, iqload, apqload ',
*    12f10.1, 2i10,a)
************ debug stuff **********************

  270        namary(33:52) = apqload(1:20)
         endif
************** debug stuff ***************************
*     print 9961, namary
*9961 format(' in postbus - namary: ',a)
************** debug stuff ***************************
         kflgbs = 1
         if (kdspflg .eq. 1) kflgbs = 0
         kflggn = 1
         if (bsopgen .eq. 0) then
            kflggn = 0
         elseif (bsopgen .eq. 1) then
            if ((abs(pgen) .lt. 0.1 .and. abs(qgen) .lt. 0.1)
     1      .or. anggn .eq. 0.0) kflggn = 0
         elseif (bsopgen .eq. 2) then
            if (abs(pgen) .lt. 0.1 .and. abs(qgen) .lt. 0.1)
     1       kflggn = 0
c        elseif (bsopgen .eq. 3) then ***** statement implied *****
c          kflggn = 1                 ***** statement implied *****
         endif
************** debug stuff ***************************
*     print 9971, pgen, qgen, bsopgen, kflggn
*9971 format('  pgen, qgen, bsopgen, kflggn:',2f7.2, 2i3)
************** debug stuff ***************************

         kflgre = 1
         if (bsoprea .eq. 0) then
            kflgre = 0
         elseif (bsoprea .eq. 1) then
            if ((abs(bused) .lt. 0.1 .and. abs(bmax) .lt. 0.1)
     1      .or. angcp .eq. 0.0) kflgre = 0
         elseif (bsoprea .eq. 2) then
            if (abs(bused) .lt. 0.1 .and. abs(bmax) .lt. 0.1)
     1       kflgre = 0
c        elseif (bsoprea .eq. 3) then ***** statement implied *****
c          kflgre = 1                 ***** statement implied *****
         endif

         kflgnm = 1
         if (name .eq. ' ') kflgnm = 0
         write (flgary,281) kflgbs, kflggn, kflgre, kflgnm
  281    format('[ ', 4i2, ' ]', ' acBus')

      elseif (kdspflg .eq. 1 .or. kotgflg .eq. 1) then
         name2 = ' '
         if (name .ne. ' ') name2 = '('//name//')'
         write (namary, 301) name2, xn, yn
  301    format('[ [ ', a15, ' ] '
     1   , 2(f6.2, ' cmtr ') , ' 5 ]')
         genary = '[]'
         reaary = '[]'
         if (kotgflg .eq. 1) then
           busscale = 0.0
           kbovflg = 0
           bushape = 'XX'
           write (busary, 201) xb, yb, bushape, busscale, kbovflg
           flgary = '[1 0 0 1] acBus'
         else
           busary = '[ 0 0 (  ) 0 0 0 ]'
           flgary = '[0 0 0 1] acBus'
         endif

      endif

      return
      end


      subroutine hruaa(years)
!!    ~ ~ ~ PURPOSE ~ ~ ~
!!    this subroutine writes average annual HRU output to the output.hru file

!!    ~ ~ ~ INCOMING VARIABLES ~ ~ ~
!!    name          |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    bio_aams(:)   |metric tons/ha|average annual biomass (dry weight) in HRU
!!    cpnm(:)       |NA            |four character code to represent crop name
!!    deepst(:)     |mm H2O        |depth of water in deep aquifer
!!    hru_km(:)     |km^2          |area of HRU in square kilometers
!!    hru_sub(:)    |none          |subbasin in which HRU is located
!!    hruaao(1,:)   |mm H2O        |precipitation in HRU during simulation
!!    hruaao(2,:)   |mm H2O        |amount of precipitation falling as freezing
!!                                 |rain/snow in HRU during simulation
!!    hruaao(3,:)   |mm H2O        |amount of snow melt in HRU during simulation
!!    hruaao(4,:)   |mm H2O        |amount of surface runoff to main channel
!!                                 |from HRU during simulation (ignores impact of
!!                                 |transmission losses)
!!    hruaao(5,:)   |mm H2O        |amount of lateral flow contribution to main
!!                                 |channel from HRU during simulation
!!    hruaao(6,:)   |mm H2O        |amount of groundwater flow contribution to
!!                                 |main channel from HRU during simulation
!!    hruaao(7,:)   |mm H2O        |amount of water moving from shallow aquifer
!!                                 |to plants or soil profile in HRU during
!!                                 |simulation
!!    hruaao(8,:)   |mm H2O        |amount of water recharging deep aquifer in
!!                                 |HRU during simulation
!!    hruaao(9,:)   |mm H2O        |total amount of water entering both aquifers
!!                                 |from HRU during simulation
!!    hruaao(10,:)  |mm H2O        |water yield (total amount of water entering
!!                                 |main channel) from HRU during simulation
!!    hruaao(11,:)  |mm H2O        |amount of water percolating out of the soil
!!                                 |profile and into the vadose zone in HRU
!!                                 |during simulation
!!    hruaao(12,:)  |mm H2O        |actual evapotranspiration in HRU during
!!                                 |simulation
!!    hruaao(13,:)  |mm H2O        |amount of transmission losses from tributary
!!                                 |channels in HRU for simulation
!!    hruaao(14,:)  |metric tons/ha|sediment yield from HRU for simulation
!!    hruaao(17,:)  |kg N/ha       |amount of nitrogen applied in continuous
!!                                 |fertilizer operation in HRU for simulation
!!    hruaao(18,:)  |kg P/ha       |amount of phosphorus applied in continuous
!!                                 |fertilizer operation in HRU for simulation
!!    hruaao(23,:)  |mm H2O        |amount of water removed from shallow aquifer
!!                                 |in HRU for irrigation during simulation
!!    hruaao(24,:)  |mm H2O        |amount of water removed from deep aquifer
!!                                 |in HRU for irrigation during simulation
!!    hruaao(25,:)  |mm H2O        |potential evapotranspiration in HRU during
!!                                 |simulation
!!    hruaao(26,:)  |kg N/ha       |annual amount of N (organic & mineral)
!!                                 |applied in HRU during grazing
!!    hruaao(27,:)  |kg P/ha       |annual amount of P (organic & mineral)
!!                                 |applied in HRU during grazing
!!    hruaao(28,:)  |kg N/ha       |average annual amount of N (organic &
!!                                 |mineral) auto-applied in HRU
!!    hruaao(29,:)  |kg P/ha       |average annual amount of P (organic &
!!                                 |mineral) auto-applied in HRU
!!    hruaao(31,:)  |stress days   |water stress days in HRU during simulation
!!    hruaao(32,:)  |stress days   |temperature stress days in HRU during
!!                                 |simulation
!!    hruaao(33,:)  |stress days   |nitrogen stress days in HRU during simulation
!!    hruaao(34,:)  |stress days   |phosphorus stress days in HRU during
!!                                 |simulation
!!    hruaao(35,:)  |kg N/ha       |organic nitrogen in surface runoff in HRU
!!                                 |during simulation
!!    hruaao(36,:)  |kg P/ha       |organic phosphorus in surface runoff in HRU
!!                                 |during simulation
!!    hruaao(37,:)  |kg N/ha       |nitrate in surface runoff in HRU during
!!                                 |simulation
!!    hruaao(38,:)  |kg N/ha       |nitrate in lateral flow in HRU during
!!                                 |simulation
!!    hruaao(39,:)  |kg P/ha       |soluble phosphorus in surface runoff in HRU
!!                                 |during simulation
!!    hruaao(40,:)  |kg N/ha       |amount of nitrogen removed from soil by plant
!!                                 |uptake in HRU during simulation
!!    hruaao(41,:)  |kg N/ha       |nitrate percolating past bottom of soil
!!                                 |profile in HRU during simulation
!!    hruaao(42,:)  |kg P/ha       |amount of phosphorus removed from soil by
!!                                 |plant uptake in HRU during simulation
!!    hruaao(43,:)  |kg P/ha       |amount of phosphorus moving from labile
!!                                 |mineral to active mineral pool in HRU during
!!                                 |simulation
!!    hruaao(44,:)  |kg P/ha       |amount of phosphorus moving from active
!!                                 |mineral to stable mineral pool in HRU during
!!                                 |simulation
!!    hruaao(45,:)  |kg N/ha       |amount of nitrogen applied to HRU in
!!                                 |fertilizer and grazing operations during
!!                                 |simulation
!!    hruaao(46,:)  |kg P/ha       |amount of phosphorus applied to HRU in
!!                                 |fertilizer and grazing operations during
!!                                 |simulation
!!    hruaao(47,:)  |kg N/ha       |amount of nitrogen added to soil by fixation
!!                                 |in HRU during simulation
!!    hruaao(48,:)  |kg N/ha       |amount of nitrogen lost by denitrification
!!                                 |in HRU during simulation
!!    hruaao(49,:)  |kg N/ha       |amount of nitrogen moving from active organic
!!                                 |to nitrate pool in HRU during simulation
!!    hruaao(50,:)  |kg N/ha       |amount of nitrogen moving from active organic
!!                                 |to stable organic pool in HRU during
!!                                 |simulation
!!    hruaao(51,:)  |kg P/ha       |amount of phosphorus moving from organic to
!!                                 |labile mineral pool in HRU during simulation
!!    hruaao(52,:)  |kg N/ha       |amount of nitrogen moving from fresh organic
!!                                 |to nitrate and active organic pools in HRU
!!                                 |during simulation
!!    hruaao(53,:)  |kg P/ha       |amount of phosphorus moving from fresh
!!                                 |organic to the labile mineral and organic
!!                                 |pools in HRU during simulation
!!    hruaao(54,:)  |kg N/ha       |amount of nitrogen added to soil in rain
!!                                 |during simulation
!!    hruaao(61,:)  |metric tons/ha|daily soil loss predicted with USLE equation
!!    hruaao(63,:)  |# bacteria/ha |less persistent bacteria transported to main
!!                                 |channel from HRU during simulation
!!    hruaao(64,:)  |# bacteria/ha |persistent bacteria transported to main
!!                                 |channel from HRU during simulation
!!    hruaao(65,:)  |kg N/ha       |nitrate loading from groundwater in HRU to
!!                                 |main channel during simulation
!!    hruaao(66,:)  |kg P/ha       |soluble P loading from groundwater in HRU to
!!                                 |main channel during simulation
!!    hruaao(67,:)  |kg P/ha       |loading of mineral P attached to sediment
!!                                 |in HRU to main channel during simulation
!!    hrugis(:)     |none          |GIS code printed to output files(output.hru,.rch)
!!    icr(:)        |none          |sequence number of crop grown within the
!!                                 |current year
!!    idplt(:)      |none          |land cover code from crop.dat
!!    ipdvas(:)     |none          |output variable codes for output.hru file
!!    isproj        |none          |special project code:
!!                                 |1 test rewind (run simulation twice)
!!    itots         |none          |number of output variables printed (output.hru)
!!    lai_aamx(:)   |none          |average annual maximum leaf area index in
!!                                 |HRU
!!    mhruo         |none          |maximum number of variables written to
!!                                 |HRU output file (output.hru)
!!    nhru          |none          |number of HRUs in watershed
!!    nmgt(:)       |none          |management code (for GIS output only)
!!    nro(:)        |none          |sequence number of year in rotation
!!    shallst(:)    |mm H2O        |depth of water in shallow aquifer
!!    sol_sw(:)     |mm H2O        |amount of water stored in the soil profile
!!                                 |on any given day
!!    yldaa(:)      |metric tons/ha|average annual yield (dry weight) in HRU
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    ii          |none          |counter
!!    j           |none          |HRU number
!!    pdvas(:)    |varies        |array to hold HRU output values
!!    pdvs(:)     |varies        |array to hold selected HRU output values
!!                               |when user doesn't want to print all
!!    sb          |none          |subbasin number
!!    years       |years         |length of simulation
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~

      use parm

      real, intent (in) :: years
      integer :: j, sb, ii, iflag
      real, dimension (mhruo) :: pdvas, pdvs
      character (len=4) :: cropname

      do j = 1, nhru
        sb = hru_sub(j)

        iflag = 0
        do ii = 1, itoth
          if (ipdhru(ii) == j) iflag = 1
        end do

        if (iflag == 1) then
        pdvas = 0.
        pdvs = 0.

        pdvas(1) = hruaao(1,j)
        pdvas(2) = hruaao(2,j)
        pdvas(3) = hruaao(3,j)
        pdvas(4) = hruaao(22,j)
        pdvas(5) = hruaao(25,j)
        pdvas(6) = hruaao(12,j)
        pdvas(7) = hruaao(21,j) / 365.4
        pdvas(8) = sol_sw(j)
        pdvas(9) = hruaao(11,j)
        pdvas(10) = hruaao(9,j)
        pdvas(11) = hruaao(8,j)
        pdvas(12) = hruaao(7,j)
        pdvas(13) = hruaao(23,j)
        pdvas(14) = hruaao(24,j)
        pdvas(15) = shallst(j)
        pdvas(16) = deepst(j)
        pdvas(17) = hruaao(19,j)
        pdvas(18) = hruaao(4,j)
        pdvas(19) = hruaao(13,j)
        pdvas(20) = hruaao(5,j)
        pdvas(21) = hruaao(6,j)
        pdvas(22) = hruaao(10,j)
        pdvas(23) = hruaao(20,j) / 365.4
        pdvas(24) = hruaao(57,j) / 365.4
        pdvas(25) = hruaao(55,j) / 365.4
        pdvas(26) = hruaao(56,j) / 365.4
        pdvas(27) = hruaao(30,j) / 365.4
        pdvas(28) = hruaao(58,j) / 365.4
        pdvas(29) = hruaao(14,j)
        pdvas(30) = hruaao(61,j)
        pdvas(31) = hruaao(45,j)
        pdvas(32) = hruaao(46,j)
        pdvas(33) = hruaao(28,j)
        pdvas(34) = hruaao(29,j)
        pdvas(35) = hruaao(26,j)
        pdvas(36) = hruaao(27,j)
        pdvas(37) = hruaao(17,j)
        pdvas(38) = hruaao(18,j)
        pdvas(39) = hruaao(54,j)
        pdvas(40) = hruaao(47,j)
        pdvas(41) = hruaao(52,j)
        pdvas(42) = hruaao(49,j)
        pdvas(43) = hruaao(50,j)
        pdvas(44) = hruaao(53,j)
        pdvas(45) = hruaao(51,j)
        pdvas(46) = hruaao(43,j)
        pdvas(47) = hruaao(44,j)
        pdvas(48) = hruaao(48,j)
        pdvas(49) = hruaao(40,j)
        pdvas(50) = hruaao(42,j)
        pdvas(51) = hruaao(35,j)
        pdvas(52) = hruaao(36,j)
        pdvas(53) = hruaao(67,j)
        pdvas(54) = hruaao(37,j)
        pdvas(55) = hruaao(38,j)
        pdvas(56) = hruaao(41,j)
        pdvas(57) = hruaao(65,j)
        pdvas(58) = hruaao(39,j)
        pdvas(59) = hruaao(66,j)
        pdvas(60) = hruaao(31,j)
        pdvas(61) = hruaao(32,j)
        pdvas(62) = hruaao(33,j)
        pdvas(63) = hruaao(34,j)
        pdvas(64) = bio_aams(j)
        pdvas(65) = lai_aamx(j)
        pdvas(66) = yldaa(j)
        pdvas(67) = hruaao(63,j)
        pdvas(68) = hruaao(64,j)
!!      the following two variables are values at the of the year
!!      they are not summed each day
        pdvas(69) = wtab(j)  !! based on 30 day antecedent climate(mm) (prec,et)
        pdvas(70) = wtabelo  !! based on depth from soil surface(mm)
!!      added current snow content in the hru (not summed)
        pdvas(71) = sno_hru(j)

!!      added current soil carbon for first layer
        pdvas(72) = cmup_kgh(j)   !! first soil layer only
!!      added current soil carbon integrated - aggregating all soil layers
        pdvas(73) = cmtot_kgh(j)

!!      adding qtile to output.hru write 3/2/2010 gsm
        pdvas(74) = hruaao(62,j)
!!      tileno3 - output.hru
        pdvas(75) = hruaao(68,j)
!!      latno3 - output.hru
        pdvas(76) = hruaao(69,j)
!!      gw deep
        pdvas(77) = hruaao(70,j)
!!      latq contribution
        pdvas(78) = hruaao(71,j)
!!      phos due to crack flow (tvap)
        pdvas(79) = hruaao(72,j)

        pdvas(80) = hruaao(73,j) / 365.4
        pdvas(81) = hruaao(74,j) / 365.4
        pdvas(82) = hruaao(75,j) / 365.4
        pdvas(83) = hruaao(76,j) / 365.4
        pdvas(84) = hruaao(77,j) / 365.4
        pdvas(85) = hruaao(78,j) / 365.4
        pdvas(86) = hruaao(79,j) / 365.4
        pdvas(87) = hruaao(80,j) / 365.4
        pdvas(88) = hruaao(81,j) / 365.4
        pdvas(89) = hruaao(82,j) / 365.4

        if (ipdvas(1) > 0) then
          do ii = 1, itots
            pdvs(ii) = pdvas(ipdvas(ii))
          end do

        idplant = idplt(j)
        if (idplant > 0) then
          cropname = cpnm(idplant)
        else
          cropname = "NOCR"
        endif

          if (iscen == 1 .and. isproj == 0) then
          write (28,1000) cropname, j, subnum(j), hruno(j), sb,
     &        nmgt(j), years, hru_km(j), (pdvs(ii), ii = 1, itots)
          else if (isproj == 1) then
          write (21,1000) cropname, j, subnum(j), hruno(j),
     &    sb, nmgt(j), years, hru_km(j), (pdvs(ii), ii = 1, itots)
          else if (iscen == 1 .and. isproj == 2) then
          write (28,2000) cropname, j, subnum(j), hruno(j), sb,
     &    nmgt(j), years, hru_km(j), (pdvs(ii), ii = 1, itots), iyr
          endif
        else
          if (iscen == 1 .and. isproj == 0) then
          write (28,1001) cropname, j, subnum(j), hruno(j), sb,
     &            nmgt(j), years, hru_km(j), (pdvas(ii), ii = 1, mhruo)
          else if (isproj == 1) then
          write (21,1001) cropname, j, subnum(j), hruno(j),
     &         sb, nmgt(j), years, hru_km(j), (pdvas(ii), ii = 1, mhruo)
          else if (iscen == 1 .and. isproj == 2) then
          write (28,1001) cropname, j, subnum(j), hruno(j), sb,
     &    nmgt(j), years, hru_km(j), (pdvas(ii), ii = 1, mhruo), iyr
          endif
        end if
        end if
      end do

      return

1000  format (a4,i5,1x,a5,a4,i5,1x,i4,1x,f4.1,e10.5,66f10.3,1x,
     *e10.5,1x,e10.5,8e10.3,3f10.3)
2000  format (a4,i5,1x,a5,a4,i5,1x,i4,1x,f4.1,e10.5,66f10.3,1x,
     *e10.5,1x,e10.5,5e10.3,6f10.3,1x,i4)
1001  format (a4,i7,1x,a5,a4,i5,1x,i4,1x,f4.1,e10.5,66f10.3,1x,
     *e10.5,1x,e10.5,8e10.3,3f10.3,1x,i4)

      end