Quantcast
Channel: Intel® Fortran Compiler
Viewing all articles
Browse latest Browse all 3270

Struture C, and Fotran / C Interoperability

$
0
0

Hello everybody,

 I am working, in the couplage of a C and Fotran couplage.

 I have this struture in C :

  ------------------------------------------------------------------------------------------------------------

struct SysRac /* Ensemble d'axes */
  {
  long int nbAxeForm;  /* Nombre d'axes formés */
  long int nbAxeSup;   /* Nombre d'axes supprimés */
  long int nbSegForm;    /* Nombre de segments formés */
  long int nbSeg; /* Nombre de segments tels qu'ils sont comptés aux 3 dates */
  int nbPrim;  /* Nombre de primaires émises */
  int nbAdv;  /* Nombre de racines adventives émises */
  float angDep;        /* Orientation */
  r3 origine;           /* Position de l'origine */
  pTAxe premAxe;       /* Premier axe du système (accès à la liste) */
  pTAxe dernAxe;       /* Dernier axe produit */
  float volMax[NBPASMAX];  /* Volume racinaire maximal pendant chaque pas de temps */
  float volDem[NBPASMAX];  /* Volume racinaire demandé pendant chaque pas de temps */
  float tSatis[NBPASMAX];  /* Taux de satisfaction de la demande à chaque pas de temps */
  float longueur; /* Longueur totale de racines */
  float profMax, profMoy; /* Profondeurs maximale et moyenne */
  float distMax, distMoy; /* Distances maximale et moyenne à l'axe du système */
  float diamMax; /* Diamètre maximal, du plus gros segment */
  float xbinf,ybinf,zbinf,xbsup,ybsup,zbsup; /* Bornes en x, y et z */
  float volProd,volPrim,volTot; /* Volumes racinaires : produit, primaire et total */
  float secPointe; /* Section totale des pointes matures et non séniles */
  float tSatisMoy; /* Taux de satisfaction moyen */
  float volSolD1, volSolD2; /* Volumes de sol à distance d1 et d2 */
  } SysRac;//LLab 04 Mar, 2014 --- Passage en C

where

typedef struct SysRac *pTSysRac;

-----------------------------------------------------------------------------------------------------------------------------------------------------

This struture is inside a C programme a I tried  to interoperate with a Fotran programm.

 

I tried with updaterootdensity

--------------------------------------------------------update rootdensity----------------------------------

subroutine updtrootdensity
 
      use, intrinsic :: ISO_C_BINDING
      use parm
      use gen
      use phys
      use biol
      use root_modu
      
         
      Implicit none !LLab 04 feb 2014
 
      
      integer::ivol !FGG norme f95 pour integer*4 en f77
      double precision::tiny !norme f98 pour real*8 en f77
      integer::i !LLab 07 Feb,2014 norme f95 pour integer*4 en f77
      real ::delta !LLab 13 Mar,2014
      
      ! real(C_FLOAT), dimension(nn,*) :: tab !LLab 18 Mar, 2014
      !real(C_FLOAT), dimension(*,nn) :: tab
     ! SR=SYSRAC !LLab 20 Mar,2014
      integer::temps !LLab 20 Mar,2014
      
       parameter (tiny = 1.d-10)  
      
      delta = 2000*delz(nvz);
      
      
!----------------------------------------------------!FGG il y a d'autres modules déjà définis dans MIN3P (d'ou la présence d'instructions USE).
                                                     !   Il faut donc s'en inspirer pour localiser le présent module d'interface C/fortran.   
        !module FTN_C
!---------------------------------------------------!LLab 05 Feb, 2014      
      
      
      if(file_rlddata) then!FGG,Jan 2014 headings written in the rlddata file, only once
       write(irlddata,'(2a)') 'variables = "time","x", "y", "z", "rld"'!LLab 3,Jan 2014
       file_rlddata = .false. !make sure headings are written only once
      endif
      
      if(inside_rld) then!LLab 18, Dec 2013*************
      
       if (time_io.gt.time_rld-tiny) then!LLab 30, Dec 2013---- update root each day    
      
        do ivol= 50,100 ! moitié sup du profil dans transp.dat
        
           rld(ivol) = rld(ivol)*1.2d0              ! 20% d'augmentation tous les jours
           
        enddo
!c !LLab 3, Jan 2014 Write update times and updated rld values in .rlddata file    
      
       do ivol=1,nn
        
        write(irlddata,'(6e15.7)') time_rld,xg(ivol),yg(ivol),zg(ivol),&!LLab 5 Feb, 2014
                                   rld(ivol) !LLab 5 Feb,2014                      
       
       enddo                                !LLab 3, Jan 2014

       write(*,*) 'Root length density updated'
       
       time_rld=time_rld+1.0d0 ! update time rld

       endif!LLab 30, Dec 2013---
       
      endif!LLab 18, Dec 2013--************ Fin Inside_rld        
      
        
!C***** couplage ***** LLab 18, Dec 2013**************************************************
        
         if(coupled_archi_rld) then!LLab 18,Dec 2013
         
          if (maillage_rld_coupled) then !spatial discretization info passed  after the first time increment

           write(*,*) 'Spatial domain discretization passed '
!c           write(*,*) 'x_coordinates,  y_coordinates,  z_coordinates'!LLab 3, Jan 2014
!c            do ivol = 1,nn
!c             write(*,*) xg(ivol),yg(ivol),zg(ivol)!LLLab 3,Jan 2014
!c            enddo

           write(*,*) 'maximum coordinate of discretization interval'!LLab 3, Jan 2014
!c           write(*,*)  ' in      x_direction, y_direction, z_direction'
!c           write(*,*)         xmax(nxx),ymax(nyy),zmax(nzz)!LLLab 3, Jan 2014
           
           write(*,*) 'minimum coordinate of discretization interval'!LLab 3, Jan 2014
!c           write(*,*)  ' in      x_direction, y_direction, z_direction'
!!c           write(*,*)         xmin(nxx),ymin(nyy),zmin(nzz)!LLab 3, Jan 2014
           
           write(*,*) 'spatial increment delta_x, delta_y, delta_z'!LLab 6, Jan 2014
!c           write(*,*)         delx(nvx),dely(nvy),delz(nvz) !LLab 6, Jan 2014
           
           maillage_rld_coupled = .false.
        
          endif
                 
          if (time_io.gt.time_rld-tiny) then !FGG, janv 2014
          
           compt_rld_coupled = compt_rld_coupled + 1
           
!-----------------------------------------------------------------------------------!LLab 5 Feb, 2014          
           !do ivol=1,50
            !rld(ivol)=rld(ivol)*1.4d0 !in waiting for values calculated by ArchiSimple
           !enddo
!-----------------------------------------------------------------------------------!LLab 5 Feb, 2014

!-------------------------------!LLab 5 Feb, 2014    
       ! program p1 !FGG déjà il ne faut pas mettre 'program' ici, car le contenu n'est plus un program
        !use FTN_C ! à mettre certainement au niveau des autres use dans cette subroutine, donc au début
      block data TOTO !LLab 21 Mar, 2014
      !type, BIND(C) :: SysRac!!LLab 19 Mar, 2014
      !integer(kind=C_LONG) :: nbAxeForm,nbAxeSup,nbSegForm,nbSeg
      !integer(kind=C_INT) :: nbPrim,nbAdv
      !real(kind=C_FLOAT) :: angDep
      !real(kind=C_FLOAT), dimension(201)     ::volMax
      !real(kind=C_FLOAT), dimension(201)     ::volDem
      !real(kind=C_FLOAT), dimension(201)     ::tSatis
      !real(kind=C_FLOAT) :: longueur,profMax,profMoy,distMax,distMoy
      !real(kind=C_FLOAT) :: diamMax,xbinf,ybinf,zbinf,xbsup,ybsup,zbsup
      !real(kind=C_FLOAT) :: volProd,volPrim,volTot
      !real(kind=C_FLOAT) :: secPointe,tsatisMoy
      !real(kind=C_FLOAT) :: volSolD1,volSolD2
      !common/SYSRAC/nbAxeForm,nbAxeSup,nbSegForm,nbSeg,nbPrim,nbAdv,
      !              & angDep,volMax,volDem,tSatis,longueur,profMax,
      !              & profMoy,distMax,distMoy,diamMax,xbinf,ybinf,xbsup,
      !              & ybsup,zbsup,volProd,volPrim,volTot,secPointe,
      !              & tsatisMoy,volSolD1,volSolD2
      common/SYSRAC/nbAxeForm,nbAxeSup,nbSegForm,nbSeg,nbPrim,nbAdv
      !common/SYSRAC/angDep,volMax,volDem,tSatis,longueur,profMax
      !common/SYSRAC/profMoy,distMax,distMoy,diamMax,xbinf,ybinf,xbsup
      !common/SYSRAC/ybsup,zbsup,volProd,volPrim,volTot,secPointe
      !common/SYSRAC/tsatisMoy,volSolD1,volSolD2
      end block data TOTO
        
        
        SR=SYSRAC!LLab 21 Mar, 2014
        call C_cycleArchi(SR,temps)
        write(*,*) 'Couplage......'
       ! do i=1,nn
       ! end do
       !  pause
       ! end program p1 !cf rem + haut sur 'program'...

............

.......

----------------------------------------------------------------------------------------------------------------------------------------------

and root_modu

--------------------------------------------- root_modu -------------------

 module root_modu   
      !use gen
      !use, intrinsic :: ISO_C_BINDING
      !interface
      !subroutine C_rldMin3p(DELTA,DATE) BIND(C,NAME="C_rldMin3p")
      !import C_INT, C_FLOAT
      !real(kind=C_FLOAT), VALUE     ::DELTA
      !integer(kind=C_INT), VALUE    ::DATE
      !end subroutine C_rldMin3p
      !end interface
      !end module root_modu  
      use gen
      use,intrinsic ::ISO_C_BINDING
      Implicit none
      !interface
      block data TOTO
      !type, BIND(C) :: SysRac!!LLab 19 Mar, 2014
      !integer(kind=C_LONG) :: nbAxeForm,nbAxeSup,nbSegForm,nbSeg
      !integer(kind=C_INT) :: nbPrim,nbAdv
      !real(kind=C_FLOAT) :: angDep
      !real(kind=C_FLOAT), dimension(201)     ::volMax
      !real(kind=C_FLOAT), dimension(201)     ::volDem
      !real(kind=C_FLOAT), dimension(201)     ::tSatis
      !real(kind=C_FLOAT) :: longueur,profMax,profMoy,distMax,distMoy
      !real(kind=C_FLOAT) :: diamMax,xbinf,ybinf,zbinf,xbsup,ybsup,zbsup
      !real(kind=C_FLOAT) :: volProd,volPrim,volTot
      !real(kind=C_FLOAT) :: secPointe,tsatisMoy
      !real(kind=C_FLOAT) :: volSolD1,volSolD2
      !common/SYSRAC/nbAxeForm,nbAxeSup,nbSegForm,nbSeg,nbPrim,nbAdv,
      !              & angDep,volMax,volDem,tSatis,longueur,profMax,
      !              & profMoy,distMax,distMoy,diamMax,xbinf,ybinf,xbsup,
      !              & ybsup,zbsup,volProd,volPrim,volTot,secPointe,
      !              & tsatisMoy,volSolD1,volSolD2
      !common/SYSRAC/nbAxeForm,nbAxeSup,nbSegForm,nbSeg,nbPrim,nbAdv
      !common/SYSRAC/angDep,volMax,volDem,tSatis,longueur,profMax
      !common/SYSRAC/profMoy,distMax,distMoy,diamMax,xbinf,ybinf,xbsup
      !common/SYSRAC/ybsup,zbsup,volProd,volPrim,volTot,secPointe
      !common/SYSRAC/tsatisMoy,volSolD1,volSolD2
      !integer(kind=C_LONG) :: nbAxeForm,nbAxeSup,nbSegForm,nbSeg
      !integer(kind=C_INT) :: nbPrim,nbAdv
      !real(kind=C_FLOAT) :: angDep
      !real(kind=C_FLOAT), dimension(201)     ::volMax
      !real(kind=C_FLOAT), dimension(201)     ::volDem
      !real(kind=C_FLOAT), dimension(201)     ::tSatis
      !real(kind=C_FLOAT) :: longueur,profMax,profMoy,distMax,distMoy
      !real(kind=C_FLOAT) :: diamMax,xbinf,ybinf,zbinf,xbsup,ybsup,zbsup
      !real(kind=C_FLOAT) :: volProd,volPrim,volTot
      !real(kind=C_FLOAT) :: secPointe,tsatisMoy
      !real(kind=C_FLOAT) :: volSolD1,volSolD2
      !end block data TOTO
      interface
      bind(C) ::/SYSRAC/
      !bind(C) ::/SYSRAC2/
      !bind(C) ::/SYSRAC3/
      !bind(C) ::/SYSRAC4/
      !bind(C) ::/SYSRAC5/
      !end type SysRac!!LLab 19 Mar, 2014
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine C_cycleArchi(SR,TEMPS) BIND(C,NAME="C_cycleArchi")!LLab 20 Mar,2014
      import C_INT
      integer(kind=C_INT), VALUE:: TEMPS
      SR=SYSRAC !LLab 20 Mar, 2014
      end subroutine C_cycleArchi!LLab 20 Mar,2014
      end interface
      end module root_modu
        !use gen  
        !use, intrinsic :: ISO_C_BINDING
        !interface
        !subroutine C_FUNC(array, N) BIND(C, NAME="C_Func")
        !import C_INT, C_FLOAT
        !real(kind=C_FLOAT), dimension(*)     ::array
        !integer(kind=C_INT), VALUE           ::N
        !end subroutine C_FUNC
        !end interface
        !end module root_modu
   ---------------------------------------------------------------------------------------------------------------

I had the following errors :

\ASM3P-RLD-1D-V.1.3\sources\root_modu.f(62): error #6622: This statement is invalid in an INTERFACE block.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\root_modu.f(16): error #6218: This statement is positioned incorrectly and/or has syntax errors.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\root_modu.f(52): error #6643: This statement is incorrectly positioned.

D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(61): error #7002: Error in opening the compiled module file.  Check INCLUDE paths.   [ROOT_MODU]
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(161): error #6236: A specification statement cannot appear in the executable section.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(179): error #6236: A specification statement cannot appear in the executable section.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(184): error #6788: This is an invalid statement; an END [SUBROUTINE] statement is required.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(184): error #6785: This name does not match the unit name.   [TOTO]
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(147): error #6321: An unterminated block exists.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(122): error #6321: An unterminated block exists.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(232): error #6317: An ENDIF occurred without a corresponding IF THEN or ELSE statement.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(234): error #6317: An ENDIF occurred without a corresponding IF THEN or ELSE statement.
1>D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90(244): error #6353: A RETURN statement is invalid in the main program.
1>compilation aborted for D:\PROJET--COUPLAGE-VISUAL-SOURCES\ASM3P--RLD-1D-V1_\ASM3P-RLD-1D-V.1.3\sources\updtrootdensity.f90 (code 1)

 

Any one could help?

Thanks in advance

Best Regards

 

   

 

 

 


Viewing all articles
Browse latest Browse all 3270

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>