      INCLUDE 'VICMAIN_FOR'
      SUBROUTINE MAIN44
C
C##  RADAGEN
C##      INCLUDE TLOCATOR REFERENCES
C##      DELETE TEMP1,TEMP2 IN SUBROUTINE MOVE_OUTPUT
C##      CONVERTED TO VICAR2
C
C##	 INTERNAL RECTIFICATION ADDED 3-6-86
C##	 REFERENCE IMAGE RECTIFICATION ADDED 3-6-86
C##	 MAGELLAN BACKSCATTER MODEL ADDED 3-6-86
C##	 PARAMETER UPDATES IMPLEMENTED 7-1-86
C##	 ANTENNA MISCORRECTION ADDED 7-1-86
c##	 PORTED TO UNIX 05-SEP-94
C##
C       RADAGEN PERFORMS FOUR FUNCTIONS:
C
C          1) IT SHADES A TERRAIN IMAGE ACCORDING TO THE FORMULA
C             COS(THETA)/(SIN(THETA)+.1*COS(THETA))**3 .
C             WHERE THETA IS THE ANGLE BETWEEN THE ILLUMINATION
C             VECTOR AND THE LOCAL SURFACE NORMAL.
C             ILLUMINATION VECTOR IS THE UNIT VECTOR WHOSE SPHERICAL
C             COORDINATES ARE AZ=90 DEGREES (TOWARDS THE RIGHT IMAGE
C             EDGE), EL = VALUE OF INPUT PARAMETER, R=1 ;
C
C          2) IT SHADOWS A TERRAIN IMAGE BY SETTING THE DN OF ANY
C             PIXEL HIDDEN BY TERRAIN FROM THE RADAR BEAM TO A LOW
C             VALUE(1). A SAMPLE IS HIDDEN IF ITS SLOPE IS LESS THAN
C             TAN(THETA).
C
C          3) IT PERFORMS THE SLANT RANGE SIMULATION;
C
C          4) IT CORRECTS THE SLANT RANGE ACCORDING TO OFFSETS
C             INTRODUCED BY THE LOCAL TERRAIN.
C
C          THE LAST TWO STEPS ARE PERFORMED AT THE SAME TIME AS
C          FOLLOWS:
C
C          OUTPUT_SAMPLE = TOTA - (T' - A) + H*SIN(THETA)
C
C          WHERE,
C
C             TOTA = TOT - A
C             TOT             THE SLANT RANGE TO THE LEFT EDGE OF TERRAIN
C                             IMAGE;
C             A               THE SLANT RANGE TO THE RIGHT EDGE OF THE
C                             TERRAIN IMAGE;
C             T'              THE SLANT RANGE TO THE SAMP IN THE TERRAIN
C                             IMAGE THAT CORRESPONDS TO THE SAMPLE IN THE
C                             OUTPUT RADAR IMAGE.
C             H               THE LOCAL TERRAIN ALTITUDE.
C
C          THESE PARAMS CAN BE CALCULATED FROM THE SATELLITE ALTITUDE,
C          SAMP POSITION IN THE TERR. IMAGE, AND THE NADIR OFFSET FROM
C          THE RIGHT EDGE OF THE TERRAIN IMAGE.
C
C          H*SIN(THETA) IS THE LOCAL TERRAIN CORRECTION, AN APPROXIMATION
C          WHICH IS GOOD WHEN SATELLITE ALT >> LOCAL TERRAIN ALTITUDE.
C
C      PARAMETERS:
C
C         EL,R          SOURCE ELEVATION MEASURED FROM THE IMAGE NORMAL
C                       WHERE VERTICAL IS 0. IN DEGREES.  DEFAULT = 20.
C
C         TOP,R         REAL VALUE INDICATING THE VALUE TO BE
C                       SCALED TO.  DEFAULT = 30.
C
C         OFF,R         THE OFFSET OF THE NADIR MEASURED FROM THE RIGHT
C                       PICTURE EDGE IN REAL PIXELS.  COMPUTED.
C
C         HEIGHT,R      HEIGHT IN KM OF SATELLITE.  DEFAULT = 1100.
C
C         OFMT          THE OUTPUT IMAGE IS TO BE HALF WORD OR
C 			BYTE (THE DEFAULT).
C
C         SSCALE,R      THE SCALE IN THE SAMPLE DIRECTION. DEFAULTS TO
C                       500. M/PIXEL.
C
C         TOFF,N        SPECIFIES HOW MANY PIXELS EVERY POINT IN
C                       THE OUTPUT RADAR IMAGE WILL BE LEFT-SHIFTED.
C                       A POINT IN THE INPUT TERRAIN IMAGE WITH
C                       ELEVATION >0 WILL BE SHIFTED RIGHT IN THE
C                       OUTPUT RADAR IMAGE AS A CONSEQUENCE OF
C                       THE SIMULATION MODELED BY THE EQUATIONS
C                       ABOVE. IF ALL THE POINTS IN THE INPUT ARE
C                       AT SOME SIZABLE ELEVATION. A SUBSTANTIAL
C                       PORTION OF THE OUTPUT DATA COULD BE RIGHT
C                       SHIFTED BEYOND THE LEFT EDGE OF THE OUTPUT
C                       PICTURE. 'TOFF' COUNTERACTS THIS SYSTEMATIC
C                       SHIFT. IF DEFAULTED, RADAGEN WILL COMPUTE
C                       A VALUE THAT WILL RESULT IN A INPUT POINT
C                       OF ELEVATION EQUAL TO THE AVERAGE ELEVATION
C                       OF THE CENTRAL LINE IN THE INPUT BEING PLACED
C                       JUST AT THE RIGHT EDGE OF THE OUTPUT.
C
C         LSCALE,R      LINE SCALE. DEFAULTS TO 500 M/PIXEL.
C
C         ZSCALE,R      ALTITUDE SCALE. DEFAULTS TO 30 M/DN.
C
C
C         SCALE,R       THE DN/COS(THETA) IN THE OUTPUT IMAGE, WHERE
C                       THETA IS THE ANGLE BETWEEN THE SURFACE
C                       NORMAL AND THE ILLUMINATION DIRECTION.
C
C
C
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /GLOBAL/ AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,
     +       ILLUM_VECTOR, TAN_THETA, REL, TOP_VALUE, MAXIM,
     +       HEIGHT, OUT_SCALE, TERRAIN_OFFSET, NADIR_OFFSET,
     +       LOG_SCALE, ALTI, RAZ, MIS_CORR, LINC, IPASS,
     +	     SS_BUF,NS_BUF,AZ_BUF,EL_BUF,HEIGHT_BUF,TOP_BUF,
     +       SSCALE_BUF,LSCALE_BUF,ZSCALE_BUF,SCALE_BUF,TOFF_BUF,
     +       OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      REAL        REL, ILLUM_VECTOR(3), TAN_THETA, NADIR_OFFSET
      REAL        ALTI, RAZ, TOP_VALUE, HEIGHT, OUT_SCALE, LOG_SCALE
      REAL        AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE, MIS_CORR(3)
      REAL	  AZ_BUF(512),EL_BUF(512),SCALE_BUF(512)
      REAL	  SSCALE_BUF(512),LSCALE_BUF(512),ZSCALE_BUF(512)
      REAL	  HEIGHT_BUF(512),TOP_BUF(512)
      INTEGER     SS_BUF(512),NS_BUF(512),TOFF_BUF(512)
      INTEGER*2   OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      INTEGER     MAXIM, TERRAIN_OFFSET, REFUNIT, LINC, IPASS
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
      EXTERNAL WORK
C
      CALL IFMESSAGE('RADAGEN version 5-SEPT-94')
      CALL PROCESS_PARAMETERS
C
C     FOR SIR-B REVISION ADDED A SECOND OUTPUT OPTION CALLED TLOCATOR
C     WITH SIZE EQUALLING A HALF WORD PER PIXEL IN THE FIRST OUTPUT
C     FILE.
C
      CALL STACKA(7,WORK,5,3*NS*2,NS*2,NS*2,NS*4,NS*4)
      RETURN
      END
C
C
C
C
C
C
      SUBROUTINE WORK(INPUT,I1,OUTPUT,I2,TLOCATOR,I5,A,I3,B,I4)
C
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /GLOBAL/ AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,
     +       ILLUM_VECTOR, TAN_THETA, REL, TOP_VALUE, MAXIM,
     +       HEIGHT, OUT_SCALE, TERRAIN_OFFSET, NADIR_OFFSET,
     +       LOG_SCALE, ALTI, RAZ, MIS_CORR, LINC, IPASS,
     +	     SS_BUF,NS_BUF,AZ_BUF,EL_BUF,HEIGHT_BUF,TOP_BUF,
     +       SSCALE_BUF,LSCALE_BUF,ZSCALE_BUF,SCALE_BUF,TOFF_BUF,
     +       OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      REAL        REL, ILLUM_VECTOR(3), TAN_THETA, NADIR_OFFSET
      REAL        ALTI, RAZ, TOP_VALUE, HEIGHT, OUT_SCALE,LOG_SCALE
      REAL        AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,MIS_CORR(3)
      REAL	  AZ_BUF(512),EL_BUF(512),SCALE_BUF(512)
      REAL	  SSCALE_BUF(512),LSCALE_BUF(512),ZSCALE_BUF(512)
      REAL	  HEIGHT_BUF(512),TOP_BUF(512)
      INTEGER     SS_BUF(512),NS_BUF(512),TOFF_BUF(512)
      INTEGER*2   OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      INTEGER     MAXIM, TERRAIN_OFFSET, REFUNIT, LINC, IPASS
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
      INTEGER   I1, I2, I3, I4, I5, SL, NL_IN, STAT
      INTEGER*2 INPUT(I1/6,3), OUTPUT(I2/2), TLOCATOR(I5/2)
      REAL      A(I3/4), B(I4/4)
C
      IF (I1.LT.3*NS*2 .OR. I2.LT.NS*2 .OR. I5.LT.NS*2 .OR.
     +	  I3.LT.NS*4 .OR. I4.LT.NS*4) THEN
	  CALL XVMESSAGE('STACKA FAILURE',' ')
	  CALL ABEND
      END IF
      CALL RAD_INITIALIZE(A,B,INPUT,OUTPUT,TLOCATOR)
      IF (UPD) THEN
	  NL_IN = NL
	  NL = LINC
	  IF (LINC.LT.3) NL=3
      END IF
C
      DO SL=1,IPASS
	  ISL = (SL - 1) * LINC
    	  IF (ISL.EQ.0) ISL = 1
	  IF ((UPD).AND.(SL.GT.1)) CALL RAD_UPDATE (A,B,
     +	         INPUT,OUTPUT,TLOCATOR,SL)
	  CALL TABLE_THE_IMAGE(A,B,INPUT,OUTPUT,TLOCATOR)
      END DO
      IF (UPD) CALL XVPCLOSE (STAT)
      RETURN
      END
C
C
C
C
       SUBROUTINE PROCESS_PARAMETERS
C
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /GLOBAL/ AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,
     +       ILLUM_VECTOR, TAN_THETA, REL, TOP_VALUE, MAXIM,
     +       HEIGHT, OUT_SCALE, TERRAIN_OFFSET, NADIR_OFFSET,
     +       LOG_SCALE, ALTI, RAZ, MIS_CORR, LINC, IPASS,
     +	     SS_BUF,NS_BUF,AZ_BUF,EL_BUF,HEIGHT_BUF,TOP_BUF,
     +       SSCALE_BUF,LSCALE_BUF,ZSCALE_BUF,SCALE_BUF,TOFF_BUF,
     +       OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      REAL        REL, ILLUM_VECTOR(3), TAN_THETA, NADIR_OFFSET
      REAL        ALTI, RAZ, TOP_VALUE, HEIGHT, OUT_SCALE, LOG_SCALE
      REAL        AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE, MIS_CORR(3)
      REAL	  AZ_BUF(512),EL_BUF(512),SCALE_BUF(512)
      REAL	  SSCALE_BUF(512),LSCALE_BUF(512),ZSCALE_BUF(512)
      REAL	  HEIGHT_BUF(512),TOP_BUF(512)
      INTEGER     SS_BUF(512),NS_BUF(512),TOFF_BUF(512)
      INTEGER*2   OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      INTEGER     MAXIM, TERRAIN_OFFSET, REFUNIT, LINC, IPASS
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      INTEGER	  NLI, NSI
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
      CHARACTER*90 LBUF(2)
      INTEGER      ICNT, STATUS, MAXPARMS
      LOGICAL      XVPTST
C
C   OPEN THE INPUT
C
      CALL XVUNIT(INUNIT,'INP',1,STATUS,' ')
      CALL XVOPEN(INUNIT,STATUS,'U_FORMAT','HALF','OPEN_ACT','SA',
     +            'IO_ACT','SA',' ')
      CALL XVGET(INUNIT,STATUS,'FORMAT',IFMT,' ')
      IF ((IFMT.NE.'BYTE').AND.(IFMT.NE.'HALF')) THEN
          CALL XVMESSAGE('TOPO MUST BE BYTE OR HALFWORD',' ')
          CALL ABEND
      ENDIF
C
      CALL XVSIZE(ISL,ISS,NL,NS,NLI,NSI)
C
C   CHECK FOR AN UPDATE FILE
C
      CALL XVP('UPDATE',LBUF(1),ICNT)
C
      IF (ICNT.GT.0) THEN
    	 UPD = .TRUE.
C
         CALL XVP('SS_OUT',SS_BUF(2),SS_BUF(1))
      	    IF (SS_BUF(1).GT.MAXPARMS) MAXPARMS = SS_BUF(1)
         CALL XVP('NS_OUT',NS_BUF(2),NS_BUF(1))
      	    IF (NS_BUF(1).GT.MAXPARMS) MAXPARMS = NS_BUF(1)
      	 CALL XVP('AZ',AZ_BUF(2),AZ_BUF(1))
	    AZ = AZ_BUF(2)
      	    IF (AZ_BUF(1).GT.MAXPARMS) MAXPARMS = AZ_BUF(1)
	 CALL XVP('EL',EL_BUF(2),EL_BUF(1))
	    EL = EL_BUF(2)
      	    IF (EL_BUF(1).GT.MAXPARMS) MAXPARMS = EL_BUF(1)
	 CALL XVP('HEIGHT',HEIGHT_BUF(2),HEIGHT_BUF(1))
	    HEIGHT = HEIGHT_BUF(2)
      	    IF (HEIGHT_BUF(1).GT.MAXPARMS) MAXPARMS = HEIGHT_BUF(1)
	 CALL XVP('TOP',TOP_BUF(2),TOP_BUF(1))
	    TOP_VALUE = TOP_BUF(2)
      	    IF (TOP_BUF(1).GT.MAXPARMS) MAXPARMS = TOP_BUF(1)
	 CALL XVP('SSCALE',SSCALE_BUF(2),SSCALE_BUF(1))
	    SSCALE = SSCALE_BUF(2)
      	    IF (SSCALE_BUF(1).GT.MAXPARMS) MAXPARMS = SSCALE_BUF(1)
	 CALL XVP('LSCALE',LSCALE_BUF(2),LSCALE_BUF(1))
	    LSCALE = LSCALE_BUF(2)
      	    IF (LSCALE_BUF(1).GT.MAXPARMS) MAXPARMS = LSCALE_BUF(1)
	 CALL XVP('ZSCALE',ZSCALE_BUF(2),ZSCALE_BUF(1))
	    ZSCALE = ZSCALE_BUF(2)
      	    IF (ZSCALE_BUF(1).GT.MAXPARMS) MAXPARMS = ZSCALE_BUF(1)
	 CALL XVP('SCALE',SCALE_BUF(2),SCALE_BUF(1))
	    SCALE = SCALE_BUF(2)
      	    IF (SCALE_BUF(1).GT.MAXPARMS) MAXPARMS = SCALE_BUF(1)
	 CALL XVP('TOFF',TOFF_BUF(2),TOFF_BUF(1))
	    TERRAIN_OFFSET = TOFF_BUF(2)
      	    IF (TOFF_BUF(1).GT.MAXPARMS) MAXPARMS = TOFF_BUF(1)
C
    	 IPASS = MAXPARMS
      	 LINC = NL / IPASS
         IF (NL.GT.(LINC * IPASS)) THEN
	    LINC = LINC + 1
	    IPASS = NL / LINC
	    IF (NL.GT.(LINC*IPASS)) IPASS = IPASS + 1
	 END IF
C
      ELSE
         UPD = .FALSE.
C
	 CALL XVP('AZ',AZ,ICNT)
	 CALL XVP('EL',EL,ICNT)
	 CALL XVP('HEIGHT',HEIGHT,ICNT)
	 CALL XVP('OFMT',OFMT,ICNT)
	 CALL XVP('TOP',TOP_VALUE,ICNT)
	 CALL XVP('SSCALE',SSCALE,ICNT)
	 CALL XVP('LSCALE',LSCALE,ICNT)
	 CALL XVP('ZSCALE',ZSCALE,ICNT)
	 CALL XVP('SCALE',SCALE,ICNT)
	 CALL XVP('TOFF',TERRAIN_OFFSET,ICNT)
    	 IPASS = 1
      END IF
C
      HEIGHT = HEIGHT * 1000
C
      MGN     = XVPTST('MAGELLAN') .OR.  XVPTST('MGN')
      RECTIFY = XVPTST('RECTIFY')
      FILL    = XVPTST('FILL')
C
      CALL XVP('MISCORR',MIS_CORR(1),ICNT)
      CALL XVP('PERIOD',MIS_CORR(2),ICNT)
      CALL XVP('DEGREE',MIS_CORR(3),ICNT)
      IF ((MIS_CORR(1).EQ.0).OR.(MIS_CORR(2).LE.0)) THEN
    	  MIS_CORR(1) = 0
    	  MIS_CORR(2) = 1
      END IF
C
C   LOG DOMAIN OUTPUT?
C
      IF (XVPTST('LOG')) THEN
    	  LOG = .TRUE.
    	  CALL XVP('LOG_SC',LOG_SCALE,ICNT)
      ELSE
    	  LOG = .FALSE.
      END IF
C
C   OPEN THE OUTPUT
C
      CALL XVUNIT(OUTUNIT(1),'OUT',1,STATUS,' ')
      IF (OFMT.EQ.'BYTE') THEN
         CALL XVOPEN(OUTUNIT(1),STATUS,'OP','WRITE','U_FORMAT',
     +               'HALF','O_FORMAT','BYTE','U_NL',NL,
     +               'U_NS',NS,'OPEN_ACT','SA','IO_ACT','SA',' ')
      ELSE
         CALL XVOPEN(OUTUNIT(1),STATUS,'OP','WRITE','U_FORMAT',
     +               'HALF','O_FORMAT','HALF','U_NL',NL,
     +               'U_NS',NS,'OPEN_ACT','SA','IO_ACT','SA',' ')
      ENDIF
C
C   OPEN THE TLOCATOR OUTPUT IF ONE IS SPECIFIED
C
      CALL XVP('OUT',LBUF(1),N_OUTPUTS)
      IF (N_OUTPUTS.EQ.2) THEN
         CALL XVUNIT(OUTUNIT(2),'OUT',2,STATUS,' ')
         CALL XVOPEN(OUTUNIT(2),STATUS,'U_FORMAT','HALF',
     +               'O_FORMAT','HALF','OP','WRITE','U_NL',NL,
     +               'U_NS',NS,'OPEN_ACT','SA','IO_ACT','SA',' ')
      ENDIF
C
C   OPEN THE REFERENCE FILE IF ONE IS SPECIFIED
C
      CALL XVP('REF',LBUF(1),ICNT)
      IF (ICNT.GT.0) THEN
         CALL XVUNIT(REFUNIT,'REF',1,STATUS,' ')
         CALL XVOPEN(REFUNIT,STATUS,'OPEN_ACT','SA','IO_ACT','SA',
     +		     'U_FORMAT','HALF',' ')
         REF=.TRUE.
      ELSE
      	 REF=.FALSE.
      ENDIF
C
      RETURN
      END
C
C
C
C
C
      SUBROUTINE RAD_INITIALIZE(A,B,INPUT,OUTPUT,TLOCATOR)
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /GLOBAL/ AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,
     +       ILLUM_VECTOR, TAN_THETA, REL, TOP_VALUE, MAXIM,
     +       HEIGHT, OUT_SCALE, TERRAIN_OFFSET, NADIR_OFFSET,
     +       LOG_SCALE, ALTI, RAZ, MIS_CORR, LINC, IPASS,
     +	     SS_BUF,NS_BUF,AZ_BUF,EL_BUF,HEIGHT_BUF,TOP_BUF,
     +       SSCALE_BUF,LSCALE_BUF,ZSCALE_BUF,SCALE_BUF,TOFF_BUF,
     +       OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      REAL        REL, ILLUM_VECTOR(3), TAN_THETA, NADIR_OFFSET
      REAL        ALTI, RAZ, TOP_VALUE, HEIGHT, OUT_SCALE, LOG_SCALE
      REAL        AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE, MIS_CORR(3)
      REAL	  AZ_BUF(512),EL_BUF(512),SCALE_BUF(512)
      REAL	  SSCALE_BUF(512),LSCALE_BUF(512),ZSCALE_BUF(512)
      REAL	  HEIGHT_BUF(512),TOP_BUF(512)
      INTEGER     SS_BUF(512),NS_BUF(512),TOFF_BUF(512)
      INTEGER*2   OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      INTEGER     MAXIM, TERRAIN_OFFSET, REFUNIT, LINC, IPASS
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
      REAL      A(NS), B(NS)
      INTEGER*2 INPUT(NS,3), OUTPUT(NS), TLOCATOR(NS)
C
      REAL      PI/3.1415927/
      REAL      DEG_PER_RAD/57.29578/
      REAL      AUGMENTED_HEIGHT, R
      INTEGER*2 I
      CHARACTER*7200   WORK
C
      IF (NL.LT.3)
     +   CALL XVMESSAGE(
     +    ' RADAGEN INPUT MUST CONTAIN AT LEAST 3 LINES.',' ')
      TAN_THETA = TAN((90.-EL)/DEG_PER_RAD)*(SSCALE/ZSCALE)
      NEXT_SAMP = NS - 1
C
      REL = (EL/360.)*2*PI         ! CONVERT TO RADIANS.
      RAZ = (AZ/360.)*2*PI
      CALL RADIUS(ILLUM_VECTOR,REL,RAZ,1.0)
C
C                                       ! ILLUM_VEC IS THE UNIT VECTOR
C                                       ! IN THE DIRECTION OF
C                                       ! ILLUMINATION.
C
      NADIR_OFFSET = HEIGHT / (ILLUM_VECTOR(3)/ILLUM_VECTOR(1))
     *                 - (NS/2)*SSCALE
      AUGMENTED_HEIGHT = SQRT(NADIR_OFFSET**2. + HEIGHT**2.)
C
      TOTAL_PIXELS_OUT=(SQRT((NADIR_OFFSET+NS*SSCALE)**2. +
     +    HEIGHT**2.)-AUGMENTED_HEIGHT)/SSCALE
      IF (SCALE.EQ.0.) THEN
    	IF (LOG) THEN
          IF (OFMT.EQ.'HALF') THEN
              SCALE = 16383./ALOG10(TOP_VALUE)
          ELSE
              SCALE = 254./ALOG10(TOP_VALUE)
          END IF
    	ELSE
          IF (OFMT.EQ.'HALF') THEN
              SCALE = 16383./TOP_VALUE
          ELSE
              SCALE = 254./TOP_VALUE
          END IF
    	END IF
      END IF
C
      MAXIM=16383
      IF (OFMT.EQ.'BYTE') MAXIM=254
C
      OUT_SCALE = FLOAT(NS)/FLOAT(TOTAL_PIXELS_OUT)
C
      CALL XVMESSAGE(' ',' ')
      WORK = ' OUTPUT RESOLUTION IN METERS/PIXEL '
      WRITE(WORK(43:50),'(F8.2)') SSCALE/OUT_SCALE
      CALL XVMESSAGE(WORK,' ')
      DO I = 1,NS
          R = SQRT(((NS-I)*SSCALE+NADIR_OFFSET)**2 +
     +        HEIGHT**2)
          A(I) = TOTAL_PIXELS_OUT*SSCALE - (R-AUGMENTED_HEIGHT)
          B(I) =(HEIGHT/R)
      END DO
      RETURN
      END
C
C
C
C
C
      SUBROUTINE RAD_UPDATE(A,B,INPUT,OUTPUT,TLOCATOR,PASS)
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /GLOBAL/ AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,
     +       ILLUM_VECTOR, TAN_THETA, REL, TOP_VALUE, MAXIM,
     +       HEIGHT, OUT_SCALE, TERRAIN_OFFSET, NADIR_OFFSET,
     +       LOG_SCALE, ALTI, RAZ, MIS_CORR, LINC, IPASS,
     +	     SS_BUF,NS_BUF,AZ_BUF,EL_BUF,HEIGHT_BUF,TOP_BUF,
     +       SSCALE_BUF,LSCALE_BUF,ZSCALE_BUF,SCALE_BUF,TOFF_BUF,
     +       OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      REAL        REL, ILLUM_VECTOR(3), TAN_THETA, NADIR_OFFSET
      REAL        ALTI, RAZ, TOP_VALUE, HEIGHT, OUT_SCALE, LOG_SCALE
      REAL        AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE, MIS_CORR(3)
      REAL	  AZ_BUF(512),EL_BUF(512),SCALE_BUF(512)
      REAL	  SSCALE_BUF(512),LSCALE_BUF(512),ZSCALE_BUF(512)
      REAL	  HEIGHT_BUF(512),TOP_BUF(512)
      INTEGER     SS_BUF(512),NS_BUF(512),TOFF_BUF(512)
      INTEGER*2   OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      INTEGER     MAXIM, TERRAIN_OFFSET, REFUNIT, LINC, IPASS
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
      REAL      A(NS), B(NS)
      INTEGER*2 INPUT(NS,3), OUTPUT(NS), TLOCATOR(NS)
C
      REAL      PI/3.1415927/
      REAL      DEG_PER_RAD/57.29578/
      REAL      AUGMENTED_HEIGHT, R
      INTEGER*2 I
      CHARACTER*7200   WORK
      INTEGER	PASS
C
C  UPDATE THE PARAMETERS PER PASS
C
      IF (SS_BUF(1).GE.PASS) ISS = SS_BUF(PASS)
      IF (SS_BUF(1).LT.PASS) ISS = SS_BUF(SS_BUF(1))
C
      IF (NS_BUF(1).GE.PASS) NS = NS_BUF(PASS)
      IF (NS_BUF(1).LT.PASS) NS = NS_BUF(NS_BUF(1))
C
      IF (AZ_BUF(1).GE.PASS) AZ = AZ_BUF(PASS)
      IF (AZ_BUF(1).LT.PASS) AZ = AZ_BUF(AZ_BUF(1))
C
      IF (EL_BUF(1).GE.PASS) EL = EL_BUF(PASS)
      IF (EL_BUF(1).LT.PASS) EL = EL_BUF(EL_BUF(1))
C
      IF (HEIGHT_BUF(1).GE.PASS) HEIGHT = 1000 * HEIGHT_BUF(PASS)
      IF (HEIGHT_BUF(1).LT.PASS)HEIGHT=1000*HEIGHT_BUF(HEIGHT_BUF(1))
C
      IF (TOP_BUF(1).GE.PASS) TOP_VALUE = TOP_BUF(PASS)
      IF (TOP_BUF(1).LT.PASS) TOP_VALUE = TOP_BUF(TOP_BUF(1))
C
      IF (SSCALE_BUF(1).GE.PASS) SSCALE = SSCALE_BUF(PASS)
      IF (SSCALE_BUF(1).LT.PASS) SSCALE = SSCALE_BUF(SSCALE_BUF(1))
C
      IF (LSCALE_BUF(1).GE.PASS) LSCALE = LSCALE_BUF(PASS)
      IF (LSCALE_BUF(1).LT.PASS) LSCALE = LSCALE_BUF(LSCALE_BUF(1))
C
      IF (ZSCALE_BUF(1).GE.PASS) ZSCALE = ZSCALE_BUF(PASS)
      IF (ZSCALE_BUF(1).LT.PASS) ZSCALE = ZSCALE_BUF(ZSCALE_BUF(1))
C
      IF (SCALE_BUF(1).GE.PASS) SCALE = SCALE_BUF(PASS)
      IF (SCALE_BUF(1).LT.PASS) SCALE = SCALE_BUF(SCALE_BUF(1))
C
      IF (TOFF_BUF(1).GE.PASS) TERRAIN_OFFSET = TOFF_BUF(PASS)
      IF (TOFF_BUF(1).LT.PASS) TERRAIN_OFFSET = TOFF_BUF(TOFF_BUF(1))
C
      IF (NL.LT.3)
     +   CALL XVMESSAGE(
     +    ' RADAGEN INPUT MUST CONTAIN AT LEAST 3 LINES.',' ')
      TAN_THETA = TAN((90.-EL)/DEG_PER_RAD)*(SSCALE/ZSCALE)
      NEXT_SAMP = NS - 1
C
      REL = (EL/360.)*2*PI         ! CONVERT TO RADIANS.
      RAZ = (AZ/360.)*2*PI
      CALL RADIUS(ILLUM_VECTOR,REL,RAZ,1.0)
C
C                                       ! ILLUM_VEC IS THE UNIT VECTOR
C                                       ! IN THE DIRECTION OF
C                                       ! ILLUMINATION.
C
      NADIR_OFFSET = HEIGHT / (ILLUM_VECTOR(3)/ILLUM_VECTOR(1))
     *                 - (NS/2)*SSCALE
      AUGMENTED_HEIGHT = SQRT(NADIR_OFFSET**2. + HEIGHT**2.)
C
      TOTAL_PIXELS_OUT=(SQRT((NADIR_OFFSET+NS*SSCALE)**2. +
     +    HEIGHT**2.)-AUGMENTED_HEIGHT)/SSCALE
      IF (SCALE.EQ.0.) THEN
    	IF (LOG) THEN
          IF (OFMT.EQ.'HALF') THEN
              SCALE = 16383./ALOG10(TOP_VALUE)
          ELSE
              SCALE = 254./ALOG10(TOP_VALUE)
          END IF
    	ELSE
          IF (OFMT.EQ.'HALF') THEN
              SCALE = 16383./TOP_VALUE
          ELSE
              SCALE = 254./TOP_VALUE
          END IF
    	END IF
      END IF
C
      MAXIM=16383
      IF (OFMT.EQ.'BYTE') MAXIM=254
C
      OUT_SCALE = FLOAT(NS)/FLOAT(TOTAL_PIXELS_OUT)
C
      CALL XVMESSAGE(' ',' ')
      WORK = ' OUTPUT RESOLUTION IN METERS/PIXEL '
      WRITE(WORK(43:50),'(F8.2)') SSCALE/OUT_SCALE
      CALL XVMESSAGE(WORK,' ')
      DO I = 1,NS
          R = SQRT(((NS-I)*SSCALE+NADIR_OFFSET)**2 +
     +        HEIGHT**2)
          A(I) = TOTAL_PIXELS_OUT*SSCALE - (R-AUGMENTED_HEIGHT)
          B(I) =(HEIGHT/R)
      END DO
      RETURN
      END
C
C
C
C
C
      SUBROUTINE TABLE_THE_IMAGE(A,B,INPUT,OUTPUT,TLOCATOR)
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /GLOBAL/ AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,
     +       ILLUM_VECTOR, TAN_THETA, REL, TOP_VALUE, MAXIM,
     +       HEIGHT, OUT_SCALE, TERRAIN_OFFSET, NADIR_OFFSET,
     +       LOG_SCALE, ALTI, RAZ, MIS_CORR, LINC, IPASS,
     +	     SS_BUF,NS_BUF,AZ_BUF,EL_BUF,HEIGHT_BUF,TOP_BUF,
     +       SSCALE_BUF,LSCALE_BUF,ZSCALE_BUF,SCALE_BUF,TOFF_BUF,
     +       OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      COMMON /MOVE/ OFF1, OFF2
      INTEGER	  OFF1, OFF2
      REAL        REL, ILLUM_VECTOR(3), TAN_THETA, NADIR_OFFSET
      REAL        ALTI, RAZ, TOP_VALUE, HEIGHT, OUT_SCALE, LOG_SCALE
      REAL        AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE, MIS_CORR(3)
      REAL	  AZ_BUF(512),EL_BUF(512),SCALE_BUF(512)
      REAL	  SSCALE_BUF(512),LSCALE_BUF(512),ZSCALE_BUF(512)
      REAL	  HEIGHT_BUF(512),TOP_BUF(512)
      INTEGER     SS_BUF(512),NS_BUF(512),TOFF_BUF(512)
      INTEGER*2   OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      INTEGER     MAXIM, TERRAIN_OFFSET, REFUNIT, LINC, IPASS
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
      REAL      A(NS), B(NS)
      INTEGER*2 INPUT(NS,3), OUTPUT(NS), TLOCATOR(NS)
C
      REAL      S(3), L(3), Z(3), Y(3), R3, R1, R2, TERRAIN_AVG
      INTEGER*2 H/0/, SHADOW_HOLD(2)
      INTEGER*2 SHADOW_COUNT, SHADOW_LIMIT/2/
      INTEGER*2 SSS/1/, LL/2/, ALT/3/, TEMP
      INTEGER   I, II, LINE, SAMP, TOP, MIDDLE, BOTTOM, STATUS
C      LOGICAL        IN_RANGE
      CHARACTER*80   STRNG
C
C     FOR SIR-B REVISION TLOCATOR IS FORWARDED TO THE MOVE_OUTPUT ROUTINE
C     WHEREVER IT IS CALLED.  AND EVERYWHERE WRITE IS USED TO WRITE AN
C     OUTPUT LINE TO THE FIRST OUTPUT, A BLOCK OF CODE HAS BEEN ADDED TO
C     WRITE TLOCATOR LINE TO THE SECOND OUTPUT IF A SECOND OUTPUT HAS BEEN
C     SPECIFIED.  FINALLY THE SECOND OUTPUT FILE IS CLOSED BY THIS ROUTINE
C     IF IT HAS BEEN SPECIFIED.
C
      IF (TERRAIN_OFFSET.EQ.-1) THEN  ! NO PARAMETER ENTERED.
          SAMP = ISL + NL/2
          CALL XVREAD(INUNIT,INPUT(1,1),STATUS,'SAMP',ISS,
     +                'NSAMPS',NS,'LINE',SAMP,' ')
          TERRAIN_AVG = 0.
          DO SAMP = 1,NS
              TERRAIN_AVG = INPUT(SAMP,1)+TERRAIN_AVG
          END DO
          TERRAIN_AVG = (TERRAIN_AVG/FLOAT(NS))*ZSCALE
          TERRAIN_OFFSET=((TERRAIN_AVG*B(1))/SSCALE)*OUT_SCALE
      END IF
      STRNG=' AVG HEIGHT USED:             LEFT BORDER OFFSET:'
      WRITE(STRNG(19:25),'(F7.2)') TERRAIN_AVG
      WRITE(STRNG(51:54),'(I4)') TERRAIN_OFFSET
      CALL XVMESSAGE(STRNG,' ')
C
      DO II=1,NS
          OUTPUT(II) = 0
      END DO
C
C WATCH OUT FOR READING INTO (I,J) ARRAYS
C
      CALL XVREAD(INUNIT,INPUT(1,1),STATUS,'SAMP',ISS,
     +           'NSAMPS',NS,'LINE',ISL,' ')
      CALL XVREAD(INUNIT,INPUT(1,2),STATUS,'SAMP',ISS,
     +           'NSAMPS',NS,' ')
      CALL XVREAD(INUNIT,INPUT(1,3),STATUS,'SAMP',ISS,
     +           'NSAMPS',NS,' ')
C
C                                       /* UPPER LEFT CORNER. */
C
      S(ALT) = (INPUT(2,1)-INPUT(1,1))*ZSCALE
      S(LL) = 0
      S(SSS) = SSCALE*2.
      L(SSS) = 0
      L(ALT) = (INPUT(1,2)-INPUT(1,1))*ZSCALE
      L(LL) = LSCALE*2
      CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +			1,1,MIS_CORR)
      CALL MOVE_OUTPUT(1,1,A,B,INPUT,OUTPUT,TLOCATOR,R3,1)
      NEXT_SAMP = NS - 1
      DO SAMP = NS-1,2,-1    ! UPPER LINE.
          IF (INPUT(SAMP,1).GE.TAN_THETA*(SAMP-NEXT_SAMP)) THEN
              S(ALT) = (INPUT(SAMP+1,1)-INPUT(SAMP-1,1))*ZSCALE
              L(ALT) = (INPUT(SAMP,2)-INPUT(SAMP,1))*ZSCALE
              CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +				1,SAMP,MIS_CORR,R3)
              CALL MOVE_OUTPUT(1,SAMP,A,B,INPUT,OUTPUT,TLOCATOR,R3,1)
              NEXT_SAMP = SAMP - INPUT(SAMP,1)*ZSCALE/TAN_THETA
          ELSE
              OUTPUT(SAMP) = 1
          END IF
          NEXT_SAMP = SAMP - INPUT(SAMP,1)/TAN_THETA
      END DO
C
C                                       /* UPPER RIGHT CORNER. */
C
      S(ALT) = (INPUT(NS,1)-INPUT(NS-1,1))*ZSCALE
      L(ALT) = (INPUT(NS,2)-INPUT(NS,1))*ZSCALE
      CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +				1,NS,MIS_CORR)
      CALL MOVE_OUTPUT(1,NS,A,B,INPUT,OUTPUT,TLOCATOR,R3,1)
      IF (RECTIFY) CALL RECTIFY_IMAGE(OUTPUT,NS,TLOCATOR)
      CALL RESAMP0(OUTPUT,NS,TLOCATOR,FILL) ! AVG. OVER ZEROES.
      CALL XVWRIT(OUTUNIT(1),OUTPUT(1),STATUS,'NSAMPS',NS,' ')
      IF (N_OUTPUTS.GT.1) THEN
        CALL XVWRIT(OUTUNIT(2),TLOCATOR(1),STATUS,'NSAMPS',NS,' ')
      ENDIF
      TOP = 1
      BOTTOM = 3
      MIDDLE = 2
C
      LINE = ISL+1
      DO WHILE (LINE.LE.NL+ISL-2)
	DO II=1,NS
            OUTPUT(II) = 0
	END DO
    	II = LINE - ISL
        SHADOW_COUNT = 0
        NEXT_SAMP = NS - 1
        S(ALT) = (INPUT(2,MIDDLE)-INPUT(1,MIDDLE))*ZSCALE
        L(ALT) = (INPUT(2,BOTTOM)-INPUT(2,TOP))*ZSCALE
        CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +				II,SAMP,MIS_CORR)
        CALL MOVE_OUTPUT(MIDDLE,SAMP,A,B,INPUT,OUTPUT,TLOCATOR,R3,II)
        DO SAMP = NS-1,2,-1
          S(ALT)=(INPUT(SAMP+1,MIDDLE)-INPUT(SAMP-1,MIDDLE))
     +       * ZSCALE
          L(ALT)=(INPUT(SAMP,BOTTOM)-INPUT(SAMP,TOP))*ZSCALE
          CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +				II,SAMP,MIS_CORR)
          CALL MOVE_OUTPUT(MIDDLE,SAMP,A,B,INPUT,OUTPUT,TLOCATOR,R3,II)
          IF (INPUT(SAMP,MIDDLE).LT.TAN_THETA*(SAMP-NEXT_SAMP)) THEN
             SHADOW_COUNT = SHADOW_COUNT + 1
             IF (SHADOW_COUNT.LT.SHADOW_LIMIT)
     +           SHADOW_HOLD(SHADOW_COUNT) = OUT_SAMP
             IF (SHADOW_COUNT.EQ.SHADOW_LIMIT) THEN
                DO I = 1,SHADOW_LIMIT-1
                   OUTPUT(SHADOW_HOLD(I)) = 1
                END DO
                OUTPUT(OUT_SAMP) = 1
             END IF
             IF (SHADOW_COUNT.GT.SHADOW_LIMIT)
     +          OUTPUT(OUT_SAMP) = 1
             ELSE
                SHADOW_COUNT = 0
                NEXT_SAMP = SAMP - INPUT(SAMP,MIDDLE)/TAN_THETA
             END IF
          END DO
          S(ALT) = (INPUT(NS,MIDDLE)-INPUT(NS-1,MIDDLE))*ZSCALE
          L(ALT)=(INPUT(NS,BOTTOM)-INPUT(NS,TOP))*ZSCALE
          CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +					II,NS,MIS_CORR)
          CALL MOVE_OUTPUT(MIDDLE,NS,A,B,INPUT,OUTPUT,TLOCATOR,R3,II)
          IF (RECTIFY) CALL RECTIFY_IMAGE(OUTPUT,NS,TLOCATOR)
          CALL RESAMP0(OUTPUT,NS,TLOCATOR,FILL) ! AVG. OVER ZEROES.
          CALL XVWRIT(OUTUNIT(1),OUTPUT,STATUS,'NSAMPS',NS,' ')
          IF (N_OUTPUTS.GT.1) THEN
           CALL XVWRIT(OUTUNIT(2),TLOCATOR(1),STATUS,'NSAMPS',NS,' ')
          ENDIF
          IF (LINE.NE.NL+ISL-2) THEN
             CALL XVREAD(INUNIT,INPUT(1,TOP),STATUS,'SAMP',ISS,
     +                   'NSAMPS',NS,' ')
              TEMP = TOP
              TOP = MIDDLE
              MIDDLE = BOTTOM
              BOTTOM = TEMP
          END IF
          LINE=LINE+1
      END DO
C
C                                       /* LAST LINE. */
C
      DO II=1,NS
          OUTPUT(II) = 0
      END DO
      II = ISL + NL - 1
      S(ALT) = (INPUT(2,BOTTOM)-INPUT(1,BOTTOM))*ZSCALE
      L(ALT) = (INPUT(1,BOTTOM)- INPUT(1,MIDDLE)) * ZSCALE
C
      CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +				II,1,MIS_CORR)
      CALL MOVE_OUTPUT(BOTTOM,1,A,B,INPUT,OUTPUT,TLOCATOR,R3,II)
      NEXT_SAMP = NS - 1
      DO SAMP = NS-1,2,-1
C                                       /* MID LINE. */
        IF (INPUT(SAMP,BOTTOM).GE.TAN_THETA*(SAMP-NEXT_SAMP)) THEN
          S(ALT) = (INPUT(SAMP+1,BOTTOM)-INPUT(SAMP-1,BOTTOM))
     +        * ZSCALE
          L(ALT) = (INPUT(SAMP,BOTTOM)-INPUT(SAMP,MIDDLE))*ZSCALE
          CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +					II,SAMP,MIS_CORR)
          CALL MOVE_OUTPUT(BOTTOM,SAMP,A,B,INPUT,OUTPUT,TLOCATOR,R3,II)
          NEXT_SAMP = SAMP - INPUT(SAMP,BOTTOM)*ZSCALE/TAN_THETA
        ELSE
          OUTPUT(SAMP) = 1
        END IF
      END DO
C                                       /* RIGHT CORNER. */
C
      S(ALT) = (INPUT(NS,BOTTOM)-INPUT(NS,BOTTOM))
     +    * ZSCALE
      L(ALT)=(INPUT(NS,BOTTOM)-INPUT(NS,MIDDLE))*ZSCALE
      CALL COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +				II,NS,MIS_CORR)
      CALL MOVE_OUTPUT(BOTTOM,NS,A,B,INPUT,OUTPUT,TLOCATOR,R3,II)
      IF (RECTIFY) CALL RECTIFY_IMAGE(OUTPUT,NS,TLOCATOR)
      CALL RESAMP0(OUTPUT,NS,TLOCATOR,FILL) ! AVG. OVER ZEROES.
      CALL XVWRIT(OUTUNIT(1),OUTPUT,STATUS,'NSAMPS',NS,' ')
      IF (N_OUTPUTS.GT.1) THEN
        CALL XVWRIT(OUTUNIT(2),TLOCATOR(1),STATUS,'NSAMPS',NS,' ')
      ENDIF
      CALL XVCLOSE(INUNIT,STATUS,' ')
      CALL XVCLOSE(OUTUNIT(1),STATUS,' ')
      IF (N_OUTPUTS.GT.1) CALL XVCLOSE(OUTUNIT(2),STATUS,' ')
      RETURN
      END
C
C
C
C
      SUBROUTINE CROSS(CROS,WITH,INTO)
      REAL CROS(3),WITH(3),INTO(3)
      INTO(1) = CROS(2)*WITH(3)-CROS(3)*WITH(2)
      INTO(2) = CROS(3)*WITH(1)-CROS(1)*WITH(3)
      INTO(3) = CROS(1)*WITH(2)-CROS(2)*WITH(1)
      RETURN
      END
C
C
C
C
      SUBROUTINE RADIUS(IS_CARTESIAN,EL,AZ,RAD)
      REAL IS_CARTESIAN(3),EL,AZ,RAD
      IS_CARTESIAN(1) = SIN(EL)*COS(AZ)*RAD
      IS_CARTESIAN(2) = SIN(EL)*SIN(AZ)*RAD
      IS_CARTESIAN(3) = COS(EL)*RAD
      RETURN
      END
C
C
C
C
C
      SUBROUTINE COMPUTE_FUNCTION(L,S,Z,ILLUM_VECTOR,Y,R1,R2,R3,SCALE,
     +			LINE,SAMP,MIS_CORR)
C
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
      REAL L(3), S(3), Z(3), ILLUM_VECTOR(3), Y(3), R1, R2, R3, SCALE
      INTEGER  LINE, SAMP, REFUNIT
      REAL DOTPROD, MIS_CORR(3)
      CALL CROSS(S,L,Z)
      CALL CROSS(Z,ILLUM_VECTOR,Y)
      R3 = 0.
      R1 = DOTPROD(Z,ILLUM_VECTOR)
      IF (R1.GE.0.) THEN
	 R2 = SQRT(Z(1)**2.+Z(2)**2.+Z(3)**2.)
	 R3 = SQRT(Y(1)**2.+Y(2)**2.+Y(3)**2.)
	 R1 = R1/R2     ! COS(THETA)
	 R3 = R3/R2     ! SIN(THETA)
         IF (.NOT.MGN) THEN
 	    R3 = R1/(R3+.1*R1)**3.0
   	 ELSE
C           SPECIAL BACKSCATTER MODELING FOR MAGELLAN PROJECT
   	    R3 = (0.0188*R1)/(R3+0.111*R1)**3.0
C	    COMPENSATION IN SCALE FOR MAGELLAN BACKSCATTER
    	    R3 = R3 * 40
   	 END IF
C
         CALL MISCORRECT (LINE, SAMP, MIS_CORR, R3)
    	 IF (LOG) THEN
    	    R3 = MAX(R3, 1.)
    	 ELSE
 	    R3 = MAX(SCALE*R3, 1.)
    	 END IF
      END IF
      RETURN
      END
C
C
C
C
C
      FUNCTION DOTPROD(DOT,WITH)
      REAL DOT(3),WITH(3)
      DOTPROD = DOT(1)*WITH(1)+DOT(2)*WITH(2)+DOT(3)*WITH(3)
      RETURN
      END
C
C
C
C
      SUBROUTINE MOVE_OUTPUT(FROM_LINE,FROM_SAMP,A,B,INPUT,OUTPUT,
     +                       TLOCATOR,R3,LINE)
C
C*******************************************************************
C
      IMPLICIT NONE
C
      COMMON /GLOBAL/ AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE,
     +       ILLUM_VECTOR, TAN_THETA, REL, TOP_VALUE, MAXIM,
     +       HEIGHT, OUT_SCALE, TERRAIN_OFFSET, NADIR_OFFSET,
     +       LOG_SCALE, ALTI, RAZ, MIS_CORR, LINC, IPASS,
     +	     SS_BUF,NS_BUF,AZ_BUF,EL_BUF,HEIGHT_BUF,TOP_BUF,
     +       SSCALE_BUF,LSCALE_BUF,ZSCALE_BUF,SCALE_BUF,TOFF_BUF,
     +       OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      COMMON /PARMS/ ISL, ISS, NL, NS, N_OUTPUTS, INUNIT, OUTUNIT,
     +       REFUNIT, REF, UPD, MGN, RECTIFY, LOG, FILL, IFMT, OFMT
      COMMON /MOVE/ OFF1, OFF2
      INTEGER	  OFF1, OFF2
      REAL        REL, ILLUM_VECTOR(3), TAN_THETA, NADIR_OFFSET
      REAL        ALTI, RAZ, TOP_VALUE, HEIGHT, OUT_SCALE, LOG_SCALE
      REAL        AZ, EL, SCALE, SSCALE, LSCALE, ZSCALE, MIS_CORR(3)
      REAL	  AZ_BUF(512),EL_BUF(512),SCALE_BUF(512)
      REAL	  SSCALE_BUF(512),LSCALE_BUF(512),ZSCALE_BUF(512)
      REAL	  HEIGHT_BUF(512),TOP_BUF(512)
      INTEGER     SS_BUF(512),NS_BUF(512),TOFF_BUF(512)
      INTEGER*2   OUT_SAMP, TOTAL_PIXELS_OUT, NEXT_SAMP
      INTEGER     MAXIM, TERRAIN_OFFSET, REFUNIT, LINC, IPASS
      INTEGER     ISL, ISS, NL, NS, INUNIT, OUTUNIT(2), N_OUTPUTS
      LOGICAL	  REF, UPD, MGN, RECTIFY, LOG, FILL
      CHARACTER*5 IFMT, OFMT
C********************************************************************
C
C
C     FOR SIR-B REVISION CODE HAS BEEN ADDED TO ASSOCIATE THE OUTPUT
C     PIXEL(S) WITH THE FROM_SAMP PIXEL IN TLOCATOR LINE.
C
C     FOR MAGELLAN CODE HAS BEEN ADDED TO ALLOW THE TLOCATOR VALUES
C     TO BE BASED ON AN IMAGE THAT IS NOT THE IMAGE BEING RADAGENed.
C
C     IF RECTIFICATION IS TO BE PERFORMED OR A TLOCATOR FILE IS BEING
C     WRITTEN OUT, THE LEFT SIDE OF THE IMAGE IS ALIGNED WITH SAMPLE
C     1 TO INCLUDE THE ENTIRE IMAGE.
C
      REAL      A(NS), B(NS), R3
      INTEGER*2 LOCBUF(16384),INPUT(NS,3), OUTPUT(NS), TLOCATOR(NS)
      INTEGER   FROM_LINE, FROM_SAMP, LINE, STAT
      INTEGER   L, C
C
      L = FROM_LINE
      C = FROM_SAMP
      ALTI = INPUT(C,L)
      OUT_SAMP=-TERRAIN_OFFSET+OUT_SCALE*(A(C)+ALTI*ZSCALE*B(C))/SSCALE
      IF (C.EQ.1) OFF1 = 1 - OUT_SAMP
      IF (RECTIFY.OR.N_OUTPUTS.GT.1) OUT_SAMP = OUT_SAMP + OFF1
      IF (OUT_SAMP.GT.NS) OUT_SAMP=NS
      IF (OUT_SAMP.LT.1) OUT_SAMP=1
C
C   PRESERVE LOG RELATIONSHIP IF IN USE
C
      IF (LOG) THEN
    	  OUTPUT(OUT_SAMP) = SCALE * ALOG10(R3 +
     +      				10.**(OUTPUT(OUT_SAMP)/SCALE))
      ELSE
          OUTPUT(OUT_SAMP) = MIN(NINT(R3),MAXIM) + OUTPUT(OUT_SAMP)
      END IF
C
      IF (OUTPUT(OUT_SAMP).GT.MAXIM) OUTPUT(OUT_SAMP) = MAXIM
C
C   COMPUTE LOCATION SHIFT BASED ON REFERENCE IMAGE
C
      IF (REF) THEN
	 CALL XVREAD(REFUNIT,LOCBUF,STAT,'LINE',LINE,' ')
	 OUT_SAMP=-TERRAIN_OFFSET+OUT_SCALE*(A(C)+LOCBUF(C)*ZSCALE
     +            *B(C))/SSCALE
	 IF (C.EQ.1) OFF2 = 1 - OUT_SAMP
	 IF (RECTIFY.OR.N_OUTPUTS.GT.1) OUT_SAMP = OUT_SAMP + OFF2
	 IF (OUT_SAMP.LT.1) OUT_SAMP=1
	 IF (OUT_SAMP.GT.NS) OUT_SAMP = NS
      END IF
C
      IF (RECTIFY.OR.N_OUTPUTS.GT.1) TLOCATOR(C) = OUT_SAMP
      RETURN
      END
C
C
C
C
      SUBROUTINE MISCORRECT(LINE,SAMP,MIS_CORR,VALUE)
C
      IMPLICIT NONE
      INTEGER  	 LINE, SAMP
      REAL	 MIS_CORR(3), VALUE, VAL, PI/3.1415926536/
C
      VAL = 1. + MIS_CORR(3)/2 * (SIN(2.*PI*LINE/MIS_CORR(2)) - 1)
      VALUE = VALUE + SAMP * MIS_CORR(1) * VAL
C
      RETURN
      END
C
C
C
C
      SUBROUTINE RESAMP0(BUF,N,TBUF,FILL)
C
      IMPLICIT INTEGER(A-Z)
C
      INTEGER*2 BUF(N),TBUF(N)
      LOGICAL    FILL
C
      RCNT = N
      IF (BUF(RCNT).NE.0) GOTO 20
10    IF (BUF(RCNT).NE.0) GOTO 15
      RCNT = RCNT - 1
      IF (RCNT.NE.0) GOTO 10
      RETURN
15    IF (.NOT.FILL) GOTO 20
      RSTART = N
      REND = RCNT
      BUF(RSTART) = BUF(REND)
      TBUF(RSTART) = TBUF(REND)
      GO TO 50
20    IF (BUF(RCNT).EQ.0) GOTO 30
      RCNT = RCNT - 1
      IF (RCNT.GT.0) GOTO 20
      RETURN
30    RSTART = RCNT + 1
40    IF (BUF(RCNT).NE.0) GOTO 50
      RCNT = RCNT - 1
      REND = RCNT
      IF (REND.GT.0) GOTO 40
      REND=1	! NOT IN ORIG BAL
      BUF(REND) = BUF(RSTART)
      TBUF(REND) = TBUF(RSTART)
50    RVAL1 = BUF(RSTART)
      RVAL2 = BUF(REND)
      RDIFF = RSTART-REND
      RDVAL = RVAL1-RVAL2
      R = RSTART - 1
60    BUF(R) = (R-REND)*RDVAL/RDIFF+RVAL2
      IF ((RSTART-R).LE.(RDIFF/2)) THEN
           TBUF(R) = TBUF(RSTART)
      ELSE IF (REND.GT.1) THEN
           TBUF(R) = TBUF(REND)
      ELSE IF (BUF(1).NE.0) THEN
           TBUF(R) = TBUF(REND)
      ELSE
           TBUF(R) = TBUF(RSTART)
      ENDIF
      R = R - 1
      IF (R.GT.REND) GOTO 60
      IF (REND.EQ.1) RETURN
      GOTO 20
      END
C
C
C
C
C
      SUBROUTINE RECTIFY_IMAGE(OUTPUT,NS,TLOCATOR)
C
C     THIS SUBROUTINE WILL MOVE THE COMPUTED INTENSITIES TO THEIR
C     ORIGINAL LOCATION AS DEFINED IN TLOCATOR TO GEOMETRICALLY
C     RECTIFY THE IMAGE.
C
      IMPLICIT NONE
      INTEGER NS,SAMP
      INTEGER*2 TLOCATOR(NS),OUTPUT(NS),OUT(32768)
C
      DO SAMP = 1,NS
	  OUT(SAMP) = 0
	  IF (TLOCATOR(SAMP).GT.0) OUT(SAMP)=OUTPUT(TLOCATOR(SAMP))
      ENDDO
C
      DO SAMP = 1,NS
	  OUTPUT(SAMP) = OUT(SAMP)
      ENDDO
C
      RETURN
      END


!!# SUBROUTINE MODULE <<SUB_ExponentialMoment>>
MODULE SUB_ExponentialMoment

!!## PURPOSE
!! Return the numerically stable calculation of the exponential
!! moment functions, $M_n(x)$.

!!## DETAILS
!! Wouldn't use for $n>10$ or so, although this case is hardly ever
!! needed.

!!## REFERENCES
! D. J. Miller, K. A. Mathews*, and C. R. Brennan, "SPLIT-CELL
! DISCRETE ORDINATES TRANSPORT ON AN UNSTRUCTURED GRID OF
! TRIANGULAR CELLS", TRANSPORT THEORY AND STATISTICAL PHYSICS,
! 25(7). 833-867 (1996).

!!## OWNER
! [waw] william.wieselquist@gmail.com

!!## DEPENDENCIES
USE KND_IntrinsicTypes                  !!((01-A-KND_IntrinsicTypes.f90))
USE FUN_Factorial                       !!((06-B-FUN_Factorial.f90))
USE FUN_Default                         !!((04-A-FUN_Default.f90))
USE FUN_Integrate1_aq                   !!((06-B-FUN_Integrate1_aq.f90))

!!## DEFAULT IMPLICIT
IMPLICIT NONE

!!## DEFAULT ACCESS
PRIVATE

!!## LOCAL VARIABLES
!small switch must be greater than 1
REAL(KIND_Rdp),SAVE :: SMALL_x=0.5_KIND_Rdp
!REAL(KIND_Rdp),SAVE :: SMALL_x=1.E-3_KIND_Rdp

!!## PUBLIC ACCESS LIST
PUBLIC :: ExponentialMoment
PUBLIC :: PRINT_ExponentialMoment
PUBLIC :: PRINT_NExponentialMoment

CONTAINS

!!### SUBROUTINE <<NExponentialMoment>>
SUBROUTINE NExponentialMoment( N , x , M , tol )

!!#### PURPOSE
!! Return the exponential moments $M_n(x)$, for $n=0,1,...,N$
!! using adaptive numerical integration.

!!#### REQUIRED INPUT
INTEGER       ,INTENT(IN) :: N
REAL(KIND_Rdp),INTENT(IN) :: x

!!#### REQUIRED OUTPUT
REAL(KIND_Rdp),INTENT(OUT) :: M(0:N)

!!#### OPTIONAL INPUT
REAL(KIND_Rdp),INTENT(IN),OPTIONAL :: tol

!!#### LOCAL VARIABLES
INTEGER        :: i
REAL(KIND_Rdp) :: tol_

!!--begin--
tol_ = DEFAULT( 10._KIND_Rdp*EPSILON(tol) , tol )
M = 0._KIND_Rdp

DO i=0,N
 M(i) = NExponentialMoment0(i,x,tol_)
END DO

!!--end--
END SUBROUTINE

!!### FUNCTION <<NExponentialMoment0>>
FUNCTION NExponentialMoment0(n,x,tol) RESULT(val)

!!#### PURPOSE
!! Return the numerical integration of the
!! exponential moment function, $M_n(x)$ for a single $n$.

!!#### REQUIRED INPUT
!! * moment order $n$
!! * argument of simplified exponential moment function $M_n(x)$
!! * tolerance on solution
INTEGER       ,INTENT(IN) :: n
REAL(KIND_Rdp),INTENT(IN) :: x,tol

!!#### REQUIRED OUTPUT
REAL(KIND_Rdp) :: val

!!--begin--

val = Integrate1_aq( Mint , (/0._KIND_Rdp,1._KIND_Rdp/) , N=10000 , tol=tol )

!!--end--
CONTAINS

PURE FUNCTION Mint(t)
REAL(KIND_Rdp),INTENT(IN) :: t
REAL(KIND_Rdp) :: Mint
!!--begin--
Mint = (1._KIND_Rdp-t)**n * EXP(-x*t)
!!--end--
END FUNCTION

END FUNCTION

!!### SUBROUTINE <<ExponentialMoment>>
SUBROUTINE ExponentialMoment( N , x , M , tol )

!!#### PURPOSE
!! Return the exponential moments $M_n(x)$, for $n=0,1,...,N$.
!! For small arguments <x>, an expansion is used.

!!#### REQUIRED INPUT
INTEGER       ,INTENT(IN) :: N
REAL(KIND_Rdp),INTENT(IN) :: x

!!#### REQUIRED OUTPUT
REAL(KIND_Rdp),INTENT(OUT) :: M(0:N)

!!#### OPTIONAL INPUT
REAL(KIND_Rdp),INTENT(IN),OPTIONAL :: tol

!!#### LOCAL VARIABLES
INTEGER :: i
REAL(KIND_Rdp) :: tol_,reali

!!--begin--

tol_ = DEFAULT( 10._KIND_Rdp*EPSILON(tol) , tol )
M = 0._KIND_Rdp

!standard recursive algorithm if x is not too small
IF( x>SMALL_x )THEN

 !normal forward recursion (for most cases)
 !IF( x>REAL(N,KIND(x)) )THEN

  M(0) = ( 1._KIND_Rdp - EXP(-x) )/x
  DO i=1,N
   M(i) = ( 1._KIND_Rdp - i*M(i-1) )/x
  END DO

 !backward recursion (used mostly for large N or X)
 ![waw] commented about because it seemed to blow up
 !ELSE
 !
 ! M(N) = NExponentialMoment0(N,x,tol_)
 ! DO i=N,1,-1
 !  M(i-1) = ( 1._KIND_Rdp - x*M(i) )/REAL(i,KIND(x))
 ! END DO
 !
 !END IF

!x is small (use backward recursion)
ELSE

 M(N) = ZeroExpansion(N,x,tol_)
 DO i=N,1,-1
  M(i-1) = ( 1._KIND_Rdp - x*M(i) )/REAL(i,KIND(x))
 END DO

END IF

!!--end--
END SUBROUTINE

!!### FUNCTION <<ZeroExpansion>>
FUNCTION ZeroExpansion(n,x,tol) RESULT(val)

!!#### PURPOSE
!! Return the result MacLaurin expansion of the exponential moment
!! function, $M_n(x)$ for small $x$.

!!#### REQUIRED INPUT
!! * moment order $n$
!! * argument of exponential moment function $M_n(x)$
!! * tolerance on solution
INTEGER       ,INTENT(IN) :: n
REAL(KIND_Rdp),INTENT(IN) :: x,tol

!!#### LOCAL VARIABLES
INTEGER        :: k,i
REAL(KIND_Rdp) :: val,terms(0:100) ![hack] assume 100 terms needed at most (1-3 terms expected)

!!--begin--

k = -1
DO
 k = k + 1
 terms(k) = ( Factorial(n)/Factorial(n+1+k) ) * (-x)**k
 !WRITE(*,*)"terms(k))=",terms(k)
 IF( ABS(terms(k))<tol )EXIT
END DO

!accumulate terms in reverse order to not lose precision
!(terms are monotonically decreasing with k)
val = 0._KIND_Rdp
DO i=k,0,-1
 val = val + terms(i)
 !WRITE(*,*)"val=",val
END DO

!!--end--
END FUNCTION

!!### SUBROUTINE <<PRINT_ExponentialMoment>>
SUBROUTINE PRINT_ExponentialMoment(N,Unit,xstart,xdiv,ndiv,tol)

!!#### MODULES
USE FUN_STR                             !!((05-B-FUN_STR.f90))
USE FUN_Default                         !!((04-A-FUN_Default.f90))
USE VAR_Units,ONLY: DEFAULT_OUTPUT_UNIT !!((03-A-VAR_Units.f90))

!!#### REQUIRED INPUT
INTEGER,INTENT(IN) :: N

!!#### OPTIONAL INPUT
INTEGER       ,OPTIONAL,INTENT(IN) :: Unit
REAL(KIND_Rdp),OPTIONAL,INTENT(IN) :: xstart,xdiv,tol
INTEGER       ,OPTIONAL,INTENT(IN) :: ndiv

!!#### LOCAL VARIABLES
REAL(KIND_Rdp) :: x,Mfun(0:N),xstart_,xdiv_
INTEGER        :: i,Unit_,ndiv_

!!--begin--
xstart_ = Default( 10._KIND_Rdp , xstart )
xdiv_   = Default( 10._KIND_Rdp , xdiv )
Unit_   = Default( DEFAULT_OUTPUT_UNIT , Unit )
ndiv_   = Default( 10 , ndiv )

x=xstart_
DO i=1,ndiv_+1
 CALL ExponentialMoment( N , x , Mfun(0:2) ,tol=tol )
 WRITE(Unit_,"("//TRIM(STR(N+2))//"(E,1x))")x,Mfun(0:N)
 x=x/xdiv_
END DO

!!--end--
END SUBROUTINE

!!### SUBROUTINE <<PRINT_NExponentialMoment>>
SUBROUTINE PRINT_NExponentialMoment(N,Unit,xstart,xdiv,ndiv,tol)

!!#### MODULES
USE FUN_STR                             !!((05-B-FUN_STR.f90))
USE FUN_Default                         !!((04-A-FUN_Default.f90))
USE VAR_Units,ONLY: DEFAULT_OUTPUT_UNIT !!((03-A-VAR_Units.f90))

!!#### REQUIRED INPUT
INTEGER,INTENT(IN) :: N

!!#### OPTIONAL INPUT
INTEGER       ,OPTIONAL,INTENT(IN) :: Unit
REAL(KIND_Rdp),OPTIONAL,INTENT(IN) :: xstart,xdiv,tol
INTEGER       ,OPTIONAL,INTENT(IN) :: ndiv

!!#### LOCAL VARIABLES
REAL(KIND_Rdp) :: x,Mfun(0:N),xstart_,xdiv_
INTEGER        :: i,Unit_,ndiv_

!!--begin--
xstart_ = Default( 10._KIND_Rdp , xstart )
xdiv_   = Default( 10._KIND_Rdp , xdiv )
Unit_   = Default( DEFAULT_OUTPUT_UNIT , Unit )
ndiv_   = Default( 10 , ndiv )

x=xstart_
DO i=1,ndiv_+1
 CALL NExponentialMoment( N , x , Mfun(0:2) ,tol=tol )
 WRITE(Unit_,"("//TRIM(STR(N+2))//"(E,1x))")x,Mfun(0:N)
 x=x/xdiv_
END DO

!!--end--
END SUBROUTINE

END MODULE


Subroutine hifun(i, xmin, xmax, fhb)
  Common /hijhb/rr(10, 201), xx(10, 201)
  External fhb
  Save
  fnorm = gauss1(fhb, xmin, xmax, 0.001)
  Do j = 1, 201
    xx(i, j) = xmin + (xmax-xmin)*(j-1)/200.0
    xdd = xx(i, j)
    rr(i, j) = gauss1(fhb, xmin, xdd, 0.001)/fnorm
  End Do
  Return
End Subroutine hifun


c
c-----------------------------------------------------------------------
c
      subroutine channelInit(xin,yin,state,time)

      implicit double precision(a-h,o-z)
      dimension state(4)
      include "cuserdt.i"
c
c     # For the point (x,y), compute the true solution (or initial
c     #  conditions) at this point
c     # returns conserved variables
c

       !u = 0.d0
       !v = 0.d0
       u = 1.d0
       v = 0.1d0
       p = 1.d0
       pi = 3.14159265358979d0

       x = xin - u*time
       y = yin - v*time

       !rho = 0.5d0
       !rho = y - 0.1d0*x + 0.5d0
       !rho = y
       !rho = x + 2.d0
       !rho = y**2  + 3.d0*x*y + 0.5*x + 1.d0
       !rho = y**2 + 0.5d0
       !rho = y**3 + 2.d0*x*y + 0.5d0
       rho = sin(2.d0*pi*x) * cos(2.d0*pi*y) + 2.0d0

       state(1) = rho
       state(2) = rho*u
       state(3) = rho*v
       velsq = u*u + v*v
       state(4) = 0.5d0*rho*velsq + p/gamma1

       return
       end


!***********************************************************************************************************************************
! UNIT:
!
!  (MODULE) MR_DEF_CONSTS_N_REF_PARS
!
! PURPOSE:
!
!   TO DEFINE THE CONSTANTS AND REFERENCE PARAMETERS, WHICH ARE MAINLY USED TO NONDIMENSIONALIZE THE SYSTEM OF FORMULAE, EQUATIONS
!   AND AUXILIARY RELATIONS SO AS TO ELIMINATE THE DIMENSION EFFECT DUE TO THE OVERLARGE OR OVERSMALL SCALE OF INPUT DATA. THESE
!   PARAMETERS ARE SELECTED INDEPENDENT OF TIME AND LOCATION, THAT IS, FOR A DEFINITE PROJECT CASE, THEY HAVE DEFINITE VALUES.
!   ALTHOUGH THESE PARAMETERS HAVE NO DISTRIBUTION ON THE GRID, SOME OF THEM MAY BE STILL CLASSIFIED BY LAYER (EG. SIGMA COORDINATE)
!   OR BY SEDIMENT GRIAN-SIZE (EG. SEDIMENT CRITICAL SHEAR STRESS, FALL VELOCITY, ETC.). IN ADDITION, THE SIGMA THICKNESS AS A
!   COMPUTATIONAL CONSTANT IS ALSO DEFINED HERE FOR IT HAS THE SAME PRECISION AS THE OTHER PARAMETERS.
!
! DEFINITION OF VARIABLES:
!
!                              R0    :    WATER DENSITY
!                              V0    :    WATER KINEMATIC VISCOSITY
!
!                                      \\ ABOVE ARE WATER PHYSICAL PROPERTIES
!
!                              SS    :    SEDIMENT SPECIFIC GRAVITY
!                              PS    :    SEDIMENT POROSITY
!
!                                      \\ ABOVE ARE SEDIMENT PHYSICAL PROPERTIES
!
!                             KAR    :    VON KARMAN CONSTANT
!                            COR2    :    CORIOLIS FREQUENCY
!                              GR    :    GRAVITATIONAL ACCELERATION
!
!                                      \\ ABOVE ARE PHYSICAL CONSTANTS
!
!                             COR    :    REFERENCE FREQUENCY
!                             XYR    :    REFERENCE HORIZONTAL DIMENSION,
!                                         GENERALLY AS AVERAGE CELL DISTANCE
!                              ZR    :    REFERENCE VERTICAL DIMENSION,
!                                         GENERALLY AS AVERAGE DEPTH
!                             UVR    :    REFERENCE HORIZONTAL VELOCITY,
!                                         GENERALLY AS AVERAGE HORIZONTAL VELOCITY MAGNITUDE
!                              WR    :    REFERENCE VERTICAL VELOCITY, WR = UVR / ( XYR / ZR )
!                              SR    :    REFERENCE FREE SURFACE ELEVATION, SR = COR * UVR * XYR / GR
!                            TUVR    :    REFERENCE SHEAR STRESS, TUVR = R0 * COR * UVR * ZR
!                           QSUVR    :    REFERENCE TRANSPORT FLUX, QSUVR = R0 * COR * XYR * ZR
!                             KIR    :    REFERENCE TURBULENCE KINETIC ENERGY, KIR = COR * UVR * ZR
!                             DIR    :    REFERENCE TURBULENCE DISSIPATION RATE, DIR = COR * UVR * UVR
!                             VZR    :    REFERENCE EDDY KINEMATIC VISCOSITY
!                             DZR    :    REFERENCE EDDY KINEMATIC DIFFUSIVITY
!                              RR    :    REFERENCE WATER-SEDIMENT MIXTURE DENSITY,
!                                         GENERALLY AS MAXIMUM WATER-SEDIMENT MIXTURE DENSITY EXPECTED
!
!                                      \\ ABOVE ARE REFERENCE PARAMETERS
!
!                              RB    :    ROSSBY NUMBER, RB = UVR / ( COR * XYR )
!                             RBT    :    ROSSBY NUMBER FOR SHEAR STRESS, RBT = UVR / ( COR * ZR )
!                       EKXY, EKZ    :    HORIZONTAL & VERTICAL EKMAN NUMBER, EKXY = VZR / ( COR * XYR * XYR ), EKZ = VZR / ( COR * ZR * ZR )
!                       SCXY, SCZ    :    HORIZONTAL & VERTICAL SCHMIDT NUMBER, SCXY = DZR / ( COR * XYR * XYR ), SCZ = DZR / ( COR * ZR * ZR )
!                              RE    :    REYNOLDS NUMBER, RE = UVR * ZR / V0
!                             RET    :    REYNOLDS NUMBER FOR SHEAR STRESS, RET = RE / SQRT( RBT )
!                              FR    :    SQUARED FROUDE NUMBER, FR = UVR * UVR / ( GR * ZR )
!                             FRD    :    SQUARED DENSIMETRIC FROUDE NUMBER, FRD = FR * R0 / ( RR - R0 )
!                            BPAR    :    BETA PARAMETER, BPAR = RB * RB / FR
!                          SURPAR    :    PARAMETER THAT MEASURES FREE SURFACE ELEVATION AS BED ELEVATION, SURPAR = FR / RB
!                        SLOPEPAR    :    PARAMETER THAT MEASURES BED SLOPE AS FREE SURFACE SLOPE, SLOPEPAR = ( XYR / ZR ) / SURPAR
!                           DSPAR    :    PARAMETER THAT MEASURES GRAIN SIZE AS BED ROUGHNESS, DSPAR = ( ( V0 * V0) / ( GR * (SS-1.0) ) )**(1/3) / ZR
!
!                                      \\ ABOVE ARE DIMENSIONLESS COMBINATIONS
!
!   // BELOW IS CONSTANT SIGMA THICKNESS
!
!                          DSIGMA    :    SIGMA THICKNESS
!
!   // BELOW ARE RANKED PARAMETERS
!
!                           SIGMA    :    SIGMA COORDINATE
!
!                                      \\ ABOVE ARE LAYER RANKED PARAMETERS
!
!                              D0    :    GRAIN SIZE
!                              DS    :    DIMENSIONLESS GRAIN SIZE
!                            TCRS    :    DIMENSIONLESS CRITICAL SHEAR STRESS
!                           WALLS    :    DIMENSIONLESS FALL VELOCITY
!                             RBS    :    ROSSBY NUMBERS FOR FALL VELOCITY
!
!                                      \\ ABOVE ARE SEDIMENT SIZE RANKED PARAMETERS
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  MODULE MR_DEF_CONSTS_N_REF_PARS

    USE MR_KINDS

    IMPLICIT NONE

    REAL   (PARD_KIND) :: R0    =    1.000E+3
    REAL   (PARD_KIND) :: V0    =    1.00E-6

    REAL   (PARD_KIND) :: SS    =    2.65
    REAL   (PARD_KIND) :: PS    =    0.4

    REAL   (PARD_KIND) :: KAR   =    0.40
    REAL   (PARD_KIND) :: COR2  =    7.292124E-5
    REAL   (PARD_KIND) :: GR    =    9.80665

    REAL   (PARD_KIND) :: COR   =    1.0
    REAL   (PARD_KIND) :: XYR   =    1.0
    REAL   (PARD_KIND) :: ZR    =    1.0
    REAL   (PARD_KIND) :: UVR   =    1.0
    REAL   (PARD_KIND) :: WR
    REAL   (PARD_KIND) :: SR
    REAL   (PARD_KIND) :: TUVR
    REAL   (PARD_KIND) :: QSUVR
    REAL   (PARD_KIND) :: KIR
    REAL   (PARD_KIND) :: DIR
    REAL   (PARD_KIND) :: VZR   =    1.00E-6
    REAL   (PARD_KIND) :: DZR   =    1.00E-6
    REAL   (PARD_KIND) :: RR    =    1.200E+3

    REAL   (PARD_KIND) :: RB
    REAL   (PARD_KIND) :: RBT
    REAL   (PARD_KIND) :: EKXY , EKZ
    REAL   (PARD_KIND) :: SCXY , SCZ
    REAL   (PARD_KIND) :: RE
    REAL   (PARD_KIND) :: RET
    REAL   (PARD_KIND) :: FR
    REAL   (PARD_KIND) :: FRD
    REAL   (PARD_KIND) :: BPAR
    REAL   (PARD_KIND) :: SURPAR
    REAL   (PARD_KIND) :: SLOPEPAR
    REAL   (PARD_KIND) :: DSPAR

    REAL   (PARD_KIND) :: DSIGMA

    REAL   (PARD_KIND) :: SIGMA(32)

    REAL   (PARD_KIND) :: D0(8) = (/ 1.0E-3 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 /)
    REAL   (PARD_KIND) :: DS(8)
    REAL   (PARD_KIND) :: TCRS(8)
    REAL   (PARD_KIND) :: WALLS(8)
    REAL   (PARD_KIND) :: RBS(8)

  END MODULE MR_DEF_CONSTS_N_REF_PARS


c     program DRDRANGV
c>> 2001-05-22 DRDRANGV Krogh Minor change for making .f90 version.
c>> 1994-10-19 DRDRANGV Krogh  Changes to use M77CON
c>> 1987-12-09 DRDRANGV Lawson  Initial Code.
c--D replaces "?": DR?RANGV, ?RANGV
c        Demonstration driver for the Gaussian random vector generator,
c     DRANGV.
c     C. L. Lawson & S. Y. Chiu, JPL, Apr 1987.
c     ------------------------------------------------------------------
      integer I, J, N, IERR, NMAX, NSAMPL
      parameter(NMAX = 3)
      double precision A(NMAX,NMAX), U(NMAX), X(NMAX)
      logical HAVEC
      data (U(  J),J=1,NMAX)/ 1.0D0,  2.0D0,  3.0D0 /
      data (A(1,J),J=1,NMAX)/ 0.05D0, 0.02D0, 0.01D0 /
      data (A(2,J),J=1,NMAX)/ 0.02D0, 0.07D0,-0.03D0 /
      data (A(3,J),J=1,NMAX)/ 0.01D0,-0.03D0, 0.06D0 /
c     ------------------------------------------------------------------
      N = NMAX
      NSAMPL = 20
      HAVEC = .false.
      print'(1x,a/1x)','Pseudorandom vectors computed by DRANGV'
      do 10 I = 1,NSAMPL
         call DRANGV(A, NMAX, N, U, X, HAVEC, IERR)
         if(IERR .ne. 0) then
            print '(1x,i3,i6)',N, IERR
         else
            print '(1x,i3,5x,3f12.3)',I,X
         endif
   10 continue
      stop
      end


!***********************************************************************
!   Copyright (c) 2019 D. de Vries
!   Original Copyright (c) 2000 Mark Drela
!
!   This file is part of XFoil.
!
!   XFoil is free software: you can redistribute it and/or modify
!   it under the terms of the GNU General Public License as published by
!   the Free Software Foundation, either version 3 of the License, or
!   (at your option) any later version.
!
!   XFoil 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 General Public License for more details.
!
!   You should have received a copy of the GNU General Public License
!   along with XFoil.  If not, see <https://www.gnu.org/licenses/>.
!***********************************************************************

!*==LEFIND.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
! GETXYF

module m_xgeom
contains
    subroutine lefind(Sle, X, Xp, Y, Yp, S, N)
        use i_xfoil, only: show_output
        use m_spline, only: d2val, seval, deval
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        integer :: N
        real :: Sle
        real, dimension(*) :: S, X, Xp, Y, Yp
        intent (in) N, S, X, Xp, Y, Yp
        intent (inout) Sle
        !
        ! Local variables
        !
        real :: dotp, dseps, dsle, dx, dxdd, dxds, dxte, dy, dydd, dyds, dyte, res, ress, xchord, xle, xte, &
                & ychord, yle, yte
        integer :: i, iter
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !------------------------------------------------------
        !     Locates leading edge spline-parameter value SLE
        !
        !     The defining condition is
        !
        !      (X-XTE,Y-YTE) . (X',Y') = 0     at  S = SLE
        !
        !     i.e. the surface tangent is normal to the chord
        !     line connecting X(SLE),Y(SLE) and the TE point.
        !------------------------------------------------------
        !
        !---- convergence tolerance
        dseps = (S(N) - S(1)) * 1.0E-5
        !
        !---- set trailing edge point coordinates
        xte = 0.5 * (X(1) + X(N))
        yte = 0.5 * (Y(1) + Y(N))
        !
        !---- get first guess for SLE
        do i = 3, N - 2
            dxte = X(i) - xte
            dyte = Y(i) - yte
            dx = X(i + 1) - X(i)
            dy = Y(i + 1) - Y(i)
            dotp = dxte * dx + dyte * dy
            if (dotp<0.0) exit
        enddo
        !
        Sle = S(i)
        !
        !---- check for sharp LE case
        !cc        WRITE(*,*) 'Sharp LE found at ',I,SLE
        if (S(i)==S(i - 1)) return
        !
        !---- Newton iteration to get exact SLE value
        do iter = 1, 50
            xle = seval(Sle, X, Xp, S, N)
            yle = seval(Sle, Y, Yp, S, N)
            dxds = deval(Sle, X, Xp, S, N)
            dyds = deval(Sle, Y, Yp, S, N)
            dxdd = d2val(Sle, X, Xp, S, N)
            dydd = d2val(Sle, Y, Yp, S, N)
            !
            xchord = xle - xte
            ychord = yle - yte
            !
            !------ drive dot product between chord line and LE tangent to zero
            res = xchord * dxds + ychord * dyds
            ress = dxds * dxds + dyds * dyds + xchord * dxdd + ychord * dydd
            !
            !------ Newton delta for SLE
            dsle = -res / ress
            !
            dsle = max(dsle, -0.02 * abs(xchord + ychord))
            dsle = min(dsle, 0.02 * abs(xchord + ychord))
            Sle = Sle + dsle
            if (abs(dsle)<dseps) return
        enddo
        if (show_output) write (*, *) 'LEFIND:  LE point not found.  Continuing...'
        Sle = S(i)
    end subroutine lefind
    !*==SOPPS.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019

    subroutine sopps(Sopp, Si, X, Xp, Y, Yp, S, N, Sle)
        use i_xfoil, only: show_output
        use m_spline, only: seval, deval
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        integer :: N
        real :: Si, Sle, Sopp
        real, dimension(*) :: S, X, Xp, Y, Yp
        intent (in) N, S, Si, Sle, X, Xp, Y, Yp
        intent (inout) Sopp
        !
        ! Local variables
        !
        real :: chord, dsopp, dxc, dyc, res, resd, sfrac, slen, xbar, xi, xle, xopp, xoppd, xte, yi, yle, &
                & yopp, yoppd, yte
        integer :: in, inopp, iter
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !--------------------------------------------------
        !     Calculates arc length SOPP of point
        !     which is opposite of point SI, on the
        !     other side of the airfoil baseline
        !--------------------------------------------------
        !
        !---- reference length for testing convergence
        slen = S(N) - S(1)
        !
        !---- set chordline vector
        xle = seval(Sle, X, Xp, S, N)
        yle = seval(Sle, Y, Yp, S, N)
        xte = 0.5 * (X(1) + X(N))
        yte = 0.5 * (Y(1) + Y(N))
        chord = sqrt((xte - xle)**2 + (yte - yle)**2)
        dxc = (xte - xle) / chord
        dyc = (yte - yle) / chord
        !
        if (Si<Sle) then
            in = 1
            inopp = N
        else
            in = N
            inopp = 1
        endif
        sfrac = (Si - Sle) / (S(in) - Sle)
        Sopp = Sle + sfrac * (S(inopp) - Sle)
        !
        if (abs(sfrac)<=1.0E-5) then
            Sopp = Sle
            return
        endif
        !
        !---- XBAR = x coordinate in chord-line axes
        xi = seval(Si, X, Xp, S, N)
        yi = seval(Si, Y, Yp, S, N)
        xle = seval(Sle, X, Xp, S, N)
        yle = seval(Sle, Y, Yp, S, N)
        xbar = (xi - xle) * dxc + (yi - yle) * dyc
        !
        !---- converge on exact opposite point with same XBAR value
        do iter = 1, 12
            xopp = seval(Sopp, X, Xp, S, N)
            yopp = seval(Sopp, Y, Yp, S, N)
            xoppd = deval(Sopp, X, Xp, S, N)
            yoppd = deval(Sopp, Y, Yp, S, N)
            !
            res = (xopp - xle) * dxc + (yopp - yle) * dyc - xbar
            resd = xoppd * dxc + yoppd * dyc
            !
            if (abs(res) / slen<1.0E-5) goto 99999
            if (resd==0.0) exit
            !
            dsopp = -res / resd
            Sopp = Sopp + dsopp
            !
            if (abs(dsopp) / slen<1.0E-5) goto 99999
        enddo
        if (show_output) write (*, *) 'SOPPS: Opposite-point location failed. Continuing...'
        Sopp = Sle + sfrac * (S(inopp) - Sle)
        !
    99999 end subroutine sopps
    !*==NORM.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! SOPPS

    subroutine norm(X, Xp, Y, Yp, S, N)
        use m_spline, only: seval, segspl, scalc
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        integer :: N
        real, dimension(*) :: S, X, Xp, Y, Yp
        intent (inout) S, X, Y
        !
        ! Local variables
        !
        real :: fudge, sle, xmax, xmin, ymin
        integer :: i
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !-----------------------------------------------
        !     Scales coordinates to get unit chord
        !-----------------------------------------------
        !
        call scalc(X, Y, S, N)
        call segspl(X, Xp, S, N)
        call segspl(Y, Yp, S, N)
        !
        call lefind(sle, X, Xp, Y, Yp, S, N)
        !
        xmax = 0.5 * (X(1) + X(N))
        xmin = seval(sle, X, Xp, S, N)
        ymin = seval(sle, Y, Yp, S, N)
        !
        fudge = 1.0 / (xmax - xmin)
        do i = 1, N
            X(i) = (X(i) - xmin) * fudge
            Y(i) = (Y(i) - ymin) * fudge
            S(i) = S(i) * fudge
        enddo
        !
    end subroutine norm
    !*==GEOPAR.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019

    subroutine geopar(X, Xp, Y, Yp, S, N, T, &
            Sle, Chord, Area, Radle, Angte, Ei11a, Ei22a, Apx1a, Apx2a, Ei11t, Ei22t, Apx1t, Apx2t, Thick, &
            & Cambr)
        use i_xfoil, only: show_output
        use m_spline, only: curv, seval
        use m_xutils, only: atanc
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! PARAMETER definitions
        !
        integer, parameter :: IBX = 600
        !
        ! Dummy arguments
        !
        real :: Angte, Apx1a, Apx1t, Apx2a, Apx2t, Area, Cambr, Chord, Ei11a, Ei11t, Ei22a, Ei22t, Radle, Sle, &
                & Thick
        integer :: N
        real, dimension(*) :: S, T, X, Xp, Y, Yp
        intent (out) Angte, Chord, Radle
        !
        ! Local variables
        !
        real :: ang1, ang2, chsq, curvle, slen, xcambr, xcena, xcent, xle, xte, xthick, ycena, ycent, yle, yte
        integer :: i
        real, dimension(2 * IBX) :: xcam, xthk, ycam, ycamp, ythk, ythkp
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! PARAMETER definitions
        !
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !------------------------------------------------------
        !     Sets geometric parameters for airfoil shape
        !------------------------------------------------------
        call lefind(Sle, X, Xp, Y, Yp, S, N)
        !
        xle = seval(Sle, X, Xp, S, N)
        yle = seval(Sle, Y, Yp, S, N)
        xte = 0.5 * (X(1) + X(N))
        yte = 0.5 * (Y(1) + Y(N))
        !
        chsq = (xte - xle)**2 + (yte - yle)**2
        Chord = sqrt(chsq)
        !
        curvle = curv(Sle, X, Xp, Y, Yp, S, N)
        !
        Radle = 0.0
        if (abs(curvle)>0.001 * (S(N) - S(1))) Radle = 1.0 / curvle
        !
        ang1 = atan2(-Yp(1), -Xp(1))
        ang2 = atanc(Yp(N), Xp(N), ang1)
        Angte = ang2 - ang1
        !

        do i = 1, N
            T(i) = 1.0
        enddo
        !
        call aecalc(N, X, Y, T, 1, Area, xcena, ycena, Ei11a, Ei22a, Apx1a, Apx2a)
        !
        call aecalc(N, X, Y, T, 2, slen, xcent, ycent, Ei11t, Ei22t, Apx1t, Apx2t)
        !
        !--- Old, approximate thickness,camber routine (on discrete points only)
        call tccalc(X, Xp, Y, Yp, S, N, Thick, xthick, Cambr, xcambr)
        !
        !--- More accurate thickness and camber estimates
        !c      CALL GETCAM(XCAM,YCAM,NCAM,XTHK,YTHK,NTHK,
        !c     &            X,XP,Y,YP,S,N )
        !c      CALL GETMAX(XCAM,YCAM,YCAMP,NCAM,XCAMBR,CAMBR)
        !c      CALL GETMAX(XTHK,YTHK,YTHKP,NTHK,XTHICK,THICK)
        !c      THICK = 2.0*THICK
        !
        if (show_output) write (*, 99001) Thick, xthick, Cambr, xcambr
        99001 format (' Max thickness = ', f12.6, '  at x = ', f7.3, /' Max camber    = ', f12.6, '  at x = ', f7.3)

        !
    end subroutine geopar
    !*==AECALC.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! GEOPAR

    subroutine aecalc(N, X, Y, T, Itype, Area, Xcen, Ycen, Ei11, Ei22, Apx1, Apx2)
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        real :: Apx1, Apx2, Area, Ei11, Ei22, Xcen, Ycen
        integer :: Itype, N
        real, dimension(*) :: T, X, Y
        intent (in) Itype, N, T, X, Y
        intent (out) Area
        intent (inout) Apx1, Apx2, Ei11, Ei22, Xcen, Ycen
        !
        ! Local variables
        !
        real :: aint, c1, c2, da, ds, dx, dy, eisq, eixx, eixy, eiyy, s1, s2, sgn, sint, ta, xa, xint, &
                & xxint, xyint, ya, yint, yyint
        integer :: io, ip
        real, save :: pi
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !---------------------------------------------------------------
        !     Calculates geometric properties of shape X,Y
        !
        !     Input:
        !       N      number of points
        !       X(.)   shape coordinate point arrays
        !       Y(.)
        !       T(.)   skin-thickness array, used only if ITYPE = 2
        !       ITYPE  = 1 ...   integration is over whole area  dx dy
        !              = 2 ...   integration is over skin  area   t ds
        !
        !     Output:
        !       XCEN,YCEN  centroid location
        !       EI11,EI22  principal moments of inertia
        !       APX1,APX2  principal-axis angles
        !---------------------------------------------------------------
        data pi/3.141592653589793238/
        !
        sint = 0.0
        aint = 0.0
        xint = 0.0
        yint = 0.0
        xxint = 0.0
        xyint = 0.0
        yyint = 0.0
        !
        do io = 1, N
            if (io==N) then
                ip = 1
            else
                ip = io + 1
            endif
            !
            dx = X(io) - X(ip)
            dy = Y(io) - Y(ip)
            xa = (X(io) + X(ip)) * 0.50
            ya = (Y(io) + Y(ip)) * 0.50
            ta = (T(io) + T(ip)) * 0.50
            !
            ds = sqrt(dx * dx + dy * dy)
            sint = sint + ds

            if (Itype==1) then
                !-------- integrate over airfoil cross-section
                da = ya * dx
                aint = aint + da
                xint = xint + xa * da
                yint = yint + ya * da / 2.0
                xxint = xxint + xa * xa * da
                xyint = xyint + xa * ya * da / 2.0
                yyint = yyint + ya * ya * da / 3.0
            else
                !-------- integrate over skin thickness
                da = ta * ds
                aint = aint + da
                xint = xint + xa * da
                yint = yint + ya * da
                xxint = xxint + xa * xa * da
                xyint = xyint + xa * ya * da
                yyint = yyint + ya * ya * da
            endif
            !
        enddo
        !
        Area = aint
        !
        if (aint==0.0) then
            Xcen = 0.0
            Ycen = 0.0
            Ei11 = 0.0
            Ei22 = 0.0
            Apx1 = 0.0
            Apx2 = atan2(1.0, 0.0)
            return
        endif
        !
        !
        !---- calculate centroid location
        Xcen = xint / aint
        Ycen = yint / aint
        !
        !---- calculate inertias
        eixx = yyint - Ycen * Ycen * aint
        eixy = xyint - Xcen * Ycen * aint
        eiyy = xxint - Xcen * Xcen * aint
        !
        !---- set principal-axis inertias, EI11 is closest to "up-down" bending inertia
        eisq = 0.25 * (eixx - eiyy)**2 + eixy**2
        sgn = sign(1.0, eiyy - eixx)
        Ei11 = 0.5 * (eixx + eiyy) - sgn * sqrt(eisq)
        Ei22 = 0.5 * (eixx + eiyy) + sgn * sqrt(eisq)
        !
        if (Ei11==0.0 .or. Ei22==0.0) then
            !----- vanishing section stiffness
            Apx1 = 0.0
            Apx2 = atan2(1.0, 0.0)
            !
        elseif (eisq / (Ei11 * Ei22)<(0.001 * sint)**4) then
            !----- rotationally-invariant section (circle, square, etc.)
            Apx1 = 0.0
            Apx2 = atan2(1.0, 0.0)
            !
        else
            !----- normal airfoil section
            c1 = eixy
            s1 = eixx - Ei11
            !
            c2 = eixy
            s2 = eixx - Ei22
            !
            if (abs(s1)>abs(s2)) then
                Apx1 = atan2(s1, c1)
                Apx2 = Apx1 + 0.5 * pi
            else
                Apx2 = atan2(s2, c2)
                Apx1 = Apx2 - 0.5 * pi
            endif

            if (Apx1<-0.5 * pi) Apx1 = Apx1 + pi
            if (Apx1>+0.5 * pi) Apx1 = Apx1 - pi
            if (Apx2<-0.5 * pi) Apx2 = Apx2 + pi
            if (Apx2>+0.5 * pi) Apx2 = Apx2 - pi
            !
        endif
        !
    end subroutine aecalc
    !*==TCCALC.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! AECALC

    subroutine tccalc(X, Xp, Y, Yp, S, N, Thick, Xthick, Cambr, Xcambr)
        use m_spline, only: seval
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        real :: Cambr, Thick, Xcambr, Xthick
        integer :: N
        real, dimension(*) :: S, X, Xp, Y, Yp
        intent (out) Xcambr, Xthick
        intent (inout) Cambr, Thick
        !
        ! Local variables
        !
        real :: chord, dxc, dyc, sle, sopp, xbar, xle, xopp, xte, ybar, ybarop, yc, yle, yopp, yt, yte
        integer :: i
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !---------------------------------------------------------------
        !     Calculates max thickness and camber at airfoil points
        !
        !     Note: this routine does not find the maximum camber or
        !           thickness exactly as it only looks at discrete points
        !
        !     Input:
        !       N      number of points
        !       X(.)   shape coordinate point arrays
        !       Y(.)
        !
        !     Output:
        !       THICK  max thickness
        !       CAMBR  max camber
        !---------------------------------------------------------------
        call lefind(sle, X, Xp, Y, Yp, S, N)
        xle = seval(sle, X, Xp, S, N)
        yle = seval(sle, Y, Yp, S, N)
        xte = 0.5 * (X(1) + X(N))
        yte = 0.5 * (Y(1) + Y(N))
        chord = sqrt((xte - xle)**2 + (yte - yle)**2)
        !
        !---- set unit chord-line vector
        dxc = (xte - xle) / chord
        dyc = (yte - yle) / chord
        !
        Thick = 0.
        Xthick = 0.
        Cambr = 0.
        Xcambr = 0.
        !
        !---- go over each point, finding the y-thickness and camber
        do i = 1, N
            xbar = (X(i) - xle) * dxc + (Y(i) - yle) * dyc
            ybar = (Y(i) - yle) * dxc - (X(i) - xle) * dyc
            !
            !------ set point on the opposite side with the same chord x value
            call sopps(sopp, S(i), X, Xp, Y, Yp, S, N, sle)
            xopp = seval(sopp, X, Xp, S, N)
            yopp = seval(sopp, Y, Yp, S, N)
            !
            ybarop = (yopp - yle) * dxc - (xopp - xle) * dyc
            !
            yc = 0.5 * (ybar + ybarop)
            yt = abs(ybar - ybarop)
            !
            if (abs(yc)>abs(Cambr)) then
                Cambr = yc
                Xcambr = xopp
            endif
            if (abs(yt)>abs(Thick)) then
                Thick = yt
                Xthick = xopp
            endif
        enddo
        !
    end subroutine tccalc
    !*==CANG.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! TCCALC

    subroutine cang(X, Y, N, Iprint, Imax, Amax)
        use i_xfoil, only: show_output
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        real :: Amax
        integer :: Imax, Iprint, N
        real, dimension(*) :: X, Y
        intent (in) Iprint, N, X, Y
        intent (inout) Amax, Imax
        !
        ! Local variables
        !
        real :: angl, crossp, dx1, dx2, dy1, dy2
        integer :: i
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !-------------------------------------------------------------------
        !     IPRINT=2:   Displays all panel node corner angles
        !     IPRINT=1:   Displays max panel node corner angle
        !     IPRINT=0:   No display... just returns values
        !-------------------------------------------------------------------
        !
        Amax = 0.0
        Imax = 1
        !
        !---- go over each point, calculating corner angle
        if (Iprint==2 .and. show_output) write (*, 99001)
        !
        99001 format (/'  i       x        y      angle')
        do i = 2, N - 1
            dx1 = X(i) - X(i - 1)
            dy1 = Y(i) - Y(i - 1)
            dx2 = X(i) - X(i + 1)
            dy2 = Y(i) - Y(i + 1)
            !
            !------ allow for doubled points
            if (dx1==0.0 .and. dy1==0.0) then
                dx1 = X(i) - X(i - 2)
                dy1 = Y(i) - Y(i - 2)
            endif
            if (dx2==0.0 .and. dy2==0.0) then
                dx2 = X(i) - X(i + 2)
                dy2 = Y(i) - Y(i + 2)
            endif
            !
            crossp = (dx2 * dy1 - dy2 * dx1) / sqrt((dx1**2 + dy1**2) * (dx2**2 + dy2**2))
            angl = asin(crossp) * (180.0 / 3.1415926)
            if (Iprint==2 .and. show_output) write (*, 99002) i, X(i), Y(i), angl
            !CC             120   0.2134  -0.0234   25.322
            99002 format (1x, i3, 2F9.4, f9.3)
            if (abs(angl)>abs(Amax)) then
                Amax = angl
                Imax = i
            endif
        enddo
        !
        if (Iprint>=1 .and. show_output) write (*, 99003) Amax, Imax, X(Imax), Y(Imax)
        99003 format (/' Maximum panel corner angle =', f7.3, '   at  i,x,y  = ', i3, 2F9.4)
        !
    end subroutine cang
    !*==INTER.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! CANG

    subroutine inter(X0, Xp0, Y0, Yp0, S0, N0, Sle0, X1, Xp1, Y1, Yp1, S1, N1, Sle1, X, Y, N, Frac)
        use m_spline, only: seval
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        real :: Frac, Sle0, Sle1
        integer :: N, N0, N1
        real, dimension(N0) :: S0, X0, Xp0, Y0, Yp0
        real, dimension(N1) :: S1, X1, Xp1, Y1, Yp1
        real, dimension(*) :: X, Y
        intent (in) Frac, N0, N1, S0, S1, Sle0, Sle1, X0, X1, Xp0, Xp1, Y0, Y1, Yp0, Yp1
        intent (out) X, Y
        intent (inout) N
        !
        ! Local variables
        !
        real :: bots0, bots1, f0, f1, sn, st0, st1, tops0, tops1, xt0, xt1, yt0, yt1
        integer :: i
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !     .....................................................................
        !
        !     Interpolates two source airfoil shapes into an "intermediate" shape.
        !
        !     Procedure:
        !        The interpolated x coordinate at a given normalized spline
        !        parameter value is a weighted average of the two source
        !        x coordinates at the same normalized spline parameter value.
        !        Ditto for the y coordinates. The normalized spline parameter
        !        runs from 0 at the leading edge to 1 at the trailing edge on
        !        each surface.
        !     .....................................................................
        !
        !
        !---- number of points in interpolated airfoil is the same as in airfoil 0
        N = N0
        !
        !---- interpolation weighting fractions
        f0 = 1.0 - Frac
        f1 = Frac
        !
        !---- top side spline parameter increments
        tops0 = S0(1) - Sle0
        tops1 = S1(1) - Sle1
        !
        !---- bottom side spline parameter increments
        bots0 = S0(N0) - Sle0
        bots1 = S1(N1) - Sle1
        !
        do i = 1, N
            !
            !------ normalized spline parameter is taken from airfoil 0 value
            if (S0(i)<Sle0) sn = (S0(i) - Sle0) / tops0             ! top side
            if (S0(i)>=Sle0) sn = (S0(i) - Sle0) / bots0            ! bottom side
            !
            !------ set actual spline parameters
            st0 = S0(i)
            if (st0<Sle0) st1 = Sle1 + tops1 * sn
            if (st0>=Sle0) st1 = Sle1 + bots1 * sn
            !
            !------ set input coordinates at common spline parameter location
            xt0 = seval(st0, X0, Xp0, S0, N0)
            yt0 = seval(st0, Y0, Yp0, S0, N0)
            xt1 = seval(st1, X1, Xp1, S1, N1)
            yt1 = seval(st1, Y1, Yp1, S1, N1)
            !
            !------ set interpolated x,y coordinates
            X(i) = f0 * xt0 + f1 * xt1
            Y(i) = f0 * yt0 + f1 * yt1
            !
        enddo
        !
    end subroutine inter
    !*==INTERX.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! INTER

    subroutine interx(X0, Xp0, Y0, Yp0, S0, N0, Sle0, X1, Xp1, Y1, Yp1, S1, N1, Sle1, X, Y, N, Frac)
        use m_spline, only: seval, sinvrt
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        real :: Frac, Sle0, Sle1
        integer :: N, N0, N1
        real, dimension(N0) :: S0, X0, Xp0, Y0, Yp0
        real, dimension(N1) :: S1, X1, Xp1, Y1, Yp1
        real, dimension(N) :: X, Y
        intent (in) Frac, Sle0, Sle1, Y0, Y1, Yp0, Yp1
        intent (out) X, Y
        intent (inout) N
        !
        ! Local variables
        !
        real :: f0, f1, st0, st1, xle0, xle1, xn, xt0, xt1, yt0, yt1
        integer :: i
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !     .....................................................................
        !
        !     Interpolates two source airfoil shapes into an "intermediate" shape.
        !
        !     Procedure:
        !        The interpolated x coordinate at a given normalized spline
        !        parameter value is a weighted average of the two source
        !        x coordinates at the same normalized spline parameter value.
        !        Ditto for the y coordinates. The normalized spline parameter
        !        runs from 0 at the leading edge to 1 at the trailing edge on
        !        each surface.
        !     .....................................................................
        !
        !
        !---- number of points in interpolated airfoil is the same as in airfoil 0
        N = N0
        !
        !---- interpolation weighting fractions
        f0 = 1.0 - Frac
        f1 = Frac
        !
        xle0 = seval(Sle0, X0, Xp0, S0, N0)
        xle1 = seval(Sle1, X1, Xp1, S1, N1)
        !
        do i = 1, N
            !
            !------ normalized x parameter is taken from airfoil 0 value
            if (S0(i)<Sle0) xn = (X0(i) - xle0) / (X0(1) - xle0)
            if (S0(i)>=Sle0) xn = (X0(i) - xle0) / (X0(N0) - xle0)
            !
            !------ set target x and initial spline parameters
            xt0 = X0(i)
            st0 = S0(i)
            if (st0<Sle0) then
                xt1 = xle1 + (X1(1) - xle1) * xn
                st1 = Sle1 + (S1(1) - Sle1) * xn
            else
                xt1 = xle1 + (X1(N1) - xle1) * xn
                st1 = Sle1 + (S1(N1) - Sle1) * xn
            endif
            !
            call sinvrt(st0, xt0, X0, Xp0, S0, N0)
            call sinvrt(st1, xt1, X1, Xp1, S1, N1)
            !
            !------ set input coordinates at common spline parameter location
            xt0 = seval(st0, X0, Xp0, S0, N0)
            yt0 = seval(st0, Y0, Yp0, S0, N0)
            xt1 = seval(st1, X1, Xp1, S1, N1)
            yt1 = seval(st1, Y1, Yp1, S1, N1)
            !
            !------ set interpolated x,y coordinates
            X(i) = f0 * xt0 + f1 * xt1
            Y(i) = f0 * yt0 + f1 * yt1
            !
        enddo
        !
    end subroutine interx
    !*==BENDUMP.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! INTERX

    subroutine bendump(N, X, Y)
        use i_xfoil, only: show_output
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        integer :: N
        real, dimension(*) :: X, Y
        !
        ! Local variables
        !
        real :: aixx, aixxt, aiyy, aiyyt, aj, ajt, area, pex, slen, xbar, xbart, xc, xct, xexint, xmax, xmin, &
                & ybar, ybart, yc, yct, yexint, ymax, ymin
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        pex = 16.0
        call ijsect(N, X, Y, pex, area, slen, &
                xmin, xmax, xexint, ymin, ymax, yexint, xc, yc, xct, yct, aixx, aiyy, aixxt, aiyyt, aj, ajt)
        !      CALL IJSECT(N,X,Y, PEX,
        !     &    AREA, SLEN,
        !     &    XC, XMIN, XMAX, XEXINT,
        !     &    YC, YMIN, YMAX, YEXINT,
        !     &    AIXX, AIXXT,
        !     &    AIYY, AIYYT,
        !     &    AJ  , AJT   )
        !
        if (show_output) then
            write (*, *)
            write (*, 99001) 'Area =', area
            write (*, 99001) 'Slen =', slen
            write (*, *)
            write (*, 99001) 'X-bending parameters(solid):'
            write (*, 99001) '        Xc =', xc
            write (*, 99001) '  max X-Xc =', xmax - xc
            write (*, 99001) '  min X-Xc =', xmin - xc
            write (*, 99001) '       Iyy =', aiyy
        endif
        xbar = max(abs(xmax - xc), abs(xmin - xc))
        if (show_output) then
            write (*, 99001) ' Iyy/(X-Xc)=', aiyy / xbar
            write (*, *)
            write (*, 99001) 'Y-bending parameters(solid):'
            write (*, 99001) '        Yc =', yc
            write (*, 99001) '  max Y-Yc =', ymax - yc
            write (*, 99001) '  min Y-Yc =', ymin - yc
            write (*, 99001) '       Ixx =', aixx
        endif
        ybar = max(abs(ymax - yc), abs(ymin - yc))
        if (show_output) then
            write (*, 99001) ' Ixx/(Y-Yc)=', aixx / ybar
            write (*, *)
            write (*, 99001) '       J   =', aj
            !
            write (*, *)
            write (*, *)
            write (*, 99001) 'X-bending parameters(skin):'
            write (*, 99001) '         Xc =', xct
            write (*, 99001) '   max X-Xc =', xmax - xct
            write (*, 99001) '   min X-Xc =', xmin - xct
            write (*, 99001) '      Iyy/t =', aiyyt
        endif
        xbart = max(abs(xmax - xct), abs(xmin - xct))
        if (show_output) then
            write (*, 99001) ' Iyy/t(X-Xc)=', aiyyt / xbart
            write (*, *)
            write (*, 99001) 'Y-bending parameters(skin):'
            write (*, 99001) '         Yc =', yct
            write (*, 99001) '   max Y-Yc =', ymax - yct
            write (*, 99001) '   min Y-Yc =', ymin - yct
            write (*, 99001) '      Ixx/t =', aixxt
        endif
        ybart = max(abs(ymax - yct), abs(ymin - yct))
        if (show_output) then
            write (*, 99001) ' Ixx/t(Y-Yc)=', aixxt / ybart
            write (*, *)
            write (*, 99001) '      J/t   =', ajt
        endif
        !
        !      WRITE(*,*)
        !      WRITE(*,1200) '  power-avg X-Xc =', XEXINT
        !      WRITE(*,1200) '  power-avg Y-Yc =', YEXINT
        !
        return
        !
        99001 format (1x, a, g14.6)
    end subroutine bendump
    !*==BENDUMP2.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! BENDUMP

    subroutine bendump2(N, X, Y, T)
        use i_xfoil, only: show_output
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        integer :: N
        real, dimension(*) :: T, X, Y
        !
        ! Local variables
        !
        real :: aixx, aixxt, aiyy, aiyyt, aj, ajt, apx1a, apx1t, apx2a, apx2t, area, dtr, ei11a, ei11t, ei22a, &
                & ei22t, pex, slen, xbara, xbart, xc, xcena, xcent, xct, xexint, xmax, xmin, ybara, ybart, yc, &
                & ycena, ycent, yct, yexint, ymax, ymin
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        dtr = atan(1.0) / 45.0
        !
        pex = 16.0
        call ijsect(N, X, Y, pex, area, slen, &
                xmin, xmax, xexint, ymin, ymax, yexint, xc, yc, xct, yct, aixx, aiyy, aixxt, aiyyt, aj, ajt)
        !      CALL IJSECT(N,X,Y, PEX,
        !     &    AREA, SLEN,
        !     &    XC, XMIN, XMAX, XEXINT,
        !     &    YC, YMIN, YMAX, YEXINT,
        !     &    AIXX, AIXXT,
        !     &    AIYY, AIYYT,
        !     &    AJ  , AJT   )
        !
        !
        call aecalc(N, X, Y, T, 1, area, xcena, ycena, ei11a, ei22a, apx1a, apx2a)
        !
        call aecalc(N, X, Y, T, 2, slen, xcent, ycent, ei11t, ei22t, apx1t, apx2t)
        !

        if (show_output) then
            write (*, *)
            write (*, 99001) 'Area =', area
            write (*, 99001) 'Slen =', slen
            write (*, *)
            write (*, 99001) 'X-bending parameters:'
            write (*, 99001) 'solid centroid Xc=', xcena
            write (*, 99001) 'skin  centroid Xc=', xcent
            write (*, 99001) ' solid max X-Xc  =', xmax - xcena
            write (*, 99001) ' solid min X-Xc  =', xmin - xcena
            write (*, 99001) ' skin  max X-Xc  =', xmax - xcent
            write (*, 99001) ' skin  min X-Xc  =', xmin - xcent
            write (*, 99001) '     solid Iyy   =', ei22a
            write (*, 99001) '     skin  Iyy/t =', ei22t
        endif
        xbara = max(abs(xmax - xcena), abs(xmin - xcena))
        xbart = max(abs(xmax - xcent), abs(xmin - xcent))
        if (show_output) then
            write (*, 99001) ' solid Iyy/(X-Xc)=', ei22a / xbara
            write (*, 99001) ' skin Iyy/t(X-Xc)=', ei22t / xbart
            !
            write (*, *)
            write (*, 99001) 'Y-bending parameters:'
            write (*, 99001) 'solid centroid Yc=', ycena
            write (*, 99001) 'skin  centroid Yc=', ycent
            write (*, 99001) ' solid max Y-Yc  =', ymax - ycena
            write (*, 99001) ' solid min Y-Yc  =', ymin - ycena
            write (*, 99001) ' skin  max Y-Yc  =', ymax - ycent
            write (*, 99001) ' skin  min Y-Yc  =', ymin - ycent
            write (*, 99001) '     solid Ixx   =', ei11a
            write (*, 99001) '     skin  Ixx/t =', ei11t
        endif
        ybara = max(abs(ymax - ycena), abs(ymin - ycena))
        ybart = max(abs(ymax - ycent), abs(ymin - ycent))
        if (show_output) then
            write (*, 99001) ' solid Ixx/(Y-Yc)=', ei11a / ybara
            write (*, 99001) ' skin Ixx/t(Y-Yc)=', ei11t / ybart
            !
            write (*, *)
            write (*, 99001) ' solid principal axis angle (deg ccw) =', apx1a / dtr
            write (*, 99001) ' skin  principal axis angle (deg ccw) =', apx1t / dtr
        endif

        !      WRITE(*,*)
        !      WRITE(*,1200) '  power-avg X-Xc =', XEXINT
        !      WRITE(*,1200) '  power-avg Y-Yc =', YEXINT
        !
        if (show_output) then
            write (*, *)
            write (*, 99001) '    solid J     =', aj
            write (*, 99001) '    skin  J/t   =', ajt
        endif
        return
        !
        99001 format (1x, a, g14.6)
    end subroutine bendump2
    !*==IJSECT.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! BENDUMP2

    subroutine ijsect(N, X, Y, Pex, Area, Slen, &
            Xmin, Xmax, Xexint, Ymin, Ymax, Yexint, Xc, Yc, Xct, Yct, Aixx, Aiyy, Aixxt, Aiyyt, Aj, Ajt)
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        real :: Aixx, Aixxt, Aiyy, Aiyyt, Aj, Ajt, Area, Pex, Slen, Xc, Xct, Xexint, Xmax, Xmin, Yc, Yct, &
                & Yexint, Ymax, Ymin
        integer :: N
        real, dimension(*) :: X, Y
        intent (in) N, X, Y
        intent (out) Aixx, Aixxt, Aiyy, Aiyyt, Ajt
        intent (inout) Aj, Area, Slen, Xc, Xct, Xmax, Xmin, Yc, Yct, Ymax, Ymin
        !
        ! Local variables
        !
        real :: c_ds, ds, dx, dy, frac, sint, xavg, xint, xxx_dy, xx_ds, xx_dy, x_ds, x_dy, yavg, yint, yopp, &
                & yyy_dx, yy_ds, yy_dx, y_ds, y_dx
        integer :: i, imid, j
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        Xmin = X(1)
        Xmax = X(1)
        Ymin = Y(1)
        Ymax = Y(1)
        !
        dx = X(1) - X(N)
        dy = Y(1) - Y(N)
        ds = sqrt(dx * dx + dy * dy)
        xavg = 0.5 * (X(1) + X(N))
        yavg = 0.5 * (Y(1) + Y(N))
        !
        x_dy = dy * xavg
        xx_dy = dy * xavg**2
        xxx_dy = dy * xavg**3
        x_ds = ds * xavg
        xx_ds = ds * xavg**2
        !
        y_dx = dx * yavg
        yy_dx = dx * yavg**2
        yyy_dx = dx * yavg**3
        y_ds = ds * yavg
        yy_ds = ds * yavg**2
        !
        c_ds = ds
        !
        do i = 2, N
            dx = X(i) - X(i - 1)
            dy = Y(i) - Y(i - 1)
            ds = sqrt(dx * dx + dy * dy)
            xavg = 0.5 * (X(i) + X(i - 1))
            yavg = 0.5 * (Y(i) + Y(i - 1))
            !
            x_dy = x_dy + dy * xavg
            xx_dy = xx_dy + dy * xavg**2
            xxx_dy = xxx_dy + dy * xavg**3
            x_ds = x_ds + ds * xavg
            xx_ds = xx_ds + ds * xavg**2
            !
            y_dx = y_dx + dx * yavg
            yy_dx = yy_dx + dx * yavg**2
            yyy_dx = yyy_dx + dx * yavg**3
            y_ds = y_ds + ds * yavg
            yy_ds = yy_ds + ds * yavg**2
            !
            c_ds = c_ds + ds
            !
            Xmin = min(Xmin, X(i))
            Xmax = max(Xmax, X(i))
            Ymin = min(Ymin, Y(i))
            Ymax = max(Ymax, Y(i))
        enddo
        !
        Area = -y_dx
        Slen = c_ds
        !
        if (Area==0.0) return
        !
        Xc = xx_dy / (2.0 * x_dy)
        Xct = x_ds / c_ds
        Aiyy = xxx_dy / 3.0 - xx_dy * Xc + x_dy * Xc**2
        Aiyyt = xx_ds - x_ds * Xct * 2.0 + c_ds * Xct**2
        !
        Yc = yy_dx / (2.0 * y_dx)
        Yct = y_ds / c_ds
        Aixx = -yyy_dx / 3.0 + yy_dx * Yc - y_dx * Yc**2
        Aixxt = yy_ds - y_ds * Yct * 2.0 + c_ds * Yct**2
        !
        !
        sint = 0.
        xint = 0.
        yint = 0.
        !
        do i = 2, N
            dx = X(i) - X(i - 1)
            dy = Y(i) - Y(i - 1)
            ds = sqrt(dx * dx + dy * dy)
            xavg = 0.5 * (X(i) + X(i - 1)) - Xc
            yavg = 0.5 * (Y(i) + Y(i - 1)) - Yc
            !
            sint = sint + ds
            !c        XINT = XINT + DS * ABS(XAVG)**PEX
            !c        YINT = YINT + DS * ABS(YAVG)**PEX
        enddo
        !
        do i = 1, N - 1
            if (X(i + 1)>=X(i)) goto 100
        enddo
        imid = N / 2
        100  imid = i
        !
        Aj = 0.0
        do i = 2, imid
            xavg = 0.5 * (X(i) + X(i - 1))
            yavg = 0.5 * (Y(i) + Y(i - 1))
            dx = X(i - 1) - X(i)
            !
            if (xavg>X(N)) then
                yopp = Y(N)
                goto 150
            endif
            if (xavg<=X(imid)) then
                yopp = Y(imid)
                goto 150
            endif
            !
            do j = N, imid, -1
                if (xavg>X(j - 1) .and. xavg<=X(j)) then
                    frac = (xavg - X(j - 1)) / (X(j) - X(j - 1))
                    yopp = Y(j - 1) + (Y(j) - Y(j - 1)) * frac
                    exit
                endif
            enddo
            !
            150  Aj = Aj + abs(yavg - yopp)**3 * dx / 3.0
        enddo
        !
        Ajt = 4.0 * Area**2 / Slen
        !
        !c      XEXINT = (XINT/SINT)**(1.0/PEX)
        !c      YEXINT = (YINT/SINT)**(1.0/PEX)
        !
    end subroutine ijsect
    !*==HALF.f90  processed by SPAG 7.21DC at 11:25 on 11 Jan 2019
    ! IJSECT

    subroutine half(X, Y, S, N)
        implicit none
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        integer :: N
        real, dimension(*) :: S, X, Y
        intent (in) S
        intent (inout) N, X, Y
        !
        ! Local variables
        !
        integer :: i, inext, k
        !
        !*** End of declarations rewritten by SPAG
        !
        !
        !*** Start of declarations rewritten by SPAG
        !
        ! Dummy arguments
        !
        !
        ! Local variables
        !
        !
        !*** End of declarations rewritten by SPAG
        !
        !-------------------------------------------------
        !     Halves the number of points in airfoil
        !-------------------------------------------------
        !
        k = 1
        inext = 3
        do i = 2, N - 1
            !------ if corner is found, preserve it.
            if (S(i)==S(i + 1)) then
                k = k + 1
                X(k) = X(i)
                Y(k) = Y(i)
                k = k + 1
                X(k) = X(i + 1)
                Y(k) = Y(i + 1)
                inext = i + 3
            endif
            !
            if (i==inext) then
                k = k + 1
                X(k) = X(i)
                Y(k) = Y(i)
                inext = i + 2
            endif
            !
        enddo
        k = k + 1
        X(k) = X(N)
        Y(k) = Y(N)
        !
        !---- set new number of points
        N = k
        !
    end subroutine half

end module m_xgeom