String array being nullified when passing - fortran

I am having trouble passing a string array. Consider the following example code:
! -- Module to declare variable
module my_data
implicit none
! -- Declare as deferred-length allocatable array
character(len=:), dimension(:), allocatable :: str_array
end module my_data
! -- Module to call subroutine
module my_subs
implicit none
contains
subroutine a(str_array)
character(len=*), dimension(:), intent(IN) :: str_array
integer :: i, j
character :: c
do i=1,size(str_array)
do j=1,len_trim(str_array(i))
c = str_array(i)(j:j)
! -- Write i, j, character, and int representation
write(*,*) 'In call: ', i, j, ' "'//c//'", ichar = ', ichar(c)
enddo
enddo
end subroutine a
end module my_subs
! -- Main program
program main
use my_data, only : str_array
use my_subs, only : a
implicit none
integer, parameter :: strlen = 200
integer :: N, i, j
character :: c
! -- Size of str array
N = 2
! -- Allocate str_array, syntax from https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/287349
allocate(character(strlen) :: str_array(N))
! -- Set both to the same string
str_array = 'abc'
do i=1,size(str_array)
do j=1,len_trim(str_array(i))
c = str_array(i)(j:j)
! -- Write i, j, character, and int representation
write(*,*) 'In main: ', i, j, ' "'//c//'", ichar = ', ichar(c)
enddo
enddo
call a(str_array)
end program main
The string array is declared as an array of assumed-length elements (from the wiki). I allocate and set the values of the string (two elements, both to abc for this example). The main routine outputs full details about the string, then calls a subroutine which also outputs the (hopefully same) full details.
Using PGI, GCC, or Intel 15.0, I get the result I expect:
chaud106#ln0005 [~/Testing] % ifort --version && ifort -check all -warn all main.f90 && ./a.out
ifort (IFORT) 15.0.3 20150407
Copyright (C) 1985-2015 Intel Corporation. All rights reserved.
In main: 1 1 "a", ichar = 97
In main: 1 2 "b", ichar = 98
In main: 1 3 "c", ichar = 99
In main: 2 1 "a", ichar = 97
In main: 2 2 "b", ichar = 98
In main: 2 3 "c", ichar = 99
In call: 1 1 "a", ichar = 97
In call: 1 2 "b", ichar = 98
In call: 1 3 "c", ichar = 99
In call: 2 1 "a", ichar = 97
In call: 2 2 "b", ichar = 98
In call: 2 3 "c", ichar = 99
However, Intel 18.0 sets the second element of the character array (all 3 characters) to the null character:
chaud106#ln0005 [~/Testing] % ifort --version && ifort -check all -warn all main.f90 && ./a.out
ifort (IFORT) 18.0.0 20170811
Copyright (C) 1985-2017 Intel Corporation. All rights reserved.
In main: 1 1 "a", ichar = 97
In main: 1 2 "b", ichar = 98
In main: 1 3 "c", ichar = 99
In main: 2 1 "a", ichar = 97
In main: 2 2 "b", ichar = 98
In main: 2 3 "c", ichar = 99
In call: 1 1 "a", ichar = 97
In call: 1 2 "b", ichar = 98
In call: 1 3 "c", ichar = 99
In call: 2 1 "", ichar = 0
In call: 2 2 "", ichar = 0
In call: 2 3 "", ichar = 0
I have several questions related to this behavior:
Why is this occurring? I was thinking it could be related to Intel enforcing lhs-reallocation, but I'm not sure. Adding -assume norealloc_lhs didn't change anything.
What is the correct syntax to pass a string array like this? Could I declare it differently and avoid this problem?
The versions of Intel I have access to on this machine have the following behavior:
ifort (IFORT) 15.0.2 20150121 - No nullification
ifort (IFORT) 15.0.3 20150407 - No nullification
ifort (IFORT) 16.0.3 20160415 - No nullification
ifort (IFORT) 17.0.4 20170411 - Nullifies
ifort (IFORT) 18.0.0 20170811 - Nullifies
On a different machine, I don't have any latest Intel:
ifort (IFORT) 14.0.2 20140120 - No nullification
ifort (IFORT) 16.0.0 20150815 - No nullification

Your program works as expected with ifort 18.0.3.
I haven't tried with lots of previous versions, but I note that 17.0.1 was the point at which Fortran 2003 automatic allocation on intrinsic assignment became the default in that compiler.
The problematic line appears to be
str_array = 'abc'
Here, str_array should first be deallocated, because the right-hand side is an expression with different length parameter from the left-hand side. Then it would be allocated as a character of length 3 (length of the right-hand side) and shape [2] as before (the right-hand side is scalar). And that does happen, as can be seen with SIZE(str_array) and LEN(str_array). Something goes a little awry later on when using it as an actual argument, though.
There are ways to work around this problem with 18.0.1:
give the dummy argument the value attribute;
str_array = ['abc','abc'] (previous allocation not required);
str_array(:) = 'abc' (if you don't want the reallocation).
Many others likely available, depending on exactly what you need. Upgrade your compiler to the latest version if you can, though.

Related

"Fortran runtime error: Bad real number" - Reading a file

I have the following external file with 8 rows ad 11 columns. This file cannot be changed in anyway.
Name Sun Jupiter Saturn Uranus Neptune EarthBC Mercury Venus Mars Pluto
mass(Msun) 1.000 9.547922048e-4 2.858857575e-4 4.366245355e-5 5.151391279e-5 3.040433607e-6 1.660477111e-7 2.448326284e-6 3.227778035e-7 6.607313077e-9
a(AU) 5.20219308 9.54531447 19.19247127 30.13430686 1.00000159 0.38709889 0.72332614 1.52364259 39.80634014
e 0.04891224 0.05409072 0.04723911 0.00734566 0.01669714 0.20563613 0.00676922 0.09330305 0.25439724
I(deg) 1.30376425 2.48750693 0.77193683 1.77045595 0.00090235 7.00457121 3.39460666 1.84908137 17.12113756
M(deg) 240.35086842 045.76754755 171.41809349 293.26102612 094.81131358 242.19484206 345.30814403 330.93171908 024.68081529
w(deg) 274.15634048 339.60245769 098.79773610 255.50375800 286.84104687 029.14401042 054.54948603 286.56509772 114.39445491
OMEGA(deg) 100.50994468 113.63306105 073.98592654 131.78208581 176.14784451 048.32221297 076.66204037 049.53656349 110.32482041
This file is read by the following program which compiles properly
program readtable
implicit none
integer :: i, j, num_col, num_row
double precision, dimension (8,11) :: a
character(14), dimension (8) :: par
num_col = 4
num_row = 8
open(100,file='SSL.dat',status='old')
do j=1, num_row
read(100,*) par(j), (a(i,j), i=1,num_col)
end do
print *, par
print *, a(2,3) !Jupiter's Mass
end program
When I run this program as Fortran90 I get the following message:
At line 14 of file test.f (unit = 100, file='SSL.dat')
Fortran runtime error: Bad real number in item 2 of list input
I think I need to make a FORMAT() statement to help the program read the file properly but I can't seem to get the format right.
As agentp said list directed is fine here, you just have to account for the first 2 lines being different. I'd do it it something like (slight guess here - I'm not 100% convinced I understand what you want):
ian-admin#agon ~/test $ cat r.f90
Program readtable
Implicit None
Integer, Parameter :: wp = Selected_real_kind( 13, 70 )
Integer :: i, j, num_col, num_row
Real( wp ) :: msun
Real( wp ), Dimension (9,11) :: a
Character(14), Dimension (8) :: par
num_col = 9
num_row = 7
Open( 100, file = 'SSL.dat', status = 'old' )
Read( 100, * )
j = 1
Read( 100, * ) par(j), msun, (a(i,j), i=1,num_col)
Do j = 2, num_row
Read(100,*) par(j), (a(i,j), i=1,num_col)
End Do
Write( *, * ) par
Write( *, * ) a(2,3) !Jupiter's Mass
End Program readtable
ian-admin#agon ~/test $ gfortran -std=f2003 -Wall -Wextra -O -fcheck=all r.f90
ian-admin#agon ~/test $ ./a.out
mass(Msun) a(AU) e I(deg) M(deg) w(deg) OMEGA(deg)
5.4090720000000002E-002

Syntax error of DATA statement in Fortran 90

I have to compute few complex integrals and for this purpose I got from my supervisor old program written in Fortran 77. However I have few problems with it. Mostly associated with syntax errors of DATA Statement. This is a part of code with a function calculating real integrals:
FUNCTION CAUSSA(F,A,B,EPS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
external f
REAL :: W(12),X(12)
DATA CONST /1.0D-12/
DATA W &
1 /0.10122 85362 9037 , 0.22238 10344 5337 , 0.31370 66458 7788 ,&
2 0.36268 37833 7836 , 0.02715 24594 1175 , 0.06225 35239 3864 ,&
3 0.09515 85116 8249 , 0.12462 89712 5553 , 0.14959 59888 1657 ,&
4 0.16915 65193 9500 , 0.18260 34150 4492 , 0.18945 06104 5506 /
DATA X &
1 /0.96028 98564 9753 , 0.79666 64774 1362 , 0.52553 24099 1632 ,&
2 0.18343 46424 9565 , 0.98940 09349 9165 , 0.94457 50230 7323 ,&
3 0.86563 12023 8783 , 0.75540 44083 5500 , 0.61787 62444 0264 ,&
4 0.45801 67776 5722 , 0.28160 35507 7925 , 0.09501 25098 3763 /
DELTA=CONST*DABS(A-B)
CAUSSA=0.d0
AA=A
5 Y=B-AA
IF(DABS(Y) .LE. DELTA) RETURN
2 BB=AA+Y
C1=0.5*(AA+BB)
C2=C1-AA
S8=0.d0
S16=0.d0
DO 1 I=1,4
U=X(I)*C2
1 S8=S8+W(I)*(F(C1+U)+F(C1-U))
DO 3 I = 5,12
U=X(I)*C2
3 S16=S16+W(I)*(F(C1+U)+F(C1-U))
S8=S8*C2
S16=S16*C2
IF(DABS(S16-S8).GT.EPS*DABS(S16)) GO TO 4
CAUSSA= CAUSSA+S16
A=BB
GO TO 5
4 Y=0.5*Y
IF(DABS(Y) .GT. DELTA) GO TO 2
write(2,7)
write(5,7)
7 FORMAT(1X,35HCAUSSA...TOO HIGH ACCURACY REQUIRED)
CAUSSA=0.d0
RETURN
END
The result of compilation is following:
sample.f90:11:
1 /0.10122 85362 9037 , 0.22238 10344 5337 , 0.31370 66458 7788 ,&
1
Error: Syntax error in DATA statement at (1)
sample.f90:17:
1 /0.96028 98564 9753 , 0.79666 64774 1362 , 0.52553 24099 1632 ,&
1
Error: Syntax error in DATA statement at (1)
I use gfortran version 4.4.7. I tried to rewrite those arrays but the result is always the same. Although this function is not the best for integrating, I still need it. Without it, that old program is collapsing.
I would appreciate any advice.
If you want to compile this as free form source, there are two things you will probably need to change
I am pretty sure that labels are illegal in continuation lines, so they should be removed
gfortran will misinterpreted the spaces between sections of the floating point numbers, so those also should be removed.
Something like this:
DATA W &
/0.10122853629037 , 0.22238103445337 , 0.31370664587788 ,&
0.36268378337836 , 0.02715245941175 , 0.06225352393864 ,&
0.09515851168249 , 0.12462897125553 , 0.14959598881657 ,&
0.16915651939500 , 0.18260341504492 , 0.18945061045506 /
should probably compile correctly [note written in browser and not tested].
Your original code was erroneously mixing both free-form and fixed-source format. Line continuations in free-form are performed by using a trailing ampersand character, &, rather than entering a character in column 6 of the following line. In fixed-source form, the first six columns are reserved for statement labels, with column 1 also used to indicate comment lines. In modern code, using structured control statements (such as select case or if-then-else) statement labels are uncommon. The first five columns are therefore wasted because they are rarely used.
Here is the same code in free-form and fixed-source format:
program main
use ISO_Fortran_env, only: &
compiler_version, &
compiler_options
! Explicit typing only
implicit none
! Variable declarations
double precision :: a, b, eps, x
a = 1.0d0
b = 2.0d0
eps = epsilon(a)
x = caussa(my_func, a, b, eps)
print '(/4a/)', &
' This file was compiled using ', compiler_version(), &
' using the options ', compiler_options()
contains
function my_func(arg) result (return_value)
! Dummy arguments
double precision, intent (in) :: arg
double precision :: return_value
return_value = arg * 42.0d0
end function my_func
function caussa(f,a,b,eps)
use ISO_Fortran_env, only: &
stderr => ERROR_UNIT
implicit double precision (a-h,o-z)
external f
integer :: i
real :: w(12),x(12)
data const /1.0d-12/
data w &
/0.10122853629037, 0.22238103445337, 0.31370664587788 ,&
0.36268378337836, 0.02715245941175, 0.06225352393864 , &
0.09515851168249, 0.12462897125553, 0.14959598881657 , &
0.16915651939500, 0.18260341504492, 0.18945061045506 /
data x &
/0.96028985649753, 0.79666647741362, 0.52553240991632, &
0.18343464249565, 0.98940093499165, 0.94457502307323, &
0.86563120238783, 0.75540440835500, 0.61787624440264, &
0.45801677765722, 0.28160355077925, 0.09501250983763 /
delta=const*dabs(a-b)
caussa=0.d0
aa=a
5 y=b-aa
if (dabs(y) <= delta) return
2 bb=aa+y
c1=0.5*(aa+bb)
c2=c1-aa
s8=0.d0
s16=0.d0
do 1 i=1,4
u=x(i)*c2
1 s8=s8+w(i)*(f(c1+u)+f(c1-u))
do 3 i = 5,12
u=x(i)*c2
3 s16=s16+w(i)*(f(c1+u)+f(c1-u))
s8=s8*c2
s16=s16*c2
if (dabs(s16-s8)>eps*dabs(s16)) go to 4
caussa = caussa+s16
a = bb
go to 5
4 y = 0.5*y
if (dabs(y) > delta) go to 2
write(2,7)
write(stderr,7)
!
! 7 format(1x,35hcaussa...too high accuracy required)
! Hollerith format specifier is a Fortran 95 deleted feature
!
7 format(1x, 'caussa...too high accuracy required')
caussa=0.d0
end function caussa
end program main
Here's the fixed-form version
PROGRAM MAIN
USE ISO_FORTRAN_ENV, ONLY:
1 COMPILER_VERSION,
2 COMPILER_OPTIONS
C EXPLICIT TYPING ONLY
IMPLICIT NONE
C VARIABLE DECLARATIONS
DOUBLE PRECISION :: A, B, EPS, X
A = 1.0D0
B = 2.0D0
EPS = EPSILON(A)
X = CAUSSA(MY_FUNC, A, B, EPS)
PRINT '(/4A/)',
1 ' THIS FILE WAS COMPILED USING ', COMPILER_VERSION(),
2 ' USING THE OPTIONS ', COMPILER_OPTIONS()
CONTAINS
FUNCTION MY_FUNC(ARG) RESULT (RETURN_VALUE)
C DUMMY ARGUMENTS
DOUBLE PRECISION, INTENT (IN) :: ARG
DOUBLE PRECISION :: RETURN_VALUE
RETURN_VALUE = ARG * 42.0D0
END FUNCTION MY_FUNC
FUNCTION CAUSSA(F,A,B,EPS)
USE ISO_FORTRAN_ENV, ONLY:
1 STDERR => ERROR_UNIT
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
EXTERNAL F
INTEGER I
REAL :: W(12), X(12)
DATA CONST /1.0D-12/
DATA W
1 /0.10122 85362 9037, 0.22238 10344 5337, 0.31370 66458 7788,
2 0.36268 37833 7836, 0.02715 24594 1175, 0.06225 35239 3864,
3 0.09515 85116 8249, 0.12462 89712 5553, 0.14959 59888 1657,
4 0.16915 65193 9500, 0.18260 34150 4492, 0.18945 06104 5506 /
DATA X
1 /0.96028 98564 9753, 0.79666 64774 1362, 0.52553 24099 1632,
2 0.18343 46424 9565, 0.98940 09349 9165, 0.94457 50230 7323,
3 0.86563 12023 8783, 0.75540 44083 5500, 0.61787 62444 0264,
4 0.45801 67776 5722, 0.28160 35507 7925, 0.09501 25098 3763 /
DELTA=CONST*DABS(A-B)
CAUSSA=0.D0
AA=A
5 Y=B-AA
IF(DABS(Y) .LE. DELTA) RETURN
2 BB=AA+Y
C1=0.5*(AA+BB)
C2=C1-AA
S8=0.D0
S16=0.D0
DO 1 I=1,4
U=X(I)*C2
1 S8=S8+W(I)*(F(C1+U)+F(C1-U))
DO 3 I = 5,12
U=X(I)*C2
3 S16=S16+W(I)*(F(C1+U)+F(C1-U))
S8=S8*C2
S16=S16*C2
IF(DABS(S16-S8).GT.EPS*DABS(S16)) GO TO 4
CAUSSA= CAUSSA+S16
A=BB
GO TO 5
4 Y=0.5*Y
IF(DABS(Y) .GT. DELTA) GO TO 2
WRITE(2,7)
WRITE(STDERR,7)
C
C 7 FORMAT(1X,35HCAUSSA...TOO HIGH ACCURACY REQUIRED)
C HOLLERITH FORMAT SPECIFIER IS A FORTRAN 95 DELETED FEATURE
C
7 FORMAT(1X, 'CAUSSA...TOO HIGH ACCURACY REQUIRED')
CAUSSA=0.D0
RETURN
END FUNCTION CAUSSA
END PROGRAM MAIN
With free-form, the concept of “significant blanks” was introduced.
In fixed-source, blanks were insignificant in most contexts. Here is a sample of a fixed-source statement showing what are now considered significant blanks followed by an equivalent statement without the blanks:
DO N = 1, MAX ITER S
DO N = 1, MAXITERS
Notice how we rewrote
DATA W
1 /0.10122 85362 9037, blah blah
as
data w &
/0.10122853629037, blah blah

Populate a constant array in order specified by other constants?

Is there a way to populate a constant array in an order specified by other constant variables?
So, in effect this:
integer, parameter :: ired = 1
integer, parameter :: iblue = 2
real, parameter :: myarr(2,3)
myarr(ired, :) = [1,0,0]
myarr(iblue,:) = [0,0,1]
Except the above of course will not compile. Is there a way to get to this in some way?
To generalize #HPM's answer to the case where ired and iblue etc may be discontiguous (e.g, 1 and 3), combined use of implied do-loop + array constructor might be useful. Because arrays in Fortran are column-major, I have aligned the vectors in a matrix such that [ vec1, vec2, ..., vecN ] where vecX is a 3-vector.
integer :: k
integer, parameter :: ired = 1, iblue = 3, mxvec = 4, ndim = 3, zero(3) = [0,0,0]
integer, dimension( ndim * mxvec ), parameter :: &
red = [ (zero, k=1,ired-1 ), [1,1,1], (zero, k=ired+1, mxvec) ], &
blue = [ (zero, k=1,iblue-1), [7,7,7], (zero, k=iblue+1,mxvec) ]
integer, parameter :: myarr( ndim, mxvec ) = reshape( red + blue, [ ndim, mxvec ] )
print "(a,/100(3i2/))", "red = ", red
print "(a,/100(3i2/))", "blue = ", blue
print "(a,/100(3i2/))", "myarr = ", myarr
print *, "myarr( :, ired ) = ", myarr( :, ired )
print *, "myarr( :, iblue ) = ", myarr( :, iblue )
Result:
red =
1 1 1
0 0 0
0 0 0
0 0 0
blue =
0 0 0
0 0 0
7 7 7
0 0 0
myarr =
1 1 1
0 0 0
7 7 7
0 0 0
myarr( :, ired ) = 1 1 1
myarr( :, iblue ) = 7 7 7
No, there is no way to assign values to a parameter after program start-up; that's exactly what the attribute parameter is intended to prevent.
You could write
real, parameter :: myarr(2,3) = reshape([1.0,0,0,0,0,1],[2,3])
to initialise myarr. Note that the elements are provided to reshape in the array element order specified by Fortran (ie column major); here it happens to be the same as if you had specified them in row major order. And note that in Fortran initialization means, precisely, setting a value in the declaration statement, which is how parameters acquire values.
I don't immediately see any way to use ired and iblue in the intialisation but I'm struggling to see that as a problem.
EDIT, after OP's comment:
I guess you could write something like
INTEGER, PARAMETER :: ired = 1
INTEGER, PARAMETER :: iblue = 2
REAL, PARAMETER, DIMENSION(2,3) :: rows = reshape([1,0,0,0,0,1],[2,3])
REAL, PARAMETER :: myarr(2,3) = RESHAPE([rows(ired,:), rows(iblue,:)], [2,3])
and now you only have to swap the values of ired and blue to change myarr. And the only thing you might forget is why you wrote such convoluted code !

Intel Fortran: write multi-item namelist to internal file?

I want to write a namelist with multiple items (hence multiple lines) to a character variable. The following code runs well when compiled with gfortran, but returns a write error when compiled with ifort:
program test
implicit none
type testtype
real*8 :: x
character(len=32) :: str
logical :: tf
end type testtype
type(testtype) :: thetype
integer :: iostat
character(len=1000) :: mystr(10)
namelist /THENAMELIST/ thetype
integer :: i
thetype%x = 1.0d0
thetype%str="This is a string."
thetype%tf = .true.
mystr=""
write(*,nml=THENAMELIST,delim="QUOTE")
write(mystr,THENAMELIST,iostat=iostat,delim="QUOTE")
write(*,*)"Iostat:",iostat
do i = 1, size(mystr)
write(*,*)i,trim(mystr(i))
end do
end program test
The output is the following:
> ifort -o test test.f90 ; ./test
&THENAMELIST
THETYPE%X = 1.00000000000000 ,
THETYPE%STR = "This is a string. ",
THETYPE%TF = T
/
Iostat: 66
1 &THENAMELIST THETYPE%X= 1.00000000000000 ,
2
3
4
5
6
7
8
9
10
Intel's list of run-time error messages tells me: "severe (66): Output statement overflows record".
For over completeness, using gfortran I of course get
> gfortran -o test test.f90 ; ./test
&THENAMELIST
THETYPE%X= 1.0000000000000000 ,
THETYPE%STR="This is a string. ",
THETYPE%TF=T,
/
Iostat: 0
1 &THENAMELIST
2 THETYPE%X= 1.0000000000000000 ,
3 THETYPE%STR="This is a string. ",
4 THETYPE%TF=T,
5 /
6
7
8
9
10
I have searched all over the internet, and learned that the internal file cannot be a scalar character variable, but that's about as much as I found. GFortran does accept a scalar variable and just writes newlines in that variable, but that, I guess, is non-standard fortran.
The compilers I used are:
gfortran GNU Fortran (MacPorts gcc48 4.8-20130411_0) 4.8.1 20130411 (prerelease)
ifort (IFORT) 12.0.5 20110719 (on mac)
ifort (IFORT) 13.1.1 20130313 (on GNU/Linux)
My question is: what is the error in my syntax, or how else can I write a namelist to an internal file, without having to patch the problem by writing to an actual external scratch file and read that into my variable (which is what I do now, but which is slow for large namelists)?

How to write output to a string in fortran?

I need to write a formated output to a string DTSTR. It use to work under layhe fortran but not gfortran
INTEGER*2 MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER DY*2
CHARACTER DTSTR*24
COMMON /RD/ DTSTR
...
...
WRITE(DTSTR,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
10 FORMAT('[ ',I2,'-',I2.2,'-',I4,2X,I2,':',I2.2,1X,2A2)
it empty just a empty line. If i use following it correctly output. But i want to store this string. Is it possible to do that with gnu fortran.
WRITE(*,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
update
I am trying to compile following file. I think the problem might be with the COMMON.
PROGRAM HELO
CALL DOTIME
WRITE(*,5700)DTSTR
5700 FORMAT(24X,A24/)
END
SUBROUTINE DOTIME
C
IMPLICIT NONE
INTEGER*2 MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER DY*2
CHARACTER DTSTR*24
COMMON /RD/ DTSTR
integer values(8)
call date_and_time(VALUES=values)
YEAR = values(1)
MON = values(2)
DAY = values(3)
HR = values(5)
MINUTE = values(6)
SEC = values(7)
HUND = values(8)
C =================================================
C
C Incompitable function => CALL GETDAT(YEAR,MON,DAY)
C Incompitable function => GETTIM(HR,MINUTE,SEC,HUND)
IF(HR .GE. 12)THEN
IF(HR .NE. 12)HR=HR-12
DY='PM'
ELSE
DY='AM'
ENDIF
WRITE(DTSTR,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
10 FORMAT('[ ',I2,'-',I2.2,'-',I4,2X,I2,':',I2.2,1X,2A2)
RETURN
END
Hmm? It works just fine for me:
program testwrite
implicit none
INTEGER :: MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER(LEN=2) :: DY
CHARACTER(LEN=24) :: DTSTR
MON = 4
DAY = 27
YEAR= 2010
HR = 13
MINUTE = 27
SEC = 0
HUND = 0
DY ='WE'
WRITE(DTSTR,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
10 FORMAT('[ ',I2,'-',I2.2,'-',I4,2X,I2,':',I2.2,1X,2A2)
print *,'<',trim(DTSTR),'>'
end program testwrite
gives
<[ 4-27-2010 13:27 WE ]>
just as one would expect. Works with several versions of gfortran I have kicking around.
Update: Yes, the problem is in your common block. The common block isn't declared in the main program. But really, it's much simpler and much, much better practice just to pass the string as an argument:
PROGRAM HELO
IMPLICIT NONE
CHARACTER(LEN=24) :: DTSTR
CALL DOTIME(DTSTR)
WRITE(*,5700)DTSTR
5700 FORMAT(24X,A24/)
END
SUBROUTINE DOTIME(DTSTR)
C
IMPLICIT NONE
INTEGER*2 MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER DY*2
CHARACTER(LEN=24), INTENT(OUT) :: DTSTR