* PACKAGE P2ADMN  
*
*"履歴 92/04/27 沼口 敦             重力波抵抗(masaaki)の導入
*"履歴 93/08/29 保坂征宏            長波放射変更
*"履歴 94/04/28 石渡正樹            平衡モデル用変更
*"
***********************************************************************
      SUBROUTINE PHYSCS      
     O         ( GTU   , GTV   , GTT   , GTQ   , 
     M           GDTG  ,
     I           GDU   , GDV   , GDT  , GDPS  , GDQ   ,
     I           GDVOR , GDDIV , 
     I           IT    , IDATE , DELT  , DELTM , 
     C           ALON  , ALAT  ,
     C           SIG   , SIGM  , DSIG  , DSIGM          )
*
*"  物理過程： 多色放射  鉛直拡散 地表 
*
*   [PARAM] 





* PACKAGE  ZXT10L32 !" 格子点数，波数 X-Z
*
      INTEGER     IMAX           !" 経度格子数
      INTEGER     JMAX           !" 緯度格子数
      INTEGER     IDIM           !" 経度配列サイズ
      INTEGER     JDIM           !" 緯度配列サイズ
      INTEGER     MMAX           !" 最大東西波数
      INTEGER     LMAX           !" 最大南北波数
      INTEGER     NMAX           !" 最大全波数
      INTEGER     MINT           !" 東西波数間隔
      INTEGER     KMAX           !" 鉛直層数
      INTEGER     KDIM           !" 鉛直配列サイズ
      INTEGER     NMDIM          !" 水平波数成分数
      INTEGER     JMXHF          !" JMAX/2+1
      INTEGER     NWORK          !" ワーク領域大きさ
*
      PARAMETER ( IMAX  = 32,     JMAX =  1,
     &            IDIM  = IMAX+1, JDIM = JMAX,
     &            MMAX  = 10,     LMAX =  0,    NMAX = MMAX, MINT = 1,
     &            KMAX  = 32,     KDIM = KMAX,
     &            NMDIM = (MMAX/MINT+1)*(2*(NMAX+1)-MMAX)
     &                  - (NMAX-LMAX)/MINT*(NMAX-LMAX+1),
     &            JMXHF = JMAX/2+1,
     &            NWORK = IDIM*JDIM*KMAX*12                       )

* PACKAGE ZHDIM  !" 標準物理定数(common)  
*
*"  [HIS]  90/08/31(numaguti)
*
      ReaL*8       ER             !" 地球半径
      ReaL*8       GRAV                        !" 重力加速度
      ReaL*8       CP                          !" 大気定圧比熱
      ReaL*8       RAIR                        !" 大気気体定数
      ReaL*8       EL                          !" 水の凝結の潜熱
      ReaL*8       CPVAP                       !" 水蒸気定圧比熱
      ReaL*8       RVAP                        !" 水蒸気気体定数
      ReaL*8       DH2O                        !" 水の密度
      ReaL*8       EPSV                        !" 水と大気の分子量比ε
      ReaL*8       ES0                         !" ０℃飽和蒸気圧：Ｐａ
      ReaL*8       STB                         !" Stefan-Boltzman
      ReaL*8       FKARM                       !" Karman 定数
      ReaL*8       EPSVT                       !" 1/ε-1
*
      COMMON   /COMCON/
     &          ER    , GRAV  ,
     &          CP    , RAIR  ,
     &          EL    , CPVAP , RVAP  , DH2O  , EPSV  , ES0   ,
     &          STB   , FKARM , EPSVT

*
*   [OUTPUT] 
      ReaL*8       GTU   ( IDIM, JDIM, KMAX )  
      ReaL*8       GTV   ( IDIM, JDIM, KMAX )  
      ReaL*8       GTT   ( IDIM, JDIM, KMAX )  
      ReaL*8       GTQ   ( IDIM, JDIM, KMAX )  
      ReaL*8       GTTG  ( IDIM, JDIM )        
*
*   [INPUT] 
      ReaL*8       GDU   ( IDIM, JDIM, KMAX )  
      ReaL*8       GDV   ( IDIM, JDIM, KMAX )  
      ReaL*8       GDT   ( IDIM, JDIM, KMAX )  
      ReaL*8       GDPS  ( IDIM, JDIM       )  
      ReaL*8       GDQ   ( IDIM, JDIM, KMAX )  
      ReaL*8       GDVOR ( IDIM, JDIM, KMAX )  
      ReaL*8       GDDIV ( IDIM, JDIM, KMAX )  
      ReaL*8       GDTG  ( IDIM, JDIM )        
*
      INTEGER    IT                          
      INTEGER    IDATE ( * )                 
      ReaL*8       DELT                        
      ReaL*8       DELTM                       
*                                                
      ReaL*8       ALON  ( IDIM )              
      ReaL*8       ALAT  ( JDIM )              
      ReaL*8       SIG   ( KMAX )              
      ReaL*8       SIGM  (KMAX+1)              
      ReaL*8       DSIG  ( KMAX )              
      ReaL*8       DSIGM (KMAX+1)              
*
*   [INTERNAL SAVE] 
      ReaL*8       RFLUX  ( IDIM, JDIM, KMAX+1 )   
      ReaL*8       RFLUXC ( IDIM, JDIM, KMAX+1 )   
*                                                   
*
      ReaL*8       SFLUX  ( IDIM, JDIM, KMAX+1 )   
      ReaL*8       DRFLUX ( IDIM, JDIM, KMAX+1, 0:1 ) 
*
      ReaL*8       GRHC   ( IDIM, JDIM )        
      ReaL*8       GRALB  ( IDIM, JDIM )        
      ReaL*8       GRBET  ( IDIM, JDIM )        
      ReaL*8       GRZ0   ( IDIM, JDIM )        
      ReaL*8       GRZSD  ( IDIM, JDIM )        
      INTEGER    IDSFC  ( IDIM, JDIM )        
      ReaL*8       GFLUX  ( IDIM, JDIM )        
*
      ReaL*8       UFLUX  ( IDIM, JDIM, KMAX+1)      
      ReaL*8       VFLUX  ( IDIM, JDIM, KMAX+1)      
      ReaL*8       TFLUX  ( IDIM, JDIM, KMAX+1)      
      ReaL*8       QFLUX  ( IDIM, JDIM, KMAX+1)      
      SAVE
*
*   [INTERNAL PARM] 
      ReaL*8       P0                       
      DATA       P0 / 1000.0 /
*
      NAMELIST  /NMADEQ/ P0
*
      LOGICAL    OPBDGT                       
      LOGICAL    OFIRST
      DATA       OPBDGT / .TRUE. /
      DATA       OFIRST / .TRUE. /
      SAVE OFIRST, OPBDGT
*
*
*   [INTERNAL WORK] 
      ReaL*8       GDTM   ( IDIM, JDIM, KMAX+1)  
      ReaL*8       GDP    ( IDIM, JDIM, KMAX )   
      ReaL*8       GDPM   ( IDIM, JDIM, KMAX+1 ) 
      ReaL*8       GDZ    ( IDIM, JDIM, KMAX )   
      ReaL*8       GDZM   ( IDIM, JDIM, KMAX+1 ) 
      ReaL*8       GTTRL  ( IDIM, JDIM, KMAX )   
      ReaL*8       GTTRS  ( IDIM, JDIM, KMAX )   
      ReaL*8       GDQG   ( IDIM, JDIM )   
*
      ReaL*8       GQPR   ( IDIM, JDIM       )  
      ReaL*8       GQCND  ( IDIM, JDIM, KMAX )  
      ReaL*8       GSCND  ( IDIM, JDIM, KMAX )  
      ReaL*8       GSRMNQ ( IDIM, JDIM, KMAX )  
      ReaL*8       TRPPM  (  IDIM, JDIM )       
      ReaL*8       RUFLUX  ( IDIM, JDIM, KMAX+1 )   
      ReaL*8       RDFLUX  ( IDIM, JDIM, KMAX+1 )   
      INTEGER    TRPLEV ( IDIM, JDIM )            
*
      ReaL*8       RMTXS  ( IDIM, JDIM,      -1:1 ) 
*
      INTEGER    I, J, K
      INTEGER    IFPAR, JFPAR
*      
*   [INTERNAL FUNC]




* PACKAGE ZQSAT     !" Clausis-Clapeyron の式(文関数)
*
*"    QSAT:  saturation water vapour mixing ratio
*"    DQSAT: d(QSAT)/d(T)
*
      ReaL*8       FQSAT
      ReaL*8       FDQSAT
      ReaL*8       T, P, QS
*
c$$$      FQSAT ( T,P )    = EPSV * ES0
c$$$     &                   * EXP( EL/RVAP *( 1./273. - 1./T ) )
c$$$     &                   / P
      FQSAT ( T,P )    = EPSV
     &                   * 1.4E+11* EXP( - 5250.87/T )
     &                   / P
*"         <---------  Nakajima version
      FDQSAT( T,QS )   = EL * QS / ( RVAP * T*T )

*
*   [ONCE] 
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' PHYSICS PACKAGE EQUIB DATE=94/04/29'
         OFIRST = .FALSE.
         CALL PHSTRG
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMADEQ, END=190 )
  190    WRITE  ( JFPAR, NMADEQ )
*
      ENDIF
*
*"          < -1. 初期値設定 >
*
*"         こんなところで初期値設定 Part I
*"         なんとかせい
*
      GDT  ( 1,1,1 ) = 2.86207E+02
      GDTG ( 1,1   ) = 2.86207E+02
      GDT  ( 2,1,1 ) = 3.00196E+02
      GDTG ( 2,1   ) = 3.00196E+02
      GDT  ( 3,1,1 ) = 3.13129E+02
      GDTG ( 3,1   ) = 3.13129E+02
      GDT  ( 4,1,1 ) = 3.17744E+02
      GDTG ( 4,1   ) = 3.17744E+02
      GDT  ( 5,1,1 ) = 3.20652E+02
      GDTG ( 5,1   ) = 3.20652E+02
      GDT  ( 6,1,1 ) = 3.48713E+02
      GDTG ( 6,1   ) = 3.48713E+02
      GDT  ( 7,1,1 ) = 3.52171E+02
      GDTG ( 7,1   ) = 3.52171E+02
      GDT  ( 8,1,1 ) = 3.63477E+02
      GDTG ( 8,1   ) = 3.63477E+02
      DO 500 I=9,IDIM
         DO 500 J=1,JDIM
            GDT  ( I,J,1 ) = 315.361
            GDTG ( I,J   ) = 315.361
 500  CONTINUE 

      DO 1000 I=1,IDIM
         DO 1000 J=1,JDIM
c$$$            GDT  ( I,J,1 ) = 250. + ReaL*8(I-1) * 10.0
c$$$            GDTG ( I,J ) = 250. + ReaL*8(I-1) * 10.0
            GDPS ( I,J   ) = P0
            GDQG ( I,J   ) = FQSAT( GDTG (I,J ), GDPS( I,J )*100. )
            GDPS ( I,J   ) = GDPS( I,J )*( 1.0 + GDQG( I,J )/EPSV )
c            GDPS ( I,J ) = GDPS( I,J )*( GDQG( I,J )/EPSV )
            GDQG ( I,J   ) = FQSAT( GDTG (I,J ), GDPS( I,J )*100. )
            GDQ  ( I,J,1 ) = FQSAT( GDTG (I,J ), GDPS( I,J )*100. )
c            GDQG( I,J ) = FQSAT( GDTG (I,J ), GDPS( I,J )*100. )
c            GDQ( I,J,1 ) = FQSAT( GDT (I,J,1 ), GDP( I,J,1 )*100. )
 1000 CONTINUE 
*
*"         < 0. 温度，気圧，高度 >
*
      CALL TINTP
     O         ( GDTM  ,
     I           GDT   ,
     C           SIG   , SIGM  )
*
      CALL PZLEVS
     O         ( GDP   , GDPM , GDZ   , GDZM  ,
     I           GDPS  , GDT  , GDTM  ,
     C           SIG   , SIGM , DSIG  , DSIGM   )
*
*"         < 1. 地表モデル >
*
      CALL PGRNDM
     M         ( GDTG  ,
     M           GRHC  , GRALB , GRBET , GRZ0  , GRZSD , 
     M           IDSFC , GFLUX ,
     I           UFLUX , VFLUX , TFLUX , QFLUX , RFLUX , SFLUX ,
     I           GDU   , GDV   , GDTM  , GDPS  , GDQ   ,
     I           IT    , IDATE , DELT  ,
     C           ALON  , ALAT                                   )
*
*"         こんなところで初期値設定 Part II
*"         なんとかせい
*
      DO 1100 I=1,IDIM
         DO 1100 J=1,JDIM
c$$$            GDT  ( I,J,1 ) = 250. + ReaL*8(I-1) * 10.0
c$$$            GDTG ( I,J ) = 250. + ReaL*8(I-1) * 10.0
c            GDT( I,J,1 ) = 315.361
c            GDTG( I,J ) = 315.361
c$$$            GDQ( I,J,1 ) = FQSAT( GDT (I,J,1 ), GDP( I,J,1) )
 1100 CONTINUE 

      GDT  ( 1,1,1 ) = 2.86207E+02
      GDTG ( 1,1   ) = 2.86207E+02
      GDT  ( 2,1,1 ) = 3.00196E+02
      GDTG ( 2,1   ) = 3.00196E+02
      GDT  ( 3,1,1 ) = 3.13129E+02
      GDTG ( 3,1   ) = 3.13129E+02
      GDT  ( 4,1,1 ) = 3.17744E+02
      GDTG ( 4,1   ) = 3.17744E+02
      GDT  ( 5,1,1 ) = 3.20652E+02
      GDTG ( 5,1   ) = 3.20652E+02
      GDT  ( 6,1,1 ) = 3.48713E+02
      GDTG ( 6,1   ) = 3.48713E+02
      GDT  ( 7,1,1 ) = 3.52171E+02
      GDTG ( 7,1   ) = 3.52171E+02
      GDT  ( 8,1,1 ) = 3.63477E+02
      GDTG ( 8,1   ) = 3.63477E+02
      DO 600 I=9,IDIM
         DO 600 J=1,JDIM
            GDT  ( I,J,1 ) = 315.361
            GDTG ( I,J   ) = 315.361
 600  CONTINUE 
      DO 1200 I=1,IDIM
         DO 1200 J=1,JDIM
            GDQ( I,J,1 ) = FQSAT( GDT (I,J,1 ), GDP( I,J,1) )
 1200 CONTINUE 

*
*"         < 2. 湿潤断熱線 >
*
      CALL RESET ( GQPR  , IDIM*JDIM      )
      CALL RESET ( GQCND , IDIM*JDIM*KMAX )
      CALL RESET ( GSCND , IDIM*JDIM*KMAX )
      CALL RESET ( GSRMNQ, IDIM*JDIM*KMAX )
*
      CALL ADIABT
     M         ( GDT   , GDQ   ,
     I           GDP   , GDPM  , GDZ   ,
     I           GDTG  , GDQG  )
*
*"         < 3. 乾燥対流調節 >
*
      CALL DADJST
     M         ( GDT   ,
     I           GDP   , GDPM  , DELT   )
*
*"         < 4. 負の水蒸気除去 >
*
      CALL RMNEGQ
     M         ( GDQ   , GSRMNQ,
     I           GDPM  ,
     I           DELT           )
*
*"         < 5. 放射 flux >
*
      CALL HISTIN ( GDT , 'ADT'  )
      CALL HISTIN ( GDQ , 'ADQ'  )
*
      CALL TINTP
     O         ( GDTM  ,
     I           GDT   ,
     C           SIG   , SIGM  )
*
      CALL RADFLX                                
     O         ( RFLUX , RMTXS , DRFLUX,
     O           SFLUX ,
     I           GDTM  , GDTG  , GDQ   , GDPM  , 
     I           IT    , IDATE ,
     C           ALON  , ALAT  , GRALB          )
*
         CALL UDFLUX
     O         ( RUFLUX , RDFLUX )
*
         write (6,*) 'in p2adeq;ij,k,rflux'
         do 2 i=1,idim
            do 2 k=1,kmax+1
               write (6,*) i,k,rflux(i,1,k)
 2          continue 
      CALL HISTIN ( RFLUX  , 'ALRAD'  )
      CALL HISTIN ( RUFLUX , 'AUFLUX'  )
      CALL HISTIN ( RDFLUX , 'ADFLUX'  )
*
*
*
*"         < 6. 温度構造決定 >
*
      CALL TRPPAS
     M        ( GDT   , GDQ,
     O          TRPLEV,
     I          GDTG  ,
     I          GDPM  , 
     I          RFLUX ,
     C          SIG   , SIGM )
*
      DO 6000 I=1,IDIM
         DO 6000 J=1,JDIM
            TRPPM(I,J) = SIGM(TRPLEV(I,J))*GDPM(I,J,1)
 6000 CONTINUE 
*
*"         < 7. 放射フラックス再計算 >
*
      CALL TINTP
     O         ( GDTM  ,
     I           GDT   ,
     C           SIG   , SIGM  )
*
      CALL RADFLX                                
     O         ( RFLUX , RMTXS , DRFLUX,
     O           SFLUX ,
     I           GDTM  , GDTG  , GDQ   , GDPM  , 
     I           IT    , IDATE ,
     C           ALON  , ALAT  , GRALB          )
*
         CALL UDFLUX
     O         ( RUFLUX , RDFLUX )
*
*"         < 8. 放射による温度変化率 >
*
      CALL RADTND
     O         ( GTTRL , GTTRS ,
     I           RFLUX , SFLUX , GDPM   )       
*
      write (6,*) 'after radtnd'
      do 1 i=1,idim
         do 1 k=1,kmax
            write(6,*) i,k,gttrl(i,1,k)
 1    continue 
*
*"         < 9. 出力 >
*
      CALL HISTIN ( TRPPM , 'TRPPM'  )
      CALL HISTIN ( GTTRL , 'QRADL' )
      CALL HISTIN ( GTTRS , 'QRADS' )
      CALL HISTIN ( RFLUX , 'LRAD'  )           
      CALL HISTIN ( RUFLUX , 'RUFLUX'  )
      CALL HISTIN ( RDFLUX , 'RDFLUX'  )
      CALL HISTIN ( RFLUX(1,1,KMAX+1),'OLR' )  
      CALL HISTIN ( RFLUX,            'SLR' )  
*
      IF ( OPBDGT ) THEN                        
         CALL PDIAG
     I         ( TFLUX , QFLUX , RFLUXC, SFLUX ,  
     I           GTT   , GTQ   , GTTG  ,
     I           GDT   , GDQ   , GDTG  , GDPM  ,
     C           GRHC                           )
      ENDIF
*
      RETURN
      END
***********************************************************************
      SUBROUTINE PHSTRG    
*
      INTEGER    ISTYPL
      DATA       ISTYPL / 1 /
      ReaL*8       VMISS
*
      CALL GZDBGT( 'MISS', VMISS )
*
      CALL HISTRG
     I       ( 'ADT'  , 'Temperature      ' ,'K    ', 'ALEV',
     I          VMISS     , VMISS , 2.5  , 10. , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'ADQ   ', 'specific humidity   ' ,'g/g   ', 'ALEV',
     I           VMISS , VMISS , 1.E-3 , 5.E-3 , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(3PF12.3)' )
*
      CALL HISTRG
     I       ( 'RAIN'  , 'precipitation      ' ,'W/m**2', 'ASFC',
     I          0.     , VMISS , 200.  , 1000. , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL HISTRG
     I       ( 'SENS'  , 'sensible heat flux ' ,'W/m**2', 'ASFC',
     I          VMISS  , VMISS , 20.   , 100.  , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL HISTRG
     I       ( 'QRADL' , 'longwave heating   ' ,'K/s    ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'OLR'   , 'outgoing longwave  ' ,'W/m**2', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL HISTRG
     I       ( 'TRPPM' , 'trpopause level' ,'mb    ', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'SLR'   , 'surface longwave   ' ,'W/m**2', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL HISTRG
     I       ( 'QCND'  , 'condensation heating','K/s   ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'SCND'  , 'condensation moistning','1/s   ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'QCNDC' , 'cumulus heating'     ,'K/s   ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'SCNDC' , 'cumulus moistning'   ,'1/s   ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'SRMNQ' , 'remove negative moist','1/s   ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG                              
     I       ( 'LRAD' , 'LONG RADIATION' ,'W/m**2  '     , 'AMLEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG                              
     I       ( 'RUFLUX' , 'UPWARD RAD FLUX' ,'W/m**2  '     , 'AMLEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG                              
     I       ( 'RDFLUX' , 'DOWNWARD RAD FLUX' ,'W/m**2  '     , 'AMLEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG                              
     I       ( 'ALRAD' , 'LONG RADIATION' ,'W/m**2  '     , 'AMLEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG                              
     I       ( 'AUFLUX' , 'UPWARD RAD FLUX' ,'W/m**2  '     , 'AMLEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG                              
     I       ( 'ADFLUX' , 'DOWNWARD RAD FLUX' ,'W/m**2  '     , 'AMLEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      RETURN
      END
