Chimie Théorique » OpenPath

! This subroutine prints a geometry

SUBROUTINE PrintGeom(Title,Nat,NCoord,Geom,Coord,IOOUT,Atome,Order,OrderInv,IndZmat)

  use Path_module, only : Renum,Nom,NCart,Pi

  IMPLICIT NONE

  INTEGER, PARAMETER :: KINT=KIND(1)

  INTEGER, PARAMETER :: KREAL=KIND(1.D0)

  CHARACTER(*), INTENT(IN) :: Title

  INTEGER(KINT), INTENT(IN) :: Nat,NCoord,IoOut

  INTEGER(KINT), INTENT(IN) :: Atome(Nat),Order(Nat), OrderInv(Nat),IndZmat(Nat,5)

  CHARACTER(32), INTENT(IN) :: Coord

  REAL(KREAL), INTENT(IN) :: Geom(NCoord)

  INTEGER(KINT) :: Idx, Iat,I,IBeg

  LOGICAL :: Debug=.FALSE.

  SELECT CASE (COORD)

  CASE ("ZMAT") 

     WRITE(IOOUT,'(1X,A)') TRIM(AdjustL(Title))

     WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Nom(Atome(OrderInv(indzmat(1,1))))

     WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Nom(Atome(OrderInv(indzmat(2,1)))), &

          Nom(Atome(OrderInv(indzmat(2,2)))),Geom(1)

     WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Nom(Atome(OrderInv(indzmat(3,1)))), &

          Nom(Atome(OrderInv(indzmat(3,2)))),Geom(2), &

          Nom(Atome(OrderInv(indzmat(3,3)))),Geom(3)*180./Pi

     Idx=4

     DO Iat=4,Nat

        WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Nom(Atome(OrderInv(indzmat(iat,1)))), &

             Nom(Atome(OrderInv(indzmat(iat,2)))),Geom(Idx), &

             Nom(Atome(OrderInv(indzmat(iat,3)))),Geom(Idx+1)*180./Pi, &

             Nom(Atome(OrderInv(indzmat(iat,4)))),Geom(Idx+2)*180./Pi

        Idx=Idx+3

     END DO

     if (debug) THEN

        WRITE(*,'(1X,A)') TRIM(AdjustL(Title))

        WRITE(*,'(1X,A5,3(1X,A4,1X,F11.6))') Nom(Atome(OrderInv(indzmat(1,1))))

        WRITE(*,'(1X,A5,3(1X,A4,1X,F11.6))') Nom(Atome(OrderInv(indzmat(2,1)))), &

             Nom(Atome(OrderInv(indzmat(2,2)))),Geom(1)

        WRITE(*,'(1X,A5,3(1X,A4,1X,F14.6))') Nom(Atome(OrderInv(indzmat(3,1)))), &

             Nom(Atome(OrderInv(indzmat(3,2)))),Geom(2), &

             Nom(Atome(OrderInv(indzmat(3,3)))),Geom(3)*180./Pi

        Idx=4

        DO Iat=4,Nat

           WRITE(*,'(1X,A5,3(1X,A4,1X,F11.6))') Nom(Atome(OrderInv(indzmat(iat,1)))), &

                Nom(Atome(OrderInv(indzmat(iat,2)))),Geom(Idx), &

                Nom(Atome(OrderInv(indzmat(iat,3)))),Geom(Idx+1)*180./Pi, &

                Nom(Atome(OrderInv(indzmat(iat,4)))),Geom(Idx+2)*180./Pi

           Idx=Idx+3

        END DO

     END IF

  CASE ("MIXED") 

     !     WRITE(*,'(1X,A,12(1X,F10.5))') "IntCoordTmp:",Geom(1:NCoord)

     WRITE(IOOUT,'(1X,A)') TRIM(AdjustL(Title))

     DO I=1,NCart

        WRITE(IOOUT,'(1X,A5,3(1X,F11.6))') Nom(Atome(OrderInv(indzmat(1,1)))) &

             ,Geom(3*I-2:3*I)

     END DO

     Idx=3*NCart+1

     SELECT CASE (NCart)

     CASE (1)

        I=2

        WRITE(IOOUT,'(1X,A5,3(I5,F11.6))') Nom(Atome(OrderInv(Indzmat(I,1)))), &

             IndZmat(I,2),Geom(Idx)

        Idx=Idx+1

        I=3

        WRITE(IOOUT,'(1X,A5,3(I5,F11.6))') Nom(Atome(OrderInv(Indzmat(I,1)))), &

             IndZmat(I,2),Geom(Idx),IndZmat(I,3),          &

             Geom(Idx+1)*180./Pi

        Idx=Idx+2

        Ibeg=4

     CASE (2)

        I=3

        WRITE(IOOUT,'(1X,A5,3(I5,F11.6))') Nom(Atome(OrderInv(Indzmat(I,1)))), &

             IndZmat(I,2),Geom(Idx),IndZmat(I,3),          &

             Geom(Idx+1)*180./Pi

        Idx=Idx+2

        Ibeg=4

     CASE DEFAULT

        IBeg=NCart+1

     END SELECT

     DO I=IBeg,Nat

        WRITE(IOOUT,'(1X,A5,3(I5,F11.6))') Nom(Atome(OrderInv(Indzmat(I,1)))), &

             IndZmat(I,2),Geom(Idx),IndZmat(I,3),          &

             Geom(Idx+1)*180./Pi, &

             IndZmat(I,4),Geom(Idx+2)*180./Pi

        Idx=Idx+3

     END DO

  CASE ('CART','HYBRID')

     WRITE(IOOUT,'(1X,I5)') Nat

     WRITE(IOOUT,'(1X,A)') TRIM(AdjustL(Title))

     DO I=1,Nat

        Iat=I

        If (renum) Iat=Order(I)

!!! CAUTION : PFL 29.AUG.2008 ->

        ! Old line:

        !        WRITE(IOOUT,'(1X,A5,3(1X,F11.6))') Nom(Atome(i)), Geom(3*Iat-2:3*Iat)

        ! uses implicitly that Geom is Geom(3,Nat) whereas it is in fact Geom(Nat,3) :-(

        WRITE(IOOUT,'(1X,A5,3(1X,F11.6))') Nom(Atome(i)), Geom(Iat), Geom(Iat+Nat), Geom(Iat+2*Nat)

     END DO

  CASE ('BAKER')

     !WRITE(IOOUT,*) "Baker coordinates are difficult to interpret. Therefore cartesian coordinates"

     !WRITE(IOOUT,*) "Should be printed"

     WRITE(*,*) "Baker coordinates are difficult to interpret. Therefore cartesian"

     WRITE(*,*) "coordinates are printed above."

  END SELECT

END SUBROUTINE PRINTGEOM