/[lmdze]/trunk/Sources/phylmd/clmain.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/clmain.f

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

revision 15 by guez, Fri Aug 1 15:24:12 2008 UTC revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC
# Line 5  SUBROUTINE clmain(dtime, itap, date0, pc Line 5  SUBROUTINE clmain(dtime, itap, date0, pc
5       rain_f, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi,&       rain_f, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi,&
6       cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v,&       cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v,&
7       d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2,&       d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2,&
8       dflux_t, dflux_q, zcoefh, zu1, zv1, t2m, q2m, u10m, v10m, &       dflux_t, dflux_q, zcoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh,&
9       pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3,&       capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl,&
10       plcl, fqcalving, ffonte, run_off_lic_0, & !IM "slab" ocean       fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)
      flux_o, flux_g, tslab, seaice)  
11    
12    ! From phylmd/clmain.F, v 1.6 2005/11/16 14:47:19    ! From phylmd/clmain.F, v 1.6 2005/11/16 14:47:19
13    
# Line 86  SUBROUTINE clmain(dtime, itap, date0, pc Line 85  SUBROUTINE clmain(dtime, itap, date0, pc
85    
86    !$$$ PB ajout pour soil    !$$$ PB ajout pour soil
87    
88    USE ioipsl    USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync
89    USE interface_surf    use histwrite_m, only: histwrite
90    USE dimens_m    use calendar, ONLY : ymds2ju
91    USE indicesol    USE dimens_m, ONLY : iim, jjm
92    USE dimphy    USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
93    USE dimsoil    USE dimphy, ONLY : klev, klon, zmasq
94    USE temps    USE dimsoil, ONLY : nsoilmx
95    USE iniprint    USE temps, ONLY : annee_ref, itau_phy
96    USE yomcst    USE dynetat0_m, ONLY : day_ini
97    USE yoethf    USE iniprint, ONLY : prt_level
98    USE fcttre    USE yomcst, ONLY : rd, rg, rkappa
99    USE conf_phys_m    USE conf_phys_m, ONLY : iflag_pbl
100    USE gath_cpl, ONLY : gath2cpl    USE gath_cpl, ONLY : gath2cpl
101      use hbtm_m, only: hbtm
102    
103    IMPLICIT NONE    IMPLICIT NONE
104    
# Line 224  SUBROUTINE clmain(dtime, itap, date0, pc Line 224  SUBROUTINE clmain(dtime, itap, date0, pc
224    
225    ! maf pour sorties IOISPL en cas de debugagage    ! maf pour sorties IOISPL en cas de debugagage
226    
227    CHARACTER*80 cldebug    CHARACTER (80) cldebug
228    SAVE cldebug    SAVE cldebug
229    CHARACTER*8 cl_surf(nbsrf)    CHARACTER (8) cl_surf(nbsrf)
230    SAVE cl_surf    SAVE cl_surf
231    INTEGER nhoridbg, nidbg    INTEGER nhoridbg, nidbg
232    SAVE nhoridbg, nidbg    SAVE nhoridbg, nidbg
# Line 251  SUBROUTINE clmain(dtime, itap, date0, pc Line 251  SUBROUTINE clmain(dtime, itap, date0, pc
251    ! -- LOOP    ! -- LOOP
252    
253    REAL yt10m(klon), yq10m(klon)    REAL yt10m(klon), yq10m(klon)
254    !IM cf. AM : pbl, hbtm2 (Comme les autres diagnostics on cumule ds    !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds
255    ! physiq ce qui permet de sortir les grdeurs par sous surface)    ! physiq ce qui permet de sortir les grdeurs par sous surface)
256    REAL pblh(klon, nbsrf)    REAL pblh(klon, nbsrf)
257    REAL plcl(klon, nbsrf)    REAL plcl(klon, nbsrf)
# Line 290  SUBROUTINE clmain(dtime, itap, date0, pc Line 290  SUBROUTINE clmain(dtime, itap, date0, pc
290    PARAMETER (t_coup=273.15)    PARAMETER (t_coup=273.15)
291    
292    CHARACTER (len=20) :: modname = 'clmain'    CHARACTER (len=20) :: modname = 'clmain'
   LOGICAL check  
   PARAMETER (check=.FALSE.)  
293    
294    !------------------------------------------------------------    !------------------------------------------------------------
295    
296    ! initialisation Anne    ! initialisation Anne
297    ytherm = 0.    ytherm = 0.
298    
   IF (check) THEN  
      print *, modname, '  klon=', klon  
   END IF  
   
299    IF (debugindex .AND. first_appel) THEN    IF (debugindex .AND. first_appel) THEN
300       first_appel = .FALSE.       first_appel = .FALSE.
301    
# Line 450  SUBROUTINE clmain(dtime, itap, date0, pc Line 444  SUBROUTINE clmain(dtime, itap, date0, pc
444          END IF          END IF
445       END DO       END DO
446    
      IF (check) THEN  
         print *, 'CLMAIN, nsrf, knon =', nsrf, knon  
      END IF  
   
447       ! variables pour avoir une sortie IOIPSL des INDEX       ! variables pour avoir une sortie IOIPSL des INDEX
448       IF (debugindex) THEN       IF (debugindex) THEN
449          tabindx = 0.          tabindx = 0.
# Line 527  SUBROUTINE clmain(dtime, itap, date0, pc Line 517  SUBROUTINE clmain(dtime, itap, date0, pc
517          END DO          END DO
518       END DO       END DO
519    
   
520       ! calculer Cdrag et les coefficients d'echange       ! calculer Cdrag et les coefficients d'echange
521       CALL coefkz(nsrf, knon, ypaprs, ypplay, & !IM 261103       CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&
522            ksta, ksta_ter, & !IM 261103            yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)
           yts, yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)  
523       !IM 081204 BEG       !IM 081204 BEG
524       !CR test       !CR test
525       IF (iflag_pbl==1) THEN       IF (iflag_pbl==1) THEN
# Line 586  SUBROUTINE clmain(dtime, itap, date0, pc Line 574  SUBROUTINE clmain(dtime, itap, date0, pc
574          yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, &          yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, &
575               1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg               1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg
576          DO k = 2, klev          DO k = 2, klev
577             yzlay(1:knon, k) = yzlay(1:knon, k-1) + rd*0.5*(yt(1:knon, k-1)+yt(1: &             yzlay(1:knon, k) = yzlay(1:knon, k-1) &
578                  knon, k))/ypaprs(1:knon, k)*(ypplay(1:knon, k-1)-ypplay(1:knon, k))/ &                  + rd*0.5*(yt(1:knon, k-1) +yt(1: knon, k)) &
579                    / ypaprs(1:knon, k) *(ypplay(1:knon, k-1)-ypplay(1:knon, k))/ &
580                  rg                  rg
581          END DO          END DO
582          DO k = 1, klev          DO k = 1, klev
583             yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1)/ypplay(1:knon, k)) &             yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &
584                  **rkappa*(1.+0.61*yq(1:knon, k))                  / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))
585          END DO          END DO
586          yzlev(1:knon, 1) = 0.          yzlev(1:knon, 1) = 0.
587          yzlev(1:knon, klev+1) = 2.*yzlay(1:knon, klev) - yzlay(1:knon, klev-1)          yzlev(1:knon, klev+1) = 2.*yzlay(1:knon, klev) - yzlay(1:knon, klev-1)
# Line 644  SUBROUTINE clmain(dtime, itap, date0, pc Line 633  SUBROUTINE clmain(dtime, itap, date0, pc
633       ! calculer la diffusion des vitesses "u" et "v"       ! calculer la diffusion des vitesses "u" et "v"
634       !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
635    
636       CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yu, ypaprs, ypplay, ydelp, &       CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yu, ypaprs, ypplay, &
637            y_d_u, y_flux_u)            ydelp, y_d_u, y_flux_u)
638       CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yv, ypaprs, ypplay, ydelp, &       CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yv, ypaprs, ypplay, &
639            y_d_v, y_flux_v)            ydelp, y_d_v, y_flux_v)
640    
641       ! pour le couplage       ! pour le couplage
642       ytaux = y_flux_u(:, 1)       ytaux = y_flux_u(:, 1)
# Line 801  SUBROUTINE clmain(dtime, itap, date0, pc Line 790  SUBROUTINE clmain(dtime, itap, date0, pc
790       END DO       END DO
791    
792       CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &       CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &
793            tairsol, qairsol, rugo1, psfce, patm, &            tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &
794            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)            yu10m, yustar)
795       !IM 081204 END       !IM 081204 END
796    
797       DO j = 1, knon       DO j = 1, knon
# Line 816  SUBROUTINE clmain(dtime, itap, date0, pc Line 805  SUBROUTINE clmain(dtime, itap, date0, pc
805    
806       END DO       END DO
807    
      !IM cf AM : pbl, HBTM  
808       DO i = 1, knon       DO i = 1, knon
809          y_cd_h(i) = ycoefh(i, 1)          y_cd_h(i) = ycoefh(i, 1)
810          y_cd_m(i) = ycoefm(i, 1)          y_cd_m(i) = ycoefm(i, 1)
811       END DO       END DO
812       !     print*, 'appel hbtm2'       CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &
813       CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, y_flux_t, &            y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &
814            y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, ycteicl, ypblt, ytherm, &            ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
           ytrmb1, ytrmb2, ytrmb3, ylcl)  
      !     print*, 'fin hbtm2'  
815    
816       DO j = 1, knon       DO j = 1, knon
817          i = ni(j)          i = ni(j)
Legend:
Removed from v.15  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.21