Changeset 7449


Ignore:
Timestamp:
06/01/18 14:40:25 (3 weeks ago)
Author:
baker
Message:

use Fortran 2003 hypoinv_wrapper.f90 to call Fortran Subroutine HYPOINV from C

Location:
trunk/src/seismic_processing/hyp2000_mgr
Files:
1 added
2 deleted
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/src/seismic_processing/hyp2000_mgr/hyp2000_mgr.c

    r7369 r7449  
    1  
    21/* 
    32 *   THIS FILE IS UNDER RCS - DO NOT MODIFY UNLESS YOU HAVE 
     
    4948    *                                                                 * 
    5049    *     C program for managing hyp2000.                             * 
    51     *     Hypo_mgr calls the FORTRAN subroutine "hypo_ew".            * 
     50    *     hyp2000_mgr calls FORTRAN 2003 Subroutine HYPOINV_WRAPPER.  * 
    5251    *******************************************************************/ 
    5352 
    5453#include <stdio.h> 
     54#include <stdlib.h> 
    5555#include <string.h> 
    56 #include <stdlib.h> 
    5756#include <time.h> 
    58 #include <earthworm.h> 
    59 #include <kom.h> 
    60 #include <transport.h> 
    61 #include <read_arc.h> 
     57 
     58#include "earthworm.h" 
     59#include "kom.h" 
     60#include "transport.h" 
     61#include "read_arc.h" 
    6262 
    6363const int BufLen = MAX_BYTES_PER_EQ;      /* Message buffer length */ 
     
    6767/* Function prototypes 
    6868 *********************/ 
    69 void GetConfig( char * ); 
    70 void LookUp( void ); 
    71 void hyp2000sum_hypo71sum2k( char * ); 
    72 void ReportError( int ); 
    73 void LogHypoError( int ); 
    74 void PrintSumLine( char * ); 
    75 int  callHypo( char * ); 
    76 void Hypo( char *, int * ); 
     69static void GetConfig( const char * ); 
     70static void LookUp( void ); 
     71static void hyp2000sum_hypo71sum2k( char * ); 
     72static void ReportError( int ); 
     73static void LogHypoError( int ); 
     74static void PrintSumLine( const char * ); 
     75static int  callHypo( const char * ); 
     76extern void hypoinv_wrapper( const char *, int * ); 
    7777 
    7878/* Read from (or derived from info in) configuration file 
     
    102102/* These strings contain file names 
    103103   ********************************/ 
    104 static char arcIn[30];          /* Archive file sent to hypo_ew            */ 
    105 static char arcOut[30];         /* Archive file output by hypo_ew          */ 
    106 static char sumName[30];        /* Summary file output by hypo_ew          */ 
     104static char arcIn[30];          /* Archive file sent to hypoinv            */ 
     105static char arcOut[30];         /* Archive file output by hypoinv          */ 
     106static char sumName[30];        /* Summary file output by hypoinv          */ 
    107107 
    108108/* Error to send to statmgr.  Errors 100-149 are reserved for hyp2000_mgr. 
     
    396396   *******************************************************************/ 
    397397#define ncommand 4        /* # of required commands you expect to process   */ 
    398 void GetConfig(char *configfile) 
    399 { 
     398static void GetConfig( const char *configfile ) { 
     399 
    400400   char   init[ncommand]; /* init flags, one byte for each required command */ 
    401401   int    nmiss;          /* number of required commands that were missed   */ 
     
    533533 ************************************************************************/ 
    534534 
    535 void LookUp( void ) 
    536 { 
     535static void LookUp( void ) { 
     536 
    537537/* Look up keys to shared memory regions of interest 
    538538   *************************************************/ 
     
    593593          ****************************************************/ 
    594594 
    595 void PrintSumLine( char *sumCard ) 
    596 { 
     595static void PrintSumLine( const char *sumCard ) { 
    597596 
    598597/* Send the summary line to the screen 
     
    616615     *******************************************************************/ 
    617616 
    618 void hyp2000sum_hypo71sum2k( char *sumcard ) 
    619 { 
     617static void hyp2000sum_hypo71sum2k( char *sumcard ) { 
     618 
    620619   char hinvsum[200]; 
    621620   char h71sum[200]; 
     
    769768   ******************************************************************/ 
    770769 
    771 void ReportError( int errNum ) 
    772 { 
     770static void ReportError( int errNum ) { 
     771 
    773772   MSG_LOGO       logo; 
    774773   unsigned short length; 
     
    797796             ************************************************************/ 
    798797 
    799 void LogHypoError( int err ) 
    800 { 
     798static void LogHypoError( int err ) { 
     799 
    801800   if ( err == -13 ) 
    802801      logit( "", "hyp2000_mgr: Skip phase card with wrong time.\n" ); 
     
    878877} 
    879878 
    880  
    881         /******************************************************* 
    882          *                   callHypo()                        * 
    883          *                                                     * 
    884          *  Calls the function Hypo and logs any errors        * 
    885          *******************************************************/ 
    886 int callHypo( char *cmd ) 
    887 { 
     879        /*********************************************************************** 
     880         *                              callHypo()                             * 
     881         *                                                                     * 
     882         *  Calls FORTRAN 2003 Subroutine HYPOINV_WRAPPER and logs any errors  * 
     883         ***********************************************************************/ 
     884static int callHypo( const char *cmd ) { 
     885 
    888886   int hypret; 
    889    Hypo( cmd, &hypret ); 
    890    if ( hypret != 1 ) 
    891    { 
    892       logit( "e", "\nhyp2000_mgr: Error occurred while executing <%s>. Return i s %d\n", 
    893              cmd , hypret); 
    894       LogHypoError( hypret ); 
    895       return( -1 ); 
    896    }     
    897    return( 0 ); 
    898 } 
    899  
    900  
    901         /******************************************************* 
    902          *                       Hypo()                        * 
    903          *                                                     * 
    904          *  System dependent function to call the hypo_ew      * 
    905          *  FORTRAN subroutine.                                * 
    906          *******************************************************/ 
    907  
    908 typedef struct { 
    909    char a[80]; 
    910 } STRING; 
    911  
    912 void Hypo( char *inMsg, int *iresr ) 
    913 { 
    914  
    915 #if defined(_MACOSX) && defined(_INTEL) && defined(_GFORTRAN) || defined(_LINUX) || defined(_SOLARIS) 
    916    /* added a func prototype to Fortran call */ 
    917    int hypo_ew_( char *, int*, int);  
    918 #endif 
    919  
    920    STRING outMsg; 
    921    int len; 
    922  
    923 /* The Windows NT version 
    924    **********************/ 
    925 #if defined(_WINNT_INTEL9) 
    926    extern void __stdcall hypo_ew( STRING, int * ); 
    927    strcpy( outMsg.a, inMsg ); 
    928    *iresr=0; 
    929    hypo_ew( outMsg, iresr ); 
    930 /*    fprintf(stderr, "DEBUG: after fortran call iresr=%d\n", *iresr); */ 
    931 #elif defined(_WINNT) 
    932    extern void __stdcall hypo_ew( STRING *, int * ); 
    933    strcpy( outMsg.a, inMsg ); 
    934    HYPO_EW( &outMsg, iresr ); 
    935 #endif 
    936  
    937  
    938 #if defined(_MACOSX) && defined(_SPARC) 
    939    /* extern hypo_ew_( char *, int * , int);  */ 
    940    strcpy( outMsg.a, inMsg ); 
    941    len=strlen(outMsg.a); 
    942    hypo_ew__( (char *) outMsg.a, iresr, len);  
    943 #endif 
    944  
    945 /* the gfortran version, tested on Mac OS X and Linux with gfortran and Forte F77 on Solaris */ 
    946 #if defined(_MACOSX) && defined(_INTEL) && defined(_GFORTRAN) || defined(_LINUX) || defined(_SOLARIS) 
    947    strcpy( outMsg.a, inMsg ); 
    948    len=strlen(outMsg.a); 
    949    hypo_ew_( (char *) outMsg.a, iresr, len);  
    950 #endif 
     887 
     888 
     889   hypoinv_wrapper( cmd, &hypret );  
    951890 
    952891/* Print a newline to avoid overwriting the 
     
    954893   ****************************************/ 
    955894   putchar( '\n' ); 
    956    return; 
     895 
     896   if ( hypret != 1 ) { 
     897      logit( "e", "\nhyp2000_mgr: Error occurred while executing <%s>." 
     898                  "Return is %d\n", 
     899                  cmd , hypret ); 
     900      LogHypoError( hypret ); 
     901      return -1; 
     902   }     
     903   return 0; 
    957904} 
    958  
  • trunk/src/seismic_processing/hyp2000_mgr/makefile.nt

    r7444 r7449  
    99H = ..\hyp2000 
    1010 
    11 F_SRCS = hyp2000_ew.for hypoinv.for \ 
     11F_SRCS = hypoinv_wrapper.f90 hypoinv.for \ 
    1212                      $H/hybda.for  $H/hycmd.for  $H/hysta.for  $H/hydel.for  $H/hyate.for  \ 
    1313        $H/hyfmc.for  $H/hycal.for  $H/hyxmc.for  $H/hycrh.for  $H/hycrt.for  $H/hystl.for  \ 
     
    3232 
    3333.c.obj: 
    34         $(CC) $(GLOBALFLAGS) /nologo /D_WINNT_INTEL9 \ 
     34        $(CC) $(GLOBALFLAGS) /nologo \ 
    3535                $(cflags) $(cdebug) $(cvarsmt) $(tflags) $< 
    3636 
  • trunk/src/seismic_processing/hyp2000_mgr/makefile.unix

    r7441 r7449  
    99SPECIFIC_FLAGS = $($(PLATFORM)_FLAGS) 
    1010 
    11 F_SRCS = hyp2000_ew_gnu.f hypoinv.for \ 
     11F_SRCS = hypoinv_wrapper.f90 hypoinv.for \ 
    1212                      $H/hybda.for  $H/hycmd.for  $H/hysta.for  $H/hydel.for  $H/hyate.for  \ 
    1313        $H/hyfmc.for  $H/hycal.for  $H/hyxmc.for  $H/hycrh.for  $H/hycrt.for  $H/hystl.for  \ 
     
    2323hyp2000_mgr: $(C_OBJ) $(F_SRCS) $H/common.inc 
    2424        $(FC) $(FC_MAIN_IS_C) $(FFLAGS) -I$(H) $(C_OBJ) $(F_SRCS) \ 
    25                 $(FLFLAGS) $(SPECIFIC_FLAGS) -o $B/hyp2000_mgr 
     25                $(SPECIFIC_FLAGS) -o $B/hyp2000_mgr 
    2626 
    2727 
Note: See TracChangeset for help on using the changeset viewer.