Changeset 467 for LMDZ.3.3


Ignore:
Timestamp:
Aug 6, 2003, 4:50:49 PM (21 years ago)
Author:
lmdzadmin
Message:

Modifs sur les seuils (cdrag etc...), inclusion des diagnostics ISCCP par Ionela
LF

Location:
LMDZ.3.3/branches/rel-LF/libf/phylmd
Files:
16 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clcdrag.F90

    r418 r467  
    4040!
    4141! Quelques constantes et options:
    42       REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
     42!!$PB      REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
     43      REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
    4344!
    4445! Variables locales :
    … …  
    6869        zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*rugos(i))))**2
    6970!
    70         IF (zri(i) .ge. 0.) THEN      ! situation stable
     71!!$        IF (zri(i) .ge. 0.) THEN      ! situation stable
     72        IF (zri(i) .gt. 0.) THEN      ! situation stable
    7173          zri(i) = min(20.,zri(i))
    7274          IF (.NOT.zxli) THEN
    … …  
    7577            zcfm1(i) = zcdn(i) * FRIV
    7678            FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
    77             zcfh1(i) = zcdn(i) * FRIH
     79!!$  PB          zcfh1(i) = zcdn(i) * FRIH
     80            zcfh1(i) = 0.8 * zcdn(i) * FRIH
    7881            pcfm(i) = zcfm1(i)
    7982            pcfh(i) = zcfh1(i)
    … …  
    8790                 *(1.0+zgeop(i)/(RG*rugos(i)))))
    8891            zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
    89             zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
     92!!$PB            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
     93            zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
    9094            pcfm(i) = zcfm2(i)
    9195            pcfh(i) = zcfh2(i)
    … …  
    9498            pcfh(i) = zcdn(i)* fins(zri(i))
    9599          ENDIF
    96           zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
    97           IF(nsrf.EQ.is_oce) pcfh(i) = zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
     100                  zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
     101          IF(nsrf.EQ.is_oce) pcfh(i) =0.8* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
    98102        ENDIF
    99103      END DO

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clesphys.h

    r433 r467  
    66       REAL co2_ppm, solaire
    77       REAL*8 RCO2, RCH4, RN2O, RCFC11, RCFC12 
     8       REAL*8 CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
     9cIM simulateur ISCCP
     10       INTEGER top_height, overlap
     11cIM seuils cdrm, cdrh
     12       REAL cdmmax, cdhmax
    813
    914       COMMON/clesphys/cycle_diurne, soil_model, new_oliq,
    1015     ,     ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad, iflag_con
    1116     ,     , co2_ppm, solaire, RCO2, RCH4, RN2O, RCFC11, RCFC12
     17     ,     , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
     18     ,     , top_height, overlap, cdmmax, cdhmax

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clesphys.inc

    r466 r467  
    66       REAL :: co2_ppm, solaire
    77       DOUBLE PRECISION :: RCO2, RCH4, RN2O, RCFC11, RCFC12 
     8       DOUBLE PRECISION :: CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
     9       INTEGER :: top_height, overlap
     10       REAL :: cdmmax, cdhmax
    811
    912       COMMON/clesphys/cycle_diurne, soil_model, new_oliq, &
    1013     &     ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad, iflag_con &
    11      &     , co2_ppm, solaire, RCO2, RCH4, RN2O, RCFC11, RCFC12
     14     &     , co2_ppm, solaire, RCO2, RCH4, RN2O, RCFC11, RCFC12 &
     15     &     , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt &
     16     &     , top_height, overlap, cdmmax, cdhmax

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F

    r458 r467  
    77     .                  jour, rmu0,
    88     .                  ok_veget, ocean, npas, nexca, ts,
    9      .                  soil_model,ftsoil,qsol,
     9     .                  soil_model,cdmmax, cdhmax, ftsoil,qsol,
    1010     .                  paprs,pplay,radsol,snow,qsurf,evap,albe,alblw,
    1111     .                  fluxlat,
    … …  
    140140c$$$ PB ajout pour soil
    141141      LOGICAL soil_model
     142cIM ajout seuils cdrm, cdrh
     143      REAL cdmmax, cdhmax
    142144      REAL ftsoil(klon,nsoilmx,nbsrf)
    143145      REAL ytsoil(klon,nsoilmx)
    … …  
    481483      ENDDO
    482484c
    483 c
     485cIM cf JLD : on seuille ycoefm et ycoefh
     486      if (nsrf.eq.is_oce) then
     487         do j=1,knon
     488c           ycoefm(j,1)=min(ycoefm(j,1),1.1E-3)
     489            ycoefm(j,1)=min(ycoefm(j,1),cdmmax)
     490c           ycoefh(j,1)=min(ycoefh(j,1),1.1E-3)
     491            ycoefh(j,1)=min(ycoefh(j,1),cdhmax)
     492         enddo
     493      endif
     494
    484495c calculer la diffusion des vitesses "u" et "v"
    485496      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
    … …  
    493504
    494505c FH modif sur le cdrag temperature
    495       do i=1,knon
    496          ycoefh(i,1)=ycoefm(i,1)*0.8
    497       enddo
     506c$$$PB : déplace dans clcdrag
     507c$$$      do i=1,knon
     508c$$$         ycoefh(i,1)=ycoefm(i,1)*0.8
     509c$$$      enddo
    498510
    499511c calculer la diffusion de "q" et de "h"
    … …  
    520532      IF (nsrf.EQ.is_oce) THEN
    521533      DO j = 1, knon
    522          yrugm(j) = 0.018*ycoefm(j,1) * (yu1(j)**2+yv1(j)**2)/RG
     534         yrugm(j) = 0.018*ycoefm(j,1) * (yu1(j)**2+yv1(j)**2)/RG
     535     $      +  0.11*14e-6 / sqrt(ycoefm(j,1) * (yu1(j)**2+yv1(j)**2))
    523536         yrugm(j) = MAX(1.5e-05,yrugm(j))
    524537      ENDDO
    … …  
    12861299      REAL t_coup
    12871300      PARAMETER (t_coup=273.15)
     1301cIM
     1302      LOGICAL check
     1303      PARAMETER (check=.false.)
    12881304c
    12891305c contre-gradient pour la chaleur sensible: Kelvin/metre
    … …  
    13881404      ENDDO
    13891405
    1390 c$$$      PRINT*,' isommet=',isommet,' knon=',knon
     1406      IF (check) THEN
     1407      PRINT*,' isommet=',isommet,' knon=',knon
     1408      ENDIF
    13911409
    13921410      DO k = 2, isommet

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/conf_phys.F90

    r433 r467  
    168168!
    169169!valeur AMIP II
    170   RCH4 = 1.65E-06* 16.043/28.97
     170!OK  RCH4 = 1.65E-06* 16.043/28.97
    171171! RCH4 = 9.137366240938903E-07
    172172!
    173173!ancienne valeur
    174174! RCH4 = 1.72E-06* 16.043/28.97
    175   call getin('RCH4', RCH4)
     175!OK call getin('RCH4', RCH4)
     176  CH4_ppb = 1650.
     177  call getin('CH4_ppb', CH4_ppb)
     178  RCH4 = CH4_ppb * 1.0E-09 * 16.043/28.97
    176179!!
    177180!Config Key  = RN2O
    … …  
    182185!
    183186!valeur AMIP II
    184   RN2O = 306.E-09* 44.013/28.97
     187!OK  RN2O = 306.E-09* 44.013/28.97
    185188! RN2O = 4.648939592682085E-07
    186189!
    187190!ancienne valeur
    188191! RN2O = 310.E-09* 44.013/28.97
    189   call getin('RN2O', RN2O)
     192!OK  call getin('RN2O', RN2O)
     193  N2O_ppb=306.
     194  call getin('N2O_ppb', N2O_ppb)
     195  RN2O = N2O_ppb * 1.0E-09 * 44.013/28.97
    190196!!
    191197!Config Key  = RCFC11
    … …  
    195201!               
    196202!
    197   RCFC11 = 280.E-12* 137.3686/28.97
     203!OK RCFC11 = 280.E-12* 137.3686/28.97
     204  CFC11_ppt = 280.
     205  call getin('CFC11_ppt',CFC11_ppt)
     206  RCFC11=CFC11_ppt* 1.0E-12 * 137.3686/28.97
    198207! RCFC11 = 1.327690990680013E-09
    199   call getin('RCFC11', RCFC11)
     208!OK call getin('RCFC11', RCFC11)
    200209!!
    201210!Config Key  = RCFC12
    … …  
    205214!               
    206215!
    207   RCFC12 = 484.E-12* 120.9140/28.97
     216!OK RCFC12 = 484.E-12* 120.9140/28.97
     217  CFC12_ppt = 484.
     218  call getin('CFC12_ppt',CFC12_ppt)
     219  RCFC12 = CFC12_ppt * 1.0E-12 * 120.9140/28.97
    208220! RCFC12 = 2.020102726958923E-09
    209   call getin('RCFC12', RCFC12)
     221!OK call getin('RCFC12', RCFC12)
    210222!!
    211223!! Constante solaire & Parametres orbitaux & taux gaz effet de serre END
    … …  
    386398  rad_chau2 = 9.0
    387399  call getin('rad_chau2',rad_chau2)
     400
     401!
     402!Config Key  = top_height
     403!Config Desc =
     404!Config Def  = 3
     405!Config Help =
     406!
     407  top_height = 3
     408  call getin('top_height',top_height)
     409
     410!
     411!Config Key  = overlap
     412!Config Desc =
     413!Config Def  = 3
     414!Config Help =
     415!
     416  overlap = 3
     417  call getin('overlap',overlap)
     418
     419
     420!IM
     421!
     422!Config Key  = cdmmax
     423!Config Desc =
     424!Config Def  = 1.3E-3
     425!Config Help =
     426!
     427  cdmmax = 1.3E-3
     428  call getin('cdmmax',cdmmax)
     429
     430!
     431!Config Key  = cdhmax
     432!Config Desc =
     433!Config Def  = 1.1E-3
     434!Config Help =
     435!
     436  cdhmax = 1.1E-3
     437  call getin('cdhmax',cdhmax)
    388438
    389439!
    … …  
    415465  write(numout,*)' co2_ppm =',co2_ppm
    416466  write(numout,*)' RCO2 = ',RCO2
    417   write(numout,*)' RCH4 = ',RCH4
    418   write(numout,*)' RN2O =  ',RN2O
    419   write(numout,*)' RCFC11 =  ',RCFC11
    420   write(numout,*)' RCFC12 =  ',RCFC12
     467  write(numout,*)' CH4_ppb =',CH4_ppb,' RCH4 = ',RCH4
     468  write(numout,*)' N2O_ppb =',N2O_ppb,' RN2O =  ',RN2O
     469  write(numout,*)' CFC11_ppt=',CFC11_ppt,' RCFC11 =  ',RCFC11
     470  write(numout,*)' CFC12_ppt=',CFC12_ppt,' RCFC12 =  ',RCFC12
    421471!IM constantes physiques END
    422472  write(numout,*)' epmax = ', epmax
    … …  
    438488  write(numout,*)' ratqsbas = ',ratqsbas
    439489  write(numout,*)' ratqshaut = ',ratqshaut
     490  write(numout,*)' top_height = ',top_height
     491  write(numout,*)' overlap = ',overlap
    440492
    441493  return

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histday.h

    r463 r467  
    170170     .                32, "ave(X)", zsto,zout)
    171171c
     172         CALL histdef(nid_day, "SWupTOAclr",
     173     .                "SWup clear sky at TOA","W/m2",
     174     .                iim,jjmp1,nhori, 1,1,1,-99,
     175     .                32, "ave(X)", zsto,zout)
     176
     177         CALL histdef(nid_day, "SWupSFCclr",
     178     .                "SWup clear sky at surface","W/m2",
     179     .                iim,jjmp1,nhori, 1,1,1,-99,
     180     .                32, "ave(X)", zsto,zout)
     181
     182         CALL histdef(nid_day, "SWdnTOAclr",
     183     .                "SWdn clear sky at TOA","W/m2",
     184     .                iim,jjmp1,nhori, 1,1,1,-99,
     185     .                32, "ave(X)", zsto,zout)
     186
     187         CALL histdef(nid_day, "SWdnSFCclr",
     188     .                "SWdn clear sky at surface","W/m2",
     189     .                iim,jjmp1,nhori, 1,1,1,-99,
     190     .                32, "ave(X)", zsto,zout)
     191cccIM   
     192         CALL histdef(nid_day, "prw", "Precipitable water", "kg/m2",
     193     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     194     .                "ave(X)", zsto,zout)
     195c
    172196c  Champs dynamiques sur niveaux de pression
    173197

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histhf.h

    r453 r467  
    8383     .                "inst(X)", zsto,zout)
    8484
    85          CALL histdef(nid_hf, "phi500", "Geopotentiel à 500mb", "m2/s2",
     85         CALL histdef(nid_hf, "phi500", "Geopotentiel a 500mb", "m2/s2",
    8686     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    8787     .                "inst(X)", zsto,zout)
    8888
     89cIM cf FH
     90         CALL histdef(nid_hf,"u1","Zonal wind at 1st layer", "m/s",
     91     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     92     .                "inst(X)", zsto,zout)
     93
     94         CALL histdef(nid_hf,"v1","Meridional wind at 1st layer",
     95     .                "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
     96     .                "inst(X)", zsto,zout)
     97 
     98         CALL histdef(nid_hf, "cdrm", " Momentum drag coef.", "-",
     99     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     100     .                "inst(X)", zsto,zout)
     101
     102         CALL histdef(nid_hf, "cdrh", "Heat drag coef.", "-",
     103     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     104     .                "inst(X)", zsto,zout)
     105 
    89106c
    90107         CALL histend(nid_hf)

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmth.h

    r455 r467  
    539539     .                iim,jjmp1,nhori, 1,1,1,-99,
    540540     .                32, "ave(X)", zsto,zout)
     541c
     542         CALL histdef(nid_mth, "prw", "Precipitable water", "kg/m2",
     543     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     544     .                "ave(X)", zsto,zout)
     545
    541546c Champs interpolles sur des niveaux de pression
    542547

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

    r461 r467  
    264264!!$  tsurf_new = 0.
    265265
     266!IM cf JLD
     267  ffonte(1:knon)=0.
     268  fqcalving(1:knon)=0.
     269
    266270  cal = 999999. ; beta = 999999. ; dif_grnd = 999999. ; capsol = 999999.
    267271  alb_new = 999999. ; z0_new = 999999. ; alb_neig = 999999.
    … …  
    10961100!IM cf. JP ---
    10971101
    1098    where(cdrag > 0.01)
    1099      cdrag = 0.01
    1100    endwhere
     1102
     1103! PF et PASB
     1104!   where(cdrag > 0.01)
     1105!     cdrag = 0.01
     1106!   endwhere
    11011107!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
    11021108
    … …  
    11161122
    11171123!IM cf. JP +++
    1118     albedo_keep(:) = (albedo_out(:,1)+albedo_out(:,2))/2.
     1124    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
    11191125!IM cf. JP ---
    11201126
    … …  
    11221128
    11231129!IM cf. JP +++
    1124   swdown_vrai(:) = swnet(:)/(1. - albedo_keep(:))
     1130  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
    11251131!IM cf. JP ---
    11261132

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F

    r421 r467  
    4040#include "mpiclim.h"
    4141c
    42 #include "oasis.h"     
    43                         ! contains the name of communication technique. Here
     42#include "oasis.h"      ! contains the name of communication technique. Here
    4443                        ! cchan=CLIM only is possible.
    4544c                       ! ctype=MPI2
    … …  
    555554      END
    556555
    557       SUBROUTINE halte
    558       print *, 'Attention dans oasis.F, halte est non defini'
    559       RETURN
    560       END
    561 
    562       SUBROUTINE locread
    563       print *, 'Attention dans oasis.F, locread est non defini'
    564       RETURN
    565       END
    566 
    567       SUBROUTINE locwrite
    568       print *, 'Attention dans oasis.F, locwrite est non defini'
    569       RETURN
    570       END
    571 
    572556      SUBROUTINE pipe_model_define
    573557      print*,'Attention dans oasis.F, pipe_model_define est non defini'
    … …  
    590574      END
    591575
    592       SUBROUTINE clim_stepi
    593       print *, 'Attention dans oasis.F, clim_stepi est non defini'
    594       RETURN
    595       END
    596 
    597       SUBROUTINE clim_start
    598       print *, 'Attention dans oasis.F, clim_start est non defini'
    599       RETURN
    600       END
    601 
    602       SUBROUTINE clim_import
    603       print *, 'Attention dans oasis.F, clim_import est non defini'
    604       RETURN
    605       END
    606 
    607       SUBROUTINE clim_export
    608       print *, 'Attention dans oasis.F, clim_export est non defini'
    609       RETURN
    610       END
    611 
    612       SUBROUTINE clim_init
    613       print *, 'Attention dans oasis.F, clim_init est non defini'
    614       RETURN
    615       END
    616 
    617       SUBROUTINE clim_define
    618       print *, 'Attention dans oasis.F, clim_define est non defini'
    619       RETURN
    620       END
    621 
    622       SUBROUTINE clim_quit
    623       print *, 'Attention dans oasis.F, clim_quit est non defini'
    624       RETURN
    625       END
    626 
    627       SUBROUTINE svipc_write
    628       print *, 'Attention dans oasis.F, svipc_write est non defini'
    629       RETURN
    630       END
    631 
    632       SUBROUTINE svipc_close
    633       print *, 'Attention dans oasis.F, svipc_close est non defini'
    634       RETURN
    635       END
    636 
    637       SUBROUTINE svipc_read
    638       print *, 'Attention dans oasis.F, svipc_read est non defini'
    639       RETURN
    640       END
    641 
    642576      SUBROUTINE quitcpl
    643577      print *, 'Attention dans oasis.F, quitcpl est non defini'

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/phyetat0.F

    r442 r467  
    44      SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm_etat0,solaire_etat0,
    55     .            rlat,rlon, pctsrf, tsol,tsoil,deltat,qsurf,qsol,snow,
    6      .           albe, evap, rain_fall, snow_fall, solsw, sollw,
     6     .           albe, alblw, evap, rain_fall, snow_fall, solsw, sollw,
    77     .           fder,radsol,frugs,agesno,clesphy0,
    88     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0,
    … …  
    3434      REAL snow(klon,nbsrf)
    3535      REAL albe(klon,nbsrf)
     36cIM BEG alblw
     37      REAL alblw(klon,nbsrf)
     38cIM END alblw
    3639      REAL evap(klon,nbsrf)
    3740      REAL radsol(klon)
    … …  
    645648
    646649c
     650cIM BEG alblw
     651c Lecture de albedo au sol LW:
     652c
     653      ierr = NF_INQ_VARID (nid, "ALBLW", nvarid)
     654      IF (ierr.NE.NF_NOERR) THEN
     655         PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
     656c        PRINT*, '          Mais je vais essayer de lire ALBLW**'
     657         PRINT*, '          Mais je vais prendre ALBE**'
     658         DO nsrf = 1, nbsrf
     659           DO i = 1, klon
     660             alblw(i,nsrf) = albe(i,nsrf)
     661           ENDDO
     662         ENDDO
     663c          IF (nsrf.GT.99) THEN
     664c            PRINT*, "Trop de sous-mailles"
     665c            CALL abort
     666c          ENDIF
     667c          WRITE(str2,'(i2.2)') nsrf
     668c          ierr = NF_INQ_VARID (nid, "ALBLW"//str2, nvarid)
     669c           IF (ierr.NE.NF_NOERR) THEN
     670c             PRINT*, "phyetat0: Le champ <ALBLW"//str2//"> est absent"
     671c             CALL abort
     672c          ENDIF
     673c#ifdef NC_DOUBLE
     674c           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alblw(1,nsrf))
     675c#else
     676c           ierr = NF_GET_VAR_REAL(nid, nvarid, alblw(1,nsrf))
     677c#endif
     678c          IF (ierr.NE.NF_NOERR) THEN
     679c            PRINT*, "phyetat0: Lecture echouee pour <ALBLW"//str2//">"
     680c            CALL abort
     681c          ENDIF
     682c          xmin = 1.0E+20
     683c          xmax = -1.0E+20
     684c          DO i = 1, klon
     685c             xmin = MIN(alblw(i,nsrf),xmin)
     686c             xmax = MAX(alblw(i,nsrf),xmax)
     687c          ENDDO
     688c          PRINT*,'Albedo du sol ALBLW**:', nsrf, xmin, xmax
     689c        ENDDO
     690      ELSE
     691         PRINT*, 'phyetat0: Le champ <ALBLW> est present'
     692         PRINT*, '          J ignore donc les autres ALBLW**'
     693#ifdef NC_DOUBLE
     694         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alblw(1,1))
     695#else
     696         ierr = NF_GET_VAR_REAL(nid, nvarid, alblw(1,1))
     697#endif
     698         IF (ierr.NE.NF_NOERR) THEN
     699            PRINT*, "phyetat0: Lecture echouee pour <ALBLW>"
     700            CALL abort
     701         ENDIF
     702         xmin = 1.0E+20
     703         xmax = -1.0E+20
     704         DO i = 1, klon
     705            xmin = MIN(alblw(i,1),xmin)
     706            xmax = MAX(alblw(i,1),xmax)
     707         ENDDO
     708         PRINT*,'Neige du sol <ALBLW>', xmin, xmax
     709         DO nsrf = 2, nbsrf
     710         DO i = 1, klon
     711            alblw(i,nsrf) = alblw(i,1)
     712         ENDDO
     713         ENDDO
     714      ENDIF
     715
     716cIM END alblw
     717
     718c
    647719c Lecture de evaporation: 
    648720c

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/phyredem.F

    r443 r467  
    44      SUBROUTINE phyredem (fichnom,dtime,radpas,
    55     .           rlat,rlon, pctsrf,tsol,tsoil,deltat,qsurf,qsol,snow,
    6      .           albedo, evap, rain_fall, snow_fall,
     6     .           albedo, alblw, evap, rain_fall, snow_fall,
    77     .           solsw, sollw,fder,
    88     .           radsol,frugs,agesno,
    … …  
    3636      REAL snow(klon,nbsrf)
    3737      REAL albedo(klon,nbsrf)
     38cIM BEG
     39      REAL alblw(klon,nbsrf)
     40cIM END
    3841      REAL evap(klon,nbsrf)
    3942      REAL rain_fall(klon)
    … …  
    360363#endif
    361364      ENDDO
     365
     366cIM BEG albedo LW
     367        DO nsrf = 1, nbsrf
     368        IF (nsrf.LE.99) THEN
     369        WRITE(str2,'(i2.2)') nsrf
     370        ierr = NF_REDEF (nid)
     371#ifdef NC_DOUBLE
     372        ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_DOUBLE,1,idim2,nvarid)
     373#else
     374        ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_FLOAT,1,idim2,nvarid)
     375#endif
     376        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
     377     .                        "albedo LW de surface No."//str2)
     378        ierr = NF_ENDDEF(nid)
     379        ELSE
     380        PRINT*, "Trop de sous-mailles"
     381        CALL abort
     382        ENDIF
     383#ifdef NC_DOUBLE
     384      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alblw(1,nsrf))
     385#else
     386      ierr = NF_PUT_VAR_REAL (nid,nvarid,alblw(1,nsrf))
     387#endif
     388      ENDDO
     389cIM END albedo LW
    362390c
    363391      DO nsrf = 1, nbsrf

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

    r463 r467  
    191191      PARAMETER(klevp1=klev+1)
    192192#include "raddim.h"
    193       REAL*8 ZFSUP(KDLON,KFLEV+1)
    194       REAL*8 ZFSDN(KDLON,KFLEV+1)
    195       REAL*8 ZFSUP0(KDLON,KFLEV+1)
    196       REAL*8 ZFSDN0(KDLON,KFLEV+1)
     193cc      REAL*8 ZFSUP(KDLON,KFLEV+1)
     194cc      REAL*8 ZFSDN(KDLON,KFLEV+1)
     195cc      REAL*8 ZFSUP0(KDLON,KFLEV+1)
     196cc      REAL*8 ZFSDN0(KDLON,KFLEV+1)
     197c
     198      REAL swdn0(klon,2), swdn(klon,2), swup0(klon,2), swup(klon,2)
     199      SAVE swdn0 , swdn, swup0, swup
    197200
    198201cccIM cf. FH
    199202      real u850(klon),v850(klon),u200(klon),v200(klon)
    200203      real u500(klon),v500(klon),phi500(klon),w500(klon)
     204cIM
     205      real prw(klon)
     206
     207cIM ISCCP - proprietes microphysiques des nuages convectifs
     208      REAL convliq(klon,klev)  ! eau liquide nuageuse convective
     209      REAL convfra(klon,klev)  ! fraction nuageuse convective
     210
     211      REAL cldl_c(klon),cldm_c(klon),cldh_c(klon) !nuages bas, moyen et haut
     212      REAL cldt_c(klon),cldq_c(klon) !nuage total, eau liquide integree
     213      REAL cldl_s(klon),cldm_s(klon),cldh_s(klon) !nuages bas, moyen et haut
     214      REAL cldt_s(klon),cldq_s(klon) !nuage total, eau liquide integree
     215
     216      INTEGER kinv, linv
     217
     218cIM ISCCP simulator BEGIN
     219      INTEGER igfi2D(iim,jjmp1)
     220cv3.4
     221      INTEGER debug, debugcol
     222      INTEGER npoints
     223      PARAMETER(npoints=klon)
     224      INTEGER sunlit(klon)
     225
     226      INTEGER ncol, seed(klon)
     227
     228cIM dans clesphys.h top_height, overlap
     229c     PARAMETER(ncol=100)
     230c     PARAMETER(ncol=625)
     231      PARAMETER(ncol=10)
     232      REAL tautab(0:255)
     233      INTEGER invtau(-20:45000)
     234      REAL emsfc_lw
     235      PARAMETER(emsfc_lw=0.99)
     236      REAL    ran0                      ! type for random number fuction
     237
     238      REAL pfull(klon,klev)
     239      REAL phalf(klon,klev+1)
     240      REAL cldtot(klon,klev)
     241      REAL dtau_s(klon,klev)
     242      REAL dtau_c(klon,klev)
     243      REAL dem_s(klon,klev)
     244      REAL dem_c(klon,klev)
     245cPLUS : variables de haut en bas pour le simulateur ISCCP
     246      REAL qv(klon,klev)
     247      REAL cc(klon,klev)
     248      REAL conv(klon,klev)
     249      REAL dtau_sH2B(klon,klev)
     250      REAL dtau_cH2B(klon,klev)
     251      REAL at(klon,klev)
     252      REAL dem_sH2B(klon,klev)
     253      REAL dem_cH2B(klon,klev)
     254
     255c output from ISCCP
     256      REAL fq_isccp(klon,7,7)
     257      REAL totalcldarea(klon)
     258      REAL meanptop(klon)
     259      REAL meantaucld(klon)
     260      REAL boxtau(klon,ncol)
     261      REAL boxptop(klon,ncol)
     262
     263c grille 4d physique
     264      INTEGER l, ni, nj, kmax, lmax, nrec
     265      INTEGER ni1, ni2, nj1, nj2
     266c     PARAMETER(kmax=7, lmax=7)
     267      PARAMETER(kmax=8, lmax=8)
     268      INTEGER kmaxm1, lmaxm1
     269      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
     270c     INTEGER iimx7, jjmx7, jjmp1x7
     271c     PARAMETER(iimx7=iim*7, jjmx7=jjm*7, jjmp1x7=jjmp1*7)
     272c     REAL fq4d(iim,jjmp1,7,7)
     273c     REAL fq3d(iimx7, jjmp1x7)
     274      INTEGER iimx8, jjmx8, jjmp1x8
     275      PARAMETER(iimx8=iim*8, jjmx8=jjm*8, jjmp1x8=jjmp1*8)
     276      REAL fq4d(iim,jjmp1,8,8)
     277      REAL fq3d(iimx8, jjmp1x8)
     278cIM180603     SAVE fq3d
     279
     280c     REAL maxfq3d, minfq3d
     281c
     282      INTEGER iw, iwmax
     283      REAL wmin, pas_w
     284c     PARAMETER(wmin=-100.,pas_w=10.,iwmax=30)
     285      PARAMETER(wmin=-200.,pas_w=10.,iwmax=40)
     286      REAL o500(klon)
     287      INTEGER nreg, nbreg
     288      PARAMETER(nbreg=5)
     289c     REAL histoW(iwmax,kmaxm1,lmaxm1)
     290      REAL histoW(kmaxm1,lmaxm1,iwmax,nbreg)
     291      REAL nhistoW(kmaxm1,lmaxm1,iwmax,nbreg)
     292cIM180603     
     293c     SAVE histoW, nhistoW
     294c     SAVE nhistoW
     295      REAL nhistoWt(kmaxm1,lmaxm1,iwmax,nbreg)
     296      SAVE nhistoWt
     297
     298c     REAL histoWinv(kmaxm1,lmaxm1,iwmax)
     299c     REAL nhistoW(kmaxm1,lmaxm1,iwmax)
     300      INTEGER linv
     301c     LOGICAL pct_ocean(klon,nbreg)
     302      INTEGER pct_ocean(klon,nbreg)
     303      REAL rlonPOS(klon)
     304c     CHARACTER*4 pdirect
     305 
     306c sorties ISCCP
     307
     308      logical ok_isccp
     309      real ecrit_isccp
     310      integer nid_isccp
     311      save ok_isccp, ecrit_isccp, nid_isccp       
     312
     313#define histISCCP
     314#undef histISCCP
     315#ifdef histISCCP
     316c     data ok_isccp,ecrit_isccp/.true.,0.125/     
     317c     data ok_isccp,ecrit_isccp/.true.,1./     
     318      data ok_isccp/.true./     
     319#else
     320      data ok_isccp/.false./
     321#endif
     322
     323      REAL zx_tau(kmaxm1), zx_pc(lmaxm1), zx_o500(iwmax)
     324c     DATA zx_tau/0.1, 1.3, 3.6, 9.4, 23., 60./
     325c     DATA zx_pc/50., 180., 310., 440., 560., 680., 800., 1015./
     326c     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
     327cOK     DATA zx_tau/0.0, 0.1, 1.3, 3.6, 9.4, 23., 60./
     328cOK     DATA zx_pc/800., 680., 560., 440., 310., 180., 50./
     329
     330c tester l'alure
     331      DATA zx_tau/1., 2., 3., 4., 5., 6., 7./
     332c     DATA zx_pc/1., 2., 3., 4., 5., 6., 7./
     333      DATA zx_pc/7., 6., 5., 4., 3., 2., 1./
     334
     335      INTEGER komega, nhoriRD
     336
     337c statistiques regime dynamique END
     338
     339c     REAL del_lon(iim), del_lat(jjmp1)
     340      REAL del_lon, del_lat
     341c     REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7)
     342      REAL zx_lonx8(iimx8), zx_latx8(jjmp1x8)
     343c     INTEGER nhorix7
     344      INTEGER nhorix8
     345
     346cIM ISCCP simulator END
    201347
    202348      logical ok_hf
    … …  
    497643      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0
    498644cccIM
    499       SAVE  ZFSUP,ZFSDN,ZFSUP0,ZFSDN0
    500645
    501646      INTEGER itaprad
    … …  
    753898         CALL phyetat0 ("startphy.nc",dtime,co2_ppm_etat0,solaire_etat0,
    754899     .       rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsurf,qsol,fsnow,
    755      .       falbe, fevap, rain_fall,snow_fall,solsw, sollwdown,
     900     .       falbe, falblw, fevap, rain_fall,snow_fall,solsw, sollwdown,
    756901     .       dlw,radsol,frugs,agesno,clesphy0,
    757902     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
    … …  
    8801025c   Initialisation des sorties
    8811026c=============================================================
     1027
     1028#ifdef histISCCP
     1029#include "ini_histISCCP.h"
     1030#endif
     1031
    8821032#ifdef histhf
    8831033#include "ini_histhf.h"
    … …  
    9581108      ENDIF
    9591109C
    960       IF (if_ebil.ge.1) THEN
    9611110        DO i = 1, klon
    9621111          ztsol(i) = 0.
    … …  
    9671116          ENDDO
    9681117        ENDDO
     1118C
     1119      IF (if_ebil.ge.1) THEN
    9691120        ztit='after dynamic'
    9701121        CALL diagetpq(paire,ztit,ip_ebil,1,1,dtime
    … …  
    10721223      DO nsrf = 1, nbsrf
    10731224      DO i = 1, klon
    1074          frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
    1075 cccc        frugs(i,nsrf) = MAX(frugs(i,nsrf),0.000015)
     1225c         frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
     1226        frugs(i,nsrf) = MAX(frugs(i,nsrf),0.000015)
    10761227      ENDDO
    10771228      ENDDO
    … …  
    10911242        rmu0 = -999.999
    10921243      ENDIF
    1093 C
     1244cIM BEG
     1245      DO i=1, klon
     1246       sunlit(i)=1
     1247       IF(rmu0(i).EQ.0.) sunlit(i)=0
     1248c      IF(rmu0(i).EQ.0.) THEN
     1249c       sunlit(i)=0
     1250c       PRINT*,' il fait nuit ',i,rlat(i),rlon(i)
     1251c      ENDIF
     1252      ENDDO
     1253cIM END
    10941254C     Calcul de l'abedo moyen par maille
    10951255      albsol(:)=0.
    … …  
    11031263C
    11041264C     Repartition sous maille des flux LW et SW
    1105       DO nsrf = 1, nbsrf
    1106       DO i = 1, klon
    1107         fsollw(i,nsrf) = sollwdown(i) - RSIGMA*ftsol(i,nsrf)**4
    1108         fsolsw(i,nsrf) = solsw(i)*(1.-falbe(i,nsrf))/(1.-albsol(i))
    1109       ENDDO
    1110       ENDDO
     1265C Modif OM+PASB+JLD
     1266C Repartition du longwave par sous-surface linearisee
     1267Cn
     1268       DO nsrf = 1, nbsrf
     1269       DO i = 1, klon
     1270c$$$        fsollw(i,nsrf) = sollwdown(i) - RSIGMA*ftsol(i,nsrf)**4
     1271c$$$        fsollw(i,nsrf) = sollw(i)
     1272         fsollw(i,nsrf) = sollw(i)
     1273     $      + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i,nsrf))
     1274         fsolsw(i,nsrf) = solsw(i)*(1.-falbe(i,nsrf))/(1.-albsol(i))
     1275       ENDDO
     1276       ENDDO
    11111277
    11121278      fder = dlw
    … …  
    11161282     e            julien, rmu0,
    11171283     e            ok_veget, ocean, npas, nexca, ftsol,
    1118      $            soil_model,ftsoil, qsol,
     1284     $            soil_model,cdmmax, cdhmax, ftsoil, qsol,
    11191285     $            paprs,pplay,radsol, fsnow,fqsurf,fevap,falbe,falblw,
    11201286     $            fluxlat,
    … …  
    16161782      enddo
    16171783
     1784cIM ISCCP simulator BEGIN
     1785      IF (ok_isccp) THEN
     1786cIM calcul tau. emi nuages convectifs
     1787      convfra(:,:)=rnebcon(:,:)
     1788      convliq(:,:)=rnebcon(:,:)*clwcon(:,:)
     1789c     CALL newmicro (paprs, pplay,ok_newmicro,
     1790c    .            t_seri, cldliq, cldfra, cldtau, cldemi,
     1791c    .            cldh, cldl, cldm, cldt, cldq)
     1792      CALL newmicro (paprs, pplay,ok_newmicro,
     1793     .            t_seri, convliq, convfra, dtau_c, dem_c,
     1794     .            cldh_c, cldl_c, cldm_c, cldt_c, cldq_c)
     1795
     1796cIM calcul tau. emi nuages startiformes
     1797      CALL newmicro (paprs, pplay,ok_newmicro,
     1798     .            t_seri, cldliq, cldfra, dtau_s, dem_s,
     1799     .            cldh_s, cldl_s, cldm_s, cldt_s, cldq_s)
     1800cIM calcul diagramme (PC, tau) cf. ISCCP D
     1801c     seed=50
     1802c     seed=ran0(klon)
     1803cT1O3     
     1804c     top_height=1
     1805cT3O3
     1806c     top_height=3
     1807c     overlap=3
     1808cIM cf GCM     
     1809      cldtot(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
     1810
     1811cIM inversion des niveaux de pression ==> de haut en bas
     1812      DO k=1,klev
     1813       kinv=klev-k+1
     1814       DO i=1,klon
     1815        pfull(i,k)=pplay(i,kinv)
     1816c on met toutes les variables de Haut 2 Bas
     1817        qv(i,k)=q_seri(i,kinv)
     1818        cc(i,k)=cldtot(i,kinv)
     1819        conv(i,k)=rnebcon(i,kinv)
     1820        dtau_sH2B(i,k)=dtau_s(i,kinv)
     1821        dtau_cH2B(i,k)=dtau_c(i,kinv)
     1822        at(i,k)=t_seri(i,kinv)
     1823        dem_sH2B(i,k)=dem_s(i,kinv)
     1824        dem_cH2B(i,k)=dem_c(i,kinv)
     1825
     1826       ENDDO
     1827      ENDDO
     1828
     1829      DO k=1,klev+1
     1830       kinv=klev-k+2
     1831       DO i=1,klon
     1832        phalf(i,k)=paprs(i,kinv)
     1833       ENDDO
     1834      ENDDO
     1835
     1836c     open(99,file='tautab.bin',access='sequential',
     1837c    $     form='unformatted',status='old')
     1838c     read(99) tautab
     1839
     1840cIM210503
     1841      IF (debut) THEN
     1842      open(99,file='tautab.formatted', FORM='FORMATTED')
     1843      read(99,'(f30.20)') tautab
     1844      close(99)
     1845c
     1846      open(99,file='invtau.formatted',form='FORMATTED')
     1847      read(99,'(i10)') invtau
     1848      close(99)
     1849c
     1850       nsrf=3
     1851       DO nreg=1, nbreg
     1852       DO i=1, klon
     1853
     1854c       IF (debut) THEN
     1855         IF(rlon(i).LT.0.) THEN
     1856           rlonPOS(i)=rlon(i)+360.
     1857         ELSE
     1858           rlonPOS(i)=rlon(i) 
     1859         ENDIF
     1860c       ENDIF
     1861
     1862c       pct_ocean(i,nreg)=.FALSE.
     1863        pct_ocean(i,nreg)=0
     1864
     1865c      DO nsrf = 1, nbsrf
     1866
     1867c test si c'est 1 point d'ocean
     1868        IF(pctsrf(i,nsrf).EQ.1.) THEN
     1869
     1870         IF(nreg.EQ.1) THEN
     1871
     1872c TROP
     1873          IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
     1874c          pct_ocean(i,nreg)=.TRUE.
     1875           pct_ocean(i,nreg)=1
     1876          ENDIF
     1877
     1878c PACIFIQUE NORD
     1879          ELSEIF(nreg.EQ.2) THEN
     1880           IF(rlat(i).GE.40.AND.rlat(i).LE.60.) THEN
     1881            IF(rlonPOS(i).GE.160..AND.rlonPOS(i).LE.235.) THEN
     1882c            pct_ocean(i,nreg)=.TRUE.
     1883             pct_ocean(i,nreg)=1
     1884            ENDIF
     1885           ENDIF
     1886c CALIFORNIE ST-CU
     1887         ELSEIF(nreg.EQ.3) THEN
     1888          IF(rlonPOS(i).GE.220..AND.rlonPOS(i).LE.250.) THEN
     1889           IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
     1890c           pct_ocean(i,nreg)=.TRUE.
     1891            pct_ocean(i,nreg)=1
     1892           ENDIF
     1893          ENDIF
     1894c HAWAI
     1895        ELSEIF(nreg.EQ.4) THEN
     1896         IF(rlonPOS(i).GE.180..AND.rlonPOS(i).LE.220.) THEN
     1897          IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
     1898c          pct_ocean(i,nreg)=.TRUE.
     1899           pct_ocean(i,nreg)=1
     1900          ENDIF
     1901         ENDIF
     1902c WARM POOL
     1903        ELSEIF(nreg.EQ.5) THEN
     1904         IF(rlonPOS(i).GE.70..AND.rlonPOS(i).LE.150.) THEN
     1905          IF(rlat(i).GE.-5.AND.rlat(i).LE.20.) THEN
     1906c          pct_ocean(i,nreg)=.TRUE.
     1907           pct_ocean(i,nreg)=1
     1908          ENDIF
     1909         ENDIF
     1910        ENDIF !nbreg
     1911c TROP
     1912c        IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
     1913c         pct_ocean(i)=.TRUE.
     1914c         WRITE(*,*) 'pct_ocean =',i, rlon(i), rlat(i)
     1915c          ENDIF !lon
     1916c         ENDIF !lat
     1917
     1918        ENDIF !pctsrf
     1919c      ENDDO
     1920       ENDDO !klon
     1921       ENDDO !nbreg
     1922 
     1923cIM somme de toutes les nhistoW BEG
     1924      DO nreg = 1, nbreg
     1925      DO k = 1, kmaxm1
     1926      DO l = 1, lmaxm1
     1927      DO iw = 1, iwmax
     1928       nhistoWt(k,l,iw,nreg)=0.
     1929      ENDDO
     1930      ENDDO
     1931      ENDDO
     1932      ENDDO
     1933cIM somme de toutes les nhistoW END
     1934      ENDIF
     1935
     1936
     1937c     CALL ISCCP_CLOUD_TYPES(nlev,ncol,seed,pfull,phalf,qv,
     1938c    &     cc,conv,dtau_s,dtau_c,top_height,overlap,
     1939c    &     tautab,invtau,skt,emsfc_lw,at,dem_s,dem_c,fq_isccp,
     1940c    &     totalcldarea,meanptop,meantaucld,boxtau,boxptop)
     1941
     1942c     DO i=1, klon
     1943c     i=1
     1944c1011  CONTINUE
     1945c
     1946cIM on verifie les donnees de INPUT en dehors du simulateur ISCCP
     1947cIM 1D non-vectorise (!) pour qu'on gagne du temps ...
     1948cIM
     1949c BEGIN find unpermittable data.....
     1950!     ---------------------------------------------------!
     1951!     find unpermittable data.....
     1952!
     1953c     do 13 k=1,klev
     1954c ca prend trop de temps ??
     1955c     cldtot(:,:) = min(max(cldtot(:,:),0.),1.)
     1956c     rnebcon(:,:) = min(max(rnebcon(:,:),0.),1.)
     1957c     dtau_s(:,:) = max(dtau_s(:,:),0.)
     1958c     dem_s(:,:) = min(max(dem_s(:,:),0.),1.)
     1959c     dtau_c(:,:) = max(dtau_c(:,:),0.)
     1960c     dem_c(:,:) = min(max(dem_c(:,:),0.),1.)
     1961c ca prend trop de temps ??
     1962
     1963c           if (cldtot(i,k) .lt. 0.) then
     1964c               print *, ' error = cloud fraction less than zero'
     1965c               STOP
     1966c           end if
     1967c           if (cldtot(i,k) .gt. 1.) then
     1968c               print *, ' error = cloud fraction greater than 1'
     1969c               STOP
     1970c           end if
     1971c           if (rnebcon(i,k) .lt. 0.) then
     1972c               print *,
     1973c    &           ' error = convective cloud fraction less than zero'
     1974c               STOP
     1975c           end if
     1976c           if (rnebcon(i,k) .gt. 1.) then
     1977c               print *,
     1978c    &           ' error = convective cloud fraction greater than 1'
     1979c               STOP
     1980c           end if
     1981
     1982c           if (dtau_s(i,k) .lt. 0.) then
     1983c               print *,
     1984c    &           ' error = stratiform cloud opt. depth less than zero'
     1985c               STOP
     1986c           end if
     1987c           if (dem_s(i,k) .lt. 0.) then
     1988c               print *,
     1989c    &           ' error = stratiform cloud emissivity less than zero'
     1990c               STOP
     1991c           end if
     1992c           if (dem_s(i,k) .gt. 1.) then
     1993c               print *,
     1994c    &           ' error = stratiform cloud emissivity greater than 1'
     1995c               STOP
     1996c           end if
     1997
     1998c           if (dtau_c(i,k) .lt. 0.) then
     1999c               print *,
     2000c    &           ' error = convective cloud opt. depth less than zero'
     2001c               STOP
     2002c           end if
     2003c           if (dem_c(i,k) .lt. 0.) then
     2004c               print *,
     2005c    &           ' error = convective cloud emissivity less than zero'
     2006c               STOP
     2007c           end if
     2008c           if (dem_c(i,k) .gt. 1.) then
     2009c               print *,
     2010c    &           ' error = convective cloud emissivity greater than 1'
     2011c               STOP
     2012c           end if
     2013c13    continue
     2014
     2015!     ---------------------------------------------------!
     2016c
     2017c END   find unpermittable data.....
     2018cv2.2.1.1     DO i=1, klon
     2019c     i=1
     2020c     seed=i
     2021c
     2022cv3.4
     2023      if (debut) then
     2024        DO i=1, klon
     2025          seed(i)=i+100
     2026c         seed(i)=i+50
     2027        ENDDO
     2028      endif
     2029c     seed=aint(ran0(klon))
     2030c     CALL ISCCP_CLOUD_TYPES(klev,ncol,seed,pfull(i,:),phalf(i,:)
     2031cv2.2.1.1
     2032c     CALL ISCCP_CLOUD_TYPES(klev,ncol,seed(i),pfull(i,:),phalf(i,:)
     2033c    &     ,q_seri(i,:),
     2034c    &     cldtot(i,:),rnebcon(i,:),dtau_s(i,:),dtau_c(i,:),
     2035c    &     top_height,overlap,
     2036c    &     tautab,invtau,ztsol,emsfc_lw,t_seri(i,:),dem_s(i,:),
     2037c    &     dem_c(i,:),
     2038c    &     fq_isccp(i,:,:),
     2039c    &     totalcldarea(i),meanptop(i),meantaucld(i),
     2040c    &     boxtau(i,:),boxptop(i,:))
     2041cv2.2.1.1
     2042cv3.4
     2043      debug=0
     2044      debugcol=0
     2045cIM260503
     2046c o500 ==> distribution nuage ftion du regime dynamique
     2047      DO i=1, klon
     2048       o500(i)=omega(i,8)*864.
     2049c      PRINT*,'pphi8 ',pphi(i,8),'zphi8,11,12',zphi(i,8),
     2050c    & zphi(i,11),zphi(i,12)
     2051      ENDDO
     2052
     2053c axe vertical pour les differents niveaux des histogrammes
     2054c     DO iw=1, iwmax
     2055c       zx_o500(iw)=wmin+(iw-1./2.)*pas_w
     2056c     ENDDO
     2057c     PRINT*,' phys AVANT seed(3361)=',seed(3361)
     2058      CALL ISCCP_CLOUD_TYPES(
     2059     &     debug,
     2060     &     debugcol,
     2061     &     klon,
     2062     &     sunlit,
     2063     &     klev,
     2064     &     ncol,
     2065     &     seed,
     2066     &     pfull,
     2067     &     phalf,
     2068c var de bas en haut ==> PB !
     2069c    &     q_seri,
     2070c    &     cldtot,
     2071c    &     rnebcon,
     2072c    &     dtau_s,
     2073c    &     dtau_c,
     2074c var de Haut en Bas BEG
     2075     &     qv, cc, conv, dtau_sH2B, dtau_cH2B,
     2076c var de Haut en Bas END
     2077     &     top_height,
     2078     &     overlap,
     2079     &     tautab,
     2080     &     invtau,
     2081     &     ztsol,
     2082     &     emsfc_lw,
     2083c var de bas en haut ==> PB !
     2084c    &     t_seri,
     2085c    &     dem_s,
     2086c    &     dem_c,
     2087c var de Haut en Bas BEG
     2088     &     at, dem_sH2B, dem_cH2B,
     2089cIM260503
     2090c    &     o500, pct_ocean,
     2091c var de Haut en Bas END
     2092     &     fq_isccp,
     2093     &     totalcldarea,
     2094     &     meanptop,
     2095     &     meantaucld,
     2096     &     boxtau,
     2097     &     boxptop)
     2098c    &     boxptop,
     2099cIM 260503
     2100c    &     histoW,
     2101c    &     nhistoW   
     2102c    &)
     2103
     2104cIM 200603
     2105c     PRINT*,'physiq fq_isccp(6,1,1)',fq_isccp(6,1,1)
     2106       
     2107cIM 200603
     2108cIM somme de toutes les nhistoW BEG
     2109c     DO k = 1, kmaxm1
     2110c     DO l = 1, lmaxm1
     2111c     DO iw = 1, iwmax
     2112c     nhistoWt(k,l,iw)=nhistoWt(k,l,iw)+nhistoW(k,l,iw)
     2113ccc      IF(k.EQ.1.AND.l.EQ.1.AND.iw.EQ.1) then
     2114c      IF(nhistoWt(k,l,iw).NE.0.) THEN
     2115c       PRINT*,' physiq nWt', k,l,iw,nhistoWt(k,l,iw)
     2116c      ENDIF
     2117c     ENDDO
     2118c     ENDDO
     2119c     ENDDO
     2120cIM somme de toutes les nhistoW END
     2121c     PRINT*,' phys APRES seed(3361)=',seed(3361)
     2122cv3.4
     2123c     i=i+1
     2124c     IF(i.LE.klon) THEN
     2125c      GOTO 1011
     2126c     ENDIF
     2127cv2.2.1.1     ENDDO
     2128
     2129c passage de la grille (klon,7,7) a (iim,jjmp1,7,7)
     2130c     minfq3d=100.
     2131c     maxfq3d=0.
     2132cIM calcul des correspondances entre la grille physique et
     2133cIM la grille dynamique
     2134c     DO i=1, klon
     2135c       grid_phys(i)=i
     2136c       PRINT*,'i, grid_phys',i,grid_phys(i)
     2137c     ENDDO
     2138c     CALL gr_fi_dyn(1,klon,iimp1,jjmp1,grid_phys,grid_dyn)
     2139c     DO j=1, jjmp1
     2140c       DO i=1, iimp1
     2141c        PRINT*,'i,j grid_dyn ',i,j,grid_dyn(i,j)
     2142c       ENDDO
     2143c     ENDDO
     2144c
     2145      DO l=1, lmax
     2146       DO k=1, kmax
     2147cIM grille physique ==> grille ecriture 2D (iim,jjmp1)
     2148c
     2149        DO i=1, iim
     2150          fq4d(i,1,k,l)=fq_isccp(1,k,l)
     2151cc         PRINT*,'first j=1 i =',i
     2152        ENDDO
     2153        DO j=2, jjm
     2154          DO i=1, iim
     2155cERROR ??         ig=i+iim*(j-1)
     2156          ig=i+1+(j-2)*iim
     2157cc         PRINT*,'i =',i,'j =',j,'ig=',ig
     2158          fq4d(i,j,k,l)=fq_isccp(ig,k,l)             
     2159         ENDDO
     2160        ENDDO
     2161        DO i=1, iim
     2162          fq4d(i,jjmp1,k,l)=fq_isccp(klon,k,l)
     2163cc         PRINT*,'last jjmp1 i =',i
     2164        ENDDO
     2165        IF(debut) THEN
     2166        DO j=1, jjmp1
     2167          DO i=1, iim
     2168            IF(j.GE.2.AND.j.LE.jjm) THEN
     2169              igfi2D(i,j)=i+1+(j-2)*iim
     2170c             PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)
     2171            ELSEIF(j.EQ.1) THEN
     2172              igfi2D(i,j)=1
     2173c             PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)
     2174            ELSEIF(j.EQ.jjmp1) THEN
     2175              igfi2D(i,j)=klon
     2176c             PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)
     2177            ENDIF
     2178          ENDDO
     2179        ENDDO
     2180        ENDIF
     2181c       STOP
     2182c
     2183c       CALL gr_fi_ecrit(1,klon,iim,jjmp1,fq_isccp(:,k,l),
     2184c    $       fq4d(:,:,k,l))
     2185       ENDDO
     2186      ENDDO
     2187      DO l=1, lmax
     2188       fq4d(:,:,8,l)=-1.e+10
     2189       fq4d(:,:,l,8)=-1.e+10
     2190      ENDDO
     2191      DO l=1, lmax
     2192       DO k=1, kmax 
     2193        DO j=1, jjmp1
     2194         DO i=1, iim
     2195
     2196c inversion TAU ?!
     2197c         ni=(i-1)*lmax+l
     2198c         nj=(j-1)*kmax+kmax-k+1
     2199c
     2200c210503 inversion en PC ==> pas besoin !!!
     2201c         ni=(i-1)*lmax+lmax-l+1
     2202c         nj=(j-1)*kmax+k
     2203c
     2204c210503
     2205          ni=(i-1)*lmax+l
     2206          nj=(j-1)*kmax+k
     2207 
     2208c210503         if(k.EQ.8) then
     2209c          fq4d(i,j,8,l)=-1.e+10
     2210c         endif
     2211
     2212c210503         if(l.EQ.8) then
     2213c          fq4d(i,j,k,8)=-1.e+10
     2214c         endif
     2215
     2216          fq3d(ni,nj)=fq4d(i,j,k,l)
     2217
     2218c         if(fq3d(ni,nj).lt.0.) then
     2219c          print*,' fq3d LT ZERO ',ni,nj,fq3d(ni,nj)
     2220c         endif
     2221c         if(fq3d(ni,nj).gt.100.) then
     2222c          print*,' fq3d GT 100 ',ni,nj,fq3d(ni,nj)
     2223c         endif
     2224c max & min fq3d
     2225c         if(fq3d(ni,nj).gt.maxfq3d) maxfq3d=fq3d(ni,nj)
     2226c         if(fq3d(ni,nj).lt.minfq3d) minfq3d=fq3d(ni,nj)
     2227         
     2228         ENDDO
     2229        ENDDO
     2230c       fq4d(:,:,8,l)=-1.e+10
     2231c       fq4d(:,:,k,8)=-1.e+10
     2232c       k=k+1
     2233c       if(k.LE.kmax) then
     2234c        goto 1022
     2235c       endif
     2236       ENDDO
     2237c      l=l+1
     2238c      if(l.LE.lmax) then
     2239c       goto 1021
     2240c      endif
     2241      ENDDO
     2242
     2243c     print*,' minfq3d=',minfq3d,' maxfq3d=',maxfq3d
     2244c
     2245c calculs statistiques distribution nuage ftion du regime dynamique
     2246c     DO i=1, klon
     2247c!      o500(i)=omega(i,9)*864.
     2248c!      PRINT*,' o500=',o500(i),' pphi(9)=',pphi(i,9)
     2249c       o500(i)=omega(i,8)*864.
     2250cc      PRINT*,' pphi(8)',pphi(i,8),'pphi(11)',pphi(i,11),
     2251cc    .'pphi(12)',pphi(i,12)
     2252cc      PRINT*,' zphi8,11,12=',zphi(i,8),zphi(i,11),zphi(i,12)
     2253cc     PRINT*,' o500',o500(i),' w500',w500(i)
     2254c     ENDDO
     2255
     2256c axe vertical pour les differents niveaux des histogrammes
     2257c     DO iw=1, iwmax
     2258c       zx_o500(iw)=wmin+(iw-1./2.)*pas_w
     2259c     ENDDO
     2260
     2261
     2262c Ce calcul doit etre fait a partir de valeurs mensuelles ??
     2263cc     CALL histo_o500_pctau(o500,fq4d,histoW)
     2264cc     CALL histo_o500_pctau(paire,pctsrf,o500,fq4d,histoW)
     2265cc     CALL histo_o500_pctau(pct_ocean,rlat,o500,fq4d,histoW)
     2266ccOK ???     CALL histo_o500_pctau(pct_ocean,o500,fq4d,histoW)
     2267c     CALL histo_o500_pctau(klon,pct_ocean,o500,fq4d,histoW,nhistoW)
     2268c     CALL histo_o500_pctau(klon,pct_ocean,o500,fq_isccp,
     2269      CALL histo_o500_pctau(nbreg,pct_ocean,o500,fq_isccp,
     2270     &histoW,nhistoW)
     2271c
     2272cIM somme de toutes les nhistoW BEG
     2273      DO nreg=1, nbreg
     2274      DO k = 1, kmaxm1
     2275      DO l = 1, lmaxm1
     2276      DO iw = 1, iwmax
     2277       nhistoWt(k,l,iw,nreg)=nhistoWt(k,l,iw,nreg)+
     2278     & nhistoW(k,l,iw,nreg)
     2279ccc      IF(k.EQ.1.AND.l.EQ.1.AND.iw.EQ.1) then
     2280c      IF(nhistoWt(k,l,iw).NE.0.) THEN
     2281c       PRINT*,' physiq nWt', k,l,iw,nhistoWt(k,l,iw)
     2282c      ENDIF
     2283      ENDDO
     2284      ENDDO
     2285      ENDDO
     2286      ENDDO
     2287cIM somme de toutes les nhistoW END
     2288c
     2289c     IF(lafin) THEN   
     2290c     DO nreg=1, nbreg
     2291c     DO iw=1, iwmax
     2292c     DO l=1,lmaxm1
     2293c     DO k=1,kmaxm1
     2294c      IF(histoW(k,l,iw,nreg).NE.0.) then
     2295c        PRINT*,'physiq H nH',k,l,iw,
     2296c    &       histoW(k,l,iw,nreg),
     2297c    &       nhistoW(k,l,iw,nreg),nhistoWt(k,l,iw,nreg)
     2298c      ENDIF
     2299c     ENDDO
     2300c     ENDDO
     2301c     ENDDO
     2302c     ENDDO
     2303cIM verif fq_isccp, fq4d, fq3d
     2304c     DO l=1, lmaxm1
     2305c       DO k=1,kmaxm1
     2306c     i=74
     2307c     j=36
     2308c     DO j=1, jjmp1
     2309c      DO i=1, iim
     2310c       DO l=1, lmaxm1
     2311c         WRITE(*,'(a,3i4,7f10.4)')
     2312c    &    'fq_isccp,j,i,l=',j,i,l,
     2313c    &    (fq_isccp(igfi2D(i,j),k,l),k=1,kmaxm1)
     2314c         WRITE(*,'(a,3i4,7f10.4)')
     2315c    &    'fq4d,j,i,l=',j,i,l,(fq4d(i,j,k,l),k=1,kmaxm1)
     2316c       ENDDO
     2317c      ENDDO
     2318c     ENDDO
     2319c     ni1=(i-1)*8+1
     2320c     ni2=i*8
     2321c     nj1=(j-1)*8+1
     2322c     nj2=j*8
     2323c     DO ni=ni1,ni2
     2324c     WRITE(*,'(a,2i4,7f10.4)')
     2325c    &     'fq3d, ni,nj=',ni,nj,
     2326c    &      (fq3d(ni,nj),nj=nj1,nj2)
     2327c     ENDDO
     2328c     ENDIF
     2329
     2330c     DO iw=1, iwmax
     2331c      DO l=1,lmaxm1
     2332c       DO k=1,kmaxm1
     2333c        PRINT*,' iw,l,k,nhistoW=',iw,l,k,nhistoW(k,l,iw)
     2334c       ENDDO
     2335c      ENDDO
     2336c     ENDDO
     2337
     2338c       DO iw=1, iwmax
     2339c        DO l=1, lmaxm1
     2340c         linv=lmaxm1-l+1
     2341c         DO k=1, kmaxm1
     2342c         histoWinv(k,l,iw)=histoW(iw,k,l)
     2343c       ENDDO
     2344c      ENDDO
     2345c     ENDDO
     2346c
     2347c pb syncronisation ?? : 48 * 30 * 7 (jour1) + 48* 29 * 7 (jour suivant)
     2348c
     2349
     2350
     2351      ENDIF !ok_isccp
     2352cIM ISCCP simulator END
     2353
    16182354c   On prend la somme des fractions nuageuses et des contenus en eau
    16192355      cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
    … …  
    17172453cccIMs             topsw0,toplw0,solsw0,sollw0)
    17182454     s             topsw0,toplw0,solsw0,sollw0,
    1719      s             ZFSUP,ZFSDN,ZFSUP0,ZFSDN0)
     2455     s             swdn0, swdn, swup0, swup     )
    17202456      itaprad = 0
    17212457      ENDIF
    … …  
    19682704cIM cf. FH     slp(:) = paprs(:,1)*exp(pphis(:)/(289.*t_seri(:,1)))
    19692705      slp(:) = paprs(:,1)*exp(pphis(:)/(RD*t_seri(:,1)))
     2706c     PRINT*,' physiq slp ',slp(2185),paprs(2185,1),pphis(2185),
     2707c    .       RD,t_seri(2185,1)
     2708c
     2709ccc prw = eau precipitable
     2710      DO i = 1, klon
     2711       prw(i) = 0.
     2712      DO k = 1, klev
     2713       prw(i) = prw(i) +
     2714     .          q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
     2715      ENDDO
     2716c      PRINT*,' i ',i,' prw',prw(i)
     2717      ENDDO
    19702718c
    19712719
    … …  
    19732721c   Ecriture des sorties
    19742722c=============================================================
     2723
     2724#ifdef histISCCP
     2725#include "write_histISCCP.h"
     2726#endif
    19752727
    19762728#ifdef histhf
    … …  
    20242776         CALL phyredem ("restartphy.nc",dtime,radpas,
    20252777     .      rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsurf, qsol,
    2026      .      fsnow, falbe, fevap, rain_fall, snow_fall,
     2778     .      fsnow, falbe,falblw, fevap, rain_fall, snow_fall,
    20272779     .      solsw, sollwdown,dlw,
    20282780     .      radsol,frugs,agesno,

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/radlwsw.F

    r433 r467  
    77     .                  sollwdown,
    88     .                  topsw0,toplw0,solsw0,sollw0,
    9      .                  ZFSUP,ZFSDN,ZFSUP0,ZFSDN0)
     9     .                  swdn0, swdn, swup0, swup    )
    1010      IMPLICIT none
    1111c======================================================================
    … …  
    9898      REAL*8 zsolsw0(kdlon), zsollw0(kdlon)
    9999      REAL*8 zznormcp
     100      REAL swdn(klon,2),swdn0(klon,2),swup(klon,2),swup0(klon,2)
    100101c
    101102c-------------------------------------------
    … …  
    234235         sollw0(iof+i) = zsollw0(i)
    235236         albpla(iof+i) = zalbpla(i)
     237         swdn0 ( iof+i,1)   = ZFSDN0 ( i,1 )
     238         swdn0 ( iof+i,2)   = ZFSDN0 ( i,kflev + 1 )
     239         swdn  ( iof+i,1)   = ZFSDN  ( i,1 )
     240         swdn  ( iof+i,2)   = ZFSDN  ( i,kflev + 1 )
     241         swup0 ( iof+i,1)   = ZFSUP0 ( i,1 )
     242         swup0 ( iof+i,2)   = ZFSUP0 ( i,kflev + 1 )
     243         swup  ( iof+i,1)   = ZFSUP  ( i,1 )
     244         swup  ( iof+i,2)   = ZFSUP  ( i,kflev + 1 )
    236245      ENDDO
    237246      DO k = 1, kflev

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histday.h

    r463 r467  
    160160c    .              'Cloud liquid water path','-')
    161161c
    162       zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
     162c     zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
     163      zx_tmp_fi2d(1 : klon) = swup( 1 : klon, 2 )
     164
    163165      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    164166      CALL histwrite(nid_day, "SWupTOA",itau_w,zx_tmp_2d,
    165167     .                               iim*jjmp1,ndex2d)
    166168c
    167       zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
     169c      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
     170      zx_tmp_fi2d(1 : klon) = swup( 1 : klon, 1 )
     171
    168172      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    169173      CALL histwrite(nid_day, "SWupSFC",itau_w,zx_tmp_2d,
    170174     .                               iim*jjmp1,ndex2d)
    171175c
    172       zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
     176c      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
     177      zx_tmp_fi2d(1 : klon) = swdn( 1 : klon, 2 )
     178
    173179      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    174180      CALL histwrite(nid_day, "SWdnTOA",itau_w,zx_tmp_2d,
    175181     .                               iim*jjmp1,ndex2d)
    176182c
    177       zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
     183c      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
     184      zx_tmp_fi2d(1 : klon) = swdn( 1 : klon, 1 )
     185
    178186      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    179187      CALL histwrite(nid_day, "SWdnSFC",itau_w,zx_tmp_2d,
    180188     .                               iim*jjmp1,ndex2d)
    181189
     190c      zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, klevp1)
     191      zx_tmp_fi2d(1 : klon) = swup0( 1 : klon, 2 )
     192
     193      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
     194      CALL histwrite(nid_day, "SWupTOAclr",itau_w,zx_tmp_2d,
     195     .                               iim*jjmp1,ndex2d)
     196
     197c      zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, 1)
     198      zx_tmp_fi2d(1 : klon) = swup0( 1 : klon, 1 )
     199
     200      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
     201      CALL histwrite(nid_day, "SWupSFCclr",itau_w,zx_tmp_2d,
     202     .                               iim*jjmp1,ndex2d)
     203 
     204c      zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, klevp1)
     205      zx_tmp_fi2d(1 : klon) = swdn0( 1 : klon, 2 )
     206
     207      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
     208      CALL histwrite(nid_day, "SWdnTOAclr",itau_w,zx_tmp_2d,
     209     .                               iim*jjmp1,ndex2d)
     210 
     211c      zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, 1)
     212      zx_tmp_fi2d(1 : klon) = swdn0( 1 : klon, 1 )
     213
     214      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
     215      CALL histwrite(nid_day, "SWdnSFCclr",itau_w,zx_tmp_2d,
     216     .                               iim*jjmp1,ndex2d)
     217cIM
     218      CALL gr_fi_ecrit(1, klon,iim,jjmp1, prw,zx_tmp_2d)
     219      CALL histwrite(nid_day,"prw",itau_w,zx_tmp_2d,
     220     .               iim*jjmp1,ndex2d)
    182221
    183222c   Ecriture de champs dynamiques sur des niveaux de pression
    … …  
    211250     .               iim*jjmp1,ndex2d)
    212251
    213       zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, klevp1)
    214       CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    215       CALL histwrite(nid_day, "SWupTOAclr",itau_w,zx_tmp_2d,
    216      .                               iim*jjmp1,ndex2d)
    217 
    218       zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, 1)
    219       CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    220       CALL histwrite(nid_day, "SWupSFCclr",itau_w,zx_tmp_2d,
    221      .                               iim*jjmp1,ndex2d)
    222  
    223       zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, klevp1)
    224       CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    225       CALL histwrite(nid_day, "SWdnTOAclr",itau_w,zx_tmp_2d,
    226      .                               iim*jjmp1,ndex2d)
    227  
    228       zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, 1)
    229       CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    230       CALL histwrite(nid_day, "SWdnSFCclr",itau_w,zx_tmp_2d,
    231      .                               iim*jjmp1,ndex2d)
    232252
    233253c

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmth.h

    r463 r467  
    459459c
    460460cccIM
    461       zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
     461c      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
     462      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 2 )
    462463      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    463464      CALL histwrite(nid_mth, "SWupTOA",itau_w,zx_tmp_2d,
    464465     .                               iim*jjmp1,ndex2d)
    465466c
    466       zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
     467c      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
     468      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 1 )
    467469      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    468470      CALL histwrite(nid_mth, "SWupSFC",itau_w,zx_tmp_2d,
    469471     .                               iim*jjmp1,ndex2d)
    470472c
    471       zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
     473c      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
     474      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 2 )
    472475      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    473476      CALL histwrite(nid_mth, "SWdnTOA",itau_w,zx_tmp_2d,
    474477     .                               iim*jjmp1,ndex2d)
    475478c
    476       zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
     479c      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
     480      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 1 )
    477481      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    478482      CALL histwrite(nid_mth, "SWdnSFC",itau_w,zx_tmp_2d,
    479483     .                               iim*jjmp1,ndex2d)
    480484c
     485      CALL gr_fi_ecrit(1, klon,iim,jjmp1, prw,zx_tmp_2d)
     486      CALL histwrite(nid_mth,"prw",itau_w,zx_tmp_2d,
     487     .               iim*jjmp1,ndex2d)
     488
    481489cccIM clear sky
    482       zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, klevp1)
     490c      zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, klevp1)
     491      zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, 2 )
    483492      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    484493      CALL histwrite(nid_mth, "SWupTOAclr",itau_w,zx_tmp_2d,
    485494     .                               iim*jjmp1,ndex2d)
    486495c
    487       zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, 1)
     496c      zx_tmp_fi2d(1 : klon) = ZFSUP0( 1 : klon, 1)
     497      zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, 1 )
    488498      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    489499      CALL histwrite(nid_mth, "SWupSFCclr",itau_w,zx_tmp_2d,
    490500     .                               iim*jjmp1,ndex2d)
    491501c
    492       zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, klevp1)
     502c      zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, klevp1)
    493503      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    494504      CALL histwrite(nid_mth, "SWdnTOAclr",itau_w,zx_tmp_2d,
    495505     .                               iim*jjmp1,ndex2d)
    496506c
    497       zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, 1)
     507c      zx_tmp_fi2d(1 : klon) = ZFSDN0( 1 : klon, 1)
     508      zx_tmp_fi2d(1 : klon) = swdn0 ( 1 : klon, 1 )
    498509      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
    499510      CALL histwrite(nid_mth, "SWdnSFCclr",itau_w,zx_tmp_2d,
Note: See TracChangeset for help on using the changeset viewer.