Ignore:
Timestamp:
Jun 29, 2018, 12:31:11 PM (7 years ago)
Author:
Laurent Fairhead
Message:

First attempt at merging with trunk

Location:
LMDZ6/branches/DYNAMICO-conv
Files:
17 deleted
6 edited
17 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/DYNAMICO-conv

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/cosp/cosp_output_mod.F90

    r2955 r3356  
    1212                            numMODISReffLiqBins, reffLIQ_binCenters
    1313
     14     IMPLICIT NONE
    1415! cosp_output_mod
    1516      INTEGER, PRIVATE             :: i
    … …  
    254255  real                      :: zjulian,zjulian_start
    255256  real,dimension(Ncolumns)  :: column_ax
    256   real,dimension(2,SR_BINS) :: sratio_bounds
    257   real,dimension(SR_BINS)   ::  sratio_ax
    258257  real,dimension(DBZE_BINS) ::  dbze_ax
    259258  CHARACTER(LEN=20), DIMENSION(3)  :: chfreq = (/ '1day', '1d  ', '3h  ' /)           
     259  real,parameter,dimension(SR_BINS) :: sratio_ax = (/0.005, &
     260                                                  0.605,2.09,4.,6., &
     261                                          8.5,12.5,17.5,22.5,27.5,35.,45.,55.,70.,50040./)
    260262
    261263!!! Variables d'entree
    … …  
    282284    enddo
    283285 
    284 
    285     sratio_bounds(2,:)=stlidar%srbval(:) ! srbval contains the upper
    286 !                                         limits from lmd_ipsl_stats.f90
    287     sratio_bounds(1,2:SR_BINS) = stlidar%srbval(1:SR_BINS-1)
    288     sratio_bounds(1,1)         = 0.0
    289     sratio_bounds(2,SR_BINS)   = 1.e5 ! This matches with Chepfer et al., JGR,
    290 !                                    ! 2009. However, it is not consistent
    291                                      ! with the upper limit in
    292                                      ! lmd_ipsl_stats.f90, which is
    293                                      ! LIDAR_UNDEF-1=998.999
    294      sratio_ax(:) = (sratio_bounds(1,:)+sratio_bounds(2,:))/2.0
    295 
    296286    cosp_outfilenames(1) = 'histmthCOSP'
    297287    cosp_outfilenames(2) = 'histdayCOSP'
    … …  
    352342! AI nov 2015
    353343   CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
    354    CALL wxios_add_vaxis("cth16", MISR_N_CTH, MISR_CTH)
     344   CALL wxios_add_vaxis("cth", MISR_N_CTH, MISR_CTH)
    355345   CALL wxios_add_vaxis("dbze", DBZE_BINS, dbze_ax)
    356346   CALL wxios_add_vaxis("scatratio", SR_BINS, sratio_ax)
    … …  
    400390      CALL histvert(cosp_nidfiles(iff),"temp","temperature","C",LIDAR_NTEMP,LIDAR_PHASE_TEMP,nverttemp(iff))
    401391
    402       CALL histvert(cosp_nidfiles(iff),"cth16","altitude","m",MISR_N_CTH,MISR_CTH,nvertmisr(iff))
     392      CALL histvert(cosp_nidfiles(iff),"cth","altitude","m",MISR_N_CTH,MISR_CTH,nvertmisr(iff))
    403393 
    404394      CALL histvert(cosp_nidfiles(iff),"ReffIce","Effective_particle_size_Ice","microns",numMODISReffIceBins, reffICE_binCenters, &

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/cosp/cosp_output_write_mod.F90

    r2955 r3356  
    66   USE cosp_output_mod
    77 
     8   IMPLICIT NONE
     9
    810   INTEGER, SAVE  :: itau_iocosp
    911!$OMP THREADPRIVATE(itau_iocosp)
    … …  
    2729#ifdef CPP_XIOS
    2830    USE wxios, only: wxios_closedef
    29     USE xios, only: xios_update_calendar
    30 #endif
    31 
     31    USE xios, only: xios_update_calendar, xios_field_is_active
     32#endif
     33  IMPLICIT NONE 
    3234!!! Variables d'entree
    3335  integer               :: itap, Nlevlmdz, Ncolumns, Npoints
    … …  
    4547
    4648!!! Variables locales
    47   integer               :: icl
     49  integer               :: icl,k,ip
    4850  logical               :: ok_sync
    49   integer               :: itau_wcosp
     51  integer               :: itau_wcosp, iff
    5052  real, dimension(Npoints,PARASOL_NREFL) :: parasolcrefl, Ncref
    5153
     54! Variables locals intermidiaires pour inverser les axes des champs 4D
     55! Compatibilite avec sorties CMIP
     56  real, dimension(Npoints,Nlevout,SR_BINS) :: tmp_fi4da_cfadL
     57  real, dimension(Npoints,Nlevout,DBZE_BINS) :: tmp_fi4da_cfadR
     58  real, dimension(Npoints,MISR_N_CTH,7) :: tmp_fi4da_misr
    5259
    5360#ifdef CPP_XIOS
    … …  
    7986! On n'ecrit pas quand itap=1 (cosp)
    8087
    81    if (prt_level >= 10) then
    82          WRITE(lunout,*)'DO iinit=1, iinitend ',iinitend
    83    endif
    84 
    85 !#ifdef CPP_XIOS
     88!   if (prt_level >= 10) then
     89!         WRITE(lunout,*)'DO iinit=1, iinitend ',iinitend
     90!   endif
     91
     92!!#ifdef CPP_XIOS
    8693! !$OMP MASTER
    8794!IF (cosp_varsdefined) THEN
    … …  
    94101!  !$OMP END MASTER
    95102!  !$OMP BARRIER
    96 !#endif
    97 
     103!!#endif
     104
     105!!!! Sorties Calipso
    98106 if (cfg%Llidar_sim) then
    99 ! Pb des valeurs indefinies, on les met a 0
    100 ! A refaire proprement
    101   do k = 1,Nlevout
    102      do ip = 1,Npoints
    103      if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
    104       stlidar%lidarcld(ip,k)=missing_val
    105      endif
    106      if(stlidar%proftemp(ip,k).eq.R_UNDEF)then !TIBO
    107       stlidar%proftemp(ip,k)=missing_val       !TIBO
    108      endif                                     !TIBO
    109      enddo
    110 
    111      do ii= 1,SR_BINS
    112       do ip = 1,Npoints
    113        if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
    114         stlidar%cfad_sr(ip,ii,k)=missing_val
    115        endif
    116       enddo
    117      enddo
    118 
    119      do ii= 1,Ncolumns                               !TIBO
    120       do ip = 1,Npoints                              !TIBO
    121 !       if(stlidar%profSR(ip,ii,k).eq.R_UNDEF)then    !TIBO
    122 !        stlidar%profSR(ip,ii,k)=missing_val          !TIBO
    123        if(stlidar%profSR(ip,k,ii).eq.R_UNDEF)then    !TIBO2
    124         stlidar%profSR(ip,k,ii)=missing_val          !TIBO2
    125        endif                                         !TIBO
    126       enddo                                          !TIBO
    127      enddo                                           !TIBO
    128   enddo
    129 
    130   do ip = 1,Npoints
    131    do k = 1,Nlevlmdz
    132      if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
    133       sglidar%beta_mol(ip,k)=missing_val
    134      endif
    135 
    136      do ii= 1,Ncolumns
    137        if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
    138         sglidar%beta_tot(ip,ii,k)=missing_val
    139        endif
    140      enddo
    141 
    142     enddo    !k = 1,Nlevlmdz
    143    enddo     !ip = 1,Npoints
    144 
    145    do k = 1,LIDAR_NCAT
    146     do ip = 1,Npoints
    147      if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
    148        stlidar%cldlayer(ip,k)=missing_val
    149      endif
    150     enddo
    151    enddo
    152 
    153    do k = 1,LIDAR_NTYPE                       !OPAQ
    154     do ip = 1,Npoints                         !OPAQ
    155      if(stlidar%cldtype(ip,k).eq.R_UNDEF)then !OPAQ
    156        stlidar%cldtype(ip,k)=missing_val      !OPAQ
    157      endif                                    !OPAQ
    158     enddo                                     !OPAQ
    159    enddo                                      !OPAQ
    160 
     107!!! AI 02 2018
     108! Traitement missing_val
     109   where(stlidar%lidarcld == R_UNDEF) stlidar%lidarcld = missing_val
     110   where(stlidar%proftemp == R_UNDEF) stlidar%proftemp = missing_val   !TIBO 
     111   where(stlidar%profSR == R_UNDEF) stlidar%profSR = missing_val       !TIBO2
     112   where(sglidar%beta_mol == R_UNDEF) sglidar%beta_mol = missing_val 
     113   where(sglidar%beta_tot == R_UNDEF) sglidar%beta_tot = missing_val
     114   where(stlidar%cldlayer == R_UNDEF) stlidar%cldlayer = missing_val
     115   where(stlidar%cldtype == R_UNDEF) stlidar%cldtype = missing_val     !OPAQ
     116   where(stlidar%cfad_sr == R_UNDEF) stlidar%cfad_sr = missing_val
    161117! AI 11 / 2015
    162 
    163118   where(stlidar%parasolrefl == R_UNDEF) stlidar%parasolrefl = missing_val
    164119   where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = missing_val
    … …  
    167122   where(stlidar%lidarcldtype == R_UNDEF) stlidar%lidarcldtype = missing_val   !OPAQ
    168123   where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = missing_val
    169    
    170 
    171    print*,'Appel histwrite2d_cosp'
    172    CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1))
    173    CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3))
    174    CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2))
    175    CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4))
    176    CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert)
    177    CALL histwrite3d_cosp(o_clcalipsotmp,stlidar%lidarcldtmp(:,:,1),nverttemp)
    178 
    179    CALL histwrite2d_cosp(o_cllcalipsoice,stlidar%cldlayerphase(:,1,1))
    180    CALL histwrite2d_cosp(o_clhcalipsoice,stlidar%cldlayerphase(:,3,1))
    181    CALL histwrite2d_cosp(o_clmcalipsoice,stlidar%cldlayerphase(:,2,1))
    182    CALL histwrite2d_cosp(o_cltcalipsoice,stlidar%cldlayerphase(:,4,1))
    183    CALL histwrite3d_cosp(o_clcalipsoice,stlidar%lidarcldphase(:,:,1),nvert)
    184    CALL histwrite3d_cosp(o_clcalipsotmpice,stlidar%lidarcldtmp(:,:,2),nverttemp)
    185 
    186    CALL histwrite2d_cosp(o_cllcalipsoliq,stlidar%cldlayerphase(:,1,2))
    187    CALL histwrite2d_cosp(o_clhcalipsoliq,stlidar%cldlayerphase(:,3,2))
    188    CALL histwrite2d_cosp(o_clmcalipsoliq,stlidar%cldlayerphase(:,2,2))
    189    CALL histwrite2d_cosp(o_cltcalipsoliq,stlidar%cldlayerphase(:,4,2))
    190    CALL histwrite3d_cosp(o_clcalipsoliq,stlidar%lidarcldphase(:,:,2),nvert)
    191    CALL histwrite3d_cosp(o_clcalipsotmpliq,stlidar%lidarcldtmp(:,:,3),nverttemp)
    192 
    193    CALL histwrite2d_cosp(o_cllcalipsoun,stlidar%cldlayerphase(:,1,3))
    194    CALL histwrite2d_cosp(o_clhcalipsoun,stlidar%cldlayerphase(:,3,3))
    195    CALL histwrite2d_cosp(o_clmcalipsoun,stlidar%cldlayerphase(:,2,3))
    196    CALL histwrite2d_cosp(o_cltcalipsoun,stlidar%cldlayerphase(:,4,3))
    197    CALL histwrite3d_cosp(o_clcalipsoun,stlidar%lidarcldphase(:,:,3),nvert)
    198    CALL histwrite3d_cosp(o_clcalipsotmpun,stlidar%lidarcldtmp(:,:,4),nverttemp)
    199 
    200    CALL histwrite2d_cosp(o_clopaquecalipso,stlidar%cldtype(:,1))               !OPAQ
    201    CALL histwrite2d_cosp(o_clthincalipso,stlidar%cldtype(:,2))                 !OPAQ
    202    CALL histwrite2d_cosp(o_clzopaquecalipso,stlidar%cldtype(:,3))              !OPAQ
    203 
    204    CALL histwrite3d_cosp(o_clcalipsoopaque,stlidar%lidarcldtype(:,:,1),nvert)  !OPAQ
    205    CALL histwrite3d_cosp(o_clcalipsothin,stlidar%lidarcldtype(:,:,2),nvert)    !OPAQ
    206    CALL histwrite3d_cosp(o_clcalipsozopaque,stlidar%lidarcldtype(:,:,3),nvert) !OPAQ
    207    CALL histwrite3d_cosp(o_clcalipsoopacity,stlidar%lidarcldtype(:,:,4),nvert) !OPAQ
    208 
    209    CALL histwrite3d_cosp(o_proftemp,stlidar%proftemp,nvert)                    !TIBO
    210 
    211 #ifdef CPP_XIOS
    212    CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr)
    213    CALL histwrite4d_cosp(o_profSR,stlidar%profSR)                              !TIBO
     124 
     125!   print*,'Appel histwrite2d_cosp'
     126   if (cfg%Lcllcalipso) CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1))
     127   if (cfg%Lclhcalipso) CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3))
     128   if (cfg%Lclmcalipso) CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2))
     129   if (cfg%Lcltcalipso) CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4))
     130   if (cfg%Lclcalipso) CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert)
     131   if (cfg%Lclcalipsotmp) CALL histwrite3d_cosp(o_clcalipsotmp,stlidar%lidarcldtmp(:,:,1),nverttemp)
     132
     133   if (cfg%Lcllcalipsoice) CALL histwrite2d_cosp(o_cllcalipsoice,stlidar%cldlayerphase(:,1,1))
     134   if (cfg%Lclhcalipsoice) CALL histwrite2d_cosp(o_clhcalipsoice,stlidar%cldlayerphase(:,3,1))
     135   if (cfg%Lclmcalipsoice) CALL histwrite2d_cosp(o_clmcalipsoice,stlidar%cldlayerphase(:,2,1))
     136   if (cfg%Lcltcalipsoice) CALL histwrite2d_cosp(o_cltcalipsoice,stlidar%cldlayerphase(:,4,1))
     137   if (cfg%Lclcalipsoice) CALL histwrite3d_cosp(o_clcalipsoice,stlidar%lidarcldphase(:,:,1),nvert)
     138   if (cfg%Lclcalipsotmpice) CALL histwrite3d_cosp(o_clcalipsotmpice,stlidar%lidarcldtmp(:,:,2),nverttemp)
     139
     140   if (cfg%Lcllcalipsoliq) CALL histwrite2d_cosp(o_cllcalipsoliq,stlidar%cldlayerphase(:,1,2))
     141   if (cfg%Lclhcalipsoliq) CALL histwrite2d_cosp(o_clhcalipsoliq,stlidar%cldlayerphase(:,3,2))
     142   if (cfg%Lclmcalipsoliq) CALL histwrite2d_cosp(o_clmcalipsoliq,stlidar%cldlayerphase(:,2,2))
     143   if (cfg%Lcltcalipsoliq) CALL histwrite2d_cosp(o_cltcalipsoliq,stlidar%cldlayerphase(:,4,2))
     144   if (cfg%Lclcalipsoliq) CALL histwrite3d_cosp(o_clcalipsoliq,stlidar%lidarcldphase(:,:,2),nvert)
     145   if (cfg%Lclcalipsotmpliq) CALL histwrite3d_cosp(o_clcalipsotmpliq,stlidar%lidarcldtmp(:,:,3),nverttemp)
     146
     147   if (cfg%Lcllcalipsoun) CALL histwrite2d_cosp(o_cllcalipsoun,stlidar%cldlayerphase(:,1,3))
     148   if (cfg%Lclhcalipsoun) CALL histwrite2d_cosp(o_clhcalipsoun,stlidar%cldlayerphase(:,3,3))
     149   if (cfg%Lclmcalipsoun) CALL histwrite2d_cosp(o_clmcalipsoun,stlidar%cldlayerphase(:,2,3))
     150   if (cfg%Lcltcalipsoun) CALL histwrite2d_cosp(o_cltcalipsoun,stlidar%cldlayerphase(:,4,3))
     151   if (cfg%Lclcalipsoun) CALL histwrite3d_cosp(o_clcalipsoun,stlidar%lidarcldphase(:,:,3),nvert)
     152   if (cfg%Lclcalipsotmpun) CALL histwrite3d_cosp(o_clcalipsotmpun,stlidar%lidarcldtmp(:,:,4),nverttemp)
     153
     154   if (cfg%Lclopaquecalipso) CALL histwrite2d_cosp(o_clopaquecalipso,stlidar%cldtype(:,1))               !OPAQ
     155   if (cfg%Lclthincalipso) CALL histwrite2d_cosp(o_clthincalipso,stlidar%cldtype(:,2))                 !OPAQ
     156   if (cfg%Lclzopaquecalipso) CALL histwrite2d_cosp(o_clzopaquecalipso,stlidar%cldtype(:,3))              !OPAQ
     157
     158   if (cfg%Lclcalipsoopaque) CALL histwrite3d_cosp(o_clcalipsoopaque,stlidar%lidarcldtype(:,:,1),nvert)  !OPAQ
     159   if (cfg%Lclcalipsothin) CALL histwrite3d_cosp(o_clcalipsothin,stlidar%lidarcldtype(:,:,2),nvert)    !OPAQ
     160   if (cfg%Lclcalipsozopaque) CALL histwrite3d_cosp(o_clcalipsozopaque,stlidar%lidarcldtype(:,:,3),nvert) !OPAQ
     161   if (cfg%Lclcalipsoopacity) CALL histwrite3d_cosp(o_clcalipsoopacity,stlidar%lidarcldtype(:,:,4),nvert) !OPAQ
     162
     163   if (cfg%Lproftemp) CALL histwrite3d_cosp(o_proftemp,stlidar%proftemp,nvert)                    !TIBO
     164
     165#ifdef CPP_XIOS
     166   do icl=1,SR_BINS
     167      tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
     168   enddo
     169!   if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr)
     170   if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,tmp_fi4da_cfadL)
     171   if (cfg%LprofSR) CALL histwrite4d_cosp(o_profSR,stlidar%profSR)                              !TIBO
    214172#else
    215    do icl=1,SR_BINS
    216       CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
     173   if (cfg%LcfadLidarsr532) then
     174     do icl=1,SR_BINS
     175        CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
     176     enddo
     177   endif
     178   if (cfg%LprofSR) then
     179     do icl=1,Ncolumns                                                              !TIBO
     180        CALL histwrite3d_cosp(o_profSR,stlidar%profSR(:,icl,:),nvert,icl)           !TIBO
     181     enddo                                                                          !TIBO
     182   endif
     183#endif
     184   if (cfg%LparasolRefl) CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
     185
     186  if (cfg%LparasolRefl) then
     187    do k=1,PARASOL_NREFL
     188     do ip=1, Npoints
     189      if (stlidar%cldlayer(ip,4).gt.0.01.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
     190        parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
     191                             stlidar%cldlayer(ip,4)
     192         Ncref(ip,k) = 1.
     193      else
     194         parasolcrefl(ip,k)=missing_val
     195         Ncref(ip,k) = 0.
     196      endif
     197     enddo
     198    enddo
     199    CALL histwrite3d_cosp(o_Ncrefl,Ncref,nvertp)
     200    CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp)
     201  endif
     202
     203#ifdef CPP_XIOS
     204   if (cfg%Latb532) CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
     205#else
     206   if (cfg%Latb532) then 
     207     do icl=1,Ncolumns
     208        CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
     209     enddo
     210   endif
     211#endif
     212
     213   if (cfg%LlidarBetaMol532) CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp)
     214
     215 endif !Lidar
     216
     217!!! Sorties Cloudsat
     218 if (cfg%Lradar_sim) then
     219
     220   where(stradar%cfad_ze == R_UNDEF) stradar%cfad_ze = missing_val
     221#ifdef CPP_XIOS
     222   do icl=1,DBZE_BINS
     223     tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
    217224   enddo
    218    do icl=1,Ncolumns                                                              !TIBO
    219       CALL histwrite3d_cosp(o_profSR,stlidar%profSR(:,icl,:),nvert,icl)           !TIBO
    220    enddo                                                                          !TIBO
    221      CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
    222 #endif
    223 
    224    do k=1,PARASOL_NREFL
    225     do ip=1, Npoints
    226      if (stlidar%cldlayer(ip,4).gt.0.01.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
    227        parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
    228                             stlidar%cldlayer(ip,4)
    229         Ncref(ip,k) = 1.
    230      else
    231         parasolcrefl(ip,k)=missing_val
    232         Ncref(ip,k) = 0.
    233      endif
     225   if (cfg%Ldbze94) CALL histwrite4d_cosp(o_dbze94,sgradar%Ze_tot)
     226!   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
     227   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
     228#else
     229   if (cfg%Ldbze94) then
     230    do icl=1,Ncolumns
     231       CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
    234232    enddo
    235    
    236    enddo
    237    CALL histwrite3d_cosp(o_Ncrefl,Ncref,nvertp)
    238    CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp)
    239 
    240 #ifdef CPP_XIOS
    241    CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
    242 #else
    243    do icl=1,Ncolumns
    244       CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
    245    enddo
    246 #endif
    247 
    248    CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp)
    249  endif !Lidar
    250 
    251  if (cfg%Lradar_sim) then
    252 
    253 #ifdef CPP_XIOS
    254    CALL histwrite4d_cosp(o_dbze94,sgradar%Ze_tot)
    255    CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
    256 #else
    257    do icl=1,Ncolumns
    258       CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvertmcosp,icl)
    259    enddo
    260    do icl=1,DBZE_BINS
     233   endif
     234   if (cfg%LcfadDbze94) then
     235    do icl=1,DBZE_BINS
    261236    CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
    262    enddo
     237    enddo
     238   endif
    263239#endif
    264240 endif
    265 
     241! endif pour radar
     242
     243!!! Sorties combinees Cloudsat et Calipso
    266244 if (cfg%Llidar_sim .and. cfg%Lradar_sim) then
    267245   where(stradar%lidar_only_freq_cloud == R_UNDEF) &
    268246                           stradar%lidar_only_freq_cloud = missing_val
    269    CALL histwrite3d_cosp(o_clcalipso2,stradar%lidar_only_freq_cloud,nvert)
     247   if (cfg%Lclcalipso) CALL histwrite3d_cosp(o_clcalipso2,stradar%lidar_only_freq_cloud,nvert)
    270248   where(stradar%radar_lidar_tcc == R_UNDEF) &
    271249                           stradar%radar_lidar_tcc = missing_val
    272    CALL histwrite2d_cosp(o_cltlidarradar,stradar%radar_lidar_tcc)
     250   if (cfg%Lcltlidarradar) CALL histwrite2d_cosp(o_cltlidarradar,stradar%radar_lidar_tcc)
    273251 endif
    274252
     253!!! Sorties Isccp
    275254 if (cfg%Lisccp_sim) then
    276 
    277 ! Traitement des valeurs indefinies
    278    do ip = 1,Npoints
    279     if(isccp%totalcldarea(ip).eq.R_UNDEF)then
    280       isccp%totalcldarea(ip)=missing_val
    281     endif
    282     if(isccp%meanptop(ip).eq.R_UNDEF)then
    283       isccp%meanptop(ip)=missing_val
    284     endif
    285     if(isccp%meantaucld(ip).eq.R_UNDEF)then
    286       isccp%meantaucld(ip)=missing_val
    287     endif
    288     if(isccp%meanalbedocld(ip).eq.R_UNDEF)then
    289      isccp%meanalbedocld(ip)=missing_val
    290     endif
    291     if(isccp%meantb(ip).eq.R_UNDEF)then
    292      isccp%meantb(ip)=missing_val
    293     endif
    294     if(isccp%meantbclr(ip).eq.R_UNDEF)then
    295        isccp%meantbclr(ip)=missing_val
    296     endif
    297 
    298     do k=1,7
    299      do ii=1,7
    300      if(isccp%fq_isccp(ip,ii,k).eq.R_UNDEF)then
    301       isccp%fq_isccp(ip,ii,k)=missing_val
    302      endif
     255  where(isccp%totalcldarea == R_UNDEF) isccp%totalcldarea = missing_val
     256  where(isccp%meanptop == R_UNDEF) isccp%meanptop = missing_val
     257  where(isccp%meantaucld == R_UNDEF) isccp%meantaucld = missing_val
     258  where(isccp%meanalbedocld == R_UNDEF) isccp%meanalbedocld = missing_val
     259  where(isccp%meantb == R_UNDEF) isccp%meantb = missing_val
     260  where(isccp%meantbclr == R_UNDEF) isccp%meantbclr = missing_val
     261  where(isccp%fq_isccp == R_UNDEF) isccp%fq_isccp = missing_val
     262  where(isccp%boxtau == R_UNDEF) isccp%boxtau = missing_val
     263  where(isccp%boxptop == R_UNDEF) isccp%boxptop = missing_val
     264
     265   CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
     266#ifdef CPP_XIOS
     267  if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp2,isccp%fq_isccp)
     268#else
     269   if (cfg%Lclisccp) then
     270     do icl=1,7
     271       CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
    303272     enddo
     273   endif
     274#endif
     275
     276   if (cfg%Lboxtauisccp) CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
     277   if (cfg%Lboxptopisccp) CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol)
     278   if (cfg%Lcltisccp) CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea)
     279   if (cfg%Lpctisccp) CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop)
     280   if (cfg%Ltauisccp) CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld)
     281   if (cfg%Lalbisccp) CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld)
     282   if (cfg%Lmeantbisccp) CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb)
     283   if (cfg%Lmeantbclrisccp) CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr)
     284 endif ! Isccp
     285
     286!!! MISR simulator
     287 if (cfg%Lmisr_sim) then
     288   where(misr%fq_MISR == R_UNDEF) misr%fq_MISR = missing_val
     289
     290#ifdef CPP_XIOS
     291   do icl=1,MISR_N_CTH
     292      tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
     293   enddo
     294!   if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR)
     295   if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr)
     296#else
     297   if (cfg%LclMISR) then
     298    do icl=1,7
     299      CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
    304300    enddo
    305 
    306     do ii=1,Ncolumns
    307      if(isccp%boxtau(ip,ii).eq.R_UNDEF)then
    308        isccp%boxtau(ip,ii)=missing_val
    309      endif
    310     enddo
    311 
    312     do ii=1,Ncolumns
    313      if(isccp%boxptop(ip,ii).eq.R_UNDEF)then
    314       isccp%boxptop(ip,ii)=missing_val
    315      endif
    316     enddo
    317    enddo
    318 
    319    CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
    320 #ifdef CPP_XIOS
    321    CALL histwrite4d_cosp(o_clisccp2,isccp%fq_isccp)
    322 #else
    323    do icl=1,7
    324    CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
    325    enddo
    326 #endif
    327    CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
    328    CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol)
    329    CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea)
    330    CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop)
    331    CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld)
    332    CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld)
    333    CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb)
    334    CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr)
    335  endif ! Isccp
    336 
    337 ! MISR simulator
    338  if (cfg%Lmisr_sim) then
    339    do ip=1,Npoints
    340      do ii=1,7
    341        do k=1,MISR_N_CTH
    342         if(misr%fq_MISR(ip,ii,k).eq.R_UNDEF)then
    343             misr%fq_MISR(ip,ii,k)=missing_val
    344         endif
    345        enddo
    346      enddo
    347    enddo
    348 
    349 #ifdef CPP_XIOS
    350    CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR)
    351 #else
    352    do icl=1,7
    353       CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
    354    enddo
     301   endif
    355302#endif
    356303 endif
    357 
    358 ! Modis simulator
     304! endif pour Misr
     305
     306!!! Modis simulator
    359307 if (cfg%Lmodis_sim) then
    360 
    361   do ip=1,Npoints
    362     if(modis%Cloud_Fraction_Low_Mean(ip).eq.R_UNDEF)then
    363       modis%Cloud_Fraction_Low_Mean(ip)=missing_val
    364     endif
    365     if(modis%Cloud_Fraction_High_Mean(ip).eq.R_UNDEF)then
    366        modis%Cloud_Fraction_High_Mean(ip)=missing_val
    367     endif
    368     if(modis%Cloud_Fraction_Mid_Mean(ip).eq.R_UNDEF)then
    369        modis%Cloud_Fraction_Mid_Mean(ip)=missing_val
    370     endif
    371     if(modis%Cloud_Fraction_Total_Mean(ip).eq.R_UNDEF)then
    372        modis%Cloud_Fraction_Total_Mean(ip)=missing_val
    373     endif
    374     if(modis%Cloud_Fraction_Water_Mean(ip).eq.R_UNDEF)then
    375        modis%Cloud_Fraction_Water_Mean(ip)=missing_val
    376     endif
    377     if(modis%Cloud_Fraction_Ice_Mean(ip).eq.R_UNDEF)then
    378        modis%Cloud_Fraction_Ice_Mean(ip)=missing_val
    379     endif
    380     if(modis%Optical_Thickness_Total_Mean(ip).eq.R_UNDEF)then
    381        modis%Optical_Thickness_Total_Mean(ip)=missing_val
    382     endif
    383     if(modis%Optical_Thickness_Water_Mean(ip).eq.R_UNDEF)then
    384        modis%Optical_Thickness_Water_Mean(ip)=missing_val
    385     endif
    386     if(modis%Optical_Thickness_Ice_Mean(ip).eq.R_UNDEF)then
    387        modis%Optical_Thickness_Ice_Mean(ip)=missing_val
    388     endif
    389     if(modis%Cloud_Particle_Size_Water_Mean(ip).eq.R_UNDEF)then
    390        modis%Cloud_Particle_Size_Water_Mean(ip)=missing_val
    391     endif
    392     if(modis%Cloud_Particle_Size_Ice_Mean(ip).eq.R_UNDEF)then
    393        modis%Cloud_Particle_Size_Ice_Mean(ip)=missing_val
    394     endif
    395     if(modis%Cloud_Top_Pressure_Total_Mean(ip).eq.R_UNDEF)then
    396        modis%Cloud_Top_Pressure_Total_Mean(ip)=missing_val
    397     endif
    398     if(modis%Liquid_Water_Path_Mean(ip).eq.R_UNDEF)then
    399        modis%Liquid_Water_Path_Mean(ip)=missing_val
    400     endif
    401     if(modis%Ice_Water_Path_Mean(ip).eq.R_UNDEF)then
    402        modis%Ice_Water_Path_Mean(ip)=missing_val
    403     endif
    404 
    405   enddo
    406 
    407     where(modis%Optical_Thickness_Total_LogMean == R_UNDEF) &
     308  where(modis%Cloud_Fraction_Low_Mean == R_UNDEF) &
     309        modis%Cloud_Fraction_Low_Mean = missing_val
     310  where(modis%Cloud_Fraction_High_Mean == R_UNDEF) &
     311        modis%Cloud_Fraction_High_Mean = missing_val
     312  where(modis%Cloud_Fraction_Mid_Mean == R_UNDEF) &
     313        modis%Cloud_Fraction_Mid_Mean = missing_val
     314  where(modis%Cloud_Fraction_Total_Mean == R_UNDEF) &
     315        modis%Cloud_Fraction_Total_Mean = missing_val
     316  where(modis%Cloud_Fraction_Water_Mean == R_UNDEF) &
     317        modis%Cloud_Fraction_Water_Mean = missing_val
     318  where(modis%Cloud_Fraction_Ice_Mean == R_UNDEF) &
     319        modis%Cloud_Fraction_Ice_Mean = missing_val
     320  where(modis%Optical_Thickness_Total_Mean == R_UNDEF) &
     321        modis%Optical_Thickness_Total_Mean = missing_val
     322  where(modis%Optical_Thickness_Water_Mean == R_UNDEF) &
     323        modis%Optical_Thickness_Water_Mean = missing_val
     324  where(modis%Optical_Thickness_Ice_Mean == R_UNDEF) &
     325        modis%Optical_Thickness_Ice_Mean = missing_val
     326  where(modis%Cloud_Particle_Size_Water_Mean == R_UNDEF) &
     327        modis%Cloud_Particle_Size_Water_Mean = missing_val
     328  where(modis%Cloud_Particle_Size_Ice_Mean == R_UNDEF) &
     329        modis%Cloud_Particle_Size_Ice_Mean = missing_val
     330  where(modis%Cloud_Top_Pressure_Total_Mean == R_UNDEF) &
     331        modis%Cloud_Top_Pressure_Total_Mean = missing_val
     332  where(modis%Liquid_Water_Path_Mean == R_UNDEF) &
     333        modis%Liquid_Water_Path_Mean = missing_val
     334  where(modis%Ice_Water_Path_Mean == R_UNDEF) &
     335        modis%Ice_Water_Path_Mean = missing_val
     336
     337  where(modis%Optical_Thickness_Total_LogMean == R_UNDEF) &
    408338          modis%Optical_Thickness_Total_LogMean = missing_val
    409339           
    410  
    411     where(modis%Optical_Thickness_Water_LogMean == R_UNDEF) &
     340  where(modis%Optical_Thickness_Water_LogMean == R_UNDEF) &
    412341          modis%Optical_Thickness_Water_LogMean = missing_val
    413342
    414     where(modis%Optical_Thickness_Ice_LogMean == R_UNDEF) &
     343  where(modis%Optical_Thickness_Ice_LogMean == R_UNDEF) &
    415344          modis%Optical_Thickness_Ice_LogMean = missing_val
    416345   
    417    CALL histwrite2d_cosp(o_cllmodis,modis%Cloud_Fraction_Low_Mean)
    418    CALL histwrite2d_cosp(o_clhmodis,modis%Cloud_Fraction_High_Mean)
    419    CALL histwrite2d_cosp(o_clmmodis,modis%Cloud_Fraction_Mid_Mean)
    420    CALL histwrite2d_cosp(o_cltmodis,modis%Cloud_Fraction_Total_Mean)
    421    CALL histwrite2d_cosp(o_clwmodis,modis%Cloud_Fraction_Water_Mean)
    422    CALL histwrite2d_cosp(o_climodis,modis%Cloud_Fraction_Ice_Mean)
    423    CALL histwrite2d_cosp(o_tautmodis,modis%Optical_Thickness_Total_Mean)
    424    CALL histwrite2d_cosp(o_tauwmodis,modis%Optical_Thickness_Water_Mean)
    425    CALL histwrite2d_cosp(o_tauimodis,modis%Optical_Thickness_Ice_Mean)
    426    CALL histwrite2d_cosp(o_tautlogmodis,modis%Optical_Thickness_Total_LogMean) 
    427    CALL histwrite2d_cosp(o_tauwlogmodis,modis%Optical_Thickness_Water_LogMean)
    428    CALL histwrite2d_cosp(o_tauilogmodis,modis%Optical_Thickness_Ice_LogMean)
    429    CALL histwrite2d_cosp(o_reffclwmodis,modis%Cloud_Particle_Size_Water_Mean)
    430    CALL histwrite2d_cosp(o_reffclimodis,modis%Cloud_Particle_Size_Ice_Mean)
    431    CALL histwrite2d_cosp(o_pctmodis,modis%Cloud_Top_Pressure_Total_Mean)
    432    CALL histwrite2d_cosp(o_lwpmodis,modis%Liquid_Water_Path_Mean)
    433    CALL histwrite2d_cosp(o_iwpmodis,modis%Ice_Water_Path_Mean)
    434 
    435    do ip=1,Npoints
    436      do ii=1,7
    437        do k=1,7
    438        if(modis%Optical_Thickness_vs_Cloud_Top_Pressure(ip,ii,k).eq.R_UNDEF)then
    439           modis%Optical_Thickness_vs_Cloud_Top_Pressure(ip,ii,k)=missing_val
    440         endif
    441        enddo
    442      enddo
    443     enddo
    444 
    445 #ifdef CPP_XIOS
    446    CALL histwrite4d_cosp(o_clmodis,modis%Optical_Thickness_vs_Cloud_Top_Pressure)
     346  if (cfg%Lcllmodis) CALL histwrite2d_cosp(o_cllmodis,modis%Cloud_Fraction_Low_Mean)
     347  if (cfg%Lclhmodis) CALL histwrite2d_cosp(o_clhmodis,modis%Cloud_Fraction_High_Mean)
     348  if (cfg%Lclmmodis) CALL histwrite2d_cosp(o_clmmodis,modis%Cloud_Fraction_Mid_Mean)
     349  if (cfg%Lcltmodis) CALL histwrite2d_cosp(o_cltmodis,modis%Cloud_Fraction_Total_Mean)
     350  if (cfg%Lclwmodis) CALL histwrite2d_cosp(o_clwmodis,modis%Cloud_Fraction_Water_Mean)
     351  if (cfg%Lclimodis) CALL histwrite2d_cosp(o_climodis,modis%Cloud_Fraction_Ice_Mean)
     352  if (cfg%Ltautmodis)  CALL histwrite2d_cosp(o_tautmodis,modis%Optical_Thickness_Total_Mean)
     353  if (cfg%Ltauwmodis) CALL histwrite2d_cosp(o_tauwmodis,modis%Optical_Thickness_Water_Mean)
     354  if (cfg%Ltauimodis) CALL histwrite2d_cosp(o_tauimodis,modis%Optical_Thickness_Ice_Mean)
     355  if (cfg%Ltautlogmodis) CALL histwrite2d_cosp(o_tautlogmodis,modis%Optical_Thickness_Total_LogMean) 
     356  if (cfg%Ltauwlogmodis) CALL histwrite2d_cosp(o_tauwlogmodis,modis%Optical_Thickness_Water_LogMean)
     357  if (cfg%Ltauilogmodis) CALL histwrite2d_cosp(o_tauilogmodis,modis%Optical_Thickness_Ice_LogMean)
     358  if (cfg%Lreffclwmodis) CALL histwrite2d_cosp(o_reffclwmodis,modis%Cloud_Particle_Size_Water_Mean)
     359  if (cfg%Lreffclimodis) CALL histwrite2d_cosp(o_reffclimodis,modis%Cloud_Particle_Size_Ice_Mean)
     360  if (cfg%Lpctmodis) CALL histwrite2d_cosp(o_pctmodis,modis%Cloud_Top_Pressure_Total_Mean)
     361  if (cfg%Llwpmodis) CALL histwrite2d_cosp(o_lwpmodis,modis%Liquid_Water_Path_Mean)
     362  if (cfg%Liwpmodis) CALL histwrite2d_cosp(o_iwpmodis,modis%Ice_Water_Path_Mean)
     363
     364    where(modis%Optical_Thickness_vs_Cloud_Top_Pressure == R_UNDEF) &
     365          modis%Optical_Thickness_vs_Cloud_Top_Pressure = missing_val
     366
     367#ifdef CPP_XIOS
     368   if (cfg%Lclmodis) CALL histwrite4d_cosp(o_clmodis,modis%Optical_Thickness_vs_Cloud_Top_Pressure)
    447369#else
     370  if (cfg%Lclmodis) then
    448371   do icl=1,7
    449372   CALL histwrite3d_cosp(o_clmodis, &
    450373     modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
    451374   enddo
     375  endif
    452376#endif
    453377
    … …  
    459383
    460384#ifdef CPP_XIOS
    461 !    print*,'dimension de crimodis=',size(modis%Optical_Thickness_vs_ReffIce,2),&
    462 !                                    size(modis%Optical_Thickness_vs_ReffIce,3)
    463     CALL histwrite4d_cosp(o_crimodis,modis%Optical_Thickness_vs_ReffIce)
    464     CALL histwrite4d_cosp(o_crlmodis,modis%Optical_Thickness_vs_ReffLiq)
     385  if (cfg%Lcrimodis) CALL histwrite4d_cosp(o_crimodis,modis%Optical_Thickness_vs_ReffIce)
     386  if (cfg%Lcrlmodis) CALL histwrite4d_cosp(o_crlmodis,modis%Optical_Thickness_vs_ReffLiq)
    465387#else
     388  if (cfg%Lcrimodis) then
    466389    do icl=1,7
    467    CALL histwrite3d_cosp(o_crimodis, &
    468      modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
    469    CALL histwrite3d_cosp(o_crlmodis, &
    470      modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
     390     CALL histwrite3d_cosp(o_crimodis, &
     391          modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
    471392    enddo
    472 #endif
    473  endif
     393  endif
     394  if (cfg%Lcrlmodis) then
     395    do icl=1,7
     396     CALL histwrite3d_cosp(o_crlmodis, &
     397          modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
     398    enddo
     399  endif
     400#endif
     401 endif !modis
    474402
    475403 IF(.NOT.cosp_varsdefined) THEN
    … …  
    915843
    916844#ifdef CPP_XIOS
    917     IF (ok_all_xml) THEN
     845!    IF (ok_all_xml) THEN
    918846     CALL xios_send_field(var%name, Field4d(:,:,1:nlev,1:nlev2))
    919847     IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
    920     ENDIF
     848!    ENDIF
    921849#endif
    922850

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/cosp/lidar_simulator.F90

    r2428 r3356  
    121121!---------------------------------------------------------------------------------
    122122
     123      USE MOD_COSP_CONSTANTS, only : ok_debug_cosp
    123124      IMPLICIT NONE
    124125      REAL :: SRsat
    … …  
    201202      REAL pnorm_perp_liq(npoints,nlev) ! perpendicular lidar backscattered signal power for liq
    202203
     204      REAL :: seuil
     205
    203206! Output variable
    204207      REAL pnorm_perp_tot (npoints,nlev) ! perpendicular lidar backscattered signal power
    … …  
    235238         Gamma = 0.009
    236239
     240  if (ok_debug_cosp) then
     241     seuil=1.e-18
     242  else
     243     seuil=0.0
     244  endif
    237245!------------------------------------------------------------
    238246!---- 1. Preliminary definitions and calculations :
    … …  
    494502
    495503      DO k= nlev, 1, -1
    496               pnorm_perp_ice(:,k) = Alpha * pnorm_ice(:,k) ! Ice particles
    497               pnorm_perp_liq(:,k) = 1000*Beta * pnorm_liq(:,k)**2 + Gamma * pnorm_liq(:,k) ! Liquid particles
     504         pnorm_perp_ice(:,k) = Alpha * pnorm_ice(:,k) ! Ice particles
     505         pnorm_perp_liq(:,k) = 1000*Beta * pnorm_liq(:,k)**2 + Gamma * pnorm_liq(:,k) ! Liquid particles
    498506      ENDDO
    499507
    … …  
    523531          tautot_lay_liq(:) = tautot_liq(:,k)-tautot_liq(:,k+1)
    524532        WHERE (tautot_lay_liq(:).GT.0.)
    525          beta_perp_liq(:,k) = pnorm_perp_liq(:,k)/ EXP(-2.0*tautot_liq(:,k+1)) * (2.*tautot_lay_liq(:)) &
    526             & / (1.-exp(-2.0*tautot_lay_liq(:)))
     533         beta_perp_liq(:,k) = pnorm_perp_liq(:,k)/ max(seuil,EXP(-2.0*tautot_liq(:,k+1))) &
     534            & * (2.*tautot_lay_liq(:)) / (1.-exp(-2.0*tautot_lay_liq(:)))
    527535
    528536        ELSEWHERE

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/cosp/phys_cosp.F90

    r2835 r3356  
    8484  use cosp_output_write_mod
    8585!  use MOD_COSP_Modis_Simulator, only : cosp_modis
     86#ifdef CPP_XIOS
     87    USE xios, ONLY: xios_field_is_active
     88#endif
     89  use cosp_read_otputkeys
    8690
    8791  IMPLICIT NONE
    … …  
    136140!$OMP THREADPRIVATE(debut_cosp)
    137141
     142  logical, save :: first_write=.true.
     143!$OMP THREADPRIVATE(first_write)
     144
    138145!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
    139146  integer                         :: overlaplmdz   !  overlap type: 1=max, 2=rand, 3=max/rand ! cosp input (output lmdz)
    … …  
    147154  real                            :: dtime,freq_cosp
    148155  real,dimension(2)               :: time_bnds
     156
     157  double precision                            :: d_dtime
     158  double precision,dimension(2)               :: d_time_bnds
    149159 
     160  real,dimension(2,SR_BINS) :: sratio_bounds
     161  real,dimension(SR_BINS)   ::  sratio_ax
     162
    150163   namelist/COSP_INPUT/overlap,isccp_topheight,isccp_topheight_direction, &
    151164              npoints_it,ncolumns,use_vgrid,nlr,csat_vgrid, &
    … …  
    157170
    158171!---------------- End of declaration of variables --------------
    159    
    160172
    161173!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    … …  
    170182  CALL read_cosp_input
    171183
    172 ! Clefs Outputs
    173   call read_cosp_output_nl(cosp_output_nl,cfg)
     184! Clefs Outputs initialisation
     185  call cosp_outputkeys_init(cfg)
     186!!!   call cosp_outputkeys_test(cfg)
     187  print*,' Cles des differents simulateurs cosp a itap :',itap
     188  print*,'Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lmodis_sim,Lrttov_sim,Lstats', &
     189          cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lmodis_sim, &
     190          cfg%Lrttov_sim,cfg%Lstats
    174191
    175192    if (overlaplmdz.ne.overlap) then
    … …  
    178195   print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
    179196
    180   print*,' Cles des differents simulateurs cosp :'
    181   print*,'Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lmodis_sim,Lrttov_sim', &
    182           cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lmodis_sim,cfg%Lrttov_sim
    183 
    184197  endif ! debut_cosp
     198
     199!!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
     200  if ((itap.gt.1).and.(first_write))then
     201#ifdef CPP_XIOS
     202    call read_xiosfieldactive(cfg)
     203#else
     204    call read_cosp_output_nl(itap,cosp_output_nl,cfg)
     205#endif
     206    first_write=.false.
     207
     208    print*,' Cles des differents simulateurs cosp a itap :',itap
     209    print*,'Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lmodis_sim,Lrttov_sim,Lstats', &
     210          cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lmodis_sim, &
     211          cfg%Lrttov_sim,cfg%Lstats
     212  endif
    185213
    186214  time_bnds(1) = dtime-dtime/2.
    187215  time_bnds(2) = dtime+dtime/2.
    188216
    189 !  print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
    190 !          itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
     217  d_time_bnds=time_bnds
     218  d_dtime=dtime
     219
    191220!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    192221! Allocate memory for gridbox type
    … …  
    195224!        print *, 'Allocating memory for gridbox type...'
    196225
    197 !! AI
    198 !        call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
    199 !                                    Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
    200 !                                    lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, &
    201 !                                    use_precipitation_fluxes,use_reff, &
    202 !                                    Platform,Satellite,Instrument,Nchannels,ZenAng, &
    203 !                                    channels(1:Nchannels),surfem(1:Nchannels),co2,ch4,n2o,co,gbx)
    204226! Surafce emissivity
    205227        emsfc_lw = 1.
    206228
    207         call construct_cosp_gridbox(dtime,time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs, &
     229        call construct_cosp_gridbox(d_dtime,d_time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs, &
    208230                                    do_ray,melt_lay,k2, &
    209231                                    Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
    … …  
    321343
    322344!+++++++++++++ Open output files and define output files axis !+++++++++++++
    323      if (debut_cosp) then
     345!    if (debut_cosp) then
    324346
    325347      !$OMP MASTER
    326         print *, ' Open outpts files and define axis'
     348!        print *, ' Open outpts files and define axis'
    327349        call cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
    328350                              ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml, &
    … …  
    331353      !$OMP BARRIER
    332354        debut_cosp=.false.
    333       endif ! debut_cosp
     355!      endif ! debut_cosp
     356!    else
    334357!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    335358        ! Call simulator
    … …  
    344367!#endif
    345368!!
    346 
    347369!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    348370
    … …  
    353375                               cfg, gbx, vgrid, sglidar, sgradar, stlidar, stradar, &
    354376                               isccp, misr, modis)
    355 
     377!    endif !debut_cosp
    356378!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    357379        ! Deallocate memory in derived types
    358380!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    359 !        print *, 'Deallocating memory...'
     381        print *, 'Deallocating memory...'
    360382        call free_cosp_gridbox(gbx)
    361383        call free_cosp_subgrid(sgx)

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/cosp/radar_simulator_types.F90

    r2428 r3356  
    44! Part of QuickBeam v1.03 by John Haynes
    55! Updated by Roj Marchand June 2010
    6 
     6  implicit none
    77  integer, parameter ::       &
    88  maxhclass = 20         ,& ! max number of hydrometeor classes
Note: See TracChangeset for help on using the changeset viewer.