* PACKAGE P2ADMN  
*
*"履歴 92/04/27 沼口 敦             重力波抵抗(masaaki)の導入
*"履歴 93/08/29 保坂征宏            長波放射変更
*"  これは古いバージョンをもとにしている. 注意
***********************************************************************
      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] 
      LOGICAL    OPBDGT                       
      LOGICAL    OFIRST
      DATA       OPBDGT / .TRUE. /
      DATA       OFIRST / .TRUE. /
**      SAVE OFIRST,OPBDGT 
*
*   [INTERNAL WORK] 
      ReaL*8       UMTX   ( IDIM, JDIM,   KMAX, -1:1 ) 
      ReaL*8       TMTX   ( IDIM, JDIM, 0:KMAX, -1:1 ) 
      ReaL*8       QMTX   ( IDIM, JDIM,   KMAX, -1:1 ) 
      ReaL*8       UMTXS  ( IDIM, JDIM            ) 
      ReaL*8       TMTXS  ( IDIM, JDIM, 0:1, -1:1 ) 
      ReaL*8       QMTXS  ( IDIM, JDIM, 0:1, -1:1 ) 
      ReaL*8       RMTXS  ( IDIM, JDIM,      -1:1 ) 
*
      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       GTUG   ( IDIM, JDIM, KMAX )   
      ReaL*8       GTVG   ( IDIM, JDIM, KMAX )   
      ReaL*8       UFLUXG ( IDIM, JDIM, KMAX+1 ) 
      ReaL*8       VFLUXG ( IDIM, JDIM, KMAX+1 ) 
*
      ReaL*8       GQPR   ( IDIM, JDIM       )  
      ReaL*8       GQCND  ( IDIM, JDIM, KMAX )  
      ReaL*8       GSCND  ( IDIM, JDIM, KMAX )  
      ReaL*8       GSRMNQ ( IDIM, JDIM, KMAX )  
*
      INTEGER    I, J, K
*
*   [ONCE] 
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' PHYSICS PACKAGE P2.4 DATE=92/04/17'
         OFIRST = .FALSE.
         CALL PHSTRG
      ENDIF
*
*"         < 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                                   )
*
*"         < 2. 放射 flux >
*
      CALL RADFLX                                
     O         ( RFLUX , RMTXS , DRFLUX,
     O           SFLUX ,
     I           GDT   , GDTG  , GDQ   , GDPM  , 
     I           IT    , IDATE ,
     C           ALON  , ALAT  , GRALB          )
*
c$$$      write (6,*) 'in p2admn;after radflx:k,rflux'
c$$$      do 1 k=1,kmax+1
c$$$         write (6,*) k,rflux(1,1,k)
c$$$ 1    continue 
*"         < 3. 陰解配列初期化 >
*
      CALL PHMTX0
     O         ( UMTX  , TMTX  , QMTX  ,
     O           UFLUX , VFLUX , TFLUX , QFLUX ,
     I           GDPM  , DELT  , GRHC  , IDSFC  )
*
*"         < 4. 鉛直拡散 flux >
*
      CALL VDFUVT
     M         ( UFLUX , VFLUX , TFLUX , QFLUX ,
     M           UMTX  , TMTX  , QMTX  ,
     I           GDU   , GDV   , GDT   , GDTM  , GDQ   ,
     C           GDP   , GDPM  , GDZ   , GDZM            )
*
*"         < 5. 地表 flux >
*
      CALL SFCUVT
     M         ( UFLUX , VFLUX , TFLUX , QFLUX ,
     M           UMTXS , TMTXS , QMTXS ,
     I           GDU   , GDV   , GDT   , GDTM  , GDTG  , GDQ   ,
     I           GDP   , GDPM  , GDZ   ,
     I           GRBET , GRZ0  , IDSFC                           )
*
*"         < 6. 時間変化率の計算 (implicit) >
*
      CALL PHYTND
     O         ( GTU   , GTV   , GTT   , GTTG  , GTQ   ,
     I           UFLUX , VFLUX ,
     I           TFLUX , SFLUX , RFLUX , GFLUX , QFLUX ,
     I           UMTX  , TMTX  , QMTX  ,
     I           UMTXS , TMTXS , QMTXS ,
     I           RMTXS , DELT  , IDSFC                   )
*
*"         < 7. フラックス補正 > 
*
      CALL FLXCOR
     M         ( UFLUX , VFLUX , TFLUX , QFLUX ,
     I           GTU   , GTV   , GTT   , GTTG  , GTQ   ,
     I           UMTX  , TMTX  , QMTX  ,
     I           UMTXS , TMTXS , QMTXS ,
     I           DELT                                    )
*
      CALL RADCOR                               
     O         ( RFLUXC ,
     I           RFLUX  , DRFLUX, GTT   , GTTG  , DELT  )
*
c$$$      write (6,*) 'in p2admn;after radcor:k,rfluxc'
c$$$      do 2 k=1,kmax+1
c$$$         write (6,*) k,rfluxc(1,1,k)
c$$$ 2    continue 
*"         < 8. 放射による温度変化率 >
*
      CALL RADTND
     O         ( GTTRL , GTTRS ,
     I           RFLUXC, SFLUX , GDPM   )       
*
c$$$      write (6,*) 'in p2admn;after radtnd:k,gttrl'
c$$$      do 3 k=1,kmax+1
c$$$         write (6,*) k,gttrl(1,1,k)
c$$$ 3    continue 
*
*"          < 9. 重力波抵抗 >
*
      CALL GRAVTY 
     O         ( GTUG   , GTVG   , UFLUXG , VFLUXG , 
     I           GRZSD  , IDSFC  , 
     I           GDU    , GDV    , GDT    , GDP    , GDTG   , 
     I           GDZ    , GDTM   , GDPM                       )
*
*"         < 10. 出力 >
*
      CALL HISTIN ( QFLUX , 'EVAP'  )
      CALL HISTIN ( TFLUX , 'SENS'  )
      CALL HISTIN ( UFLUX , 'TAUX'  )
      CALL HISTIN ( VFLUX , 'TAUY'  )
      CALL HISTIN ( GTT   , 'QVDF'  )
      CALL HISTIN ( GTQ   , 'SVDF'  )
      CALL HISTIN ( GTU   , 'FVDFX' )
      CALL HISTIN ( GTV   , 'FVDFY' )
      CALL HISTIN ( GTTRL , 'QRADL' )
      CALL HISTIN ( GTTRS , 'QRADS' )
      CALL HISTIN ( RFLUXC, 'LRAD'  )           
      CALL HISTIN ( RFLUXC(1,1,KMAX+1),'OLR' )  
      CALL HISTIN ( RFLUXC,            'SLR' )  
      CALL HISTIN ( SFLUX(1,1,KMAX+1), 'OSR' )
      CALL HISTIN ( SFLUX,             'SSR' )
      CALL HISTIN ( GTUG   , 'FGRVX' )
      CALL HISTIN ( GTVG   , 'FGRVY' )
      CALL HISTIN ( UFLUXG , 'TAUGX' )
      CALL HISTIN ( VFLUXG , 'TAUGY' )
*
      DO 9100 K = 1, KMAX
         DO 9100 I = 1, IDIM
            DO 9100 J = 1, JDIM
               GTT ( I,J,K ) = GTT ( I,J,K ) + GTTRL ( I,J,K )
     &                                       + GTTRS ( I,J,K )
               GTU ( I,J,K ) = GTU ( I,J,K ) + GTUG  ( I,J,K )
               GTV ( I,J,K ) = GTV ( I,J,K ) + GTVG  ( I,J,K )
 9100 CONTINUE
*
      IF ( OPBDGT ) THEN                        
         CALL PDIAG
     I         ( TFLUX , QFLUX , RFLUXC, SFLUX ,  
     I           GTT   , GTQ   , GTTG  ,
     I           GDT   , GDQ   , GDTG  , GDPM  ,
     C           GRHC                           )
      ENDIF
*
      CALL TGINTG                                
     M         ( GDTG  , RFLUX , DRFLUX ,   
     I           GTTG  , DELTM    )
*
      RETURN
*======================================================================
      ENTRY      PADJST       
     M         ( GDU   , GDV   , GDT   , GDPS  , GDQ   ,
     I           GDVOR , GDDIV ,
     I           DELT  ,
     C           SIG   , SIGM  , DSIG  , DSIGM          )
*
*"         < 1. 温度，気圧，高度 >
*
      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   )
*
      CALL RESET ( GQPR  , IDIM*JDIM      )
      CALL RESET ( GQCND , IDIM*JDIM*KMAX )
      CALL RESET ( GSCND , IDIM*JDIM*KMAX )
      CALL RESET ( GSRMNQ, IDIM*JDIM*KMAX )
*
*"         < 2. 負の水蒸気除去(1) >
*
      CALL RMNEGQ
     M         ( GDQ   , GSRMNQ,
     I           GDPM  ,
     I           DELT           )
*
*"         < 3. 湿潤過程 >
*
      CALL CUMADJ
     M         ( GDT   , GDQ   ,
     M           GQPR  , GQCND , GSCND ,
     I           GDP   , GDPM  , GDZ   , DELT   )
*
      CALL HISTIN ( GQCND , 'QCNDC'  )
      CALL HISTIN ( GSCND , 'SCNDC'  )
*
      CALL LSCOND
     M         ( GDT   , GDQ   ,
     M           GQPR  , GQCND , GSCND ,
     I           GDP   , GDPM  , DELT   )
*
*"         < 4. 乾燥対流調節 >
*
      CALL DADJST
     M         ( GDT   ,
     I           GDP   , GDPM  , DELT   )
*
*"         < 5. 負の水蒸気除去(2) >
*
      CALL RMNEGQ
     M         ( GDQ   , GSRMNQ,
     I           GDPM  ,
     I           DELT           )
*
*"         < 6. ヒストリー出力 >
*
      CALL HISTIN ( GQPR  , 'RAIN'  )
      CALL HISTIN ( GQCND , 'QCND'  )
      CALL HISTIN ( GSCND , 'SCND'  )
      CALL HISTIN ( GSRMNQ, 'SRMNQ' )
*
      IF ( OPBDGT ) THEN
         CALL PDIAG2
     I         ( GQPR  )
      ENDIF
*
      RETURN
      END
***********************************************************************
      SUBROUTINE PHSTRG    
*
      INTEGER    ISTYPL
      DATA       ISTYPL / 1 /
      ReaL*8       VMISS
*
      CALL GZDBGT( 'MISS', VMISS )
*
      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       ( 'EVAP'  , 'latent heat flux   ' ,'W/m**2', 'ASFC',
     I          VMISS  , VMISS , 20.   , 100.  , 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       ( 'OLR'   , 'outgoing longwave  ' ,'W/m**2', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.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       ( 'OSR'   , 'outgoing shortwave ' ,'W/m**2', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL HISTRG
     I       ( 'SSR'   , 'surface shortwave  ' ,'W/m**2', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL HISTRG
     I       ( 'TAUX' , 'surface stress(x) '  ,'N/m**2', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'TAUY'  , 'surface stress(y) '  ,'N/m**2', 'ASFC',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'QVDF'  , 'diffusive heating  ' ,'K/s   ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'SVDF'  , 'diffusive moistning' ,'1/s   ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'FVDFX' , 'diffusive force(x)'  ,'m/s**2 ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'FVDFY' , 'diffusive force(y)'  ,'m/s**2 ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.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       ( 'QRADL' , 'longwave heating   ' ,'K/s    ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'DFM' , 'vert diff coef(mom)  ' ,'Kg m/s    ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'DFH' , 'vert diff coef(heat)  ' ,'Kg m/s    ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'DFE' , 'vert diff coef(q)  ' ,'Kg m/s    ', 'ALEV',
     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
c$$$      CALL HISTRG
c$$$     I       ( 'FGRVX' , 'gravity wave u force','m/s**2  ', 'ALEV',
c$$$     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
c$$$     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
c$$$*
c$$$      CALL HISTRG
c$$$     I       ( 'FGRVY' , 'gravity wave v force','m/s**2  ', 'ALEV',
c$$$     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
c$$$     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
c$$$*
c$$$      CALL HISTRG
c$$$     I       ( 'TAUGX' , 'gravity wave u flux' ,'N/m**2  ', 'AMLEV',
c$$$     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
c$$$     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
c$$$*
c$$$      CALL HISTRG
c$$$     I       ( 'TAUGY' , 'gravity wave v flux' ,'N/m**2  ', 'AMLEV',
c$$$     I          VMISS  , VMISS , VMISS , VMISS , ISTYPL  ,
c$$$     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)' )

      RETURN
      END
