Chimie Théorique » Opt'n Path

! This subroutine prints a geometry

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

!----------------------------------------------------------------------

!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon,

!  Centre National de la Recherche Scientifique,

!  Université Claude Bernard Lyon 1. All rights reserved.

!

!  This work is registered with the Agency for the Protection of Programs

!  as IDDN.FR.001.100009.000.S.P.2014.000.30625

!

!  Authors: P. Fleurat-Lessard, P. Dayal

!  Contact: optnpath@gmail.com

!

! This file is part of "Opt'n Path".

!

!  "Opt'n Path" is free software: you can redistribute it and/or modify

!  it under the terms of the GNU Affero General Public License as

!  published by the Free Software Foundation, either version 3 of the License,

!  or (at your option) any later version.

!

!  "Opt'n Path" is distributed in the hope that it will be useful,

!  but WITHOUT ANY WARRANTY; without even the implied warranty of

!

!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

!  GNU Affero General Public License for more details.

!

!  You should have received a copy of the GNU Affero General Public License

!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.

!

! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,

! for commercial licensing opportunities.

!----------------------------------------------------------------------

  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

  CHARACTER(32) :: Name1, Name2, Name3,Name4

  LOGICAL :: Debug=.FALSE.

  SELECT CASE (COORD)

  CASE ("ZMAT")

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

     WRITE(Name1,'(A,I5)') Nom(Atome(OrderInv(indzmat(1,1)))),indzmat(1,1)

!     WRITE(*,*) "Name1:",Name1,"*"

     Call CleanString(Name1,' ')

!     WRITE(*,*) "Name1:",Name1,"*"

     WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Name1(1:5)

     WRITE(Name1,'(A,I5)') Nom(Atome(OrderInv(indzmat(2,1)))),indzmat(2,1)

     Call CleanString(Name1,' ')

     WRITE(Name2,'(A,I5)') Nom(Atome(OrderInv(indzmat(2,2)))),indzmat(2,2)

     Call CleanString(Name2,' ')

     WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Name1(1:5), &

          Name2(1:5),Geom(1)

     WRITE(Name1,'(A,I5)') Nom(Atome(OrderInv(indzmat(3,1)))),indzmat(3,1)

     Call CleanString(Name1,' ')

     WRITE(Name2,'(A,I5)') Nom(Atome(OrderInv(indzmat(3,2)))),indzmat(3,2)

     Call CleanString(Name2,' ')

     WRITE(Name3,'(A,I5)') Nom(Atome(OrderInv(indzmat(3,3)))),indzmat(3,3)

     Call CleanString(Name3,' ')

     WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Name1, &

          Name2,Geom(2), &

          Name3,Geom(3)*180./Pi

     Idx=4

     DO Iat=4,Nat

     WRITE(Name1,'(A,I5)') Nom(Atome(OrderInv(indzmat(iat,1)))),indzmat(iat,1)

     Call CleanString(Name1,' ')

     WRITE(Name2,'(A,I5)') Nom(Atome(OrderInv(indzmat(iat,2)))),indzmat(iat,2)

     Call CleanString(Name2,' ')

     WRITE(Name3,'(A,I5)') Nom(Atome(OrderInv(indzmat(iat,3)))),indzmat(iat,3)

     Call CleanString(Name3,' ')

     WRITE(Name4,'(A,I5)') Nom(Atome(OrderInv(indzmat(iat,4)))),indzmat(iat,4)

     Call CleanString(Name4,' ')

        ! 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

        WRITE(IOOUT,'(1X,A5,3(1X,A4,1X,F11.6))') Name1, &

             Name2,Geom(Idx), &

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

             Name4,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