ppf_lib_f.f

read envisat and analyis sar data from NASA

      STATUS =  PL_PRINT_MSG(24,MSG)
      
C*******************************************************
C* Calculate the geodesic (minimum) distance between   *
C* two points that lay on the same ellipsoid           * 
C*                                                     *
C*         LON1_T is the Geocentric longitude of the   *
C*                first point [deg]                    *
C*         LAT1_T is the Geocentric latitude of the    *
C*                first point [deg]                    *
C*         LON2_T is the Geocentric longitude of the   *
C*                second point [deg]                   *
C*         LAT2_T is the Geocentric latitude of the    *
C*                second point [deg]                   *
C*         H_T is the geodetic altitude between both   * 
C*                points [m]                           *
C*         D_T is the geodesic distance [m]            *
C*         AZ1_T is the topocentric azimuth of the     *
C*                 geodesic line between the two       *
C*                 points at point 1 [deg]             *  
C*         AZ2_T is the topocentric azimuth of the     *
C*                 geodesic line between the two       *
C*                 points at point 2 [deg]             *  
C*                                                     *
C*******************************************************
	       
      LON1_T= 4.17
      LAT1_T= 10.0

      LON2_T= 4.17
      LAT2_T= -20.0

      H_T= 0.D0                                            

      N=1
      MSG(N) = "\n\nPL_GEO_DISTANCE\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)
                                            
      EXT_STATUS=PL_GEO_DISTANCE(LON1_T, LAT1_T, LON2_T, LAT2_T, 
     &                       H_T, D_T, AZ1_T, AZ2_T)

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 4
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_GEO_DISTANCE failed'
          ENDIF
      ENDIF

      WRITE(MSG(1),400) 'D_T', D_T, '\0'
      WRITE(MSG(2),400) 'AZ1_T', AZ1_T, '\0'
      WRITE(MSG(3),400) 'AZ2_T', AZ2_T, '\0'
      STATUS =  PL_PRINT_MSG(3,MSG)

      
C**************************************************************/
C* Calling: pl_tmjd,  pl_emjd,  pl_pmjd,  pl_tadd,  pl_tsub   */
C**************************************************************/

      MJDT(1) =  -1
      MJDT(2) =  43200
      MJDT(3) =  0
      MJDT(4) =  -500000

C* From Transport to Processing and External: tmjd  */
C****************************************************/

      N=1
      MSG(N) = "\n\nPL_TMJD\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)
 
      EXT_STATUS = PL_TMJD( MJDT, MJDP, UTCE, DUT1E )

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 5
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_TMJD failed'
          ENDIF
      ENDIF 

      WRITE(MSG(1),400) 'MJDP(1):', MJDP(1), '\0'    
      WRITE(MSG(2),400) 'MJDP(2):', MJDP(2), '\0'    
      WRITE(MSG(3),500) 'UTCE:', UTCE, '\0'
      WRITE(MSG(4),500) 'DUT1E:', DUT1E, '\0'  

      STATUS =  PL_PRINT_MSG(4,MSG)

      
400   FORMAT('-',1X,(A),F30.10,(A))
500   FORMAT('-',1X,(A),A50,(A))

C* From External to Transport and Processing: emjd  */
C****************************************************/
 
      UTCE_2=UTCE
      DUT1E_2=DUT1E

      N=1
      MSG(N) = "\n\nPL_EMJD\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)

      EXT_STATUS = PL_EMJD( MJDT_2, MJDP_2, UTCE_2, DUT1E_2 )

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 6
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_EMJD failed'
          ENDIF
      ENDIF

      WRITE(MSG(1),601) '- MJDT(1)' ,MJDT_2(1), '\0'
      WRITE(MSG(2),601) '- MJDT(2)' ,MJDT_2(2), '\0'
      WRITE(MSG(3),601) '- MJDT(3)' ,MJDT_2(3), '\0'
      WRITE(MSG(4),601) '- MJDT(4)' ,MJDT_2(4), '\0' 
      WRITE(MSG(5),400) '- MJDP(1)' ,MJDP_2(1), '\0'
      WRITE(MSG(6),400) '- MJDP(2)' ,MJDP_2(2), '\0' 

      STATUS =  PL_PRINT_MSG(6,MSG)

601   FORMAT(1X,(A),I15,(A))

C* From Processing to Transport and External: pmjd  */
C****************************************************/
 
      MJDP_3(1) = MJDP(1)
      MJDP_3(2) = MJDP(2)

      N=1
      MSG(N) = "\n\nPL_PMJD\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)
 
      EXT_STATUS = PL_PMJD( MJDT_3, MJDP_3, UTCE_3, DUT1E_3 )

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 7
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_PMJD failed'
          ENDIF
      ENDIF 
 
      WRITE(MSG(1),601) '- MJDT(1)' ,MJDT_3(1), '\0'
      WRITE(MSG(2),601) '- MJDT(2)' ,MJDT_3(2), '\0'
      WRITE(MSG(3),601) '- MJDT(3)' ,MJDT_3(3), '\0'
      WRITE(MSG(4),601) '- MJDT(4)' ,MJDT_3(4), '\0'  
      WRITE(MSG(5),500) '- UTCE' , UTCE_3, '\0'
      WRITE(MSG(6),500) '- DUT1E' , DUT1E_3, '\0'

      STATUS =  PL_PRINT_MSG(6,MSG)
     
C* Adding two Transport Format times: tadd    */
C**********************************************/
 
      MJDT_A1(1) =  1111
      MJDT_A1(2) =  86000
      MJDT_A1(3) =  333333
      MJDT_A1(4) =  4444
 
      MJDT_ADD(1) =  111
      MJDT_ADD(2) =  422
      MJDT_ADD(3) =  800000
      MJDT_ADD(4) =  0

      N=1
      MSG(N) = "\n\nPL_TADD\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)
 
      EXT_STATUS = PL_TADD( MJDT_A1, MJDT_A3, MJDT_ADD )

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 8
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_TADD failed'
          ENDIF
      ENDIF 
      
      WRITE(MSG(1),700) 'MJDT_1',MJDT_A1(1),MJDT_A1(2),MJDT_A1(3)
     &                 ,MJDT_A1(4), '\0'
      WRITE(MSG(2),700) 'MJDT_ADD',MJDT_ADD(1),MJDT_ADD(2),MJDT_ADD(3)
     &                 ,MJDT_ADD(4), '\0'
      WRITE(MSG(3),700) 'MJDT_T',MJDT_A3(1),MJDT_A3(2),MJDT_A3(3)
     &                 ,MJDT_A3(4), '\0'
      STATUS =  PL_PRINT_MSG(3,MSG)


700   FORMAT
     &('-',1X,(A),'(1)',I15,' (2)',I15,' (3)',I15,' (4)',I15,(A)) 

C* Substracting two Transport Format times: tsub  */
C**************************************************/
 
      N=1
      MSG(N) = "\n\nPL_TSUB\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)

      EXT_STATUS = PL_TSUB( MJDT_A3, MJDT_A1, MJDT_SUB )

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 9
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_TSUB failed'
          ENDIF
      ENDIF

      WRITE(MSG(1),700) 'MJDT_T',MJDT_A3(1),MJDT_A3(2),MJDT_A3(3)
     &                 ,MJDT_A3(4), '\0'      
      WRITE(MSG(2),700) 'MJDT_1',MJDT_A1(1),MJDT_A1(2),MJDT_A1(3)
     &                 ,MJDT_A1(4), '\0'
      WRITE(MSG(3),700) 'MJDT_SUB',MJDT_SUB(1),MJDT_SUB(2),MJDT_SUB(3)
     &                 ,MJDT_SUB(4), '\0'
      
      STATUS =  PL_PRINT_MSG(3,MSG)

C************************************************/
C*                                              */
C* Calling: pl_sun and pl_moon                  */
C*                                              */
C*     UT1(1) is UTC time in MJD2000 [days]     */
C*     UT1(2) is Delta UT1 time [s]             */
C*                                              */
C************************************************/

      UT1(1) =  0.D0
      UT1(2) =  DUMMY_D

C************************************************/
C*                                              */
C*   RSUN is Sun position vector in True        */
C*   of Date coordinate system (x,y,z) [m]      */   
C*   RDSUN is Sun velocity vector in True       */
C*   of Date coordinate system (Vx,Vy,Vz) [m]   */ 
C*                                              */
C************************************************/

      N=1
      MSG(N) = "\n\nPL_SUN\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)

      EXT_STATUS = PL_SUN( UT1, RSUN, RDSUN )

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 12
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_SUN failed'
          ENDIF
      ENDIF 
      
      WRITE(MSG(1),400) 'RSUN(1)', RSUN(1), '\0'
      WRITE(MSG(2),400) 'RSUN(2)', RSUN(2), '\0'
      WRITE(MSG(3),400) 'RSUN(3)', RSUN(3), '\0'
      WRITE(MSG(4),400) 'RDSUN(1)', RDSUN(1), '\0'
      WRITE(MSG(5),400) 'RDSUN(2)', RDSUN(2), '\0'
      WRITE(MSG(6),400) 'RDSUN(3)', RDSUN(3), '\0'

      STATUS =  PL_PRINT_MSG(6,MSG)
      
C************************************************/
C*                                              */
C*   RMOON is Moon position vector in True      */
C*   of Date coordinate system (x,y,z) [m]      */   
C*   RDMOON is Moon velocity vector in True     */
C*   of Date coordinate system (Vx,Vy,Vz) [m]   */ 
C*                                              */
C************************************************/

      UT1_2(1)=UT1(1)
      UT1_2(2)=UT1(2) 

      N=1
      MSG(N) = "\n\nPL_MOON\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)

      EXT_STATUS = PL_MOON( UT1, RMOON, RDMOON )

      IF (EXT_STATUS .NE. 0) THEN
          FUNC_ID = 13
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_MOON failed'
          ENDIF
      ENDIF 
          
      WRITE(MSG(1),400) 'RMOON(1)', RMOON(1), '\0'
      WRITE(MSG(2),400) 'RMOON(2)', RMOON(2), '\0'
      WRITE(MSG(3),400) 'RMOON(3)', RMOON(3), '\0'
      WRITE(MSG(4),400) 'RDMOON(1)', RDMOON(1), '\0'
      WRITE(MSG(5),400) 'RDMOON(2)', RDMOON(2), '\0'
      WRITE(MSG(6),400) 'RDMOON(3)', RDMOON(3), '\0'

      STATUS =  PL_PRINT_MSG(6,MSG)
   

C**********************************************************
C* Computing planets position and velocity in the         *
C* Heliocentric Mean of 2000.0 coordinate system: s       *
C*                                                        *
C*     R_PLANET is the planet position vector in          *
C*              Heliocentric Mean of 2000.0 CS            *
C*              (x,y,z) [m]                               *    
C*     R_PLANET is the planet velocity vector in          *
C*              Heliocentric Mean of 2000.0 CS            *
C*              (x,y,z) [m/s]                             *
C*                                                        *  
C**********************************************************
 
      PLANET_ID=2
C**** PLANET_ID=2 means VENUS ************

      N=1
      MSG(N) = "\n\nPL_PLANETS\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG)   

      EXT_STATUS = PL_PLANETS( PLANET_ID, UT1, R_PLANET, RD_PLANET)

      IF( EXT_STATUS.NE.0 ) THEN
          FUNC_ID = 14
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_PLANETS failed'
          ENDIF
      ENDIF 
      
      WRITE(MSG(1),400) 'R_PLANET(1)', R_PLANET(1), '\0'
      WRITE(MSG(2),400) 'R_PLANET(2)', R_PLANET(2), '\0'
      WRITE(MSG(3),400) 'R_PLANET(3)', R_PLANET(3), '\0'
      WRITE(MSG(4),400) 'RD_PLANET(1)', RD_PLANET(1), '\0'
      WRITE(MSG(5),400) 'RD_PLANET(2)', RD_PLANET(2), '\0'
      WRITE(MSG(6),400) 'RD_PLANET(3)', RD_PLANET(3), '\0'

      STATUS =  PL_PRINT_MSG(6,MSG)

C****************************************************************
C*                                                              *
C* Computing star cartesian coordinates: PL_star_radec          *
C*                                                              *
C*    RA0 is the star right ascension in the Barycentric Mean   *
C*        of 2000.0 coordinate system at J2000.0 [rad]          * 
C*    DEC0 is the star declination in the Barycentric Mean      *
C*        of 2000.0 coordinate system at J2000.0 [rad]          *
C*    MU_RA is the star proper motion in the right ascension    *
C*        [rad/century]                                         *
C*    MU_DEC is the star proper motion in the declination       *
C*        [rad/century]                                         *
C*    RAD_VEL is the star radial velocity [au/century]          *
C*    PAR is the star parallax [rad]                            *
C*    RA is the star right ascension in True of Date at UT1     *
C*       [rad]                                                  *
C*    DEC is the star declination in True of Date at UT1 [rad]  *
C*                                                              * 
C****************************************************************
 
      UT1(1) = -200.0
      UT1(2) = 0.0

      RA0   = 3.141592
      DEC0  = 0.D0
      MU_RA = 0.D0
      MU_DEC  = 0.D0
      RAD_VEL = 0.D0
      PAR   = 0.D0

      N=1
      MSG(N) = "\n\nPL_STAR_RADEC\n\0"
      STATUS =  PL_PRINT_MSG(N,MSG) 
 
      EXT_STATUS = PL_STAR_RADEC( UT1, RA0, DEC0, MU_RA, MU_DEC, 
     &                        RAD_VEL, PAR, RA, DEC )

      IF( EXT_STATUS.NE.0 ) THEN
          FUNC_ID = 15
          STATUS = PL_VECTOR_MSG(FUNC_ID, EXT_STATUS, N, MSG)
          STATUS = PL_PRINT_MSG(N, MSG)

          IF (EXT_STATUS.LE. -1) THEN
          STOP 'PL_STAR_RADEC failed'
          ENDIF
      ENDIF 
     
      WRITE(MSG(1),400) 'UT1(1)', UT1(1), '\0'
      WRITE(MSG(2),400) 'RA0', RA0, '\0'
      WRITE(MSG(3),400) 'DEC0', DEC0, '\0'
      WRITE(MSG(4),400) 'RA', RA, '\0'
      WRITE(MSG(5),400) 'DEC', DEC, '\0'
      STATUS =  PL_PRINT_MSG(5,MSG)

    
      END