Support gfortran 8

src/fortran/gfile.f90

@@ -27,6 +27,7 @@ module GFile
     public :: GfTypeAllocate
     public :: GfGetValue, GfSetValue, GfForceSetValue
     public :: GfGetArrValue, GfSetArrValue
+    public :: GfConvertStringArrToString, GfConvertStringToStringArr
 
     private :: GfGetValueString, GfGetValueInteger, GfGetValueReal
     private :: GfSetValueString, GfSetValueInteger, GfSetValueReal
@@ -76,18 +77,38 @@ module GFile
     end interface
 
 contains
+    function GfConvertStringArrToString(inString) result(outString)
+      character(len=1), intent(in) , dimension(:) :: inString
+      character(len=SIZE(inString)) :: outString
+      integer :: i
+      do i = 1, SIZE(inString)
+        outString(i:i) = inString(i)
+      end do
+    end function 
+
+    function GfConvertStringToStringArr(inString) result(outString)
+      character(len=*), intent(in) :: inString
+      character(len=1), dimension(len(inString)) :: outString
+      integer :: i
+      do i = 1, LEN(inString)
+        outString(i) = inString(i:i)
+      end do
+    end function
+
     function GfGetArrayValueString(g1,varname,varval) result(iOut)
       type(GfType), intent(in) :: g1
       character(kind=skc,len=*), intent(in) :: varname
-      character(kind=skc,len=*), intent(inout) :: varval(:)
+      character(kind=skc,len=1), intent(inout) :: varval(:,:)
       logical :: iOut
       integer :: i
       character(len=5) :: f
+      character(kind=skc) :: tempStringArr(sklen)
+      character(kind=skc, len=sklen) :: tempString
 
       iOut = .true.
-      do i=1,size(varval)
+      do i=1,size(varval, dim=1)
         write(f,'(I2)') i
-        iOut = GfGetValueString(g1,varname//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
+        iOut = GfGetValueString(g1,TRIM(varname)//"("//trim(adjustl(f))//")",varval(i,:)) .and. iOut
       end do
     end function
 
@@ -102,7 +123,7 @@ function GfGetArrayValueInteger(g1,varname,varval) result(iOut)
       iOut = .true.
       do i=1,size(varval)
         write(f,'(I2)') i
-        iOut = GfGetValueInteger(g1,varname//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
+        iOut = GfGetValueInteger(g1,TRIM(varname)//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
       end do
     end function
 
@@ -117,7 +138,7 @@ function GfGetArrayValueReal(g1,varname,varval) result(iOut)
       iOut = .true.
       do i=1,size(varval)
         write(f,'(I2)') i
-        iOut = GfGetValueReal(g1,varname//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
+        iOut = GfGetValueReal(g1,TRIM(varname)//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
       end do
     end function
 
@@ -126,15 +147,15 @@ function GfGetArrayValueReal(g1,varname,varval) result(iOut)
     function GfSetArrayValueString(g1,varname,varval) result(iOut)
       type(GfType), intent(inout) :: g1
       character(kind=skc,len=*), intent(in) :: varname
-      character(kind=skc,len=*), intent(in) :: varval(:)
+      character(kind=skc,len=1), intent(in) :: varval(:,:)
       logical :: iOut
       integer :: i
       character(len=5) :: f
 
       iOut = .true.
-      do i=1,size(varval)
+      do i=1,size(varval, dim=1)
         write(f,'(I2)') i
-        iOut = GfForceSetValueString(g1,varname//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
+        iOut = GfForceSetValueString(g1,TRIM(varname)//"("//trim(adjustl(f))//")",varval(i,:)) .and. iOut
       end do
     end function
 
@@ -149,7 +170,7 @@ function GfSetArrayValueInteger(g1,varname,varval) result(iOut)
       iOut = .true.
       do i=1,size(varval)
         write(f,'(I2)') i
-        iOut = GfForceSetValueInteger(g1,varname//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
+        iOut = GfForceSetValueInteger(g1,TRIM(varname)//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
       end do
     end function
 
@@ -164,7 +185,7 @@ function GfSetArrayValueReal(g1,varname,varval) result(iOut)
       iOut = .true.
       do i=1,size(varval)
         write(f,'(I2)') i
-        iOut = GfForceSetValueReal(g1,varname//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
+        iOut = GfForceSetValueReal(g1,TRIM(varname)//"("//trim(adjustl(f))//")",varval(i)) .and. iOut
       end do
     end function
 
@@ -212,17 +233,21 @@ end function GfTypeAllocate
     function GfGetValueString (g1, variableName, variable) result(iOut)
        type(GfType), intent(in)         :: g1
        character(len=*),  intent(in)    :: variableName
-       character(len=*),  intent(inout) :: variable
+       character(len=1),  intent(inout) :: variable(:)
        logical                          :: iOut
 
        integer(kind=ski)          :: j
        character(len=sklen)       :: var
+       character(len=sklen) :: tempString
+       integer :: i
 
        iOut = GfIsDefined(g1,variableName,j)
 
        if (iOut) then 
          read(g1%variableValues(j),fmt="(a)") var
-         variable = trim(var)
+         do i = 1, len_trim(var)
+           variable(i) = var(i:i)
+         end do
        end if
 
        if (.not. iOut) print *,"Warning GfGetValueString: "//trim(variableName)
@@ -239,6 +264,7 @@ function GfGetValueInteger (g1, variableName, variable) result(iOut)
 
        integer(kind=ski) :: j
        integer(kind=ski) :: var
+       character(len=sklen) :: tempString
 
        iOut = GfIsDefined(g1, variableName, j)
 
@@ -261,6 +287,7 @@ function GfGetValueReal (g1, variableName, variable) result(iOut)
 
        integer(kind=ski)          :: j
        real(kind=skr)             :: var
+       character(len=sklen) :: tempString
 
        iOut = GfIsDefined(g1, variableName, j)
 
@@ -269,7 +296,6 @@ function GfGetValueReal (g1, variableName, variable) result(iOut)
          variable=var
        end if
 
-
        if (.not. iOut) print *,"Warning GfGetValueReal: "//trim(variableName)
 
 
@@ -280,15 +306,17 @@ end function GfGetValueReal
     function GfSetValueString (g1, variableName, variable) result(iOut)
        type(GfType),      intent(inout) :: g1
        character(len=*),  intent(in)    :: variableName
-       character(len=*),  intent(in)    :: variable
+       character(len=1),  intent(in)    :: variable(:)
        logical                          :: iOut
 
-       integer(kind=ski)                :: j
+       integer(kind=ski)                :: j, i
 
        iOut = GfIsDefined(g1, variableName, j)
 
        if (iOut) then
-         g1%variableValues(j) = variable
+         do i = 1, SIZE(variable)
+           g1%variableValues(j)(i:i) = variable(i)
+         end do
        endif
 
        if (.not. iOut) print *,"Warning GfSetValueString: "//trim(variableName)
@@ -312,7 +340,6 @@ function GfSetValueInteger (g1, variableName, variable) result(iOut)
          write(g1%variableValues(j),fmt=*) variable
        endif
 
-
        if (.not. iOut) print *,"Warning GfSetValueInteger: "//trim(variableName)
 
 
@@ -337,7 +364,6 @@ function GfSetValueReal (g1, variableName, variable) result(iOut)
          write(g1%variableValues(j),fmt="(g30.15)") variable
        endif
 
-
        if (.not. iOut) print *,"Warning GfSetValueReal: "//trim(variableName)
 
 
@@ -348,14 +374,17 @@ end function GfSetValueReal
     function GfForceSetValueString (g1, variableName, variable) result(iout)
         type (gftype),      intent(inout) :: g1
         character(len=*),   intent(in)    :: variableName
-        character(len=*),   intent(in)    :: variable
+        character(len=1),   intent(in)    :: variable(:)
         logical                           :: iOut
 
         type (gftype)             :: g2
         integer(kind=ski)         :: i
+        character(len=sklen) :: tempString 
 
         iOut = .true.
 
+        tempString = GfConvertStringArrToString(variable)
+
         if ( .not. gfIsDefined(g1, variableName, i) ) then
                 g2 = g1
                 g1%nLines = g1%nLines+1
@@ -365,7 +394,7 @@ function GfForceSetValueString (g1, variableName, variable) result(iout)
                 do i=1, g1%nLines-1
                     g1%fileLines(i) = g2%fileLines(i)
                 end do
-                g1%fileLines(g1%nLines) = variableName//" = "//variable
+                g1%fileLines(g1%nLines) = variableName//" = "//tempString
 
                 do i=1, g1%nvariables-1
                     g1%variableNames(i) = g2%variableNames(i)
@@ -411,11 +440,12 @@ function GfForceSetValueReal (g1, variableName, variable) result(iOut)
                    g1%variableNames(i) = g2%variableNames(i)
                    g1%variableValues(i) = g2%variableValues(i)
                 end do
-                g1%variableNames(g1%nVariables)=variableName
+                g1%variableNames(g1%nVariables) = variableName
                 g1%variableValues(g1%nVariables)="  "
         end if
         iOut = gfSetValue(g1, variableName, variable)
 
+
        if (.not. iOut) print *,"Warning GfForceSetValueReal: "//trim(variableName)
 
     end function GfForceSetValueReal
@@ -449,11 +479,12 @@ function GfForceSetValueInteger (g1, variableName, variable) result(iOut)
                g1%variableNames(i)=g2%variableNames(i)
                g1%variableValues(i)=g2%variableValues(i)
             end do
-            g1%variableNames(g1%nVariables)=variableName
+            g1%variableNames(g1%nVariables) = variableName
             g1%variableValues(g1%nVariables)="  "
         end if
         iOut = gfSetValue(g1, variablename, variable)
 
+
        if (.not. iOut) print *,"Warning GfForceSetValueInteger: "//trim(variableName)
 
     end function GfForceSetValueInteger
@@ -612,7 +643,6 @@ function GfIsDefined (g1,variableName,variableIndex) Result(iOut)
        logical :: iOut
        integer(kind=ski) :: i
 
-
        iOut = .false.
 
        if (present(variableIndex)) variableIndex=-1

src/fortran/shadow_kernel.f90

@@ -63,7 +63,7 @@ Module shadow_kernel
 
   	!---- Variables SOURCE ----!
 #define EXPAND_SOURCE_SCALAR(ctype,ftype,fkind,pytype,name,cformat,fformat,defvalue) ftype(kind=fkind) :: name
-#define EXPAND_SOURCE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=length) :: name
+#define EXPAND_SOURCE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=1), dimension(length) :: name
 #include "shadow_source.def"
 
 
@@ -82,9 +82,9 @@ Module shadow_kernel
     ! NOTE: FOR ADDING A NEW VARIABLE, IT SHOULD BE ADDED IN *.def
 
 #define EXPAND_OE_SCALAR(ctype,ftype,fkind,pytype,name,cformat,fformat,defvalue) ftype(kind=fkind) :: name
-#define EXPAND_OE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=length) :: name
+#define EXPAND_OE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=1), dimension(length) :: name
 #define EXPAND_OE_ARRAYS(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,defvalue) ftype(kind=fkind), dimension(arrdim) :: name
-#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) ftype(kind=fkind, len=length), dimension(arrdim) :: name
+#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) ftype(kind=fkind, len=1), dimension(arrdim, length) :: name
 #include "shadow_oe_without_repetitions.def"
 
 
@@ -4506,6 +4506,7 @@ SUBROUTINE REFLEC (PIN,WNUM,SIN_REF,COS_POLE,R_P,R_S,PHASEP,PHASES,ABSOR,K_WHAT)
 integer(kind=ski):: i,j,nrefl,ierr,ier,index1,iunit
 integer(kind=ski):: ngx, ngy, ntx, nty, nin, npair
 
+
 ! C
 ! C SAVE the variables that need to be saved across subsequent invocations
 ! C of this subroutine.
@@ -4556,10 +4557,10 @@ SUBROUTINE REFLEC (PIN,WNUM,SIN_REF,COS_POLE,R_P,R_S,PHASEP,PHASES,ABSOR,K_WHAT)
        ! other codes to create it).
        ! Note: the old binary format is also accepted when reading 
        !  
-        OPEN  (23,FILE=FILE_REFL,STATUS='OLD', &
+        OPEN  (23,FILE=GfConvertStringArrToString(FILE_REFL),STATUS='OLD', &
                       FORM='UNFORMATTED', IOSTAT=iErr)
         IF (ierr /= 0 ) then
-             PRINT *,"Error: REFLEC: File not found: "//TRIM(file_refl)
+             PRINT *,"Error: REFLEC: File not found: "//TRIM(GfConvertStringArrToString(file_refl))
              RETURN 
              ! STOP ' Fatal error: aborted'
         END IF
@@ -6360,7 +6361,7 @@ SUBROUTINE SCREEN_EXTERNAL(I_SCR,I_ELEMENT,RAY,RAY_OUT)
 ! C indices (into xvec and zvec) and number of points per polygon.
 ! C 
         IFLAG = 0
-        filename = FILE_SCR_EXT(I_SCR)
+        filename = GfConvertStringArrToString(FILE_SCR_EXT(I_SCR,:))
         CALL SCREEN_EXTERNAL_GETDIMENSIONS(filename, N_POLYS,N_POINTS,IFLAG)
         !print *,'>>> SCREEN_EXTERNAL_GETDIMENSIONS: N_POLYS: ',N_POLYS
         !print *,'>>> SCREEN_EXTERNAL_GETDIMENSIONS: N_POINTS: ',N_POINTS
@@ -10398,8 +10399,8 @@ SUBROUTINE INPUT_OE (I_OENUM,iTerminate)
 !c
 !c
 IF (I_OENUM.EQ.1) THEN
-    FILE_SOURCE = RSTRING ('File containing the source array [Default: begin.dat] ? ')
-    IF (trim(FILE_SOURCE) == "") FILE_SOURCE="begin.dat"
+    FILE_SOURCE = GfConvertStringToStringArr(RSTRING ('File containing the source array [Default: begin.dat] ? '))
+    IF (trim(GfConvertStringArrToString(FILE_SOURCE)) == "") FILE_SOURCE=GfConvertStringToStringArr("begin.dat")
 END IF
 10101	CONTINUE
 !c
@@ -11925,12 +11926,12 @@ End Subroutine PoolSourceToGlobal
   Subroutine PoolOEToGlobal(oe) !bind(C,NAME="PoolOEToGlobal")
 
     type(poolOE),intent(in out) :: oe
-    integer(kind=ski) :: i
+    integer(kind=ski) :: i, j
 
 #define EXPAND_OE_SCALAR(ctype,ftype,fkind,pytype,name,cformat,fformat,defvalue) name = oe%name
 #define EXPAND_OE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) name = oe%name
-#define EXPAND_OE_ARRAYS(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,defvalue) forall(i=1:arrdim) name(i) = oe%name(i)
-#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) forall(i=1:arrdim) name(i) = oe%name(i)
+#define EXPAND_OE_ARRAYS(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,defvalue) name = oe%name
+#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) name = oe%name
 #include "shadow_oe.def"
 
 

src/fortran/shadow_variables.f90

@@ -66,16 +66,16 @@ Module shadow_variables
     ! again the same variables encapsulated in a structure 
     type, public, bind(C) :: poolSource
 #define EXPAND_SOURCE_SCALAR(ctype,ftype,fkind,pytype,name,cformat,fformat,defvalue) ftype(kind=fkind) :: name
-#define EXPAND_SOURCE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=length) :: name
+#define EXPAND_SOURCE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=1), dimension(length) :: name
 #include "shadow_source.def"
     end type poolSource
 
 
     type, public, bind(C) :: poolOE
 #define EXPAND_OE_SCALAR(ctype,ftype,fkind,pytype,name,cformat,fformat,defvalue) ftype(kind=fkind) :: name
-#define EXPAND_OE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=length) :: name
+#define EXPAND_OE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) ftype(kind=fkind,len=1), dimension(length) :: name
 #define EXPAND_OE_ARRAYS(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,defvalue) ftype(kind=fkind), dimension(arrdim) :: name
-#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) ftype(kind=fkind, len=length), dimension(arrdim) :: name
+#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) ftype(kind=fkind, len=1), dimension(arrdim,length) :: name
 #include "shadow_oe.def"
     end type poolOE
 
@@ -299,11 +299,11 @@ end subroutine PoolSourceDefault
 
   subroutine PoolOEDefault(oe)
     type (poolOE), intent(inout) :: oe
-    integer(kind=ski) :: i
+    integer(kind=ski) :: i, j
 #define EXPAND_OE_SCALAR(ctype,ftype,fkind,pytype,name,cformat,fformat,defvalue) oe%name=defvalue
 #define EXPAND_OE_STRING(ctype,ftype,fkind,pytype,name,cformat,fformat,length,defvalue) oe%name=defvalue
 #define EXPAND_OE_ARRAYS(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,defvalue) FORALL(i=1:arrdim) oe%name(i)=defvalue
-#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) FORALL(i=1:arrdim) oe%name(i)=defvalue
+#define EXPAND_OE_ARRSTR(ctype,ftype,fkind,pytype,name,cformat,fformat,arrdim,length,defvalue) FORALL(i=1:arrdim, j=1:length) oe%name(i,j)=defvalue
 #include "shadow_oe.def" 
   end subroutine PoolOEDefault