/[lmdze]/trunk/phylmd/Radlwsw/swu.f90
ViewVC logotype

Diff of /trunk/phylmd/Radlwsw/swu.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/phylmd/Radlwsw/swu.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/Radlwsw/swu.f revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC
# Line 1  Line 1 
   
 ! IM ctes ds clesphys.h   SUBROUTINE SWU  
 ! (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC,  
1  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, paki, &  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, paki, &
2      pcld, pclear, pdsig, pfact, prmu, psec, pud)      pcld, pclear, pdsig, pfact, prmu, psec, pud)
3    
4    USE dimens_m    USE dimens_m
5    USE dimphy    USE dimphy
6    USE clesphys    USE clesphys
# Line 48  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol Line 46  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol
46    DOUBLE PRECISION zsigo(kdlon)    DOUBLE PRECISION zsigo(kdlon)
47    DOUBLE PRECISION zud(kdlon, 2)    DOUBLE PRECISION zud(kdlon, 2)
48    DOUBLE PRECISION zrth, zrtu, zwh2o, zdsco2, zdsh2o, zfppw    DOUBLE PRECISION zrth, zrtu, zwh2o, zdsco2, zdsh2o, zfppw
49    INTEGER jl, jk, jkp1, jkl, jklp1, ja    INTEGER jl, jk, jkp1, jkl, ja
50    
51    ! * Prescribed Data:    ! * Prescribed Data:
52    
# Line 60  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol Line 58  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol
58    SAVE rtdh2o, rtdumg    SAVE rtdh2o, rtdumg
59    DOUBLE PRECISION rth2o, rtumg    DOUBLE PRECISION rth2o, rtumg
60    SAVE rth2o, rtumg    SAVE rth2o, rtumg
61    DATA zpdh2o, zpdumg/0.8, 0.75/    DATA zpdh2o, zpdumg/0.8d0, 0.75d0/
62    DATA zprh2o, zprumg/30000., 30000./    DATA zprh2o, zprumg/30000.d0, 30000.d0/
63    DATA rtdh2o, rtdumg/0.40, 0.375/    DATA rtdh2o, rtdumg/0.40d0, 0.375d0/
64    DATA rth2o, rtumg/240., 240./    DATA rth2o, rtumg/240.d0, 240.d0/
65    ! ------------------------------------------------------------------    ! ------------------------------------------------------------------
66    
67    ! *         1.     COMPUTES AMOUNTS OF ABSORBERS    ! *         1.     COMPUTES AMOUNTS OF ABSORBERS
# Line 107  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol Line 105  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol
105    DO jk = 1, kflev    DO jk = 1, kflev
106      jkp1 = jk + 1      jkp1 = jk + 1
107      jkl = kflev + 1 - jk      jkl = kflev + 1 - jk
     jklp1 = jkl + 1  
108      DO jl = 1, kdlon      DO jl = 1, kdlon
109        zrth = (rth2o/ptave(jl,jk))**rtdh2o        zrth = (rth2o/ptave(jl,jk))**rtdh2o
110        zrtu = (rtumg/ptave(jl,jk))**rtdumg        zrtu = (rtumg/ptave(jl,jk))**rtdumg
# Line 178  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol Line 175  SUBROUTINE swu(psct, pcldsw, ppmb, ppsol
175      END DO      END DO
176    END DO    END DO
177    
   
   ! ------------------------------------------------------------------  
   
   RETURN  
178  END SUBROUTINE swu  END SUBROUTINE swu
Legend:
Removed from v.82  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21