Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Scientific Software
CrysFML
Commits
63998740
Commit
63998740
authored
Mar 31, 2022
by
juan rodriguez-carvajal
Browse files
Few cosmetic changes
parent
0419f725
Pipeline
#13220
failed with stages
in 7 minutes and 41 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Src/CFML_GlobalDeps_Windows.f90
deleted
100644 → 0
View file @
0419f725
!!-------------------------------------------------------
!!---- Crystallographic Fortran Modules Library (CrysFML)
!!-------------------------------------------------------
!!---- The CrysFML project is distributed under LGPL. In agreement with the
!!---- Intergovernmental Convention of the ILL, this software cannot be used
!!---- in military applications.
!!----
!!---- Copyright (C) 1999-2012 Institut Laue-Langevin (ILL), Grenoble, FRANCE
!!---- Universidad de La Laguna (ULL), Tenerife, SPAIN
!!---- Laboratoire Leon Brillouin(LLB), Saclay, FRANCE
!!----
!!---- Authors: Juan Rodriguez-Carvajal (ILL)
!!---- Javier Gonzalez-Platas (ULL)
!!---- Nebil Ayape Katcho (ILL)
!!----
!!---- Contributors: Laurent Chapon (ILL)
!!---- Marc Janoschek (Los Alamos National Laboratory, USA)
!!---- Oksana Zaharko (Paul Scherrer Institute, Switzerland)
!!---- Tierry Roisnel (CDIFX,Rennes France)
!!---- Eric Pellegrini (ILL)
!!----
!!---- This library is free software; you can redistribute it and/or
!!---- modify it under the terms of the GNU Lesser General Public
!!---- License as published by the Free Software Foundation; either
!!---- version 3.0 of the License, or (at your option) any later version.
!!----
!!---- This library 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
!!---- Lesser General Public License for more details.
!!----
!!---- You should have received a copy of the GNU Lesser General Public
!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
!!----
!!----
!!---- MODULE: CFML_GlobalDeps (Windows version)
!!---- INFO: Precision for CrysFML library and Operating System information
!!---- All the global variables defined in this module are implicitly public.
!!----
!!---- HISTORY
!!--.. Update: 02/03/2011
!!--..
!!---- VARIABLES
!!--..
!!--.. Operating system
!!--..
!!---- OPS
!!---- OPS_NAME
!!---- OPS_SEP
!!--..
!!--.. Precision Data
!!--..
!!---- SP
!!---- DP
!!---- CP
!!--..
!!--.. Trigonometric
!!--..
!!---- PI
!!---- TO_DEG
!!---- TO_RAD
!!---- TPI
!!--..
!!--.. Numeric
!!--..
!!---- DEPS
!!---- EPS
!!--..
!!---- FUNCTIONS
!!--..
!!---- DIRECTORY_EXISTS
!!----
!!---- SUBROUTINES
!!--..
!!---- WRITE_DATE_TIME
!!----
!!
Module
CFML_GlobalDeps
!---- Variables ----!
implicit
None
public
!------------------------------------!
!---- Operating System variables ----!
!------------------------------------!
!!----
!!---- OPS
!!---- Integer variable 1: Windows, 2: Linux, 3: MacOs, ....
!!---- This is a variable set by the user of the library for the case
!!---- that there is no external library with a procedure for getting
!!---- the operating system.
!!----
!!---- Update: March 2009
!!
integer
,
parameter
::
OPS
=
1
! Windows
!!----
!!---- OPS_NAME
!!---- Character variable containing the name of the operating system
!!---- This is a variable set by the user of the library for the case
!!---- that there is no external library with a procedure for getting
!!---- the operating system.
!!----
!!---- Update: March 2009
!!
character
(
len
=*
),
parameter
::
OPS_NAME
=
"Windows"
!!----
!!---- OPS_SEP
!!---- ASCII code of directory separator character
!!---- Here it is written explicitly as a character variable
!!----
!!---- Update: March 2009
!!
character
(
len
=*
),
parameter
::
OPS_SEP
=
"\"
!------------------------------!
!---- Precision Parameters ----!
!------------------------------!
!!----
!!---- SP
!!---- SP: Single precision ( sp = selected_real_kind(6,30) )
!!----
!!---- Update: January - 2009
!!
integer
,
parameter
::
sp
=
selected_real_kind
(
6
,
30
)
!!----
!!---- DP
!!---- DP: Double precision ( dp = selected_real_kind(14,150) )
!!----
!!---- Update: January - 2009
!!
integer
,
parameter
::
dp
=
selected_real_kind
(
14
,
150
)
!!----
!!---- CP
!!---- CP: Current precision
!!----
!!---- Update: January - 2009
!!
integer
,
parameter
::
cp
=
sp
!----------------------------------!
!---- Trigonometric Parameters ----!
!----------------------------------!
!!----
!!---- PI
!!---- real(kind=dp), parameter :: pi = 3.141592653589793238463_dp
!!----
!!---- Pi value
!!----
!!---- Update: January - 2009
!!
real
(
kind
=
dp
),
parameter
::
pi
=
3.141592653589793238463_dp
!!----
!!---- TO_DEG
!!---- real(kind=dp), parameter :: to_DEG = 180.0_dp/pi
!!----
!!---- Conversion from Radians to Degrees
!!----
!!---- Update: January - 2009
!!
real
(
kind
=
dp
),
parameter
::
to_DEG
=
180.0_dp
/
pi
!!----
!!---- TO_RAD
!!---- real(kind=dp), parameter :: to_RAD = pi/180.0_dp
!!----
!!---- Conversion from Degrees to Radians
!!----
!!---- Update: January - 2009
!!
real
(
kind
=
dp
),
parameter
::
to_RAD
=
pi
/
180.0_dp
!!----
!!---- TPI
!!---- real(kind=dp), parameter :: tpi = 6.283185307179586476925_dp
!!----
!!---- 2.0*Pi value
!!----
!!---- Update: January - 2009
!!
real
(
kind
=
dp
),
parameter
::
tpi
=
6.283185307179586476925_dp
!----------------------------!
!---- Numeric Parameters ----!
!----------------------------!
!!----
!!---- DEPS
!!---- real(kind=dp), parameter :: deps=0.00000001_dp
!!----
!!---- Epsilon value use for comparison of real numbers
!!----
!!---- Update: January - 2009
!!
real
(
kind
=
dp
),
parameter
,
public
::
deps
=
0.00000001_dp
!!----
!!---- EPS
!!---- real(kind=cp), public :: eps=0.00001_cp
!!----
!!---- Epsilon value use for comparison of real numbers
!!----
!!---- Update: January - 2009
!!
real
(
kind
=
cp
),
parameter
,
public
::
eps
=
0.00001_cp
integer
,
parameter
::
IL
=
selected_int_kind
(
16
)
! Long Integer
Contains
!-------------------!
!---- Functions ----!
!-------------------!
!!----
!!---- Function Directory_Exists(Dirname) Result(info)
!!---- character(len=*), intent(in) :: Dirname
!!---- logical :: info
!!----
!!---- Generic function dependent of the compiler that return
!!---- a logical value if a directory exists or not.
!!----
!!---- Update: April - 2009
!!
Function
Directory_Exists
(
Dirname
)
Result
(
info
)
!---- Argument ----!
character
(
len
=*
),
intent
(
in
)
::
Dirname
logical
::
info
!---- Local Variables ----!
character
(
len
=
512
)
::
linea
integer
::
nlong
! Init value
info
=
.false.
linea
=
trim
(
dirname
)
nlong
=
len_trim
(
linea
)
if
(
nlong
==
0
)
return
if
(
linea
(
nlong
:
nlong
)
/
=
ops_sep
)
linea
=
trim
(
linea
)//
ops_sep
! All compilers except Intel
inquire
(
file
=
trim
(
linea
)//
'.'
,
exist
=
info
)
! Intel
!inquire(directory=trim(linea), exist=info)
return
End
Function
Directory_Exists
!---------------------!
!---- Subroutines ----!
!---------------------!
!!----
!!---- Subroutine Write_Date_Time(lun,dtim)
!!---- integer, optional,intent(in) :: lun
!!---- character(len=*),optional,intent(out):: dtim
!!----
!!---- Generic subroutine for writing the date and time
!!---- in form Date: Day/Month/Year Time: hour:minute:second
!!---- to a file with logical unit = lun. The output argument
!!---- can be provided to get a string with the same information
!!----
!!---- Updated: January - 2014
!!
Subroutine
Write_Date_Time
(
lun
,
dtim
)
integer
,
optional
,
intent
(
in
)
::
lun
character
(
len
=*
),
optional
,
intent
(
out
)::
dtim
!--- Local variables ----!
character
(
len
=
10
)
::
dat
character
(
len
=
10
)
::
tim
call
date_and_time
(
date
=
dat
,
time
=
tim
)
if
(
present
(
lun
))
&
write
(
unit
=
lun
,
fmt
=
"(/,4a)"
)
&
" => Date: "
,
dat
(
7
:
8
)//
"/"
//
dat
(
5
:
6
)//
"/"
//
dat
(
1
:
4
),
&
" Time: "
,
tim
(
1
:
2
)//
":"
//
tim
(
3
:
4
)//
":"
//
tim
(
5
:
10
)
if
(
present
(
dtim
))
&
dtim
=
"# Date: "
//
dat
(
7
:
8
)//
"/"
//
dat
(
5
:
6
)//
"/"
//
dat
(
1
:
4
)//
&
" Time: "
//
tim
(
1
:
2
)//
":"
//
tim
(
3
:
4
)//
":"
//
tim
(
5
:
10
)
return
End
Subroutine
Write_Date_Time
End
Module
CFML_GlobalDeps
Src/CFML_IO_Formats.f90
View file @
63998740
...
...
@@ -741,7 +741,7 @@
Job_Info
%
W
=
0.0
Job_Info
%
X
=
0.0
Job_Info
%
Y
=
0.0
Job_Info
%
theta_step
=
0.0
Job_Info
%
bkg
=
0.0
...
...
@@ -749,10 +749,10 @@
line
=
u_case
(
adjustl
(
file_dat
(
i
)))
if
(
line
(
1
:
5
)
==
"TITLE"
)
Job_info
%
title
=
line
(
7
:)
if
(
line
(
1
:
5
)
==
"NPATT"
)
then
read
(
unit
=
line
(
7
:),
fmt
=*
,
iostat
=
ier
)
Job_info
%
Num_Patterns
if
(
ier
/
=
0
)
Job_info
%
Num_Patterns
=
1
end
if
if
(
line
(
1
:
6
)
==
"PHASE_"
)
then
nphas
=
nphas
+1
...
...
@@ -775,7 +775,7 @@
end
if
end
if
if
(
line
(
1
:
4
)
==
"STEP"
)
then
if
(
line
(
1
:
4
)
==
"STEP"
)
then
read
(
unit
=
line
(
5
:),
fmt
=*
,
iostat
=
ier
)
Job_info
%
theta_step
if
(
ier
/
=
0
)
then
Job_info
%
theta_Step
=
0.05
...
...
@@ -787,7 +787,7 @@
read
(
unit
=
line
(
7
:),
fmt
=*
,
iostat
=
ier
)
Job_info
%
bkg
if
(
ier
/
=
0
)
Job_info
%
bkg
=
20.0
end
if
end
do
if
(
nphas
==
0
)
then
...
...
@@ -859,8 +859,8 @@
Job_Info
%
ratio
=
0.0
Job_Info
%
dtt1
=
0.0
Job_Info
%
dtt2
=
0.0
if
(
ncmd
>
0
)
then
if
(
allocated
(
Job_Info
%
cmd
))
deallocate
(
Job_Info
%
cmd
)
allocate
(
Job_Info
%
cmd
(
ncmd
))
...
...
@@ -2044,26 +2044,26 @@
np1
=
nline_ini
call
Read_Key_Str
(
filevar
,
nline_ini
,
nline_end
,
&
"_symmetry_space_group_name_H-M"
,
spgr_hm
)
!if (len_trim(spgr_hm) ==0 ) spgr_hm=adjustl(filevar(nline_ini+1))
!if (len_trim(spgr_hm) ==
0 ) spgr_hm=adjustl(filevar(nline_ini+1))
!nline_ini=np1
! TR feb. 2015 .(re-reading the same item with another name)
if
(
len_trim
(
spgr_hm
)
==
0
)
then
nline_ini
=
np1
spgr_hm
=
" "
call
Read_Key_Str
(
filevar
,
nline_ini
,
nline_end
,
"_space_group_name_H-M_alt"
,
spgr_hm
)
if
(
len_trim
(
spgr_hm
)
==
0
)
spgr_hm
=
adjustl
(
filevar
(
nline_ini
+1
))
if
(
len_trim
(
spgr_hm
)
==
0
)
spgr_hm
=
adjustl
(
filevar
(
nline_ini
+1
))
end
if
if
(
spgr_hm
==
"?"
.or.
spgr_hm
==
"#"
)
then
if
(
spgr_hm
==
"?"
.or.
spgr_hm
==
"#"
)
then
spgr_hm
=
" "
else
np1
=
index
(
spgr_hm
,
"'"
)
np2
=
index
(
spgr_hm
,
"'"
,
back
=
.true.
)
np2
=
index
(
spgr_hm
,
"'"
,
back
=
.true.
)
if
(
np1
>
0
.and.
np2
>
0
.and.
np2
>
np1
)
then
spgr_hm
=
spgr_hm
(
np1
+1
:
np2
-1
)
else
np1
=
index
(
spgr_hm
,
'"'
)
np2
=
index
(
spgr_hm
,
'"'
,
back
=
.true.
)
np2
=
index
(
spgr_hm
,
'"'
,
back
=
.true.
)
if
(
np1
>
0
.and.
np2
>
0
.and.
np2
>
np1
)
then
spgr_hm
=
spgr_hm
(
np1
+1
:
np2
-1
)
else
...
...
@@ -5351,7 +5351,7 @@
n_end
=
ip
(
iph
+1
)
call
Read_Cif_Symm
(
file_dat
,
n_ini
,
n_end
,
noper
,
symm_car
)
if
(
noper
==
0
)
then
if
(
noper
==
0
)
then
err_form
=
.true.
ERR_Form_Mess
=
" => No Space Group/No Symmetry information in this file "
return
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment