Changeset 5095 for LMDZ6


Ignore:
Timestamp:
Jul 22, 2024, 9:46:57 AM (8 weeks ago)
Author:
abarral
Message:

Revert cosp*/ from the trunk, as it's external code
Add missing bits from FCM2 source

Location:
LMDZ6/branches/Amaury_dev
Files:
1061 added
69 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/MISR_simulator.F

    r5082 r5095  
    133133           
    134134        ! define location of "layer top"
    135         if(ilev==1 .or. ilev==nlev) then
     135        if(ilev.eq.1 .or. ilev.eq.nlev) then
    136136            ztest=zfull(j,ilev)
    137137        else
    … …  
    144144        do loop=2,n_MISR_CTH
    145145       
    146             if ( ztest >
     146            if ( ztest .gt.
    147147     &                1000*MISR_CTH_boundaries(loop+1) ) then
    148148       
    … …  
    173173             dtau=0
    174174             
    175              if (frac_out(j,ibox,ilev)==1) then
     175             if (frac_out(j,ibox,ilev).eq.1) then
    176176                        dtau = dtau_s(j,ilev)
    177177                 endif
    178178                 
    179                  if (frac_out(j,ibox,ilev)==2) then
     179                 if (frac_out(j,ibox,ilev).eq.2) then
    180180                        dtau = dtau_c(j,ilev)
    181181                 end if
    … …  
    186186        ! NOW for MISR ..
    187187        ! if there a cloud ... start the counter ... store this height
    188         if(thres_crossed_MISR == 0 .and. dtau > 0.) then
     188        if(thres_crossed_MISR .eq. 0 .and. dtau .gt. 0.) then
    189189       
    190190            ! first encountered a "cloud"
    … …  
    193193        endif   
    194194               
    195         if( thres_crossed_MISR < 99 .and.
    196      &              thres_crossed_MISR > 0 ) then
     195        if( thres_crossed_MISR .lt. 99 .and.
     196     &              thres_crossed_MISR .gt. 0 ) then
    197197     
    198                 if( dtau == 0.) then
     198                if( dtau .eq. 0.) then
    199199       
    200200                    ! we have come to the end of the current cloud
    … …  
    212212            ! then MISR will like see a top below the top of the current
    213213            ! layer
    214             if( dtau>0 .and. (cloud_dtau-dtau) < 1) then
    215            
    216                 if(dtau < 1 .or. ilev==1 .or. ilev==nlev) then
     214            if( dtau.gt.0 .and. (cloud_dtau-dtau) .lt. 1) then
     215           
     216                if(dtau .lt. 1 .or. ilev.eq.1 .or. ilev.eq.nlev) then
    217217
    218218                    ! MISR will likely penetrate to some point
    … …  
    233233       
    234234            ! check for a distinctive water layer
    235             if(dtau > 1 .and. at(j,ilev)>273 ) then
     235            if(dtau .gt. 1 .and. at(j,ilev).gt.273 ) then
    236236     
    237237                    ! must be a water cloud ...
    … …  
    242242            ! if the total column optical depth is "large" than
    243243            ! MISR can't seen anything else ... set current point as CTH level
    244             if(tau(j,ibox) > 5) then
     244            if(tau(j,ibox) .gt. 5) then
    245245
    246246                thres_crossed_MISR=99           
    … …  
    254254        ! check to see if there was a cloud for which we didn't
    255255        ! set a MISR cloud top boundary
    256         if( thres_crossed_MISR == 1) then
     256        if( thres_crossed_MISR .eq. 1) then
    257257   
    258258        ! if the cloud has a total optical depth of greater
    … …  
    260260        ! with a height near the true cloud top
    261261        ! otherwise there should be no CTH
    262         if( tau(j,ibox) > 0.5) then
     262        if( tau(j,ibox) .gt. 0.5) then
    263263
    264264            ! keep MISR detected CTH
    265265           
    266         elseif(tau(j,ibox) > 0.2) then
     266        elseif(tau(j,ibox) .gt. 0.2) then
    267267
    268268            ! MISR may detect but wont likley have a good height
    … …  
    294294    !   This setup assumes the columns represent a about a 1 to 4 km scale
    295295    !   it will need to be modified significantly, otherwise
    296         if(ncol==1) then
     296        if(ncol.eq.1) then
    297297   
    298298       ! adjust based on neightboring points ... i.e. only 2D grid was input
    299299           do j=2,npoints-1
    300300           
    301             if(box_MISR_ztop(j-1,1)>0 .and.
    302      &             box_MISR_ztop(j+1,1)>0       ) then
     301            if(box_MISR_ztop(j-1,1).gt.0 .and.
     302     &             box_MISR_ztop(j+1,1).gt.0       ) then
    303303
    304304                if( abs( box_MISR_ztop(j-1,1) - 
    305      &                   box_MISR_ztop(j+1,1) ) < 500
     305     &                   box_MISR_ztop(j+1,1) ) .lt. 500
    306306     &              .and.
    307      &                   box_MISR_ztop(j,1) <
     307     &                   box_MISR_ztop(j,1) .lt.
    308308     &                   box_MISR_ztop(j+1,1)     ) then
    309309           
    … …  
    319319         do ibox=2,ncol-1
    320320           
    321             if(box_MISR_ztop(1,ibox-1)>0 .and.
    322      &             box_MISR_ztop(1,ibox+1)>0        ) then
     321            if(box_MISR_ztop(1,ibox-1).gt.0 .and.
     322     &             box_MISR_ztop(1,ibox+1).gt.0        ) then
    323323
    324324                if( abs( box_MISR_ztop(1,ibox-1) - 
    325      &                   box_MISR_ztop(1,ibox+1) ) < 500
     325     &                   box_MISR_ztop(1,ibox+1) ) .lt. 500
    326326     &              .and.
    327      &                   box_MISR_ztop(1,ibox) <
     327     &                   box_MISR_ztop(1,ibox) .lt.
    328328     &                   box_MISR_ztop(1,ibox+1)     ) then
    329329           
    … …  
    357357         do ibox=1,ncol
    358358
    359             if (tau(j,ibox) > (tauchk)) then
     359            if (tau(j,ibox) .gt. (tauchk)) then
    360360               box_cloudy(j,ibox)=.true.
    361361            endif
    … …  
    366366   
    367367          !determine optical depth category
    368               if (tau(j,ibox) < isccp_taumin) then
     368              if (tau(j,ibox) .lt. isccp_taumin) then
    369369                  itau=1
    370               else if (tau(j,ibox) >= isccp_taumin
    371      &          .and. tau(j,ibox) < 1.3) then
     370              else if (tau(j,ibox) .ge. isccp_taumin                                   
     371     &          .and. tau(j,ibox) .lt. 1.3) then
    372372                  itau=2
    373               else if (tau(j,ibox) >= 1.3
    374      &          .and. tau(j,ibox) < 3.6) then
     373              else if (tau(j,ibox) .ge. 1.3
     374     &          .and. tau(j,ibox) .lt. 3.6) then
    375375                  itau=3
    376               else if (tau(j,ibox) >= 3.6
    377      &          .and. tau(j,ibox) < 9.4) then
     376              else if (tau(j,ibox) .ge. 3.6
     377     &          .and. tau(j,ibox) .lt. 9.4) then
    378378                  itau=4
    379               else if (tau(j,ibox) >= 9.4
    380      &          .and. tau(j,ibox) < 23.) then
     379              else if (tau(j,ibox) .ge. 9.4
     380     &          .and. tau(j,ibox) .lt. 23.) then
    381381                  itau=5
    382               else if (tau(j,ibox) >= 23.
    383      &          .and. tau(j,ibox) < 60.) then
     382              else if (tau(j,ibox) .ge. 23.
     383     &          .and. tau(j,ibox) .lt. 60.) then
    384384                  itau=6
    385               else if (tau(j,ibox) >= 60.) then
     385              else if (tau(j,ibox) .ge. 60.) then
    386386                  itau=7
    387387              endif
    … …  
    390390
    391391       ! update MISR histograms and summary metrics - roj 5/2005
    392        if (sunlit(j)==1) then
     392       if (sunlit(j).eq.1) then
    393393                     
    394394              !if cloudy added by roj 5/2005
    395           if( box_MISR_ztop(j,ibox)==0) then
     395          if( box_MISR_ztop(j,ibox).eq.0) then
    396396         
    397397            ! no cloud detected
    398398            iMISR_ztop=0
    399399
    400           elseif( box_MISR_ztop(j,ibox)==-1) then
     400          elseif( box_MISR_ztop(j,ibox).eq.-1) then
    401401
    402402            ! cloud can be detected but too thin to get CTH
    … …  
    416416            do loop=2,n_MISR_CTH
    417417       
    418                 if ( box_MISR_ztop(j,ibox) >
     418                if ( box_MISR_ztop(j,ibox) .gt.
    419419     &                1000*MISR_CTH_boundaries(loop+1) ) then
    420420       
    … …  
    466466       enddo ! ibox - loop over subcolumns         
    467467     
    468        if( MISR_cldarea(j) > 0.) then
     468       if( MISR_cldarea(j) .gt. 0.) then
    469469        MISR_mean_ztop(j)= MISR_mean_ztop(j) / MISR_cldarea(j)   ! roj 5/2006
    470470       endif

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/array_lib.F90

    r5082 r5095  
    4545 
    4646! ----- INPUTS -----
    47   real(kind=8), dimension(:), intent(in) :: list
    48   real(kind=8), intent(in) :: val
     47  real*8, dimension(:), intent(in) :: list
     48  real*8, intent(in) :: val 
    4949  integer, intent(in), optional :: sort
    5050 
    5151! ----- OUTPUTS -----
    52   integer(kind=4) :: infind
    53   real(kind=8), intent(out), optional :: dist
     52  integer*4 :: infind
     53  real*8, intent(out), optional :: dist
    5454
    5555! ----- INTERNAL -----
    56   real(kind=8), dimension(size(list)) :: lists
    57   integer(kind=4) :: nlist, result, tmp(1), sort_list
    58   integer(kind=4), dimension(size(list)) :: mask, idx
     56  real*8, dimension(size(list)) :: lists
     57  integer*4 :: nlist, result, tmp(1), sort_list
     58  integer*4, dimension(size(list)) :: mask, idx
    5959
    6060  if (present(sort)) then
    … …  
    121121
    122122! ----- INPUTS -----
    123   real(kind=8), dimension(:), intent(in) :: yarr, xarr, xxarr
    124   real(kind=8), intent(in) :: tol
     123  real*8, dimension(:), intent(in) :: yarr, xarr, xxarr
     124  real*8, intent(in) :: tol
    125125
    126126! ----- OUTPUTS -----
    127   real(kind=8), dimension(size(xxarr)), intent(out) :: yyarr
     127  real*8, dimension(size(xxarr)), intent(out) :: yyarr
    128128
    129129! ----- INTERNAL -----
    130   real(kind=8), dimension(size(xarr)) :: ysort, xsort
    131   integer(kind=4), dimension(size(xarr)) :: ist
    132   integer(kind=4) :: nx, nxx, i, iloc
    133   real(kind=8) :: d, m
     130  real*8, dimension(size(xarr)) :: ysort, xsort
     131  integer*4, dimension(size(xarr)) :: ist
     132  integer*4 :: nx, nxx, i, iloc
     133  real*8 :: d, m
    134134
    135135  nx = size(xarr)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/atmos_lib.F90

    r5082 r5095  
    4343
    4444! ----- OUTPUTS -----
    45   real(kind=8), intent(out), dimension(ndat) :: &
     45  real*8, intent(out), dimension(ndat) :: &
    4646  hgt, &                        ! height (m)
    4747  prs, &                        ! pressure (hPa)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/calc_Re.F90

    r5082 r5095  
    4040! ----- INPUTS ----- 
    4141 
    42   real(kind=8), intent(in) :: Q,Np,rho_a
     42  real*8, intent(in) :: Q,Np,rho_a
    4343 
    4444  integer, intent(in):: dtype
    45   real(kind=8), intent(in) :: dmin,dmax,rho_c,p1,p2,p3
    46    
    47   real(kind=8), intent(inout) :: apm,bpm
     45  real*8, intent(in) :: dmin,dmax,rho_c,p1,p2,p3
     46   
     47  real*8, intent(inout) :: apm,bpm 
    4848   
    4949! ----- OUTPUTS -----
    5050
    51   real(kind=8), intent(out) :: Re
     51  real*8, intent(out) :: Re
    5252 
    5353! ----- INTERNAL -----
    5454 
    5555  integer :: local_dtype
    56   real(kind=8)  :: local_p3,local_Np
    57 
    58   real(kind=8) :: pi, &
     56  real*8  :: local_p3,local_Np
     57
     58  real*8 :: pi, &
    5959  N0,D0,vu,dm,ld, &         ! gamma, exponential variables
    6060  rg,log_sigma_g
    6161 
    62   real(kind=8) :: tmp1,tmp2
     62  real*8 :: tmp1,tmp2
    6363
    6464  pi = acos(-1.0)
    … …  
    7272  ! Exponential is same as modified gamma with vu =1
    7373  ! if Np is specified then we will just treat as modified gamma
    74   if(dtype==2 .and. Np>0) then
     74  if(dtype.eq.2 .and. Np>0) then
    7575    local_dtype=1;
    7676    local_p3=1;
    … …  
    119119   
    120120
    121     if( Np==0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
     121    if( Np.eq.0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
    122122     
    123123        dm = p2             ! by definition, should have units of microns
    … …  
    126126    else   ! use value of Np
    127127       
    128         if(Np==0) then
     128        if(Np.eq.0) then
    129129       
    130130            if( abs(p1+1) > 1E-8 ) then  !   use default number concentration
    … …  
    233233     
    234234    ! get rg ...
    235     if( Np==0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
     235    if( Np.eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
    236236   
    237237            rg = p2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90

    r5093 r5095  
    185185    do k=1,PARASOL_NREFL
    186186     do ip=1, Npoints
    187       if (stlidar%cldlayer(ip,4)>0.01.and.stlidar%parasolrefl(ip,k)/=missing_val) then
     187      if (stlidar%cldlayer(ip,4).gt.0.01.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
    188188        parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
    189189                             stlidar%cldlayer(ip,4)
    … …  
    456456    CHARACTER(LEN=20) :: typeecrit
    457457
    458     ! ug On récupère le type écrit de la structure:
    459     !       Assez moche, à refaire si meilleure méthode...
     458    ! ug On récupère le type écrit de la structure:
     459    !       Assez moche, Ã|  refaire si meilleure méthode...
    460460    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
    461461       typeecrit = 'once'
    … …  
    523523
    524524! Axe vertical
    525       IF (nvertsave==nvertp(iff)) THEN
     525      IF (nvertsave.eq.nvertp(iff)) THEN
    526526          klevs=PARASOL_NREFL
    527527          nam_axvert="sza"
    528       ELSE IF (nvertsave==nvertisccp(iff)) THEN
     528      ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
    529529          klevs=7
    530530          nam_axvert="pressure2"
    531       ELSE IF (nvertsave==nvertcol(iff)) THEN
     531      ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
    532532          klevs=Ncolout
    533533          nam_axvert="column"
    534       ELSE IF (nvertsave==nverttemp(iff)) THEN
     534      ELSE IF (nvertsave.eq.nverttemp(iff)) THEN
    535535          klevs=LIDAR_NTEMP
    536536          nam_axvert="temp"
    537       ELSE IF (nvertsave==nvertmisr(iff)) THEN
     537      ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
    538538          klevs=MISR_N_CTH
    539539          nam_axvert="cth16"
    540       ELSE IF (nvertsave==nvertReffIce(iff)) THEN
     540      ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN
    541541          klevs= numMODISReffIceBins
    542542          nam_axvert="ReffIce"
    543       ELSE IF (nvertsave==nvertReffLiq(iff)) THEN
     543      ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN
    544544          klevs= numMODISReffLiqBins
    545545          nam_axvert="ReffLiq"
    … …  
    558558      END IF
    559559
    560     ! ug On récupère le type écrit de la structure:
    561     !       Assez moche, à refaire si meilleure méthode...
     560    ! ug On récupère le type écrit de la structure:
     561    !       Assez moche, Ã|  refaire si meilleure méthode...
    562562    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
    563563       typeecrit = 'once'
    … …  
    628628    IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
    629629
    630   ! On regarde si on est dans la phase de définition ou d'écriture:
     630  ! On regarde si on est dans la phase de définition ou d'écriture:
    631631  IF(.NOT.cosp_varsdefined) THEN
    632632!$OMP MASTER
    633       !Si phase de définition.... on définit
     633      !Si phase de définition.... on définit
    634634      CALL conf_cospoutputs(var%name,var%cles)
    635635      DO iff=1, 3
    … …  
    640640!$OMP END MASTER
    641641  ELSE
    642     !Et sinon on.... écrit
     642    !Et sinon on.... écrit
    643643    IF (SIZE(field)/=klon) &
    644644  CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
    … …  
    725725               nom=var%name
    726726      END IF
    727   ! On regarde si on est dans la phase de définition ou d'écriture:
     727  ! On regarde si on est dans la phase de définition ou d'écriture:
    728728  IF(.NOT.cosp_varsdefined) THEN
    729       !Si phase de définition.... on définit
     729      !Si phase de définition.... on définit
    730730!$OMP MASTER
    731731      CALL conf_cospoutputs(var%name,var%cles)
    … …  
    737737!$OMP END MASTER
    738738  ELSE
    739     !Et sinon on.... écrit
     739    !Et sinon on.... écrit
    740740    IF (SIZE(field,1)/=klon) &
    741741   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                 
    … …  
    809809
    810810  IF(cosp_varsdefined) THEN
    811     !Et sinon on.... écrit
     811    !Et sinon on.... écrit
    812812    IF (SIZE(field,1)/=klon) &
    813813   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)           

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/dsd.F90

    r5082 r5095  
    6060  integer, intent(in) :: nsizes
    6161  integer, intent(in) :: dtype
    62   real(kind=8), intent(in)  :: Q,Re_,Np,D(nsizes)
    63   real(kind=8), intent(in)  :: rho_a,tk,dmin,dmax,rho_c,p1,p2,p3
    64    
    65   real(kind=8), intent(inout) :: apm,bpm
     62  real*8, intent(in)  :: Q,Re_,Np,D(nsizes)
     63  real*8, intent(in)  :: rho_a,tk,dmin,dmax,rho_c,p1,p2,p3
     64   
     65  real*8, intent(inout) :: apm,bpm 
    6666 
    6767! ----- OUTPUTS -----
    6868
    69   real(kind=8), intent(out) :: N(nsizes)
     69  real*8, intent(out) :: N(nsizes)
    7070 
    7171! ----- INTERNAL -----
    7272 
    73    real(kind=8) :: fc(nsizes)
    74 
    75   real(kind=8) :: &
     73   real*8 :: fc(nsizes)
     74
     75  real*8 :: &
    7676  N0,D0,vu,local_np,dm,ld, &            ! gamma, exponential variables
    7777  dmin_mm,dmax_mm,ahp,bhp, &        ! power law variables
    … …  
    7979  rho_e                 ! particle density (kg m^-3)
    8080 
    81   real(kind=8) :: tmp1, tmp2
    82   real(kind=8) :: pi,rc,tc
    83   real(kind=8) :: Re
     81  real*8 :: tmp1, tmp2
     82  real*8 :: pi,rc,tc
     83  real*8 :: Re
    8484
    8585  integer k,lidx,uidx
    … …  
    352352      log_sigma_g = p3
    353353      tmp2 = (bpm*log_sigma_g)**2.
    354       if(Re<=0) then
     354      if(Re.le.0) then
    355355        rg = p2
    356356      else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/format_input.F90

    r5082 r5095  
    4040
    4141! ----- INPUTS -----
    42   real(kind=8), dimension(:,:), intent(in) :: &
     42  real*8, dimension(:,:), intent(in) :: &
    4343    hgt_matrix,env_hgt_matrix,env_t_matrix,env_p_matrix,env_rh_matrix
    4444
    4545! ----- OUTPUTS -----
    46   real(kind=8), dimension(:,:), intent(out) :: &
     46  real*8, dimension(:,:), intent(out) :: &
    4747    t_matrix,p_matrix,rh_matrix
    4848
    … …  
    9797
    9898! ----- OUTPUTS -----
    99   real(kind=8), dimension(:,:), intent(inout) :: &
     99  real*8, dimension(:,:), intent(inout) :: &
    100100    hgt_matrix,p_matrix,t_matrix,rh_matrix
    101   real(kind=8), dimension(:,:,:), intent(inout) :: &
     101  real*8, dimension(:,:,:), intent(inout) :: &
    102102    hm_matrix
    103103  logical, intent(out) :: hgt_reversed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/gases.F90

    r5082 r5095  
    2727  nbands_o2 = 48 ,&
    2828  nbands_h2o = 30
    29   real(kind=8), intent(in) :: PRES_mb, T, RH, f
    30   real(kind=8) :: gases, th, e, p, sumo, gm0, a0, ap, term1, term2, term3, &
     29  real*8, intent(in) :: PRES_mb, T, RH, f
     30  real*8 :: gases, th, e, p, sumo, gm0, a0, ap, term1, term2, term3, &
    3131            bf, be, term4, npp
    32   real(kind=8), dimension(nbands_o2) :: v0, a1, a2, a3, a4, a5, a6
    33   real(kind=8), dimension(nbands_h2o) :: v1, b1, b2, b3
    34   real(kind=8) :: e_th,one_th,pth3,eth35,aux1,aux2,aux3,aux4
    35   real(kind=8) :: gm,delt,x,y,gm2
    36   real(kind=8) :: fpp_o2,fpp_h2o,s_o2,s_h2o
     32  real*8, dimension(nbands_o2) :: v0, a1, a2, a3, a4, a5, a6
     33  real*8, dimension(nbands_h2o) :: v1, b1, b2, b3
     34  real*8 :: e_th,one_th,pth3,eth35,aux1,aux2,aux3,aux4
     35  real*8 :: gm,delt,x,y,gm2
     36  real*8 :: fpp_o2,fpp_h2o,s_o2,s_h2o
    3737  integer :: i
    3838 

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/icarus.F

    r5086 r5095  
    293293      ncolprint=0
    294294
    295       if ( debug/=0 ) then
     295      if ( debug.ne.0 ) then
    296296          j=1
    297297          write(6,'(a10)') 'j='
    … …  
    347347!     ---------------------------------------------------!
    348348
    349       if (ncolprint/=0) then
     349      if (ncolprint.ne.0) then
    350350      do j=1,npoints,1000
    351351        write(6,'(a10)') 'j='
    … …  
    354354      endif
    355355
    356       if (top_height == 1 .or. top_height == 3) then
     356      if (top_height .eq. 1 .or. top_height .eq. 3) then
    357357
    358358      do j=1,npoints
    … …  
    364364      enddo
    365365
    366       do ilev=1,nlev
     366      do 12 ilev=1,nlev
    367367        do j=1,npoints
    368          if (pfull(j,ilev) < 40000. .and.
    369      &          pfull(j,ilev) >  5000. .and.
    370      &          at(j,ilev) < attropmin(j)) then
     368         if (pfull(j,ilev) .lt. 40000. .and.
     369     &          pfull(j,ilev) .gt.  5000. .and.
     370     &          at(j,ilev) .lt. attropmin(j)) then
    371371                ptrop(j) = pfull(j,ilev)
    372372                attropmin(j) = at(j,ilev)
    … …  
    375375           end if
    376376        enddo
    377       END DO
    378 
    379       do ilev=1,nlev
     37712    continue
     378
     379      do 13 ilev=1,nlev
    380380        do j=1,npoints
    381            if (at(j,ilev) > atmax(j) .and.
    382      &              ilev  >= itrop(j)) atmax(j)=at(j,ilev)
    383         enddo
    384       END DO
     381           if (at(j,ilev) .gt. atmax(j) .and.
     382     &              ilev  .ge. itrop(j)) atmax(j)=at(j,ilev)
     383        enddo
     38413    continue
    385385
    386386      end if
    387387
    388388
    389       if (top_height == 1 .or. top_height == 3) then
     389      if (top_height .eq. 1 .or. top_height .eq. 3) then
    390390          do j=1,npoints
    391391              meantb(j) = 0.
    392392              meantbclr(j) = 0.
    393           END DO
     393          end do
    394394      else
    395395          do j=1,npoints
    396396              meantb(j) = output_missing_value
    397397              meantbclr(j) = output_missing_value
    398           END DO
     398          end do
    399399      end if
    400400     
    … …  
    408408          rangevec(j)=0
    409409
    410           if (cc(j,ilev) < 0. .or. cc(j,ilev) > 1.) then
     410          if (cc(j,ilev) .lt. 0. .or. cc(j,ilev) .gt. 1.) then
    411411!           error = cloud fraction less than zero
    412412!           error = cloud fraction greater than 1
    … …  
    414414          endif
    415415
    416           if (conv(j,ilev) < 0. .or. conv(j,ilev) > 1.) then
     416          if (conv(j,ilev) .lt. 0. .or. conv(j,ilev) .gt. 1.) then
    417417!           ' error = convective cloud fraction less than zero'
    418418!           ' error = convective cloud fraction greater than 1'
    … …  
    420420          endif
    421421
    422           if (dtau_s(j,ilev) < 0.) then
     422          if (dtau_s(j,ilev) .lt. 0.) then
    423423!           ' error = stratiform cloud opt. depth less than zero'
    424424            rangevec(j)=rangevec(j)+4
    425425          endif
    426426
    427           if (dtau_c(j,ilev) < 0.) then
     427          if (dtau_c(j,ilev) .lt. 0.) then
    428428!           ' error = convective cloud opt. depth less than zero'
    429429            rangevec(j)=rangevec(j)+8
    430430          endif
    431431
    432           if (dem_s(j,ilev) < 0. .or. dem_s(j,ilev) > 1.) then
     432          if (dem_s(j,ilev) .lt. 0. .or. dem_s(j,ilev) .gt. 1.) then
    433433!             ' error = stratiform cloud emissivity less than zero'
    434434!             ' error = stratiform cloud emissivity greater than 1'
    … …  
    436436          endif
    437437
    438           if (dem_c(j,ilev) < 0. .or. dem_c(j,ilev) > 1.) then
     438          if (dem_c(j,ilev) .lt. 0. .or. dem_c(j,ilev) .gt. 1.) then
    439439!             ' error = convective cloud emissivity less than zero'
    440440!             ' error = convective cloud emissivity greater than 1'
    … …  
    448448        enddo
    449449
    450         if (rangeerror/=0) then
     450        if (rangeerror.ne.0) then
    451451              write (6,*) 'Input variable out of range'
    452452              write (6,*) 'rangevec:'
    … …  
    466466 
    467467      !initialize tau and albedocld to zero
    468       do ibox=1,ncol
     468      do 15 ibox=1,ncol
    469469        do j=1,npoints
    470470            tau(j,ibox)=0.
    … …  
    474474          box_cloudy(j,ibox)=.false.
    475475        enddo
    476       END DO
     47615    continue
    477477
    478478      !compute total cloud optical depth for each column     
    … …  
    481481            do ibox=1,ncol
    482482              do j=1,npoints
    483                  if (frac_out(j,ibox,ilev)==1) then
     483                 if (frac_out(j,ibox,ilev).eq.1) then
    484484                        tau(j,ibox)=tau(j,ibox)
    485485     &                     + dtau_s(j,ilev)
    486486                 endif
    487                  if (frac_out(j,ibox,ilev)==2) then
     487                 if (frac_out(j,ibox,ilev).eq.2) then
    488488                        tau(j,ibox)=tau(j,ibox)
    489489     &                     + dtau_c(j,ilev)
    … …  
    492492            enddo ! ibox
    493493      enddo ! ilev
    494           if (ncolprint/=0) then
     494          if (ncolprint.ne.0) then
    495495
    496496              do j=1,npoints ,1000
    … …  
    521521!             sky versions of these quantities.
    522522
    523       if (top_height == 1 .or. top_height == 3) then
     523      if (top_height .eq. 1 .or. top_height .eq. 3) then
    524524
    525525
    … …  
    539539        pstd = 1.013250E+06
    540540        t0 = 296.
    541         if (ncolprint /= 0)
     541        if (ncolprint .ne. 0)
    542542     &         write(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
    543         do ilev=1,nlev
     543        do 125 ilev=1,nlev
    544544          do j=1,npoints
    545545               !press and dpress are dyne/cm2 = Pascals *10
    … …  
    559559               dem_wv(j,ilev) = 1. - exp( -1. * tauwv(j))
    560560          enddo
    561                if (ncolprint /= 0) then
     561               if (ncolprint .ne. 0) then
    562562               do j=1,npoints ,1000
    563563               write(6,'(a10)') 'j='
    … …  
    568568               enddo
    569569             endif
    570       END DO
     570125     continue
    571571
    572572        !initialize variables
    … …  
    598598
    599599          enddo   
    600             if (ncolprint/=0) then
     600            if (ncolprint.ne.0) then
    601601             do j=1,npoints ,1000
    602602              write(6,'(a10)') 'j='
    … …  
    627627        enddo
    628628
    629         if (ncolprint/=0) then
     629        if (ncolprint.ne.0) then
    630630        do j=1,npoints ,1000
    631631          write(6,'(a10)') 'j='
    … …  
    649649
    650650
    651         if (ncolprint/=0) then
     651        if (ncolprint.ne.0) then
    652652
    653653        do j=1,npoints ,1000
    … …  
    683683
    684684              ! emissivity for point in this layer
    685                 if (frac_out(j,ibox,ilev)==1) then
     685                if (frac_out(j,ibox,ilev).eq.1) then
    686686                dem(j,ibox)= 1. -
    687687     &             ( (1. - dem_wv(j,ilev)) * (1. -  dem_s(j,ilev)) )
    688                 else if (frac_out(j,ibox,ilev)==2) then
     688                else if (frac_out(j,ibox,ilev).eq.2) then
    689689                dem(j,ibox)= 1. -
    690690     &             ( (1. - dem_wv(j,ilev)) * (1. -  dem_c(j,ilev)) )
    … …  
    710710            enddo ! ibox
    711711
    712             if (ncolprint/=0) then
     712            if (ncolprint.ne.0) then
    713713              do j=1,npoints,1000
    714714              write (6,'(a)') 'ilev:'
    … …  
    740740            bb(j)=1/( exp(1307.27/skt(j)) - 1. )
    741741            !bb(j)=5.67e-8*skt(j)**4
    742           END DO
     742          end do
    743743
    744744        do ibox=1,ncol
    … …  
    751751     &         * trans_layers_above(j,ibox)
    752752           
    753           END DO
    754         END DO
     753          end do
     754        end do
    755755
    756756        !calculate mean infrared brightness temperature
    … …  
    758758          do j=1,npoints
    759759            meantb(j) = meantb(j)+1307.27/(log(1.+(1./fluxtop(j,ibox))))
    760           END DO
    761         END DO
     760          end do
     761        end do
    762762          do j=1, npoints
    763763            meantb(j) = meantb(j) / real(ncol)
    764           END DO
    765 
    766         if (ncolprint/=0) then
     764          end do       
     765
     766        if (ncolprint.ne.0) then
    767767
    768768          do j=1,npoints ,1000
    … …  
    784784          write (6,'(8f7.2)') (meantb(j),ibox=1,ncolprint)
    785785     
    786           END DO
     786          end do
    787787      endif
    788788   
    … …  
    819819          enddo
    820820
    821           if (top_height == 1) then
     821          if (top_height .eq. 1) then
    822822            do j=1,npoints 
    823               if (transmax(j) > 0.001 .and.
    824      &          transmax(j) <= 0.9999999) then
     823              if (transmax(j) .gt. 0.001 .and.
     824     &          transmax(j) .le. 0.9999999) then
    825825                fluxtopinit(j) = fluxtop(j,ibox)
    826826              tauir(j) = tau(j,ibox) *rec2p13
    … …  
    829829            do icycle=1,2
    830830              do j=1,npoints 
    831                 if (tau(j,ibox) > (tauchk            )) then
    832                 if (transmax(j) > 0.001 .and.
    833      &            transmax(j) <= 0.9999999) then
     831                if (tau(j,ibox) .gt. (tauchk            )) then
     832                if (transmax(j) .gt. 0.001 .and.
     833     &            transmax(j) .le. 0.9999999) then
    834834                  emcld(j,ibox) = 1. - exp(-1. * tauir(j)  )
    835835                  fluxtop(j,ibox) = fluxtopinit(j) -   
    … …  
    839839                  tb(j,ibox)= 1307.27
    840840     &              / (log(1. + (1./fluxtop(j,ibox))))
    841                   if (tb(j,ibox) > 260.) then
     841                  if (tb(j,ibox) .gt. 260.) then
    842842                  tauir(j) = tau(j,ibox) / 2.56
    843843                  end if                   
    … …  
    850850       
    851851          do j=1,npoints
    852             if (tau(j,ibox) > (tauchk            )) then
     852            if (tau(j,ibox) .gt. (tauchk            )) then
    853853                !cloudy box
    854854                !NOTE: tb is the cloud-top temperature not infrared brightness temperature
    855855                !at this point in the code
    856856                tb(j,ibox)= 1307.27/ (log(1. + (1./fluxtop(j,ibox))))
    857                 if (top_height==1.and.tauir(j)<taumin(j)) then
     857                if (top_height.eq.1.and.tauir(j).lt.taumin(j)) then
    858858                         tb(j,ibox) = attrop(j) - 5.
    859859                   tau(j,ibox) = 2.13*taumin(j)
    … …  
    866866        enddo ! ibox
    867867
    868         if (ncolprint/=0) then
     868        if (ncolprint.ne.0) then
    869869
    870870          do j=1,npoints,1000
    … …  
    925925
    926926      !compute cloud top pressure
    927       do ibox=1,ncol
     927      do 30 ibox=1,ncol
    928928        !segregate according to optical thickness
    929         if (top_height == 1 .or. top_height == 3) then
     929        if (top_height .eq. 1 .or. top_height .eq. 3) then 
    930930          !find level whose temperature
    931931          !most closely matches brightness temperature
    … …  
    933933            nmatch(j)=0
    934934          enddo
    935           do k1=1,nlev-1
    936             if (top_height_direction == 2) then
     935          do 29 k1=1,nlev-1
     936            if (top_height_direction .eq. 2) then
    937937              ilev = nlev - k1
    938938            else
    … …  
    941941            !cdir nodep
    942942            do j=1,npoints
    943              if (ilev >= itrop(j)) then
    944               if ((at(j,ilev)   >= tb(j,ibox) .and.
    945      &          at(j,ilev+1) <= tb(j,ibox)) .or.
    946      &          (at(j,ilev) <= tb(j,ibox) .and.
    947      &          at(j,ilev+1) >= tb(j,ibox))) then
     943             if (ilev .ge. itrop(j)) then
     944              if ((at(j,ilev)   .ge. tb(j,ibox) .and.
     945     &          at(j,ilev+1) .le. tb(j,ibox)) .or.
     946     &          (at(j,ilev) .le. tb(j,ibox) .and.
     947     &          at(j,ilev+1) .ge. tb(j,ibox))) then
    948948                nmatch(j)=nmatch(j)+1
    949949                match(j,nmatch(j))=ilev
    … …  
    951951             end if                         
    952952            enddo
    953       END DO
     95329        continue
    954954
    955955          do j=1,npoints
    956             if (nmatch(j) >= 1) then
     956            if (nmatch(j) .ge. 1) then
    957957              k1 = match(j,nmatch(j))
    958958              k2 = k1 + 1
    … …  
    962962              logp=logp1+(logp2-logp1)*abs(tb(j,ibox)-at(j,k1))/atd
    963963              ptop(j,ibox) = exp(logp)
    964               if(abs(pfull(j,k1)-ptop(j,ibox)) <
     964              if(abs(pfull(j,k1)-ptop(j,ibox)) .lt.
    965965     &            abs(pfull(j,k2)-ptop(j,ibox))) then
    966966                 levmatch(j,ibox)=k1
    … …  
    969969              end if   
    970970            else
    971               if (tb(j,ibox) <= attrop(j)) then
     971              if (tb(j,ibox) .le. attrop(j)) then
    972972                ptop(j,ibox)=ptrop(j)
    973973                levmatch(j,ibox)=itrop(j)
    974974              end if
    975               if (tb(j,ibox) >= atmax(j)) then
     975              if (tb(j,ibox) .ge. atmax(j)) then
    976976                ptop(j,ibox)=pfull(j,nlev)
    977977                levmatch(j,ibox)=nlev
    … …  
    987987          do ilev=1,nlev
    988988            do j=1,npoints     
    989               if ((ptop(j,ibox) == 0. )
    990      &           .and.(frac_out(j,ibox,ilev) /= 0)) then
     989              if ((ptop(j,ibox) .eq. 0. )
     990     &           .and.(frac_out(j,ibox,ilev) .ne. 0)) then
    991991                ptop(j,ibox)=phalf(j,ilev)
    992992              levmatch(j,ibox)=ilev
    993993              end if
    994             END DO
    995           END DO
     994            end do
     995          end do
    996996        end if                           
    997997         
    998998        do j=1,npoints
    999           if (tau(j,ibox) <= (tauchk            )) then
     999          if (tau(j,ibox) .le. (tauchk            )) then
    10001000            ptop(j,ibox)=0.
    10011001            levmatch(j,ibox)=0     
    … …  
    10031003        enddo
    10041004
    1005       END DO
     100530    continue
    10061006             
    10071007!
    … …  
    10321032
    10331033      !reset frequencies
    1034       do ilev=1,7
     1034      do 38 ilev=1,7
    10351035      do 38 ilev2=1,7
    10361036        do j=1,npoints !
    1037              if (sunlit(j)==1 .or. top_height == 3) then
     1037             if (sunlit(j).eq.1 .or. top_height .eq. 3) then
    10381038                fq_isccp(j,ilev,ilev2)= 0.
    10391039             else
    … …  
    10421042        enddo
    1043104338    continue
    1044       END DO
    10451044
    10461045      !reset variables need for averaging cloud properties
    10471046      do j=1,npoints
    1048         if (sunlit(j)==1 .or. top_height == 3) then
     1047        if (sunlit(j).eq.1 .or. top_height .eq. 3) then
    10491048             totalcldarea(j) = 0.
    10501049             meanalbedocld(j) = 0.
    … …  
    10611060      boxarea = 1./real(ncol)
    10621061     
    1063       do ibox=1,ncol
     1062      do 39 ibox=1,ncol
    10641063        do j=1,npoints
    10651064
    1066           if (tau(j,ibox) > (tauchk            )
    1067      &      .and. ptop(j,ibox) > 0.) then
     1065          if (tau(j,ibox) .gt. (tauchk            )
     1066     &      .and. ptop(j,ibox) .gt. 0.) then
    10681067              box_cloudy(j,ibox)=.true.
    10691068          endif
    … …  
    10711070          if (box_cloudy(j,ibox)) then
    10721071
    1073               if (sunlit(j)==1 .or. top_height == 3) then
     1072              if (sunlit(j).eq.1 .or. top_height .eq. 3) then
    10741073
    10751074                boxtau(j,ibox) = tau(j,ibox)
    10761075
    1077                 if (tau(j,ibox) >= isccp_taumin) then
     1076                if (tau(j,ibox) .ge. isccp_taumin) then
    10781077                   totalcldarea(j) = totalcldarea(j) + boxarea
    10791078               
    … …  
    10921091          endif
    10931092
    1094           if (sunlit(j)==1 .or. top_height == 3) then
     1093          if (sunlit(j).eq.1 .or. top_height .eq. 3) then
    10951094
    10961095           if (box_cloudy(j,ibox)) then
    … …  
    11021101              boxptop(j,ibox) = ptop(j,ibox)
    11031102   
    1104               if (tau(j,ibox) >= isccp_taumin) then
     1103              if (tau(j,ibox) .ge. isccp_taumin) then
    11051104                meanptop(j) = meanptop(j) + ptop(j,ibox)*boxarea
    11061105              end if           
    … …  
    11111110
    11121111              !determine optical depth category
    1113               if (tau(j,ibox) < isccp_taumin) then
     1112              if (tau(j,ibox) .lt. isccp_taumin) then
    11141113                  itau(j)=1
    1115               else if (tau(j,ibox) >= isccp_taumin
     1114              else if (tau(j,ibox) .ge. isccp_taumin
    11161115     &                                   
    1117      &          .and. tau(j,ibox) < 1.3) then
     1116     &          .and. tau(j,ibox) .lt. 1.3) then
    11181117                itau(j)=2
    1119               else if (tau(j,ibox) >= 1.3
    1120      &          .and. tau(j,ibox) < 3.6) then
     1118              else if (tau(j,ibox) .ge. 1.3
     1119     &          .and. tau(j,ibox) .lt. 3.6) then
    11211120                itau(j)=3
    1122               else if (tau(j,ibox) >= 3.6
    1123      &          .and. tau(j,ibox) < 9.4) then
     1121              else if (tau(j,ibox) .ge. 3.6
     1122     &          .and. tau(j,ibox) .lt. 9.4) then
    11241123                  itau(j)=4
    1125               else if (tau(j,ibox) >= 9.4
    1126      &          .and. tau(j,ibox) < 23.) then
     1124              else if (tau(j,ibox) .ge. 9.4
     1125     &          .and. tau(j,ibox) .lt. 23.) then
    11271126                  itau(j)=5
    1128               else if (tau(j,ibox) >= 23.
    1129      &          .and. tau(j,ibox) < 60.) then
     1127              else if (tau(j,ibox) .ge. 23.
     1128     &          .and. tau(j,ibox) .lt. 60.) then
    11301129                  itau(j)=6
    1131               else if (tau(j,ibox) >= 60.) then
     1130              else if (tau(j,ibox) .ge. 60.) then
    11321131                  itau(j)=7
    11331132              end if
    11341133
    11351134              !determine cloud top pressure category
    1136               if (    ptop(j,ibox) > 0.
    1137      &          .and.ptop(j,ibox) < 180.) then
     1135              if (    ptop(j,ibox) .gt. 0. 
     1136     &          .and.ptop(j,ibox) .lt. 180.) then
    11381137                  ipres(j)=1
    1139               else if(ptop(j,ibox) >= 180.
    1140      &          .and.ptop(j,ibox) < 310.) then
     1138              else if(ptop(j,ibox) .ge. 180.
     1139     &          .and.ptop(j,ibox) .lt. 310.) then
    11411140                  ipres(j)=2
    1142               else if(ptop(j,ibox) >= 310.
    1143      &          .and.ptop(j,ibox) < 440.) then
     1141              else if(ptop(j,ibox) .ge. 310.
     1142     &          .and.ptop(j,ibox) .lt. 440.) then
    11441143                  ipres(j)=3
    1145               else if(ptop(j,ibox) >= 440.
    1146      &          .and.ptop(j,ibox) < 560.) then
     1144              else if(ptop(j,ibox) .ge. 440.
     1145     &          .and.ptop(j,ibox) .lt. 560.) then
    11471146                  ipres(j)=4
    1148               else if(ptop(j,ibox) >= 560.
    1149      &          .and.ptop(j,ibox) < 680.) then
     1147              else if(ptop(j,ibox) .ge. 560.
     1148     &          .and.ptop(j,ibox) .lt. 680.) then
    11501149                  ipres(j)=5
    1151               else if(ptop(j,ibox) >= 680.
    1152      &          .and.ptop(j,ibox) < 800.) then
     1150              else if(ptop(j,ibox) .ge. 680.
     1151     &          .and.ptop(j,ibox) .lt. 800.) then
    11531152                  ipres(j)=6
    1154               else if(ptop(j,ibox) >= 800.) then
     1153              else if(ptop(j,ibox) .ge. 800.) then
    11551154                  ipres(j)=7
    11561155              end if
    11571156
    11581157              !update frequencies
    1159               if(ipres(j) > 0.and.itau(j) > 0) then
     1158              if(ipres(j) .gt. 0.and.itau(j) .gt. 0) then
    11601159              fq_isccp(j,itau(j),ipres(j))=
    11611160     &          fq_isccp(j,itau(j),ipres(j))+ boxarea
    … …  
    11671166                       
    11681167        enddo ! j
    1169       END DO
     116839    continue
    11701169     
    11711170      !compute mean cloud properties
    11721171      do j=1,npoints
    1173         if (totalcldarea(j) > 0.) then
     1172        if (totalcldarea(j) .gt. 0.) then
    11741173          ! code above guarantees that totalcldarea > 0
    11751174          ! only if sunlit .eq. 1 .or. top_height = 3
    … …  
    11941193!     OPTIONAL PRINTOUT OF DATA TO CHECK PROGRAM
    11951194!
    1196       if (debugcol/=0) then
     1195      if (debugcol.ne.0) then
    11971196!     
    11981197         do j=1,npoints,debugcol
    … …  
    12081207              do ibox=1,ncol
    12091208                   acc(ilev,ibox)=frac_out(j,ibox,ilev)*2
    1210                    if (levmatch(j,ibox) == ilev)
     1209                   if (levmatch(j,ibox) .eq. ilev)
    12111210     &                 acc(ilev,ibox)=acc(ilev,ibox)+1
    12121211              enddo
    … …  
    12281227     &           (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev)
    12291228     &           ,(cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    1230              END DO
     1229             end do
    12311230             close(9)
    12321231
    1233              if (ncolprint/=0) then
     1232             if (ncolprint.ne.0) then
    12341233               write(6,'(a1)') ' '
    12351234                    write(6,'(a2,1X,5(a7,1X),a50)')

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/lidar_simulator.F90

    r5093 r5095  
    247247!------------------------------------------------------------
    248248
    249       if ( npart /= 4 ) then
     249      if ( npart .ne. 4 ) then
    250250        print *,'Error in lidar_simulator, npart should be 4, not',npart
    251251        stop
    … …  
    267267         polpart(INDX_LSLIQ,5) =  0.0626
    268268!*     LS Ice coefficients:
    269       if (ice_type==0) then
     269      if (ice_type.eq.0) then     
    270270         polpart(INDX_LSICE,1) = -1.0176e-8
    271271         polpart(INDX_LSICE,2) =  1.7615e-6
    … …  
    275275      endif
    276276!*     LS Ice NS coefficients:
    277       if (ice_type==1) then
     277      if (ice_type.eq.1) then
    278278         polpart(INDX_LSICE,1) = 1.3615e-8
    279279         polpart(INDX_LSICE,2) = -2.04206e-6
    … …  
    289289         polpart(INDX_CVLIQ,5) =  0.0626
    290290!*     CONV Ice coefficients:
    291       if (ice_type==0) then
     291      if (ice_type.eq.0) then
    292292         polpart(INDX_CVICE,1) = -1.0176e-8
    293293         polpart(INDX_CVICE,2) =  1.7615e-6
    … …  
    296296         polpart(INDX_CVICE,5) =  0.0460
    297297      endif
    298       if (ice_type==1) then
     298      if (ice_type.eq.1) then
    299299         polpart(INDX_CVICE,1) = 1.3615e-8
    300300         polpart(INDX_CVICE,2) = -2.04206e-6
    … …  
    342342! polynomes kp_lidar derived from Mie theory:
    343343      do i = 1, npart
    344        where ( rad_part(:,:,i)>0.0)
     344       where ( rad_part(:,:,i).gt.0.0)
    345345         kp_part(:,:,i) = &
    346346            polpart(i,1)*(rad_part(:,:,i)*1e6)**4 &
    … …  
    362362! alpha of particles in each subcolumn:
    363363      do i = 1, npart
    364         where ( rad_part(:,:,i)>0.0)
     364        where ( rad_part(:,:,i).gt.0.0)
    365365          alpha_part(:,:,i) = 3.0/4.0 * Qscat &
    366366                 * rhoair(:,:) * qpart(:,:,i) &
    … …  
    378378!     opt. thick of each layer
    379379      tau_mol(:,1:nlev) = alpha_mol(:,1:nlev) &
    380    *(zheight(:,2:nlev+1)-zheight(:,1:nlev))
     380         & *(zheight(:,2:nlev+1)-zheight(:,1:nlev))
    381381!     opt. thick from TOA
    382382      DO k = nlev-1, 1, -1
    … …  
    390390!       opt. thick of each layer
    391391        tau_part(:,:,i) = tau_part(:,:,i) &
    392    * (zheight(:,2:nlev+1)-zheight(:,1:nlev) )
     392           & * (zheight(:,2:nlev+1)-zheight(:,1:nlev) )
    393393!       opt. thick from TOA
    394394        DO k = nlev-1, 1, -1
    … …  
    400400!      Upper layer
    401401       pmol(:,nlev) = beta_mol(:,nlev) / (2.*tau_mol(:,nlev)) &
    402    * (1.-exp(-2.0*tau_mol(:,nlev)))
     402            & * (1.-exp(-2.0*tau_mol(:,nlev)))
    403403!      Other layers
    404404       DO k= nlev-1, 1, -1
    405405        tau_mol_lay(:) = tau_mol(:,k)-tau_mol(:,k+1) ! opt. thick. of layer k
    406         WHERE (tau_mol_lay(:)>0.)
     406        WHERE (tau_mol_lay(:).GT.0.)
    407407          pmol(:,k) = beta_mol(:,k) * EXP(-2.0*tau_mol(:,k+1)) / (2.*tau_mol_lay(:)) &
    408    * (1.-exp(-2.0*tau_mol_lay(:)))
     408            & * (1.-exp(-2.0*tau_mol_lay(:)))
    409409        ELSEWHERE
    410410!         This must never happend, but just in case, to avoid div. by 0
    … …  
    429429!     Upper layer
    430430      pnorm(:,nlev) = betatot(:,nlev) / (2.*tautot(:,nlev)) &
    431    * (1.-exp(-2.0*tautot(:,nlev)))
     431            & * (1.-exp(-2.0*tautot(:,nlev)))
    432432
    433433!     Other layers
    434434      DO k= nlev-1, 1, -1
    435435          tautot_lay(:) = tautot(:,k)-tautot(:,k+1) ! optical thickness of layer k
    436         WHERE (tautot_lay(:)>0.)
     436        WHERE (tautot_lay(:).GT.0.)
    437437          pnorm(:,k) = betatot(:,k) * EXP(-2.0*tautot(:,k+1)) / (2.*tautot_lay(:)) &
    438    * (1.-EXP(-2.0*tautot_lay(:)))
     438               & * (1.-EXP(-2.0*tautot_lay(:)))
    439439        ELSEWHERE
    440440!         This must never happend, but just in case, to avoid div. by 0
    … …  
    468468!     Upper layer
    469469      pnorm_ice(:,nlev) = betatot_ice(:,nlev) / (2.*tautot_ice(:,nlev)) &
    470    * (1.-exp(-2.0*tautot_ice(:,nlev)))
     470            & * (1.-exp(-2.0*tautot_ice(:,nlev)))
    471471
    472472      DO k= nlev-1, 1, -1
    473473          tautot_lay_ice(:) = tautot_ice(:,k)-tautot_ice(:,k+1)
    474         WHERE (tautot_lay_ice(:)>0.)
     474        WHERE (tautot_lay_ice(:).GT.0.)
    475475         pnorm_ice(:,k)=betatot_ice(:,k)*EXP(-2.0*tautot_ice(:,k+1))/(2.*tautot_lay_ice(:)) &
    476    * (1.-EXP(-2.0*tautot_lay_ice(:)))
     476               & * (1.-EXP(-2.0*tautot_lay_ice(:)))
    477477        ELSEWHERE
    478478         pnorm_ice(:,k)=betatot_ice(:,k)*EXP(-2.0*tautot_ice(:,k+1))
    … …  
    483483!     Upper layer
    484484      pnorm_liq(:,nlev) = betatot_liq(:,nlev) / (2.*tautot_liq(:,nlev)) &
    485    * (1.-exp(-2.0*tautot_liq(:,nlev)))
     485            & * (1.-exp(-2.0*tautot_liq(:,nlev)))
    486486
    487487      DO k= nlev-1, 1, -1
    488488          tautot_lay_liq(:) = tautot_liq(:,k)-tautot_liq(:,k+1)
    489         WHERE (tautot_lay_liq(:)>0.)
     489        WHERE (tautot_lay_liq(:).GT.0.)
    490490          pnorm_liq(:,k)=betatot_liq(:,k)*EXP(-2.0*tautot_liq(:,k+1))/(2.*tautot_lay_liq(:)) &
    491    * (1.-EXP(-2.0*tautot_lay_liq(:)))
     491               & * (1.-EXP(-2.0*tautot_lay_liq(:)))
    492492        ELSEWHERE
    493493          pnorm_liq(:,k)=betatot_liq(:,k)*EXP(-2.0*tautot_liq(:,k+1))
    … …  
    510510!     Upper layer
    511511      beta_perp_ice(:,nlev) = pnorm_perp_ice(:,nlev) * (2.*tautot_ice(:,nlev)) &
    512    / (1.-exp(-2.0*tautot_ice(:,nlev)))
     512            & / (1.-exp(-2.0*tautot_ice(:,nlev)))
    513513
    514514      DO k= nlev-1, 1, -1
    515515        tautot_lay_ice(:) = tautot_ice(:,k)-tautot_ice(:,k+1)
    516         WHERE (tautot_lay_ice(:)>0.)
     516        WHERE (tautot_lay_ice(:).GT.0.)
    517517         beta_perp_ice(:,k) = pnorm_perp_ice(:,k)/ EXP(-2.0*tautot_ice(:,k+1)) * (2.*tautot_lay_ice(:)) &
    518    / (1.-exp(-2.0*tautot_lay_ice(:)))
     518            & / (1.-exp(-2.0*tautot_lay_ice(:)))
    519519
    520520        ELSEWHERE
    … …  
    526526!     Upper layer
    527527      beta_perp_liq(:,nlev) = pnorm_perp_liq(:,nlev) * (2.*tautot_liq(:,nlev)) &
    528    / (1.-exp(-2.0*tautot_liq(:,nlev)))
     528            & / (1.-exp(-2.0*tautot_liq(:,nlev)))
    529529
    530530      DO k= nlev-1, 1, -1
    531531          tautot_lay_liq(:) = tautot_liq(:,k)-tautot_liq(:,k+1)
    532         WHERE (tautot_lay_liq(:)>0.)
     532        WHERE (tautot_lay_liq(:).GT.0.)
    533533         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(:)))
     534            & * (2.*tautot_lay_liq(:)) / (1.-exp(-2.0*tautot_lay_liq(:)))
    535535
    536536        ELSEWHERE
    … …  
    547547! Computation of the total perpendicular lidar signal (ATBperp for liq+ice)
    548548!     Upper layer
    549     WHERE(tautot(:,nlev)>0)
     549    WHERE(tautot(:,nlev).GT.0)
    550550          pnorm_perp_tot(:,nlev) = &
    551551              (beta_perp_ice(:,nlev)+beta_perp_liq(:,nlev)-(beta_mol(:,nlev)/(1+1/0.0284))) / (2.*tautot(:,nlev)) &
    552    * (1.-exp(-2.0*tautot(:,nlev)))
     552              & * (1.-exp(-2.0*tautot(:,nlev)))
    553553    ELSEWHERE
    554554    pnorm_perp_tot(:,nlev) = 0.
    … …  
    563563          ! We remove one contribution using
    564564          ! Betaperp=beta_mol(:,k)/(1+1/0.0284)) [bodhaine et al. 1999] in the following equations:
    565             WHERE (pnorm(:,k)==0)
     565            WHERE (pnorm(:,k).eq.0)
    566566                  pnorm_perp_tot(:,k)=0.
    567567                  ELSEWHERE
    568                     WHERE (tautot_lay(:)>0.)
     568                    WHERE (tautot_lay(:).GT.0.)
    569569                      pnorm_perp_tot(:,k) = &
    570570                          (beta_perp_ice(:,k)+beta_perp_liq(:,k)-(beta_mol(:,k)/(1+1/0.0284))) * &
    571571                          EXP(-2.0*tautot(:,k+1)) / (2.*tautot_lay(:)) &
    572    * (1.-EXP(-2.0*tautot_lay(:)))
     572                          & * (1.-EXP(-2.0*tautot_lay(:)))
    573573                    ELSEWHERE
    574574          !         This must never happen, but just in case, to avoid div. by 0
    … …  
    690690! Lum_norm=f(tetaS,tau_cloud) derived from adding-doubling calculations
    691691!        valid ONLY ABOVE OCEAN (albedo_sfce=5%)
    692 !        valid only in one viewing direction (theta_v=30°, phi_s-phi_v=320°)
     692!        valid only in one viewing direction (theta_v=30�, phi_s-phi_v=320�)
    693693!        based on adding-doubling radiative transfer computation
    694694!        for tau values (0 to 100) and for tetas values (0 to 80)
    695695!        for 2 scattering phase functions: liquid spherical, ice non spherical
    696696
    697     IF ( nrefl> ntetas ) THEN
     697    IF ( nrefl.GT. ntetas ) THEN
    698698        PRINT *,'Error in lidar_simulator, nrefl should be less then ',ntetas,' not',nrefl
    699699        STOP
    … …  
    711711!
    712712! relative fraction of the opt. thick due to liquid or ice clouds
    713     WHERE (tautot_S(:) > 0.)
     713    WHERE (tautot_S(:) .GT. 0.)
    714714        frac_taucol_liq(:) = tautot_S_liq(:) / tautot_S(:)
    715715        frac_taucol_ice(:) = tautot_S_ice(:) / tautot_S(:)
    … …  
    733733    DO it=1,ntetas
    734734      DO ny=1,nbtau-1
    735         WHERE (tautot_S(:)>=tau(ny).AND.tautot_S(:)<=tau(ny+1))
     735        WHERE (tautot_S(:).GE.tau(ny).AND.tautot_S(:).LE.tau(ny+1))
    736736            rlumA_mod(:,it) = aA(it,ny)*tautot_S(:) + bA(it,ny)
    737737            rlumB_mod(:,it) = aB(it,ny)*tautot_S(:) + bB(it,ny)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/m_mrgrnk.F90

    r5081 r5095  
    3333         IRNGT (1) = 1
    3434         Return
     35      Case Default
     36         Continue
    3537      End Select
    3638!
    … …  
    231233         IRNGT (1) = 1
    232234         Return
     235      Case Default
     236         Continue
    233237      End Select
    234238!

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/math_lib.F90

    r5086 r5095  
    3434
    3535! ----- INPUTS -----
    36   real(kind=8), intent(in) :: x
     36  real*8, intent(in) :: x
    3737 
    3838! ----- OUTPUTS -----
    39   real(kind=8) :: gamma
     39  real*8 :: gamma
    4040
    4141! ----- INTERNAL ----- 
    42   real(kind=8) :: pi,ga,z,r,gr
    43   real(kind=8) :: g(26)
     42  real*8 :: pi,ga,z,r,gr
     43  real*8 :: g(26)
    4444  integer :: k,m1,m
    4545       
    … …  
    124124
    125125! ----- INPUTS ----- 
    126   real(kind=8), intent(in), dimension(:) :: f,s
     126  real*8, intent(in), dimension(:) :: f,s 
    127127  integer, intent(in) :: i1, i2
    128128
    129129! ---- OUTPUTS -----
    130   real(kind=8) :: path_integral
     130  real*8 :: path_integral 
    131131 
    132132! ----- INTERNAL -----   
    133   real(kind=8) :: sumo, deltah, val
    134   integer(kind=4) :: nelm, j
    135   integer(kind=4), dimension(i2-i1+1) :: idx
    136   real(kind=8), dimension(i2-i1+1) :: f_rev, s_rev
     133  real*8 :: sumo, deltah, val
     134  integer*4 :: nelm, j
     135  integer*4, dimension(i2-i1+1) :: idx
     136  real*8, dimension(i2-i1+1) :: f_rev, s_rev
    137137
    138138  nelm = i2-i1+1
    … …  
    273273       exit
    274274    end if
    275   END DO
     275  end do
    276276 
    277277  if (lerror) then
    … …  
    316316    end if
    317317    ilo = ilo + 1
    318   END DO
     318  end do
    319319
    320320  ilo = max ( 2, ilo )
    … …  
    326326    end if
    327327    ihi = ihi - 1
    328   END DO
     328  end do
    329329 
    330330  ihi = min ( ihi, ntab - 1 )
    … …  
    374374    syl = x2
    375375 
    376   END DO
     376  end do
    377377 
    378378  result = sum1 &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp.F90

    r5082 r5095  
    179179   minp = minval(gbx%psfc)
    180180   maxp = maxval(gbx%psfc)
    181    if (Npoints > 1) seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1
     181   if (Npoints .gt. 1) seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1
    182182   ! Below it's how it was done in the original implementation of the ISCCP simulator.
    183183   ! The one above is better for offline data, when you may have packed data
    … …  
    414414                if (sgx%frac_out (j,i,Nlevels+1-k) == I_LSC) frac_ls(j,k)=frac_ls(j,k)+1.
    415415                if (sgx%frac_out (j,i,Nlevels+1-k) == I_CVC) frac_cv(j,k)=frac_cv(j,k)+1.
    416                 if (sgx%prec_frac(j,i,Nlevels+1-k) == 1) prec_ls(j,k)=prec_ls(j,k)+1.
    417                 if (sgx%prec_frac(j,i,Nlevels+1-k) == 2) prec_cv(j,k)=prec_cv(j,k)+1.
    418                 if (sgx%prec_frac(j,i,Nlevels+1-k) == 3) then
     416                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 1) prec_ls(j,k)=prec_ls(j,k)+1.
     417                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 2) prec_cv(j,k)=prec_cv(j,k)+1.
     418                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 3) then
    419419                    prec_cv(j,k)=prec_cv(j,k)+1.
    420420                    prec_ls(j,k)=prec_ls(j,k)+1.
    … …  
    501501            do j=1,Npoints
    502502                !--------- Clouds -------
    503                 if (frac_ls(j,k) /= 0.) then
     503                if (frac_ls(j,k) .ne. 0.) then
    504504                    sghydro%mr_hydro(j,:,k,I_LSCLIQ) = sghydro%mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
    505505                    sghydro%mr_hydro(j,:,k,I_LSCICE) = sghydro%mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
    506506                endif
    507                 if (frac_cv(j,k) /= 0.) then
     507                if (frac_cv(j,k) .ne. 0.) then
    508508                    sghydro%mr_hydro(j,:,k,I_CVCLIQ) = sghydro%mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
    509509                    sghydro%mr_hydro(j,:,k,I_CVCICE) = sghydro%mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
    … …  
    511511                !--------- Precip -------
    512512                if (gbx%use_precipitation_fluxes) then
    513                     if (prec_ls(j,k) /= 0.) then
     513                    if (prec_ls(j,k) .ne. 0.) then
    514514                        gbx%rain_ls(j,k) = gbx%rain_ls(j,k)/prec_ls(j,k)
    515515                        gbx%snow_ls(j,k) = gbx%snow_ls(j,k)/prec_ls(j,k)
    516516                        gbx%grpl_ls(j,k) = gbx%grpl_ls(j,k)/prec_ls(j,k)
    517517                    endif
    518                     if (prec_cv(j,k) /= 0.) then
     518                    if (prec_cv(j,k) .ne. 0.) then
    519519                        gbx%rain_cv(j,k) = gbx%rain_cv(j,k)/prec_cv(j,k)
    520520                        gbx%snow_cv(j,k) = gbx%snow_cv(j,k)/prec_cv(j,k)
    521521                    endif
    522522                else
    523                     if (prec_ls(j,k) /= 0.) then
     523                    if (prec_ls(j,k) .ne. 0.) then
    524524                        sghydro%mr_hydro(j,:,k,I_LSRAIN) = sghydro%mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
    525525                        sghydro%mr_hydro(j,:,k,I_LSSNOW) = sghydro%mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
    526526                        sghydro%mr_hydro(j,:,k,I_LSGRPL) = sghydro%mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
    527527                    endif
    528                     if (prec_cv(j,k) /= 0.) then
     528                    if (prec_cv(j,k) .ne. 0.) then
    529529                        sghydro%mr_hydro(j,:,k,I_CVRAIN) = sghydro%mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
    530530                        sghydro%mr_hydro(j,:,k,I_CVSNOW) = sghydro%mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_modis_simulator.F90

    r5086 r5095  
    176176              opticalThickness(i, j, k) = 0.   
    177177            end if
    178           END DO
    179         END DO
    180       END DO
     178          end do
     179        end do
     180      end do
    181181
    182182      !
    … …  
    197197          do i = 1, nSunlit
    198198            if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
    199           END DO
    200         END DO
    201       END DO
     199          end do
     200        end do
     201      end do
    202202
    203203      !
    … …  
    220220                                retrievedPhase(i, :), retrievedCloudTopPressure(i, :),      &
    221221                                retrievedTau(i, :), retrievedSize(i, :))
    222      END DO
     222     end do
    223223     
    224224      ! DJS2015: Call L3 modis simulator used by cospv2.0

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_radar.F90

    r5082 r5095  
    5353
    5454        real undef
    55         real(kind=8), dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, &
     55        real*8, dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, &
    5656            t_matrix,rh_matrix
    57         real(kind=8), dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix
    58         real(kind=8), dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix
    59         real(kind=8), dimension(hp%nhclass,nprof,ngate), intent(inout) :: Np_matrix
     57        real*8, dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix
     58        real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix
     59        real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: Np_matrix
    6060
    6161        ! ----- OUTPUTS -----
    62         real(kind=8), dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
     62        real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
    6363            g_to_vol,dBZe,a_to_vol
    6464        ! ----- OPTIONAL -----
    65         real(kind=8), optional, dimension(nprof,ngate) :: &
     65        real*8, optional, dimension(nprof,ngate) :: &
    6666            g_to_vol_in,g_to_vol_out
    6767     end subroutine radar_simulator
    … …  
    8686  nsizes            ! num of discrete drop sizes
    8787
    88   real(kind=8), dimension(:,:), allocatable :: &
     88  real*8, dimension(:,:), allocatable :: &
    8989  g_to_vol ! integrated atten due to gases, r>v (dB)
    9090
    91   real(kind=8), dimension(:,:), allocatable :: &
     91  real*8, dimension(:,:), allocatable :: &
    9292  Ze_non, &         ! radar reflectivity withOUT attenuation (dBZ)
    9393  Ze_ray, &         ! Rayleigh reflectivity (dBZ)
    … …  
    100100  rh_matrix                     !relative humidity (%)
    101101
    102   real(kind=8), dimension(:,:,:), allocatable :: &
     102  real*8, dimension(:,:,:), allocatable :: &
    103103  hm_matrix, &          ! hydrometeor mixing ratio (g kg^-1)
    104104  re_matrix, &          ! effective radius (microns).   Optional. 0 ==> use Np_matrix or defaults

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_types.F90

    r5082 r5095  
    11101110
    11111111
    1112     if(y%Nhydro/=N_HYDRO) then
     1112    if(y%Nhydro.ne.N_HYDRO) then
    11131113
    11141114        write(*,*) 'Number of hydrometeor input to subroutine', &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_llnl_stats.F90

    r5082 r5095  
    119119       do j=Nlevels,1,-1 !top->surf
    120120        sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
    121         if ((sc_ratio <= s_att) .and. (flag_sat == 0)) flag_sat = j
    122         if (Ze_tot(pr,i,j) < -30.) then  !radar can't detect cloud
    123          if ( (sc_ratio > s_cld) .or. (flag_sat == j) ) then  !lidar sense cloud
     121        if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
     122        if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
     123         if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
    124124            lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf
    125125            flag_cld=1
    … …  
    129129        endif
    130130       enddo !levels
    131        if (flag_cld == 1) tcc(pr)=tcc(pr)+1.
     131       if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1.
    132132     enddo !columns
    133133   enddo !points

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90

    r5082 r5095  
    148148      do ic = 1, ncol
    149149        pnorm_c = pnorm(:,ic,:)
    150         where ((pnorm_c<xmax) .and. (pmol<xmax) .and. (pmol> 0.0 ))
     150        where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
    151151            x3d_c = pnorm_c/pmol
    152152        elsewhere
    … …  
    247247! c 0- Initializations
    248248! c -------------------------------------------------------
    249       if ( Nbins < 6) return
     249      if ( Nbins .lt. 6) return
    250250
    251251      srbval(1) =  S_att
    … …  
    275275               do i = 1, Npoints
    276276                  if (x(i,k,j) /= undef) then
    277                      if ((x(i,k,j)>srbval_ext(ib-1)).and.(x(i,k,j)<=srbval_ext(ib))) &
     277                     if ((x(i,k,j).gt.srbval_ext(ib-1)).and.(x(i,k,j).le.srbval_ext(ib))) &
    278278                          cfad(i,ib,j) = cfad(i,ib,j) + 1.0
    279279                  else
    … …  
    285285      enddo
    286286
    287       where (cfad /= undef)  cfad = cfad / float(Ncolumns)
     287      where (cfad .ne. undef)  cfad = cfad / float(Ncolumns)
    288288
    289289! c -------------------------------------------------------
    … …  
    373373! ---------------------------------------------------------------
    374374
    375       if ( Ncat /= 4 ) then
     375      if ( Ncat .ne. 4 ) then
    376376         print *,'Error in lmd_ipsl_stats.cosp_cldfrac, Ncat must be 4, not',Ncat
    377377         stop
    … …  
    423423
    424424! cloud detection at subgrid-scale:
    425          where ( (x(:,:,k)>S_cld) .and. (x(:,:,k)/= undef) )
     425         where ( (x(:,:,k).gt.S_cld) .and. (x(:,:,k).ne. undef) )
    426426           cldy(:,:,k)=1.0
    427427         elsewhere
    … …  
    430430
    431431! number of usefull sub-columns:
    432          where ( (x(:,:,k)>S_att) .and. (x(:,:,k)/= undef)  )
     432         where ( (x(:,:,k).gt.S_att) .and. (x(:,:,k).ne. undef)  )
    433433           srok(:,:,k)=1.0
    434434         elsewhere
    … …  
    513513          ! Computation of the cloud fraction as a function of the temperature
    514514          ! instead of height, for ice,liquid and all clouds
    515           if(srok(ip,ic,k)>0.)then
     515          if(srok(ip,ic,k).gt.0.)then
    516516          do itemp=1,Ntemp
    517             if( (tmp(ip,k)>=tempmod(itemp)).and.(tmp(ip,k)<tempmod(itemp+1)) )then
     517            if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    518518              lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
    519519            endif
    … …  
    521521          endif
    522522
    523           if(cldy(ip,ic,k)==1.)then
     523          if(cldy(ip,ic,k).eq.1.)then
    524524          do itemp=1,Ntemp
    525             if( (tmp(ip,k)>=tempmod(itemp)).and.(tmp(ip,k)<tempmod(itemp+1)) )then
     525            if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    526526              lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
    527527            endif
    … …  
    532532          iz=1
    533533          p1 = pplay(ip,k)
    534           if ( p1>0. .and. p1<(440.*100.)) then ! high clouds
     534          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
    535535            iz=3
    536           else if(p1>=(440.*100.) .and. p1<(680.*100.)) then  ! mid clouds
     536          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
    537537            iz=2
    538538         endif
    … …  
    554554! -- grid-box 3D cloud fraction
    555555
    556       where ( nsub(:,:)>0.0 )
     556      where ( nsub(:,:).gt.0.0 )
    557557         lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
    558558      elsewhere
    … …  
    573573       enddo
    574574      enddo
    575       where ( nsublayer(:,:)>0.0 )
     575      where ( nsublayer(:,:).gt.0.0 )
    576576         cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
    577577      elsewhere
    … …  
    593593
    594594! Avoid zero values
    595         if( (cldy(i,ncol,nlev)==1.) .and. (ATBperp(i,ncol,nlev)>0.) )then
     595        if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
    596596! Computation of the ATBperp along the phase discrimination line
    597597           ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    604604!____________________________________________________________________________________________________
    605605!
    606            if( (ATBperp(i,ncol,nlev)-ATBperp_tmp)>=0. )then   ! Ice clouds
     606           if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then   ! Ice clouds
    607607             ! ICE with temperature above 273,15°K = Liquid (false ice)
    608             if(tmp(i,nlev)>273.15)then                ! Temperature above 273,15 K
     608            if(tmp(i,nlev).gt.273.15)then                ! Temperature above 273,15 K
    609609              ! Liquid: False ice corrected by the temperature to Liquid
    610610               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.   ! false ice detection ==> added to Liquid
    … …  
    613613                                                    ! to classify the phase cloud
    614614                   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    615                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     615                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    616616                   cldlayphase(i,ncol,3,2) = 1.
    617                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     617                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    618618                   cldlayphase(i,ncol,2,2) = 1.
    619619                else                                                    ! low cloud
    … …  
    621621                endif
    622622                   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
    623                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     623                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    624624                   cldlayphase(i,ncol,3,5) = 1.
    625                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     625                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    626626                   cldlayphase(i,ncol,2,5) = 1.
    627627                else                                                    ! low cloud
    … …  
    634634              tmpi(i,ncol,nlev)=tmp(i,nlev)
    635635                   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    636                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     636                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    637637                   cldlayphase(i,ncol,3,1) = 1.
    638                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     638                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    639639                   cldlayphase(i,ncol,2,1) = 1.
    640640                else                                                    ! low cloud
    … …  
    651651             else                                        ! Liquid clouds
    652652              ! Liquid with temperature above 231,15°K
    653             if(tmp(i,nlev)>231.15)then
     653            if(tmp(i,nlev).gt.231.15)then
    654654               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.
    655655               tmpl(i,ncol,nlev)=tmp(i,nlev)
    656656                   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    657                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     657                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    658658                   cldlayphase(i,ncol,3,2) = 1. 
    659                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     659                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    660660                   cldlayphase(i,ncol,2,2) = 1.
    661661                else                                                    ! low cloud
    … …  
    670670                                                    ! to classify the phase cloud
    671671                   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
    672                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     672                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    673673                   cldlayphase(i,ncol,3,4) = 1. 
    674                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     674                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    675675                   cldlayphase(i,ncol,2,4) = 1.
    676676                else                                                    ! low cloud
    … …  
    678678                endif
    679679                   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    680                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     680                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    681681                   cldlayphase(i,ncol,3,1) = 1. 
    682                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     682                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    683683                   cldlayphase(i,ncol,2,1) = 1.
    684684                else                                                    ! low cloud
    … …  
    702702         p1 = pplay(i,nlev)
    703703
    704         if( (cldy(i,ncol,nlev)==1.) .and. (ATBperp(i,ncol,nlev)>0.) )then
     704        if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
    705705! Phase discrimination line : ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50
    706706!                                  + ATB*epsilon50 + zeta50
    … …  
    715715!
    716716            ! ICE with temperature above 273,15°K = Liquid (false ice)
    717           if( (ATBperp(i,ncol,nlev)-ATBperp_tmp)>=0. )then   ! Ice clouds
    718             if(tmp(i,nlev)>273.15)then
     717          if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then   ! Ice clouds
     718            if(tmp(i,nlev).gt.273.15)then
    719719               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.  ! false ice ==> liq
    720720               tmpl(i,ncol,nlev)=tmp(i,nlev)
    … …  
    722722
    723723                   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    724                if ( p1>0. .and. p1<(440.*100.)) then              ! high cloud
     724               if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
    725725                   cldlayphase(i,ncol,3,2) = 1.
    726                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     726                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    727727                   cldlayphase(i,ncol,2,2) = 1.
    728728                else                                                    ! low cloud
    … …  
    731731
    732732                   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
    733                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     733                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    734734                   cldlayphase(i,ncol,3,5) = 1.
    735                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     735                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    736736                   cldlayphase(i,ncol,2,5) = 1.
    737737                else                                                    ! low cloud
    … …  
    745745
    746746                   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    747                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     747                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    748748                   cldlayphase(i,ncol,3,1) = 1.
    749                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     749                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    750750                   cldlayphase(i,ncol,2,1) = 1.
    751751                else                                                    ! low cloud
    … …  
    762762          else 
    763763             ! Liquid with temperature above 231,15°K
    764             if(tmp(i,nlev)>231.15)then
     764            if(tmp(i,nlev).gt.231.15)then
    765765               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.
    766766               tmpl(i,ncol,nlev)=tmp(i,nlev)
    767767
    768768                   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    769                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     769                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    770770                   cldlayphase(i,ncol,3,2) = 1. 
    771                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     771                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    772772                   cldlayphase(i,ncol,2,2) = 1.
    773773                else                                                    ! low cloud
    … …  
    782782
    783783                   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
    784                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     784                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    785785                   cldlayphase(i,ncol,3,4) = 1. 
    786                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     786                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    787787                   cldlayphase(i,ncol,2,4) = 1.
    788788                else                                                    ! low cloud
    … …  
    791791
    792792                   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    793                 if ( p1>0. .and. p1<(440.*100.)) then             ! high cloud
     793                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
    794794                   cldlayphase(i,ncol,3,1) = 1. 
    795                 else if(p1>=(440.*100.) .and. p1<(680.*100.)) then ! mid cloud
     795                else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
    796796                   cldlayphase(i,ncol,2,1) = 1.
    797797                else                                                    ! low cloud
    … …  
    805805
    806806           ! Find the level of the highest cloud with SR>30
    807             if(x(i,ncol,nlev)>S_cld_att)then     ! SR > 30.
     807            if(x(i,ncol,nlev).gt.S_cld_att)then  ! SR > 30.
    808808                toplvlsat=nlev-1
    809809                goto 99
    … …  
    821821!____________________________________________________________________________________________________
    822822!
    823 if(toplvlsat/=0)then
     823if(toplvlsat.ne.0)then         
    824824      do nlev=toplvlsat,1,-1
    825825         p1 = pplay(i,nlev)
    826         if(cldy(i,ncol,nlev)==1.)then
     826        if(cldy(i,ncol,nlev).eq.1.)then
    827827           lidarcldphase(i,nlev,3)=lidarcldphase(i,nlev,3)+1.
    828828           tmpu(i,ncol,nlev)=tmp(i,nlev)
    829829
    830830                   cldlayphase(i,ncol,4,3) = 1.                         ! tot cloud
    831           if ( p1>0. .and. p1<(440.*100.)) then              ! high cloud
     831          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
    832832             cldlayphase(i,ncol,3,3) = 1.
    833           else if(p1>=(440.*100.) .and. p1<(680.*100.)) then  ! mid cloud
     833          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid cloud
    834834             cldlayphase(i,ncol,2,3) = 1.
    835835          else                                                     ! low cloud
    … …  
    857857! of the occurrences
    858858lidarcldphasetmp(:,:)=lidarcldphase(:,:,1)+lidarcldphase(:,:,2);
    859 WHERE (lidarcldphasetmp(:,:)> 0.)
     859WHERE (lidarcldphasetmp(:,:).gt. 0.)
    860860   lidarcldphase(:,:,6)=lidarcldphase(:,:,1)/lidarcldphasetmp(:,:)
    861861ELSEWHERE
    … …  
    864864
    865865! Compute Phase 3D Cloud Fraction
    866      WHERE ( nsub(:,:)>0.0 )
     866     WHERE ( nsub(:,:).gt.0.0 )
    867867       lidarcldphase(:,:,1)=lidarcldphase(:,:,1)/nsub(:,:)
    868868       lidarcldphase(:,:,2)=lidarcldphase(:,:,2)/nsub(:,:)
    … …  
    899899! Compute the Ice percentage in cloud = ice/(ice+liq)
    900900cldlayerphasetmp(:,:)=cldlayerphase(:,:,1)+cldlayerphase(:,:,2)
    901     WHERE (cldlayerphasetmp(:,:)> 0.)
     901    WHERE (cldlayerphasetmp(:,:).gt. 0.)
    902902       cldlayerphase(:,:,6)=cldlayerphase(:,:,1)/cldlayerphasetmp(:,:)
    903903    ELSEWHERE
    … …  
    906906
    907907    do i=1,Nphase-1
    908       WHERE ( cldlayerphasesum(:,:)>0.0 )
     908      WHERE ( cldlayerphasesum(:,:).gt.0.0 )
    909909         cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
    910910      ENDWHERE
    … …  
    917917          checkcldlayerphase2=0.
    918918
    919           if (cldlayerphasesum(i,iz)>0.0 )then
     919          if (cldlayerphasesum(i,iz).gt.0.0 )then
    920920             do ic=1,Nphase-3
    921921                checkcldlayerphase=checkcldlayerphase+cldlayerphase(i,iz,ic) 
    922922             enddo
    923923             checkcldlayerphase2=cldlayer(i,iz)-checkcldlayerphase
    924              if( (checkcldlayerphase2>0.01).or.(checkcldlayerphase2<-0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
     924             if( (checkcldlayerphase2.gt.0.01).or.(checkcldlayerphase2.lt.-0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
    925925
    926926          endif
    … …  
    930930
    931931    do i=1,Nphase-1
    932       WHERE ( nsublayer(:,:)==0.0 )
     932      WHERE ( nsublayer(:,:).eq.0.0 )
    933933         cldlayerphase(:,:,i) = undef
    934934      ENDWHERE
    … …  
    942942do i=1,Npoints
    943943do itemp=1,Ntemp
    944 if(tmpi(i,ncol,nlev)>0.)then
    945       if( (tmpi(i,ncol,nlev)>=tempmod(itemp)).and.(tmpi(i,ncol,nlev)<tempmod(itemp+1)) )then
     944if(tmpi(i,ncol,nlev).gt.0.)then
     945      if( (tmpi(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpi(i,ncol,nlev).lt.tempmod(itemp+1)) )then
    946946        lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1.
    947947      endif
    948 elseif(tmpl(i,ncol,nlev)>0.)then
    949       if( (tmpl(i,ncol,nlev)>=tempmod(itemp)).and.(tmpl(i,ncol,nlev)<tempmod(itemp+1)) )then
     948elseif(tmpl(i,ncol,nlev).gt.0.)then
     949      if( (tmpl(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpl(i,ncol,nlev).lt.tempmod(itemp+1)) )then
    950950        lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1.
    951951      endif
    952 elseif(tmpu(i,ncol,nlev)>0.)then
    953       if( (tmpu(i,ncol,nlev)>=tempmod(itemp)).and.(tmpu(i,ncol,nlev)<tempmod(itemp+1)) )then
     952elseif(tmpu(i,ncol,nlev).gt.0.)then
     953      if( (tmpu(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpu(i,ncol,nlev).lt.tempmod(itemp+1)) )then
    954954        lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1.
    955955      endif
    … …  
    965965checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
    966966
    967         if(checktemp/=lidarcldtemp(i,itemp,1))then
     967        if(checktemp.NE.lidarcldtemp(i,itemp,1))then
    968968          print *, i,itemp
    969969          print *, lidarcldtemp(i,itemp,1:4)
    … …  
    984984
    985985do i=1,4
    986   WHERE(lidarcldtempind(:,:)>0.)
     986  WHERE(lidarcldtempind(:,:).gt.0.)
    987987     lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
    988988  ELSEWHERE
    … …  
    10461046    do k=1,Nlevels
    10471047       ! Cloud detection at subgrid-scale:
    1048        where ( (x(:,:,k) > S_cld) .and. (x(:,:,k) /= undef) )
     1048       where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    10491049          cldy(:,:,k)=1.0
    10501050       elsewhere
    … …  
    10521052       endwhere
    10531053       ! Fully attenuated layer detection at subgrid-scale:
    1054        where ( (x(:,:,k) > 0.0) .and. (x(:,:,k) < S_att_opaq) .and. (x(:,:,k) /= undef) )
     1054       where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .lt. S_att_opaq) .and. (x(:,:,k) .ne. undef) )
    10551055          cldyopaq(:,:,k)=1.0
    10561056       elsewhere
    … …  
    10591059
    10601060       ! Number of useful sub-column layers:
    1061        where ( (x(:,:,k) > S_att) .and. (x(:,:,k) /= undef) )
     1061       where ( (x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
    10621062          srok(:,:,k)=1.0
    10631063       elsewhere
    … …  
    10651065       endwhere
    10661066       ! Number of useful sub-columns layers for z_opaque 3D fraction:
    1067        where ( (x(:,:,k) > 0.0) .and. (x(:,:,k) /= undef) )
     1067       where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .ne. undef) )
    10681068          srokopaq(:,:,k)=1.0
    10691069       elsewhere
    … …  
    10981098
    10991099     ! Declaring non-opaque cloudy profiles as thin cloud profiles
    1100            if ( (cldlay(ip,ic,4) == 1.0) .and. (cldlay(ip,ic,1) == 0.0) ) then
     1100           if ( (cldlay(ip,ic,4) .eq. 1.0) .and. (cldlay(ip,ic,1) .eq. 0.0) ) then
    11011101              cldlay(ip,ic,2)  =  1.0
    11021102           endif
    … …  
    11051105
    11061106     ! Opaque cloud profiles
    1107            if ( cldlay(ip,ic,1) == 1.0 ) then
     1107           if ( cldlay(ip,ic,1) .eq. 1.0 ) then
    11081108              zopac = 0.0
    11091109              do k=2,Nlevels
    11101110     ! Declaring opaque cloud fraction and z_opaque altitude for 3D and 2D variables
    1111                  if ( (cldy(ip,ic,k) == 1.0) .and. (zopac == 0.0) ) then
     1111                 if ( (cldy(ip,ic,k) .eq. 1.0) .and. (zopac .eq. 0.0) ) then
    11121112                    lidarcldtype(ip,k-1,3) = lidarcldtype(ip,k-1,3) + 1.0
    11131113                    cldlay(ip,ic,3)        = vgrid_z(k-1) !z_opaque altitude
    … …  
    11151115                    zopac = 1.0
    11161116                 endif
    1117                  if ( cldy(ip,ic,k) == 1.0 ) then
     1117                 if ( cldy(ip,ic,k) .eq. 1.0 ) then
    11181118                    lidarcldtype(ip,k,1)   = lidarcldtype(ip,k,1) + 1.0
    11191119                 endif
    … …  
    11221122
    11231123     ! Thin cloud profiles
    1124            if ( cldlay(ip,ic,2) == 1.0 ) then
     1124           if ( cldlay(ip,ic,2) .eq. 1.0 ) then
    11251125              do k=1,Nlevels
    11261126     ! Declaring thin cloud fraction for 3D variable
    1127                  if ( cldy(ip,ic,k) == 1.0 ) then
     1127                 if ( cldy(ip,ic,k) .eq. 1.0 ) then
    11281128                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1.0
    11291129                 endif
    … …  
    11351135
    11361136    ! 3D cloud types fraction (opaque=1 and thin=2)
    1137     where ( nsub(:,:) > 0.0 )
     1137    where ( nsub(:,:) .gt. 0.0 )
    11381138       lidarcldtype(:,:,1) = lidarcldtype(:,:,1)/nsub(:,:)
    11391139       lidarcldtype(:,:,2) = lidarcldtype(:,:,2)/nsub(:,:)
    … …  
    11431143    endwhere
    11441144    ! 3D z_opaque fraction (=3)
    1145     where ( nsubopaq(:,:) > 0.0 )
     1145    where ( nsubopaq(:,:) .gt. 0.0 )
    11461146       lidarcldtype(:,:,3) = lidarcldtype(:,:,3)/nsubopaq(:,:)
    11471147    elsewhere
    … …  
    11521152    do ip = 1, Npoints
    11531153        do k = Nlevels-1, 1, -1
    1154            if ( lidarcldtype(ip,k,3) /= undef ) then
     1154           if ( lidarcldtype(ip,k,3) .ne. undef ) then
    11551155              lidarcldtype(ip,k,4) = lidarcldtype(ip,k+1,4) + lidarcldtype(ip,k,3)
    11561156           endif
    11571157        enddo
    11581158    enddo
    1159     where ( nsubopaq(:,:) == 0.0 )
     1159    where ( nsubopaq(:,:) .eq. 0.0 )
    11601160       lidarcldtype(:,:,4) = undef
    11611161    endwhere
    … …  
    11691169       enddo
    11701170    enddo
    1171     where (nsublayer(:,:) > 0.0)
     1171    where (nsublayer(:,:) .gt. 0.0)
    11721172       cldtype(:,:) = cldtype(:,:)/nsublayer(:,:)
    11731173    elsewhere

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90

    r5086 r5095  
    331331        retrievedTau(i) = R_UNDEF
    332332      end if
    333     END DO
     333    end do
    334334    where((retrievedSize(:) < 0.).and.(retrievedSize(:) /= R_UNDEF)) retrievedSize(:) = 1.0e-06*re_fill
    335335
    … …  
    666666    do ij=2,nbin1+1
    667667       do ik=2,nbin2+1
    668           jointHist(ij-1,ik-1)=count(var1 >= bin1(ij-1) .and. var1 < bin1(ij) .and. &
    669                var2 >= bin2(ik-1) .and. var2 < bin2(ik))
     668          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
     669               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       
    670670       enddo
    671671    enddo
    … …  
    802802        tauMask(:, :, i) = .false.
    803803      end where
    804     END DO
     804    end do
    805805
    806806    do i = 1, numPressureHistogramBins
    … …  
    811811        pressureMask(:, :, i) = .false.
    812812      end where
    813     END DO
     813    end do
    814814   
    815815    do i = 1, numPressureHistogramBins
    … …  
    817817        Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = &
    818818          real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
    819       END DO
    820     END DO
     819      end do
     820    end do
    821821   
    822822  end subroutine modis_L3_simulator
    … …  
    851851      end if
    852852      if(totalTau >= tauLimit) exit
    853     END DO
     853    end do
    854854    cloud_top_pressure = totalProduct/totalTau
    855855  end function cloud_top_pressure
    … …  
    877877      end if
    878878      if(totalTau >= tauLimit) exit
    879     END DO
     879    end do
    880880    weight_by_extinction = totalProduct/totalTau
    881881  end function weight_by_extinction
    … …  
    11141114    do i = 1, size(cloudIndicies)
    11151115      call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    1116     END DO
     1116    end do
    11171117                   
    11181118    call adding_doubling(Refl(:), Trans(:), Refl_tot, Trans_tot) 
    … …  
    12921292          Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1 - Refl_cumulative(i-1) * Refl(i))
    12931293          Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1 - Refl_cumulative(i-1) * Refl(i))
    1294       END DO
     1294      end do
    12951295     
    12961296      Refl_tot = Refl_cumulative(size(Refl))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90

    r5086 r5095  
    3838 
    3939! ----- INPUTS -----
    40   real(kind=8), intent(in) :: freq,tk
     40  real*8, intent(in) :: freq,tk
    4141 
    4242! ----- OUTPUTS -----
    43   real(kind=8), intent(out) :: n_r, n_i
     43  real*8, intent(out) :: n_r, n_i
    4444
    4545! ----- INTERNAL -----   
    46   real(kind=8) ld,es,ei,a,ls,sg,tm1,cos1,sin1
    47   real(kind=8) e_r,e_i
    48   real(kind=8) pi
    49   real(kind=8) tc
    50   complex(kind=8) e_comp, sq
     46  real*8 ld,es,ei,a,ls,sg,tm1,cos1,sin1
     47  real*8 e_r,e_i
     48  real*8 pi
     49  real*8 tc
     50  complex*16 e_comp, sq
    5151
    5252  tc = tk - 273.15
    … …  
    102102
    103103! ----- INPUTS -----
    104   real(kind=8), intent(in) :: freq, t
     104  real*8, intent(in) :: freq, t
    105105 
    106106! ----- OUTPUTS ----- 
    107   real(kind=8), intent(out) :: n_r,n_i
     107  real*8, intent(out) :: n_r,n_i
    108108
    109109! Parameters:
    110   integer(kind=2) :: i,lt1,lt2,nwl,nwlt
     110  integer*2 :: i,lt1,lt2,nwl,nwlt
    111111  parameter(nwl=468,nwlt=62)
    112112
    113   real(kind=8) :: alam,cutice,pi,t1,t2,wlmax,wlmin, &
     113  real*8 :: alam,cutice,pi,t1,t2,wlmax,wlmin, &
    114114            x,x1,x2,y,y1,y2,ylo,yhi,tk
    115115
    116   real(kind=8) :: &
     116  real*8 :: &
    117117       tabim(nwl),tabimt(nwlt,4),tabre(nwl),tabret(nwlt,4),temref(4), &
    118118       wl(nwl),wlt(nwlt)
    … …  
    519519
    520520!   // region from 0.045 microns to 167.0 microns - no temperature depend
     521    do i=2,nwl
     522      if(alam < wl(i)) continue
     523    enddo
    521524    x1=log(wl(i-1))
    522525    x2=log(wl(i))
    … …  
    536539    if(tk > temref(1)) tk=temref(1)
    537540    if(tk < temref(4)) tk=temref(4)
    538     do i=2,4
    539       if(tk>=temref(i)) go to 12
    540     END DO
     541    do 11 i=2,4
     542      if(tk.ge.temref(i)) go to 12
     543    11 continue
    541544    12 lt1=i
    542545    lt2=i-1
    543     do i=2,nwlt
    544       if(alam<=wlt(i)) go to 14
    545     END DO
     546    do 13 i=2,nwlt
     547      if(alam.le.wlt(i)) go to 14
     548    13 continue
    546549    14 x1=log(wlt(i-1))
    547550    x2=log(wlt(i))
    … …  
    583586      Subroutine MieInt(Dx, SCm, Inp, Dqv, Dqxt, Dqsc, Dbsc, Dg, Xs1, Xs2, DPh, Error)
    584587
    585       Integer (kind=2)  Imaxx
     588      Integer * 2  Imaxx
    586589      Parameter (Imaxx = 12000)
    587       Real (kind=4)     RIMax          ! largest real part of refractive index
     590      Real * 4     RIMax          ! largest real part of refractive index
    588591      Parameter (RIMax = 2.5)
    589       Real (kind=4)     IRIMax         ! largest imaginary part of refractive index
     592      Real * 4     IRIMax         ! largest imaginary part of refractive index
    590593      Parameter (IRIMax = -2)
    591       Integer (kind=2)  Itermax
     594      Integer * 2  Itermax
    592595      Parameter (Itermax = 12000 * 2.5)
    593596                                ! must be large enough to cope with the
    594597                                ! largest possible nmx = x * abs(scm) + 15
    595598                                ! or nmx =  Dx + 4.05*Dx**(1./3.) + 2.0
    596       Integer (kind=2)  Imaxnp
     599      Integer * 2  Imaxnp
    597600      Parameter (Imaxnp = 10000)  ! Change this as required
    598601!     INPUT
    599       Real (kind=8)     Dx
    600       Complex (kind=8)  SCm
    601       Integer (kind=4)  Inp
    602       Real (kind=8)     Dqv(Inp)
     602      Real * 8     Dx
     603      Complex * 16  SCm
     604      Integer * 4  Inp
     605      Real * 8     Dqv(Inp)
    603606!     OUTPUT
    604       Complex (kind=8)  Xs1(InP)
    605       Complex (kind=8)  Xs2(InP)
    606       Real (kind=8)     Dqxt
    607       Real (kind=8)     Dqsc
    608       Real (kind=8)     Dg
    609       Real (kind=8)     Dbsc
    610       Real (kind=8)     DPh(InP)
    611       Integer (kind=4)  Error
     607      Complex * 16  Xs1(InP)
     608      Complex * 16  Xs2(InP)
     609      Real * 8     Dqxt
     610      Real * 8     Dqsc
     611      Real * 8     Dg
     612      Real * 8     Dbsc
     613      Real * 8     DPh(InP)
     614      Integer * 4  Error
    612615!     LOCAL
    613       Integer (kind=2)  I
    614       Integer (kind=2)  NStop
    615       Integer (kind=2)  NmX
    616       Integer (kind=4)  N    ! N*N > 32767 ie N > 181
    617       Integer (kind=4)  Inp2
    618       Real (kind=8)     Chi,Chi0,Chi1
    619       Real (kind=8)     APsi,APsi0,APsi1
    620       Real (kind=8)     Pi0(Imaxnp)
    621       Real (kind=8)     Pi1(Imaxnp)
    622       Real (kind=8)     Taun(Imaxnp)
    623       Real (kind=8)     Psi,Psi0,Psi1
    624       Complex (kind=4)  Ir
    625       Complex (kind=8) Cm
    626       Complex (kind=8) A,ANM1,APB
    627       Complex (kind=8) B,BNM1,AMB
    628       Complex (kind=8) D(Itermax)
    629       Complex (kind=8) Sp(Imaxnp)
    630       Complex (kind=8) Sm(Imaxnp)
    631       Complex (kind=8) Xi,Xi0,Xi1
    632       Complex (kind=8) Y
     616      Integer * 2  I
     617      Integer * 2  NStop
     618      Integer * 2  NmX
     619      Integer * 4  N    ! N*N > 32767 ie N > 181
     620      Integer * 4  Inp2
     621      Real * 8     Chi,Chi0,Chi1
     622      Real * 8     APsi,APsi0,APsi1
     623      Real * 8     Pi0(Imaxnp)
     624      Real * 8     Pi1(Imaxnp)
     625      Real * 8     Taun(Imaxnp)
     626      Real * 8     Psi,Psi0,Psi1
     627      Complex * 8  Ir
     628      Complex * 16 Cm
     629      Complex * 16 A,ANM1,APB
     630      Complex * 16 B,BNM1,AMB
     631      Complex * 16 D(Itermax)
     632      Complex * 16 Sp(Imaxnp)
     633      Complex * 16 Sm(Imaxnp)
     634      Complex * 16 Xi,Xi0,Xi1
     635      Complex * 16 Y
    633636!     ACCELERATOR VARIABLES
    634       Integer (kind=2)  Tnp1
    635       Integer (kind=2)  Tnm1
    636       Real (kind=8)     Dn
    637       Real (kind=8)     Rnx
    638       Real (kind=8)     S(Imaxnp)
    639       Real (kind=8)     T(Imaxnp)
    640       Real (kind=8)     Turbo
    641       Real (kind=8)     A2
    642       Complex (kind=8) A1
     637      Integer * 2  Tnp1
     638      Integer * 2  Tnm1
     639      Real * 8     Dn
     640      Real * 8     Rnx
     641      Real * 8     S(Imaxnp)
     642      Real * 8     T(Imaxnp)
     643      Real * 8     Turbo
     644      Real * 8     A2
     645      Complex * 16 A1
    643646     
    644       If ((Dx>Imaxx) .Or. (InP>ImaxNP)) Then
     647      If ((Dx.Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then
    645648        Error = 1
    646649        Return
    … …  
    649652      Ir = 1 / Cm
    650653      Y =  Dx * Cm
    651       If (Dx<0.02) Then
     654      If (Dx.Lt.0.02) Then
    652655         NStop = 2
    653656      Else
    654          If (Dx<=8.0) Then
     657         If (Dx.Le.8.0) Then
    655658            NStop = Dx + 4.00*Dx**(1./3.) + 2.0
    656659         Else
    657             If (Dx< 4200.0) Then
     660            If (Dx.Lt. 4200.0) Then
    658661               NStop = Dx + 4.05*Dx**(1./3.) + 2.0
    659662            Else
    … …  
    663666      End If
    664667      NmX = Max(Real(NStop),Real(Abs(Y))) + 15.
    665       If (Nmx > Itermax) then
     668      If (Nmx .gt. Itermax) then
    666669          Error = 1
    667670          Return
    … …  
    706709         Dqxt = Tnp1 *      Dble(A + B)          + Dqxt
    707710         Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc
    708          If (N>1) then
     711         If (N.Gt.1) then
    709712         Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    710713         End If
    … …  
    714717         AMB = A2 * (A - B)
    715718         Do I = 1,Inp2
    716             If (I>Inp) Then
     719            If (I.GT.Inp) Then
    717720               S(I) = -Pi1(I)
    718721            Else
    … …  
    733736         Xi1 = Dcmplx(APsi1,Chi1)
    734737      End Do
    735       If (Dg >0) Dg = 2 * Dg / Dqsc
     738      If (Dg .GT.0) Dg = 2 * Dg / Dqsc
    736739      Dqsc =  2 * Dqsc / Dx**2
    737740      Dqxt =  2 * Dqxt / Dx**2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/pf_to_mr.F

    r5082 r5095  
    107107                mx_rain_cv(j,ibox,ilev)=0.
    108108                mx_snow_cv(j,ibox,ilev)=0.
    109                 if ((prec_frac(j,ibox,ilev) == 1.) .or.
    110      &              (prec_frac(j,ibox,ilev) == 3.)) then
     109                if ((prec_frac(j,ibox,ilev) .eq. 1.) .or.
     110     &              (prec_frac(j,ibox,ilev) .eq. 3.)) then
    111111                    mx_rain_ls(j,ibox,ilev)=
    112112     &                     (term4r_ls**(1./(1.+br/4.)))/rho
    … …  
    116116     &                     (term4g_ls**(1./(1.+bg/4.)))/rho
    117117                endif
    118                 if ((prec_frac(j,ibox,ilev) == 2.) .or.
    119      &              (prec_frac(j,ibox,ilev) == 3.)) then
     118                if ((prec_frac(j,ibox,ilev) .eq. 2.) .or.
     119     &              (prec_frac(j,ibox,ilev) .eq. 3.)) then
    120120                    mx_rain_cv(j,ibox,ilev)=
    121121     &                     (term4r_cv**(1./(1.+br/4.)))/rho

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90

    r5082 r5095  
    193193          cfg%Lrttov_sim,cfg%Lstats
    194194
    195     if (overlaplmdz/=overlap) then
     195    if (overlaplmdz.ne.overlap) then
    196196       print*,'Attention overlaplmdz different de overlap lu dans namelist '
    197197    endif
    … …  
    201201
    202202!!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
    203   if ((itap>1).and.(first_write))then
     203  if ((itap.gt.1).and.(first_write))then
    204204   
    205205    IF (using_xios) call read_xiosfieldactive(cfg)
    … …  
    268268
    269269        do ip = 1, Npoints
    270           if (fracTerLic(ip)>=0.5) then
     270          if (fracTerLic(ip).ge.0.5) then
    271271             gbx%land(ip) = 1.
    272272          else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/prec_scops.F

    r5082 r5095  
    5555
    5656      cv_col = 0.05*ncol
    57       if (cv_col == 0) cv_col=1
     57      if (cv_col .eq. 0) cv_col=1
    5858 
    5959      do ilev=1,nlev
    … …  
    7272        flag_cv=0
    7373        do ilev=1,nlev
    74           if (frac_out(j,ibox,ilev) == 1) then
     74          if (frac_out(j,ibox,ilev) .eq. 1) then
    7575            flag_ls=1
    7676          endif
    77           if (frac_out(j,ibox,ilev) == 2) then
     77          if (frac_out(j,ibox,ilev) .eq. 2) then
    7878            flag_cv=1
    7979          endif
    8080        enddo !loop over nlev
    81         if (flag_ls == 1) then
     81        if (flag_ls .eq. 1) then
    8282           frac_out_ls(j,ibox)=1
    8383        endif
    84         if (flag_cv == 1) then
     84        if (flag_cv .eq. 1) then
    8585           frac_out_cv(j,ibox)=1
    8686        endif
    … …  
    9393        flag_cv=0
    9494   
    95         if (ls_p_rate(j,1) > 0.) then
     95        if (ls_p_rate(j,1) .gt. 0.) then
    9696            do ibox=1,ncol ! possibility ONE
    97                 if (frac_out(j,ibox,1) == 1) then
     97                if (frac_out(j,ibox,1) .eq. 1) then
    9898                    prec_frac(j,ibox,1) = 1
    9999                    flag_ls=1
    100100                endif
    101101            enddo ! loop over ncol
    102             if (flag_ls == 0) then ! possibility THREE
     102            if (flag_ls .eq. 0) then ! possibility THREE
    103103                do ibox=1,ncol
    104                     if (frac_out(j,ibox,2) == 1) then
     104                    if (frac_out(j,ibox,2) .eq. 1) then
    105105                        prec_frac(j,ibox,1) = 1
    106106                        flag_ls=1
    … …  
    108108                enddo ! loop over ncol
    109109            endif
    110         if (flag_ls == 0) then ! possibility Four
    111         do ibox=1,ncol
    112         if (frac_out_ls(j,ibox) == 1) then
     110        if (flag_ls .eq. 0) then ! possibility Four
     111        do ibox=1,ncol
     112        if (frac_out_ls(j,ibox) .eq. 1) then
    113113            prec_frac(j,ibox,1) = 1
    114114            flag_ls=1
    … …  
    116116        enddo ! loop over ncol
    117117        endif
    118         if (flag_ls == 0) then ! possibility Five
     118        if (flag_ls .eq. 0) then ! possibility Five
    119119        do ibox=1,ncol
    120120    !     prec_frac(j,1:ncol,1) = 1
    … …  
    125125       ! There is large scale precipitation
    126126     
    127         if (cv_p_rate(j,1) > 0.) then
     127        if (cv_p_rate(j,1) .gt. 0.) then
    128128         do ibox=1,ncol ! possibility ONE
    129           if (frac_out(j,ibox,1) == 2) then
    130            if (prec_frac(j,ibox,1) == 0) then
     129          if (frac_out(j,ibox,1) .eq. 2) then
     130           if (prec_frac(j,ibox,1) .eq. 0) then
    131131        prec_frac(j,ibox,1) = 2
    132132       else
    … …  
    136136      endif
    137137        enddo ! loop over ncol
    138         if (flag_cv == 0) then ! possibility THREE
    139         do ibox=1,ncol
    140         if (frac_out(j,ibox,2) == 2) then
    141                 if (prec_frac(j,ibox,1) == 0) then
     138        if (flag_cv .eq. 0) then ! possibility THREE
     139        do ibox=1,ncol
     140        if (frac_out(j,ibox,2) .eq. 2) then
     141                if (prec_frac(j,ibox,1) .eq. 0) then
    142142            prec_frac(j,ibox,1) = 2
    143143            else
    … …  
    148148        enddo ! loop over ncol
    149149        endif
    150         if (flag_cv == 0) then ! possibility Four
    151         do ibox=1,ncol
    152         if (frac_out_cv(j,ibox) == 1) then
    153                 if (prec_frac(j,ibox,1) == 0) then
     150        if (flag_cv .eq. 0) then ! possibility Four
     151        do ibox=1,ncol
     152        if (frac_out_cv(j,ibox) .eq. 1) then
     153                if (prec_frac(j,ibox,1) .eq. 0) then
    154154            prec_frac(j,ibox,1) = 2
    155155            else
    … …  
    160160        enddo ! loop over ncol
    161161        endif
    162         if (flag_cv == 0) then  ! possibility Five
     162        if (flag_cv .eq. 0) then  ! possibility Five
    163163        do ibox=1,cv_col
    164                 if (prec_frac(j,ibox,1) == 0) then
     164                if (prec_frac(j,ibox,1) .eq. 0) then
    165165            prec_frac(j,ibox,1) = 2
    166166            else
    … …  
    183183        flag_cv=0
    184184   
    185         if (ls_p_rate(j,ilev) > 0.) then
     185        if (ls_p_rate(j,ilev) .gt. 0.) then
    186186         do ibox=1,ncol ! possibility ONE&TWO
    187           if ((frac_out(j,ibox,ilev) == 1) .or.
    188      &       ((prec_frac(j,ibox,ilev-1) == 1)
    189      &       .or. (prec_frac(j,ibox,ilev-1) == 3))) then
     187          if ((frac_out(j,ibox,ilev) .eq. 1) .or.
     188     &       ((prec_frac(j,ibox,ilev-1) .eq. 1)
     189     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
    190190           prec_frac(j,ibox,ilev) = 1
    191191           flag_ls=1
    192192          endif
    193193        enddo ! loop over ncol
    194         if ((flag_ls == 0) .and. (ilev < nlev)) then ! possibility THREE
    195         do ibox=1,ncol
    196         if (frac_out(j,ibox,ilev+1) == 1) then
     194        if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     195        do ibox=1,ncol
     196        if (frac_out(j,ibox,ilev+1) .eq. 1) then
    197197            prec_frac(j,ibox,ilev) = 1
    198198            flag_ls=1
    … …  
    200200        enddo ! loop over ncol
    201201        endif
    202         if (flag_ls == 0) then ! possibility Four
    203         do ibox=1,ncol
    204         if (frac_out_ls(j,ibox) == 1) then
     202        if (flag_ls .eq. 0) then ! possibility Four
     203        do ibox=1,ncol
     204        if (frac_out_ls(j,ibox) .eq. 1) then
    205205            prec_frac(j,ibox,ilev) = 1
    206206            flag_ls=1
    … …  
    208208        enddo ! loop over ncol
    209209        endif
    210         if (flag_ls == 0) then ! possibility Five
     210        if (flag_ls .eq. 0) then ! possibility Five
    211211        do ibox=1,ncol
    212212!     prec_frac(j,1:ncol,ilev) = 1
    … …  
    216216      endif ! There is large scale precipitation
    217217   
    218         if (cv_p_rate(j,ilev) > 0.) then
     218        if (cv_p_rate(j,ilev) .gt. 0.) then
    219219         do ibox=1,ncol ! possibility ONE&TWO
    220           if ((frac_out(j,ibox,ilev) == 2) .or.
    221      &       ((prec_frac(j,ibox,ilev-1) == 2)
    222      &       .or. (prec_frac(j,ibox,ilev-1) == 3))) then
    223             if (prec_frac(j,ibox,ilev) == 0) then
     220          if ((frac_out(j,ibox,ilev) .eq. 2) .or.
     221     &       ((prec_frac(j,ibox,ilev-1) .eq. 2)
     222     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
     223            if (prec_frac(j,ibox,ilev) .eq. 0) then
    224224         prec_frac(j,ibox,ilev) = 2
    225225        else
    … …  
    229229        endif
    230230       enddo ! loop over ncol
    231         if ((flag_cv == 0) .and. (ilev < nlev)) then ! possibility THREE
    232         do ibox=1,ncol
    233         if (frac_out(j,ibox,ilev+1) == 2) then
    234                 if (prec_frac(j,ibox,ilev) == 0) then
     231        if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     232        do ibox=1,ncol
     233        if (frac_out(j,ibox,ilev+1) .eq. 2) then
     234                if (prec_frac(j,ibox,ilev) .eq. 0) then
    235235            prec_frac(j,ibox,ilev) = 2
    236236            else
    … …  
    241241        enddo ! loop over ncol
    242242        endif
    243         if (flag_cv == 0) then ! possibility Four
    244         do ibox=1,ncol
    245         if (frac_out_cv(j,ibox) == 1) then
    246                 if (prec_frac(j,ibox,ilev) == 0) then
     243        if (flag_cv .eq. 0) then ! possibility Four
     244        do ibox=1,ncol
     245        if (frac_out_cv(j,ibox) .eq. 1) then
     246                if (prec_frac(j,ibox,ilev) .eq. 0) then
    247247            prec_frac(j,ibox,ilev) = 2
    248248            else
    … …  
    253253        enddo ! loop over ncol
    254254        endif
    255         if (flag_cv == 0) then  ! possibility Five
     255        if (flag_cv .eq. 0) then  ! possibility Five
    256256        do ibox=1,cv_col
    257                 if (prec_frac(j,ibox,ilev) == 0) then
     257                if (prec_frac(j,ibox,ilev) .eq. 0) then
    258258            prec_frac(j,ibox,ilev) = 2
    259259            else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/predict_mom07.F90

    r5082 r5095  
    77            implicit none
    88       
    9             real(kind=8) :: a1,a2,a3,b1,b2,b3,c1,c2,c3
    10             real(kind=8) :: m2,tc,n,m,a_,b_,c_,A,B,C,n2
     9            real*8 :: a1,a2,a3,b1,b2,b3,c1,c2,c3
     10            real*8 :: m2,tc,n,m,a_,b_,c_,A,B,C,n2
    1111       
    1212            a1=      13.6078
    … …  
    3030           
    3131        ! predict m from m2 and tc
    32                 if(m2/=-9999) then
     32                if(m2.ne.-9999) then
    3333                m=A*exp(B*tc)*m2**C
    3434                endif
    3535        ! get m2 if mass-dimension relationship not proportional to D**2
    36                 if(m2==-9999) then
     36                if(m2.eq.-9999) then
    3737                m2=(m/(A*exp(B*tc)))**(1.0/C)   
    3838                endif

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator.F90

    r5082 r5095  
    9191
    9292  real undef
    93   real(kind=8), dimension(nprof,ngate), intent(in) :: &
     93  real*8, dimension(nprof,ngate), intent(in) :: &
    9494    hgt_matrix, p_matrix,t_matrix,rh_matrix
    9595
    96   real(kind=8), dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix
    97   real(kind=8), dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix
    98   real(kind=8), dimension(hp%nhclass,nprof,ngate), intent(inout)    :: Np_matrix
     96  real*8, dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix
     97  real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix
     98  real*8, dimension(hp%nhclass,nprof,ngate), intent(inout)    :: Np_matrix
    9999
    100100! ----- OUTPUTS -----
    101   real(kind=8), dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
     101  real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
    102102       g_to_vol,dBZe,a_to_vol
    103103
    104104! ----- OPTIONAL -----
    105   real(kind=8), optional, dimension(nprof,ngate) :: &
     105  real*8, optional, dimension(nprof,ngate) :: &
    106106  g_to_vol_in,g_to_vol_out ! integrated atten due to gases, r>v (dB). This allows to output and then input
    107107                           ! the same gaseous absorption in different calls. Optional to allow compatibility
    … …  
    112112
    113113  real, parameter :: one_third = 1.0/3.0
    114   real(kind=8) :: t_kelvin
     114  real*8 :: t_kelvin
    115115  integer :: &
    116116  phase, & ! 0=liquid, 1=ice
    … …  
    118118
    119119  logical :: hydro      ! true=hydrometeor in vol, false=none
    120   real(kind=8) :: &
     120  real*8 :: &
    121121  rho_a, &   ! air density (kg m^-3)
    122122  gases      ! function: 2-way gas atten (dB/km)
    123123
    124   real(kind=8), dimension(:), allocatable :: &
     124  real*8, dimension(:), allocatable :: &
    125125  Di, Deq, &   ! discrete drop sizes (um)
    126126  Ni, &        ! discrete concentrations (cm^-3 um^-1)
    127127  rhoi         ! discrete densities (kg m^-3)
    128128
    129   real(kind=8), dimension(nprof, ngate) :: &
     129  real*8, dimension(nprof, ngate) :: &
    130130  z_vol, &      ! effective reflectivity factor (mm^6/m^3)
    131131  z_ray, &                      ! reflectivity factor, Rayleigh only (mm^6/m^3)
    … …  
    135135
    136136  integer,parameter :: KR8 = selected_real_kind(15,300)
    137   real(kind=8), parameter :: xx = -1.0_KR8
    138   real(kind=8),  dimension(:), allocatable :: xxa
    139   real(kind=8) :: kr, ze, zr, pi, scale_factor, tc, Re, ld, tmp1, ze2, kr2, apm, bpm
    140   real(kind=8) :: half_a_atten_current,half_a_atten_above
    141   real(kind=8) :: half_g_atten_current,half_g_atten_above
    142   integer(kind=4) :: tp, i, j, k, pr, itt, iff
    143 
    144   real(kind=8)    step,base, Np
    145   integer(kind=4) iRe_type,n,max_bin
     137  real*8, parameter :: xx = -1.0_KR8
     138  real*8,  dimension(:), allocatable :: xxa
     139  real*8 :: kr, ze, zr, pi, scale_factor, tc, Re, ld, tmp1, ze2, kr2, apm, bpm
     140  real*8 :: half_a_atten_current,half_a_atten_above
     141  real*8 :: half_g_atten_current,half_g_atten_above
     142  integer*4 :: tp, i, j, k, pr, itt, iff
     143
     144  real*8    step,base, Np
     145  integer*4 iRe_type,n,max_bin
    146146
    147147  integer   start_gate,end_gate,d_gate
    … …  
    207207            itt = infind(hp%mt_tti,t_kelvin)
    208208          endif
    209           if (re_matrix(tp,pr,k)==0) then
     209          if (re_matrix(tp,pr,k).eq.0) then
    210210            call calc_Re(hm_matrix(tp,pr,k),Np_matrix(tp,pr,k),rho_a, &
    211211              hp%dtype(tp),hp%dmin(tp),hp%dmax(tp),hp%apm(tp),hp%bpm(tp), &
    … …  
    221221
    222222          iRe_type=1
    223           if(Re>0) then
     223          if(Re.gt.0) then
    224224            ! determine index in to scale LUT
    225225            !
    … …  
    232232            base=hp%base_list(n+1)
    233233            iRe_type=Re/step
    234             if (iRe_type<1) iRe_type=1
     234            if (iRe_type.lt.1) iRe_type=1
    235235
    236236            Re=step*(iRe_type+0.5)      ! set value of Re to closest value allowed in LUT.
    … …  
    238238
    239239            ! make sure iRe_type is within bounds
    240             if (iRe_type>=nRe_types) then
     240            if (iRe_type.ge.nRe_types) then
    241241!               write(*,*) 'Warning: size of Re exceed value permitted ', &
    242242!                    'in Look-Up Table (LUT).  Will calculate. '

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_init.F90

    r5082 r5095  
    7474! ----- INTERNAL ----- 
    7575  integer :: i,j
    76   real(kind=8)  :: delt, deltp
     76  real*8  :: delt, deltp
    7777       
    7878    !

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_types.F90

    r5082 r5095  
    1212  integer, parameter ::       &
    1313  nd = 85               ! number of discrete particles used in construction DSDs
    14   real(kind=8), parameter ::        &
     14  real*8, parameter ::        &
    1515  dmin = 0.1                 ,& ! min size of discrete particle
    1616  dmax = 10000.                 ! max size of discrete particle
    … …  
    3636 
    3737    ! variables used to store hydrometeor "default" properties
    38     real(kind=8),  dimension(maxhclass) :: p1,p2,p3,dmin,dmax,apm,bpm,rho
     38    real*8,  dimension(maxhclass) :: p1,p2,p3,dmin,dmax,apm,bpm,rho
    3939    integer, dimension(maxhclass) :: dtype,col,cp,phase
    4040 
    4141    ! Radar properties
    42     real(kind=8)  :: freq,k2
     42    real*8  :: freq,k2
    4343    integer :: nhclass      ! number of hydrometeor classes in use
    4444    integer :: use_gas_abs, do_ray
    … …  
    5656    logical, dimension(maxhclass,nRe_types) :: N_scale_flag
    5757    logical, dimension(maxhclass,mt_ntt,nRe_types) :: Z_scale_flag,Z_scale_added_flag
    58     real(kind=8),  dimension(maxhclass,mt_ntt,nRe_types) :: Ze_scaled,Zr_scaled,kr_scaled
    59     real(kind=8),  dimension(maxhclass,nd,nRe_types) :: fc, rho_eff
     58    real*8,  dimension(maxhclass,mt_ntt,nRe_types) :: Ze_scaled,Zr_scaled,kr_scaled
     59    real*8,  dimension(maxhclass,nd,nRe_types) :: fc, rho_eff
    6060
    6161    ! used to determine Re index
    62     real(kind=8)  :: step_list(Re_MAX_BIN),base_list(Re_MAX_BIN)
     62    real*8  :: step_list(Re_MAX_BIN),base_list(Re_MAX_BIN)
    6363 
    6464    ! used to determine temperature index
    65     real(kind=8) :: &
     65    real*8 :: &
    6666        mt_ttl(cnt_liq), &  ! liquid temperatures (K)
    6767        mt_tti(cnt_ice)     ! ice temperatures (K)
    6868
    69     real(kind=8) :: D(nd) ! set of discrete diameters used to represent DSDs
     69    real*8 :: D(nd) ! set of discrete diameters used to represent DSDs
    7070
    7171  end type class_param

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/scops.F

    r5086 r5095  
    133133      enddo
    134134
    135       if (ncolprint/=0) then
     135      if (ncolprint.ne.0) then
    136136        write (6,'(a)') 'frac_out_pp_rev:'
    137137          do j=1,npoints,1000
    … …  
    145145        write (6,'(I3)') ncol
    146146      endif
    147       if (ncolprint/=0) then
     147      if (ncolprint.ne.0) then
    148148        write (6,'(a)') 'last_frac_pp:'
    149149          do j=1,npoints,1000
    … …  
    161161     
    162162      !loop over vertical levels
    163       DO ilev = 1,nlev
     163      DO 200 ilev = 1,nlev
    164164                                 
    165165!     Initialise threshold
    166166
    167         IF (ilev==1) then
     167        IF (ilev.eq.1) then
    168168          ! If max overlap
    169           IF (overlap==1) then
     169          IF (overlap.eq.1) then
    170170            ! select pixels spread evenly
    171171            ! across the gridbox
    … …  
    187187              enddo
    188188            ENDIF
    189             IF (ncolprint/=0) then
     189            IF (ncolprint.ne.0) then
    190190              write (6,'(a)') 'threshold_nsf2:'
    191191                do j=1,npoints,1000
    … …  
    197197        ENDIF
    198198
    199         IF (ncolprint/=0) then
     199        IF (ncolprint.ne.0) then
    200200            write (6,'(a)') 'ilev:'
    201201            write (6,'(I2)') ilev
    … …  
    206206          ! All versions
    207207          do j=1,npoints
    208             if (boxpos(j,ibox)<=conv(j,ilev)) then
     208            if (boxpos(j,ibox).le.conv(j,ilev)) then
    209209              maxocc(j,ibox) = 1
    210210            else
    … …  
    214214
    215215          ! Max overlap
    216           if (overlap==1) then
     216          if (overlap.eq.1) then
    217217            do j=1,npoints
    218218              threshold_min(j,ibox)=conv(j,ilev)
    … …  
    222222
    223223          ! Random overlap
    224           if (overlap==2) then
     224          if (overlap.eq.2) then
    225225            do j=1,npoints
    226226              threshold_min(j,ibox)=conv(j,ilev)
    … …  
    230230
    231231          ! Max/Random overlap
    232           if (overlap==3) then
     232          if (overlap.eq.3) then
    233233            do j=1,npoints
    234234              threshold_min(j,ibox)=max(conv(j,ilev),
    235235     &          min(tca(j,ilev-1),tca(j,ilev)))
    236236              if (threshold(j,ibox)
    237      &          <min(tca(j,ilev-1),tca(j,ilev))
    238      &          .and.(threshold(j,ibox)>conv(j,ilev))) then
     237     &          .lt.min(tca(j,ilev-1),tca(j,ilev))
     238     &          .and.(threshold(j,ibox).gt.conv(j,ilev))) then
    239239                   maxosc(j,ibox)= 1
    240240              else
    … …  
    276276           DO ibox=1,ncol
    277277             do j=1,npoints
    278                if (tca(j,ilev)>threshold(j,ibox)) then
     278               if (tca(j,ilev).gt.threshold(j,ibox)) then
    279279               frac_out(j,ibox,ilev)=1
    280280               else
    … …  
    289289           DO ibox=1,ncol
    290290             do j=1,npoints
    291                 if (threshold(j,ibox)<=conv(j,ilev)) then
     291                if (threshold(j,ibox).le.conv(j,ilev)) then
    292292                    ! = 2 IF threshold le conv(j)
    293293                    frac_out(j,ibox,ilev) = 2
    … …  
    302302!         from last level next time round
    303303
    304           if (ncolprint/=0) then
     304          if (ncolprint.ne.0) then
    305305
    306306            do j=1,npoints ,1000
    … …  
    331331          endif
    332332
    333       END DO    !loop over nlev
     333200   CONTINUE    !loop over nlev
    334334
    335335

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/zeff.F90

    r5086 r5095  
    3535  integer, intent(in) :: ice, xr
    3636  integer, intent(in) :: nsizes
    37   real(kind=8), intent(in) :: freq,D(nsizes),N(nsizes),tt,qe(nsizes), &
     37  real*8, intent(in) :: freq,D(nsizes),N(nsizes),tt,qe(nsizes), &
    3838    qs(nsizes), rho_e(nsizes)
    39   real(kind=8), intent(inout) :: k2
     39  real*8, intent(inout) :: k2
    4040 
    4141! ----- OUTPUTS -----
    42   real(kind=8), intent(out) :: z_eff,z_ray,kr
     42  real*8, intent(out) :: z_eff,z_ray,kr
    4343   
    4444! ----- INTERNAL -----
    4545  integer :: &
    4646  correct_for_rho        ! correct for density flag
    47   real(kind=8), dimension(nsizes) :: &
     47  real*8, dimension(nsizes) :: &
    4848  D0, &                  ! D in (m)
    4949  N0, &                  ! N in m^-3 m^-1
    … …  
    5353  rho_ice, &             ! bulk density ice (kg m^-3)
    5454  f                 ! ice fraction
    55   real(kind=8), dimension(nsizes) :: xtemp
    56   real(kind=8) :: &
     55  real*8, dimension(nsizes) :: xtemp
     56  real*8 :: &
    5757  wl, &                  ! wavelength (m)
    5858  cr                            ! kr(dB/km) = cr * kr(1/km)
    59   complex(kind=8) :: &
     59  complex*16 :: &
    6060  m                 ! complex index of refraction of bulk form
    61   complex(kind=8), dimension(nsizes) :: &
     61  complex*16, dimension(nsizes) :: &
    6262  m0                ! complex index of refraction
    6363 
    64   integer(kind=4) :: i,one
    65   real(kind=8) :: pi
    66   real(kind=8) :: eta_sum, eta_mie, const, z0_eff, z0_ray, k_sum, &
     64  integer*4 :: i,one
     65  real*8 :: pi
     66  real*8 :: eta_sum, eta_mie, const, z0_eff, z0_ray, k_sum, &
    6767            n_r, n_i, dqv(1), dqsc, dg, dph(1)
    68   integer(kind=4) :: err
    69   complex(kind=8) :: Xs1(1), Xs2(1)
     68  integer*4 :: err
     69  complex*16 :: Xs1(1), Xs2(1)
    7070
    7171  one=1
    … …  
    113113      call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    114114        dg, xs1, xs2, dph, err)
    115     END DO
     115    end do
    116116   
    117117  else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/MISR_simulator.F90

    r5082 r5095  
    8484       do ilev=1,nlev
    8585          ! Define location of "layer top"
    86           if(ilev==1 .or. ilev==nlev) then
     86          if(ilev.eq.1 .or. ilev.eq.nlev) then
    8787             ztest=zfull(j,ilev)
    8888          else
    … …  
    9494          iMISR_ztop=2
    9595          do loop=2,numMISRHgtBins
    96              if ( ztest > 1000*misr_histHgt(loop+1) ) then
     96             if ( ztest .gt. 1000*misr_histHgt(loop+1) ) then
    9797                iMISR_ztop=loop+1
    9898             endif
    … …  
    110110          do ilev=1,nlev
    111111             ! If there a cloud, start the counter and store this height
    112              if(thres_crossed_MISR == 0 .and. dtau(j,ibox,ilev) > 0.) then
     112             if(thres_crossed_MISR .eq. 0 .and. dtau(j,ibox,ilev) .gt. 0.) then
    113113                ! First encountered a "cloud"
    114114                thres_crossed_MISR = 1 
    … …  
    116116             endif
    117117
    118              if( thres_crossed_MISR < 99 .and. thres_crossed_MISR > 0 ) then
    119                 if( dtau(j,ibox,ilev) == 0.) then
     118             if( thres_crossed_MISR .lt. 99 .and. thres_crossed_MISR .gt. 0 ) then
     119                if( dtau(j,ibox,ilev) .eq. 0.) then
    120120                   ! We have come to the end of the current cloud layer without yet
    121121                   ! selecting a CTH boundary. Restart cloud tau counter
    … …  
    129129                ! current layer cloud top to the current level then MISR will like
    130130                ! see a top below the top of the current layer.
    131                 if( dtau(j,ibox,ilev)>0 .and. (cloud_dtau-dtau(j,ibox,ilev)) < 1) then
    132                    if(dtau(j,ibox,ilev) < 1 .or. ilev==1 .or. ilev==nlev) then
     131                if( dtau(j,ibox,ilev).gt.0 .and. (cloud_dtau-dtau(j,ibox,ilev)) .lt. 1) then
     132                   if(dtau(j,ibox,ilev) .lt. 1 .or. ilev.eq.1 .or. ilev.eq.nlev) then
    133133                      ! MISR will likely penetrate to some point within this layer ... the middle
    134134                      MISR_penetration_height=zfull(j,ilev)
    … …  
    142142               
    143143                ! Check for a distinctive water layer
    144                 if(dtau(j,ibox,ilev) > 1 .and. at(j,ilev) > 273 ) then
     144                if(dtau(j,ibox,ilev) .gt. 1 .and. at(j,ilev) .gt. 273 ) then
    145145                   ! Must be a water cloud, take this as CTH level
    146146                   thres_crossed_MISR=99
    … …  
    149149                ! If the total column optical depth is "large" than MISR can't see
    150150                ! anything else. Set current point as CTH level
    151                 if(sum(dtau(j,ibox,1:ilev)) > 5) then
     151                if(sum(dtau(j,ibox,1:ilev)) .gt. 5) then
    152152                   thres_crossed_MISR=99           
    153153                endif
    … …  
    157157          ! Check to see if there was a cloud for which we didn't
    158158          ! set a MISR cloud top boundary
    159           if( thres_crossed_MISR == 1) then
     159          if( thres_crossed_MISR .eq. 1) then
    160160             ! If the cloud has a total optical depth of greater
    161161             ! than ~ 0.5 MISR will still likely pick up this cloud
    162162             ! with a height near the true cloud top
    163163             ! otherwise there should be no CTH
    164              if(sum(dtau(j,ibox,1:nlev)) > 0.5) then
     164             if(sum(dtau(j,ibox,1:nlev)) .gt. 0.5) then
    165165                ! keep MISR detected CTH
    166              elseif(sum(dtau(j,ibox,1:nlev)) > 0.2) then
     166             elseif(sum(dtau(j,ibox,1:nlev)) .gt. 0.2) then
    167167                ! MISR may detect but wont likley have a good height
    168168                box_MISR_ztop(j,ibox)=-1
    … …  
    215215    ! Fill dark scenes
    216216    do j=1,numMISRHgtBins
    217        where(sunlit /= 1) dist_model_layertops(1:npoints,j) = R_UNDEF
     217       where(sunlit .ne. 1) dist_model_layertops(1:npoints,j) = R_UNDEF
    218218    enddo
    219219
    … …  
    257257
    258258       ! Subcolumns that are cloudy(true) and not(false)
    259        box_cloudy(1:ncol) = merge(.true.,.false.,tau(j,1:ncol) > tauchk)
     259       box_cloudy(1:ncol) = merge(.true.,.false.,tau(j,1:ncol) .gt. tauchk)
    260260
    261261       ! Fill optically thin clouds with fill value
    262262       where(.not. box_cloudy(1:ncol)) tauWRK(j,1:ncol)  = -999._wp
    263        where(box_MISR_ztopWRK(j,1:ncol) == 0) box_MISR_ztopWRK(j,1:ncol)=-999._wp
     263       where(box_MISR_ztopWRK(j,1:ncol) .eq. 0) box_MISR_ztopWRK(j,1:ncol)=-999._wp
    264264
    265265       ! Compute joint histogram and column quantities for points that are sunlit and cloudy
    266        if (sunlit(j) == 1) then
     266       if (sunlit(j) .eq. 1) then
    267267          ! Joint histogram
    268268          call hist2D(tauWRK(j,1:ncol),box_MISR_ztopWRK(j,1:ncol),ncol,misr_histTau,numMISRTauBins,&
    … …  
    272272
    273273          ! Column cloud area
    274           MISR_cldarea(j)=real(count(box_MISR_ztopWRK(j,1:ncol) /= -999.))/ncol
     274          MISR_cldarea(j)=real(count(box_MISR_ztopWRK(j,1:ncol) .ne. -999.))/ncol
    275275
    276276          ! Column cloud-top height
    277           if ( count(box_MISR_ztopWRK(j,1:ncol) /= -999.) /= 0 ) then
    278              MISR_mean_ztop(j) = sum(box_MISR_ztopWRK(j,1:ncol),box_MISR_ztopWRK(j,1:ncol) /= -999.)/ &
    279                   count(box_MISR_ztopWRK(j,1:ncol) /= -999.)
     277          if ( count(box_MISR_ztopWRK(j,1:ncol) .ne. -999.) .ne. 0 ) then
     278             MISR_mean_ztop(j) = sum(box_MISR_ztopWRK(j,1:ncol),box_MISR_ztopWRK(j,1:ncol) .ne. -999.)/ &
     279                  count(box_MISR_ztopWRK(j,1:ncol) .ne. -999.)
    280280          else
    281281             MISR_mean_ztop(j) = R_UNDEF

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp.F90

    r5086 r5095  
    402402
    403403    ! Set flag to deallocate rttov types (only done on final call to simulator)
    404     if (size(cospOUT%isccp_meantb) == stop_idx) lrttov_cleanUp = .true.
     404    if (size(cospOUT%isccp_meantb) .eq. stop_idx) lrttov_cleanUp = .true.   
    405405   
    406406    ! ISCCP column
    … …  
    563563       modisIN%w0        => cospIN%ss_alb
    564564       modisIN%Nsunlit   = count(cospgridIN%sunlit > 0)
    565        if (modisIN%Nsunlit > 0) then
     565       if (modisIN%Nsunlit .gt. 0) then
    566566          allocate(modisIN%sunlit(modisIN%Nsunlit),modisIN%pres(modisIN%Nsunlit,cospIN%Nlevels+1))
    567567          modisIN%sunlit    = pack((/ (i, i = 1, Npoints ) /),mask = cospgridIN%sunlit > 0)
    568568          modisIN%pres      = cospgridIN%phalf(int(modisIN%sunlit(:)),:)
    569569       endif
    570        if (count(cospgridIN%sunlit <= 0) > 0) then
     570       if (count(cospgridIN%sunlit <= 0) .gt. 0) then
    571571          allocate(modisIN%notSunlit(count(cospgridIN%sunlit <= 0)))
    572572          modisIN%notSunlit = pack((/ (i, i = 1, Npoints ) /),mask = .not. cospgridIN%sunlit > 0)
    … …  
    731731                                  modisRetrievedCloudTopPressure(i,:),                   &
    732732                                  modisRetrievedTau(i,:),modisRetrievedSize(i,:))
    733           END DO
     733          end do
    734734       endif
    735735    endif
    … …  
    14501450  !         is turned off.
    14511451  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1452   if (any(cospgridIN%sunlit < 0)) then
     1452  if (any(cospgridIN%sunlit .lt. 0)) then
    14531453     nError=nError+1
    14541454     errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%sunlit contains values out of range (0 or 1)'
    … …  
    15131513          cospOUT%modis_Optical_Thickness_vs_ReffLIQ(:,:,:)            = R_UNDEF
    15141514  endif
    1515   if (any(cospgridIN%at < 0)) then
     1515  if (any(cospgridIN%at .lt. 0)) then   
    15161516       nError=nError+1
    15171517       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%at contains values out of range (at<0), expected units (K)'
    … …  
    15491549       if (associated(cospOUT%radar_lidar_tcc))       cospOUT%radar_lidar_tcc(:)           = R_UNDEF       
    15501550    endif
    1551     if (any(cospgridIN%pfull < 0)) then
     1551    if (any(cospgridIN%pfull .lt. 0)) then
    15521552       nError=nError+1
    15531553       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%pfull contains values out of range'
    … …  
    15661566       if (associated(cospOUT%isccp_fq))            cospOUT%isccp_fq(:,:,:)        = R_UNDEF     
    15671567    endif
    1568     if (any(cospgridIN%phalf < 0)) then
     1568    if (any(cospgridIN%phalf .lt. 0)) then
    15691569       nError=nError+1
    15701570       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%phalf contains values out of range'
    … …  
    16321632       if (associated(cospOUT%calipso_lidarcldtmp))   cospOUT%calipso_lidarcldtmp(:,:,:)   = R_UNDEF     
    16331633    endif
    1634     if (any(cospgridIN%qv < 0)) then
     1634    if (any(cospgridIN%qv .lt. 0)) then
    16351635       nError=nError+1
    16361636       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%qv contains values out of range'
    … …  
    16491649       if (associated(cospOUT%isccp_fq))            cospOUT%isccp_fq(:,:,:)        = R_UNDEF               
    16501650    endif
    1651     if (any(cospgridIN%hgt_matrix < -300)) then
     1651    if (any(cospgridIN%hgt_matrix .lt. -300)) then
    16521652       nError=nError+1
    16531653       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%hgt_matrix contains values out of range'
    … …  
    16741674       if (associated(cospOUT%radar_lidar_tcc))           cospOUT%radar_lidar_tcc(:)             = R_UNDEF       
    16751675    endif
    1676     if (any(cospgridIN%hgt_matrix_half < -300)) then
     1676    if (any(cospgridIN%hgt_matrix_half .lt. -300)) then
    16771677       nError=nError+1
    16781678       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%hgt_matrix_half contains values out of range'
    … …  
    16931693       if (associated(cospOUT%radar_lidar_tcc))       cospOUT%radar_lidar_tcc(:)           = R_UNDEF                 
    16941694    endif
    1695     if (any(cospgridIN%land < 0)) then
     1695    if (any(cospgridIN%land .lt. 0)) then
    16961696       nError=nError+1
    16971697       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%land contains values out of range'
    … …  
    17081708       if (associated(cospOUT%parasolGrid_refl))      cospOUT%parasolGrid_refl(:,:)        = R_UNDEF
    17091709    endif
    1710     if (any(cospgridIN%skt < 0)) then
     1710    if (any(cospgridIN%skt .lt. 0)) then
    17111711       nError=nError+1
    17121712       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%skt contains values out of range'
    … …  
    17271727
    17281728        ! RTTOV Inputs
    1729     if (cospgridIN%zenang < -90. .OR. cospgridIN%zenang > 90) then
     1729    if (cospgridIN%zenang .lt. -90. .OR. cospgridIN%zenang .gt. 90) then
    17301730       nError=nError+1
    17311731       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%zenang contains values out of range'
    … …  
    17331733       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17341734    endif
    1735     if (cospgridIN%co2 < 0) then
     1735    if (cospgridIN%co2 .lt. 0) then
    17361736       nError=nError+1
    17371737       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%co2 contains values out of range'
    … …  
    17391739       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17401740    endif
    1741     if (cospgridIN%ch4 < 0) then
     1741    if (cospgridIN%ch4 .lt. 0) then
    17421742       nError=nError+1
    17431743       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%ch4 contains values out of range'
    … …  
    17451745       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17461746    endif
    1747     if (cospgridIN%n2o < 0) then
     1747    if (cospgridIN%n2o .lt. 0) then
    17481748       nError=nError+1
    17491749       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%n2o contains values out of range'
    … …  
    17511751       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17521752    endif
    1753     if (cospgridIN%co< 0) then
     1753    if (cospgridIN%co.lt. 0) then
    17541754       nError=nError+1
    17551755       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%co contains values out of range'
    … …  
    17571757       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17581758    endif
    1759     if (any(cospgridIN%o3 < 0)) then
     1759    if (any(cospgridIN%o3 .lt. 0)) then
    17601760       nError=nError+1
    17611761       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%o3 contains values out of range'
    … …  
    17631763       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17641764    endif
    1765     if (any(cospgridIN%emis_sfc < 0. .OR. cospgridIN%emis_sfc > 1)) then
     1765    if (any(cospgridIN%emis_sfc .lt. 0. .OR. cospgridIN%emis_sfc .gt. 1)) then
    17661766       nError=nError+1
    17671767       errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%emis_sfc contains values out of range'
    … …  
    17691769       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17701770    endif
    1771     if (any(cospgridIN%u_sfc < -100. .OR. cospgridIN%u_sfc > 100.)) then
     1771    if (any(cospgridIN%u_sfc .lt. -100. .OR. cospgridIN%u_sfc .gt. 100.)) then
    17721772       nError=nError+1
    17731773       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%u_sfc contains values out of range'
    … …  
    17751775       Lrttov_subcolumn = .false.
    17761776    endif
    1777     if (any(cospgridIN%v_sfc < -100. .OR. cospgridIN%v_sfc > 100.)) then
     1777    if (any(cospgridIN%v_sfc .lt. -100. .OR. cospgridIN%v_sfc .gt. 100.)) then
    17781778       nError=nError+1
    17791779       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%v_sfc contains values out of range'
    … …  
    17811781       if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF       
    17821782    endif
    1783     if (any(cospgridIN%lat < -90 .OR. cospgridIN%lat > 90)) then
     1783    if (any(cospgridIN%lat .lt. -90 .OR. cospgridIN%lat .gt. 90)) then
    17841784       nError=nError+1
    17851785       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%lat contains values out of range'
    … …  
    17891789
    17901790    ! COSP_INPUTS
    1791     if (cospIN%emsfc_lw < 0. .OR. cospIN%emsfc_lw > 1.) then
     1791    if (cospIN%emsfc_lw .lt. 0. .OR. cospIN%emsfc_lw .gt. 1.) then
    17921792       nError=nError+1
    17931793       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%emsfc_lw contains values out of range'
    … …  
    18051805       
    18061806    endif
    1807     if (any(cospIN%tau_067 < 0)) then
     1807    if (any(cospIN%tau_067 .lt. 0)) then
    18081808       nError=nError+1
    18091809       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tau_067 contains values out of range'
    … …  
    18701870       
    18711871    endif
    1872     if (any(cospIN%emiss_11 < 0. .OR. cospIN%emiss_11 > 1)) then
     1872    if (any(cospIN%emiss_11 .lt. 0. .OR. cospIN%emiss_11 .gt. 1)) then
    18731873       nError=nError+1
    18741874       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%emiss_11 contains values out of range'
    … …  
    18861886         
    18871887    endif
    1888     if (any(cospIN%asym < -1. .OR. cospIN%asym > 1)) then
     1888    if (any(cospIN%asym .lt. -1. .OR. cospIN%asym .gt. 1)) then
    18891889       nError=nError+1
    18901890       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%asym contains values out of range'
    … …  
    19321932            cospOUT%modis_Optical_Thickness_vs_ReffLIQ(:,:,:)            = R_UNDEF             
    19331933    endif
    1934     if (any(cospIN%ss_alb < 0 .OR. cospIN%ss_alb > 1)) then
     1934    if (any(cospIN%ss_alb .lt. 0 .OR. cospIN%ss_alb .gt. 1)) then
    19351935       nError=nError+1
    19361936       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%ss_alb contains values out of range'
    … …  
    19781978            cospOUT%modis_Optical_Thickness_vs_ReffLIQ(:,:,:)            = R_UNDEF                 
    19791979    endif
    1980     if (any(cospIN%betatot < 0)) then
     1980    if (any(cospIN%betatot .lt. 0)) then
    19811981       nError=nError+1
    19821982       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%betatot contains values out of range'
    … …  
    19911991       if (associated(cospOUT%calipso_srbval))        cospOUT%calipso_srbval(:)            = R_UNDEF
    19921992    endif
    1993     if (any(cospIN%betatot_liq < 0)) then
     1993    if (any(cospIN%betatot_liq .lt. 0)) then
    19941994       nError=nError+1
    19951995       errorMessage(nError) = ('ERROR: COSP input variable: cospIN%betatot_liq contains values out of range')
    … …  
    20042004       if (associated(cospOUT%calipso_srbval))        cospOUT%calipso_srbval(:)            = R_UNDEF       
    20052005    endif
    2006     if (any(cospIN%betatot_ice < 0)) then
     2006    if (any(cospIN%betatot_ice .lt. 0)) then
    20072007       nError=nError+1
    20082008       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%betatot_ice contains values out of range'
    … …  
    20172017       if (associated(cospOUT%calipso_srbval))        cospOUT%calipso_srbval(:)            = R_UNDEF
    20182018    endif
    2019     if (any(cospIN%beta_mol < 0)) then
     2019    if (any(cospIN%beta_mol .lt. 0)) then
    20202020       nError=nError+1
    20212021       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%beta_mol contains values out of range'
    … …  
    20362036       if (associated(cospOUT%radar_lidar_tcc))       cospOUT%radar_lidar_tcc(:)           = R_UNDEF         
    20372037    endif   
    2038     if (any(cospIN%tautot < 0)) then
     2038    if (any(cospIN%tautot .lt. 0)) then
    20392039       nError=nError+1
    20402040       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot contains values out of range'
    … …  
    20492049       if (associated(cospOUT%calipso_srbval))        cospOUT%calipso_srbval(:)            = R_UNDEF     
    20502050    endif
    2051     if (any(cospIN%tautot_liq < 0)) then
     2051    if (any(cospIN%tautot_liq .lt. 0)) then
    20522052       nError=nError+1
    20532053       errorMessage(nError) = ('ERROR: COSP input variable: cospIN%tautot_liq contains values out of range')
    … …  
    20622062       if (associated(cospOUT%calipso_srbval))        cospOUT%calipso_srbval(:)            = R_UNDEF       
    20632063    endif
    2064     if (any(cospIN%tautot_ice < 0)) then
     2064    if (any(cospIN%tautot_ice .lt. 0)) then
    20652065       nError=nError+1
    20662066       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_ice contains values out of range'
    … …  
    20752075       if (associated(cospOUT%calipso_srbval))        cospOUT%calipso_srbval(:)            = R_UNDEF       
    20762076    endif
    2077     if (any(cospIN%tau_mol < 0)) then
     2077    if (any(cospIN%tau_mol .lt. 0)) then
    20782078       nError=nError+1
    20792079       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tau_mol contains values out of range'
    … …  
    20882088       if (associated(cospOUT%calipso_srbval))        cospOUT%calipso_srbval(:)            = R_UNDEF         
    20892089    endif   
    2090     if (any(cospIN%tautot_S_liq < 0)) then
     2090    if (any(cospIN%tautot_S_liq .lt. 0)) then
    20912091       nError=nError+1
    20922092       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_S_liq contains values out of range'
    … …  
    20962096       if (associated(cospOUT%parasolGrid_refl)) cospOUT%parasolGrid_refl(:,:)  = R_UNDEF
    20972097    endif
    2098     if (any(cospIN%tautot_S_ice < 0)) then
     2098    if (any(cospIN%tautot_S_ice .lt. 0)) then
    20992099       nError=nError+1
    21002100       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_S_ice contains values out of range'
    … …  
    21042104       if (associated(cospOUT%parasolGrid_refl)) cospOUT%parasolGrid_refl(:,:)  = R_UNDEF       
    21052105    endif   
    2106     if (any(cospIN%z_vol_cloudsat < 0)) then
     2106    if (any(cospIN%z_vol_cloudsat .lt. 0)) then
    21072107       nError=nError+1
    21082108       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%z_vol_cloudsat contains values out of range'
    … …  
    21162116       if (associated(cospOUT%radar_lidar_tcc))           cospOUT%radar_lidar_tcc(:)             = R_UNDEF     
    21172117    endif
    2118     if (any(cospIN%kr_vol_cloudsat < 0)) then
     2118    if (any(cospIN%kr_vol_cloudsat .lt. 0)) then
    21192119       nError=nError+1
    21202120       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%kr_vol_cloudsat contains values out of range'
    … …  
    21282128       if (associated(cospOUT%radar_lidar_tcc))           cospOUT%radar_lidar_tcc(:)             = R_UNDEF     
    21292129    endif   
    2130     if (any(cospIN%g_vol_cloudsat < 0)) then
     2130    if (any(cospIN%g_vol_cloudsat .lt. 0)) then
    21312131       nError=nError+1
    21322132       errorMessage(nError) = 'ERROR: COSP input variable: cospIN%g_vol_cloudsat contains values out of range'
    … …  
    21452145  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    21462146  ! ISCCP
    2147   if (size(cospIN%frac_out,1)  /= cospIN%Npoints .OR. &
    2148       size(cospIN%tau_067,1)   /= cospIN%Npoints .OR. &
    2149       size(cospIN%emiss_11,1)  /= cospIN%Npoints .OR. &
    2150       size(cospgridIN%skt)     /= cospIN%Npoints .OR. &
    2151       size(cospgridIN%qv,1)    /= cospIN%Npoints .OR. &
    2152       size(cospgridIN%at,1)    /= cospIN%Npoints .OR. &
    2153       size(cospgridIN%phalf,1) /= cospIN%Npoints .OR. &
    2154       size(cospgridIN%sunlit)  /= cospIN%Npoints .OR. &
    2155       size(cospgridIN%pfull,1) /= cospIN%Npoints) then
     2147  if (size(cospIN%frac_out,1)  .ne. cospIN%Npoints .OR. &
     2148      size(cospIN%tau_067,1)   .ne. cospIN%Npoints .OR. &
     2149      size(cospIN%emiss_11,1)  .ne. cospIN%Npoints .OR. &
     2150      size(cospgridIN%skt)     .ne. cospIN%Npoints .OR. &
     2151      size(cospgridIN%qv,1)    .ne. cospIN%Npoints .OR. &
     2152      size(cospgridIN%at,1)    .ne. cospIN%Npoints .OR. &
     2153      size(cospgridIN%phalf,1) .ne. cospIN%Npoints .OR. &
     2154      size(cospgridIN%sunlit)  .ne. cospIN%Npoints .OR. &
     2155      size(cospgridIN%pfull,1) .ne. cospIN%Npoints) then
    21562156      Lisccp_subcolumn = .false.
    21572157      Lisccp_column    = .false.
    … …  
    21592159      errorMessage(nError) = 'ERROR(isccp_simulator): The number of points in the input fields are inconsistent'
    21602160  endif
    2161   if (size(cospIN%frac_out,2) /= cospIN%Ncolumns .OR. &
    2162       size(cospIN%tau_067,2)  /= cospIN%Ncolumns .OR. &
    2163       size(cospIN%emiss_11,2) /= cospIN%Ncolumns) then
     2161  if (size(cospIN%frac_out,2) .ne. cospIN%Ncolumns .OR. &
     2162      size(cospIN%tau_067,2)  .ne. cospIN%Ncolumns .OR. &
     2163      size(cospIN%emiss_11,2) .ne. cospIN%Ncolumns) then
    21642164      Lisccp_subcolumn = .false.
    21652165      Lisccp_column    = .false.
    … …  
    21672167      errorMessage(nError) = 'ERROR(isccp_simulator): The number of sub-columns in the input fields are inconsistent'
    21682168  endif
    2169   if (size(cospIN%frac_out,3)  /= cospIN%Nlevels .OR. &
    2170       size(cospIN%tau_067,3)   /= cospIN%Nlevels .OR. &
    2171       size(cospIN%emiss_11,3)  /= cospIN%Nlevels .OR. &
    2172       size(cospgridIN%qv,2)    /= cospIN%Nlevels .OR. &
    2173       size(cospgridIN%at,2)    /= cospIN%Nlevels .OR. &
    2174       size(cospgridIN%pfull,2) /= cospIN%Nlevels .OR. &
    2175       size(cospgridIN%phalf,2) /= cospIN%Nlevels+1) then
     2169  if (size(cospIN%frac_out,3)  .ne. cospIN%Nlevels .OR. &
     2170      size(cospIN%tau_067,3)   .ne. cospIN%Nlevels .OR. &
     2171      size(cospIN%emiss_11,3)  .ne. cospIN%Nlevels .OR. &
     2172      size(cospgridIN%qv,2)    .ne. cospIN%Nlevels .OR. &
     2173      size(cospgridIN%at,2)    .ne. cospIN%Nlevels .OR. &
     2174      size(cospgridIN%pfull,2) .ne. cospIN%Nlevels .OR. &   
     2175      size(cospgridIN%phalf,2) .ne. cospIN%Nlevels+1) then
    21762176      Lisccp_subcolumn = .false.
    21772177      Lisccp_column    = .false.
    … …  
    21812181     
    21822182  ! MISR
    2183   if (size(cospIN%tau_067,1)        /= cospIN%Npoints .OR. &
    2184       size(cospgridIN%sunlit)       /= cospIN%Npoints .OR. &
    2185       size(cospgridIN%hgt_matrix,1) /= cospIN%Npoints .OR. &
    2186       size(cospgridIN%at,1)         /= cospIN%Npoints) then
     2183  if (size(cospIN%tau_067,1)        .ne. cospIN%Npoints .OR. &
     2184      size(cospgridIN%sunlit)       .ne. cospIN%Npoints .OR. &
     2185      size(cospgridIN%hgt_matrix,1) .ne. cospIN%Npoints .OR. &
     2186      size(cospgridIN%at,1)         .ne. cospIN%Npoints) then
    21872187      Lmisr_subcolumn = .false.
    21882188      Lmisr_column    = .false.
    … …  
    21902190      errorMessage(nError) = 'ERROR(misr_simulator): The number of points in the input fields are inconsistent'
    21912191  endif
    2192   if (size(cospIN%tau_067,2) /= cospIN%Ncolumns) then
     2192  if (size(cospIN%tau_067,2) .ne. cospIN%Ncolumns) then
    21932193      Lmisr_subcolumn = .false.
    21942194      Lmisr_column    = .false.
    … …  
    21962196      errorMessage(nError) = 'ERROR(misr_simulator): The number of sub-columns in the input fields are inconsistent'
    21972197  endif
    2198   if (size(cospIN%tau_067,3)        /= cospIN%Nlevels .OR. &
    2199       size(cospgridIN%hgt_matrix,2) /= cospIN%Nlevels .OR. &
    2200       size(cospgridIN%at,2)         /= cospIN%Nlevels) then
     2198  if (size(cospIN%tau_067,3)        .ne. cospIN%Nlevels .OR. &
     2199      size(cospgridIN%hgt_matrix,2) .ne. cospIN%Nlevels .OR. &
     2200      size(cospgridIN%at,2)         .ne. cospIN%Nlevels) then
    22012201      Lmisr_subcolumn = .false.
    22022202      Lmisr_column    = .false.
    … …  
    22062206
    22072207  ! MODIS
    2208   if (size(cospIN%fracLiq,1) /= cospIN%Npoints .OR. &
    2209       size(cospIN%tau_067,1) /= cospIN%Npoints .OR. &
    2210       size(cospIN%asym,1)    /= cospIN%Npoints .OR. &
    2211       size(cospIN%ss_alb,1)  /= cospIN%Npoints) then
     2208  if (size(cospIN%fracLiq,1) .ne. cospIN%Npoints .OR. &
     2209      size(cospIN%tau_067,1) .ne. cospIN%Npoints .OR. &
     2210      size(cospIN%asym,1)    .ne. cospIN%Npoints .OR. &
     2211      size(cospIN%ss_alb,1)  .ne. cospIN%Npoints) then
    22122212      Lmodis_subcolumn = .false.
    22132213      Lmodis_column    = .false.
    … …  
    22152215      errorMessage(nError) = 'ERROR(modis_simulator): The number of points in the input fields are inconsistent'
    22162216  endif
    2217   if (size(cospIN%fracLiq,2) /= cospIN%Ncolumns .OR. &
    2218       size(cospIN%tau_067,2) /= cospIN%Ncolumns .OR. &
    2219       size(cospIN%asym,2)    /= cospIN%Ncolumns .OR. &
    2220       size(cospIN%ss_alb,2)  /= cospIN%Ncolumns) then
     2217  if (size(cospIN%fracLiq,2) .ne. cospIN%Ncolumns .OR. &
     2218      size(cospIN%tau_067,2) .ne. cospIN%Ncolumns .OR. &
     2219      size(cospIN%asym,2)    .ne. cospIN%Ncolumns .OR. &
     2220      size(cospIN%ss_alb,2)  .ne. cospIN%Ncolumns) then
    22212221      Lmodis_subcolumn = .false.
    22222222      Lmodis_column    = .false.
    … …  
    22242224      errorMessage(nError) = 'ERROR(modis_simulator): The number of sub-columns in the input fields are inconsistent'
    22252225  endif       
    2226   if (size(cospIN%fracLiq,3) /= cospIN%Nlevels .OR. &
    2227       size(cospIN%tau_067,3) /= cospIN%Nlevels .OR. &
    2228       size(cospIN%asym,3)    /= cospIN%Nlevels .OR. &
    2229       size(cospIN%ss_alb,3)  /= cospIN%Nlevels) then
     2226  if (size(cospIN%fracLiq,3) .ne. cospIN%Nlevels .OR. &
     2227      size(cospIN%tau_067,3) .ne. cospIN%Nlevels .OR. &
     2228      size(cospIN%asym,3)    .ne. cospIN%Nlevels .OR. &
     2229      size(cospIN%ss_alb,3)  .ne. cospIN%Nlevels) then
    22302230      Lmodis_subcolumn = .false.
    22312231      Lmodis_column    = .false.
    … …  
    22352235 
    22362236  ! CLOUDSAT   
    2237   if (size(cospIN%z_vol_cloudsat,1)   /= cospIN%Npoints .OR. &
    2238       size(cospIN%kr_vol_cloudsat,1)  /= cospIN%Npoints .OR. &
    2239       size(cospIN%g_vol_cloudsat,1)   /= cospIN%Npoints .OR. &
    2240       size(cospgridIN%hgt_matrix,1)   /= cospIN%Npoints) then
     2237  if (size(cospIN%z_vol_cloudsat,1)   .ne. cospIN%Npoints .OR. &
     2238      size(cospIN%kr_vol_cloudsat,1)  .ne. cospIN%Npoints .OR. &
     2239      size(cospIN%g_vol_cloudsat,1)   .ne. cospIN%Npoints .OR. &
     2240      size(cospgridIN%hgt_matrix,1)   .ne. cospIN%Npoints) then
    22412241      Lcloudsat_subcolumn = .false.
    22422242      Lcloudsat_column    = .false.
    … …  
    22442244      errorMessage(nError) = 'ERROR(cloudsat_simulator): The number of points in the input fields are inconsistent'
    22452245  endif
    2246   if (size(cospIN%z_vol_cloudsat,2)  /= cospIN%Ncolumns .OR. &
    2247       size(cospIN%kr_vol_cloudsat,2) /= cospIN%Ncolumns .OR. &
    2248       size(cospIN%g_vol_cloudsat,2)  /= cospIN%Ncolumns) then
     2246  if (size(cospIN%z_vol_cloudsat,2)  .ne. cospIN%Ncolumns .OR. &
     2247      size(cospIN%kr_vol_cloudsat,2) .ne. cospIN%Ncolumns .OR. &
     2248      size(cospIN%g_vol_cloudsat,2)  .ne. cospIN%Ncolumns) then
    22492249      Lcloudsat_subcolumn = .false.
    22502250      Lcloudsat_column    = .false.
    … …  
    22522252      errorMessage(nError) = 'ERROR(cloudsat_simulator): The number of sub-columns in the input fields are inconsistent'
    22532253  endif       
    2254   if (size(cospIN%z_vol_cloudsat,3)  /= cospIN%Nlevels .OR. &
    2255       size(cospIN%kr_vol_cloudsat,3) /= cospIN%Nlevels .OR. &
    2256       size(cospIN%g_vol_cloudsat,3)  /= cospIN%Nlevels .OR. &
    2257       size(cospgridIN%hgt_matrix,2)  /= cospIN%Nlevels) then
     2254  if (size(cospIN%z_vol_cloudsat,3)  .ne. cospIN%Nlevels .OR. &
     2255      size(cospIN%kr_vol_cloudsat,3) .ne. cospIN%Nlevels .OR. &
     2256      size(cospIN%g_vol_cloudsat,3)  .ne. cospIN%Nlevels .OR. &
     2257      size(cospgridIN%hgt_matrix,2)  .ne. cospIN%Nlevels) then
    22582258      Lcloudsat_subcolumn = .false.
    22592259      Lcloudsat_column    = .false.
    … …  
    22632263
    22642264  ! CALIPSO
    2265   if (size(cospIN%beta_mol,1)    /= cospIN%Npoints .OR. &
    2266       size(cospIN%betatot,1)     /= cospIN%Npoints .OR. &
    2267       size(cospIN%betatot_liq,1) /= cospIN%Npoints .OR. &
    2268       size(cospIN%betatot_ice,1) /= cospIN%Npoints .OR. &
    2269       size(cospIN%tau_mol,1)     /= cospIN%Npoints .OR. &
    2270       size(cospIN%tautot,1)      /= cospIN%Npoints .OR. &
    2271       size(cospIN%tautot_liq,1)  /= cospIN%Npoints .OR. &
    2272       size(cospIN%tautot_ice,1)  /= cospIN%Npoints) then
     2265  if (size(cospIN%beta_mol,1)    .ne. cospIN%Npoints .OR. &
     2266      size(cospIN%betatot,1)     .ne. cospIN%Npoints .OR. &
     2267      size(cospIN%betatot_liq,1) .ne. cospIN%Npoints .OR. &
     2268      size(cospIN%betatot_ice,1) .ne. cospIN%Npoints .OR. &
     2269      size(cospIN%tau_mol,1)     .ne. cospIN%Npoints .OR. &
     2270      size(cospIN%tautot,1)      .ne. cospIN%Npoints .OR. &
     2271      size(cospIN%tautot_liq,1)  .ne. cospIN%Npoints .OR. &
     2272      size(cospIN%tautot_ice,1)  .ne. cospIN%Npoints) then
    22732273      Lcalipso_subcolumn = .false.
    22742274      Lcalipso_column    = .false.
    … …  
    22762276      errorMessage(nError) = 'ERROR(calipso_simulator): The number of points in the input fields are inconsistent'
    22772277  endif         
    2278    if (size(cospIN%betatot,2)     /= cospIN%Ncolumns .OR. &
    2279        size(cospIN%betatot_liq,2) /= cospIN%Ncolumns .OR. &
    2280        size(cospIN%betatot_ice,2) /= cospIN%Ncolumns .OR. &
    2281        size(cospIN%tautot,2)      /= cospIN%Ncolumns .OR. &
    2282        size(cospIN%tautot_liq,2)  /= cospIN%Ncolumns .OR. &
    2283        size(cospIN%tautot_ice,2)  /= cospIN%Ncolumns) then
     2278   if (size(cospIN%betatot,2)     .ne. cospIN%Ncolumns .OR. &
     2279       size(cospIN%betatot_liq,2) .ne. cospIN%Ncolumns .OR. &
     2280       size(cospIN%betatot_ice,2) .ne. cospIN%Ncolumns .OR. &
     2281       size(cospIN%tautot,2)      .ne. cospIN%Ncolumns .OR. &
     2282       size(cospIN%tautot_liq,2)  .ne. cospIN%Ncolumns .OR. &
     2283       size(cospIN%tautot_ice,2)  .ne. cospIN%Ncolumns) then
    22842284       Lcalipso_subcolumn = .false.
    22852285       Lcalipso_column    = .false.
    … …  
    22872287      errorMessage(nError) = 'ERROR(calipso_simulator): The number of sub-columns in the input fields are inconsistent'
    22882288  endif       
    2289   if (size(cospIN%beta_mol,2)    /= cospIN%Nlevels .OR. &
    2290       size(cospIN%betatot,3)     /= cospIN%Nlevels .OR. &
    2291       size(cospIN%betatot_liq,3) /= cospIN%Nlevels .OR. &
    2292       size(cospIN%betatot_ice,3) /= cospIN%Nlevels .OR. &
    2293       size(cospIN%tau_mol,2)     /= cospIN%Nlevels .OR. &
    2294       size(cospIN%tautot,3)      /= cospIN%Nlevels .OR. &
    2295       size(cospIN%tautot_liq,3)  /= cospIN%Nlevels .OR. &
    2296       size(cospIN%tautot_ice,3)  /= cospIN%Nlevels) then
     2289  if (size(cospIN%beta_mol,2)    .ne. cospIN%Nlevels .OR. &
     2290      size(cospIN%betatot,3)     .ne. cospIN%Nlevels .OR. &
     2291      size(cospIN%betatot_liq,3) .ne. cospIN%Nlevels .OR. &
     2292      size(cospIN%betatot_ice,3) .ne. cospIN%Nlevels .OR. &
     2293      size(cospIN%tau_mol,2)     .ne. cospIN%Nlevels .OR. &
     2294      size(cospIN%tautot,3)      .ne. cospIN%Nlevels .OR. &
     2295      size(cospIN%tautot_liq,3)  .ne. cospIN%Nlevels .OR. &
     2296      size(cospIN%tautot_ice,3)  .ne. cospIN%Nlevels) then
    22972297      Lcalipso_subcolumn = .false.
    22982298      Lcalipso_column    = .false.
    … …  
    23022302 
    23032303  ! PARASOL
    2304   if (size(cospIN%tautot_S_liq,1) /= cospIN%Npoints .OR. &
    2305       size(cospIN%tautot_S_ice,1) /= cospIN%Npoints) then
     2304  if (size(cospIN%tautot_S_liq,1) .ne. cospIN%Npoints .OR. &
     2305      size(cospIN%tautot_S_ice,1) .ne. cospIN%Npoints) then
    23062306      Lparasol_subcolumn = .false.
    23072307      Lparasol_column    = .false.
    … …  
    23092309      errorMessage(nError) = 'ERROR(parasol_simulator): The number of points in the input fields are inconsistent'
    23102310  endif
    2311   if (size(cospIN%tautot_S_liq,2) /= cospIN%Ncolumns .OR. &
    2312       size(cospIN%tautot_S_ice,2) /= cospIN%Ncolumns) then
     2311  if (size(cospIN%tautot_S_liq,2) .ne. cospIN%Ncolumns .OR. &
     2312      size(cospIN%tautot_S_ice,2) .ne. cospIN%Ncolumns) then
    23132313      Lparasol_subcolumn = .false.
    23142314      Lparasol_column    = .false.
    … …  
    23182318 
    23192319  ! RTTOV
    2320   if (size(cospgridIN%pfull,1)           /= cospIN%Npoints .OR. &
    2321       size(cospgridIN%at,1)              /= cospIN%Npoints .OR. &
    2322       size(cospgridIN%qv,1)              /= cospIN%Npoints .OR. &
    2323       size(cospgridIN%hgt_matrix_half,1) /= cospIN%Npoints .OR. &
    2324       size(cospgridIN%u_sfc)             /= cospIN%Npoints .OR. &
    2325       size(cospgridIN%v_sfc)             /= cospIN%Npoints .OR. &
    2326       size(cospgridIN%skt)               /= cospIN%Npoints .OR. &
    2327       size(cospgridIN%phalf,1)           /= cospIN%Npoints .OR. &
    2328       size(cospgridIN%qv,1)              /= cospIN%Npoints .OR. &
    2329       size(cospgridIN%land)              /= cospIN%Npoints .OR. &
    2330       size(cospgridIN%lat)               /= cospIN%Npoints) then
     2320  if (size(cospgridIN%pfull,1)           .ne. cospIN%Npoints .OR. &
     2321      size(cospgridIN%at,1)              .ne. cospIN%Npoints .OR. &
     2322      size(cospgridIN%qv,1)              .ne. cospIN%Npoints .OR. &
     2323      size(cospgridIN%hgt_matrix_half,1) .ne. cospIN%Npoints .OR. &
     2324      size(cospgridIN%u_sfc)             .ne. cospIN%Npoints .OR. &
     2325      size(cospgridIN%v_sfc)             .ne. cospIN%Npoints .OR. &
     2326      size(cospgridIN%skt)               .ne. cospIN%Npoints .OR. &
     2327      size(cospgridIN%phalf,1)           .ne. cospIN%Npoints .OR. &
     2328      size(cospgridIN%qv,1)              .ne. cospIN%Npoints .OR. &
     2329      size(cospgridIN%land)              .ne. cospIN%Npoints .OR. &
     2330      size(cospgridIN%lat)               .ne. cospIN%Npoints) then
    23312331      Lrttov_subcolumn = .false.
    23322332      Lrttov_column    = .false.
    … …  
    23342334      errorMessage(nError) = 'ERROR(rttov_simulator): The number of points in the input fields are inconsistent'
    23352335  endif     
    2336   if (size(cospgridIN%pfull,2)           /= cospIN%Nlevels   .OR. &
    2337       size(cospgridIN%at,2)              /= cospIN%Nlevels   .OR. &
    2338       size(cospgridIN%qv,2)              /= cospIN%Nlevels   .OR. &
    2339       size(cospgridIN%hgt_matrix_half,2) /= cospIN%Nlevels+1 .OR. &
    2340       size(cospgridIN%phalf,2)           /= cospIN%Nlevels+1 .OR. &
    2341       size(cospgridIN%qv,2)              /= cospIN%Nlevels) then
     2336  if (size(cospgridIN%pfull,2)           .ne. cospIN%Nlevels   .OR. &
     2337      size(cospgridIN%at,2)              .ne. cospIN%Nlevels   .OR. &
     2338      size(cospgridIN%qv,2)              .ne. cospIN%Nlevels   .OR. &
     2339      size(cospgridIN%hgt_matrix_half,2) .ne. cospIN%Nlevels+1 .OR. &
     2340      size(cospgridIN%phalf,2)           .ne. cospIN%Nlevels+1 .OR. &
     2341      size(cospgridIN%qv,2)              .ne. cospIN%Nlevels) then
    23422342      Lrttov_subcolumn = .false.
    23432343      Lrttov_column    = .false.

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_interface_v1p4.F90

    r5082 r5095  
    684684       ! Determine indices for "chunking" (again, if necessary)
    685685       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    686        if (num_chunks == 1) then
     686       if (num_chunks .eq. 1) then
    687687          start_idx = 1
    688688          end_idx   = gbx%Npoints
    … …  
    691691          start_idx = (i-1)*gbx%Npoints_it+1
    692692          end_idx   = i*gbx%Npoints_it
    693           if (end_idx > gbx%Npoints) end_idx=gbx%Npoints
     693          if (end_idx .gt. gbx%Npoints) end_idx=gbx%Npoints
    694694          Nptsperit = end_idx-start_idx+1
    695695       endif
    … …  
    698698       ! Allocate space
    699699       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    700        if (i == 1) then
     700       if (i .eq. 1) then
    701701          call construct_cospIN(Nptsperit,gbx%ncolumns,gbx%nlevels,cospIN)
    702702          call construct_cospstateIN(Nptsperit,gbx%nlevels,gbx%nchan,cospstateIN)
    703703       endif
    704        if (i == num_chunks) then
     704       if (i .eq. num_chunks) then
    705705          call destroy_cospIN(cospIN)
    706706          call destroy_cospstateIN(cospstateIN)
    … …  
    948948    cospgridIN%phalf(:,1)                               = 0._wp
    949949    cospgridIN%phalf(:,2:gbx%Nlevels+1)                 = gbx%ph(start_idx:end_idx,gbx%Nlevels:1:-1)   
    950     if (gbx%Ncolumns > 1) then
     950    if (gbx%Ncolumns .gt. 1) then
    951951       
    952952       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    … …  
    956956       seed(:)=0
    957957       seed = int(gbx%psfc)  ! In case of Npoints=1
    958        if (Npoints > 1) seed=int((gbx%psfc(start_idx:end_idx)-minval(gbx%psfc(start_idx:end_idx)))/      &
     958       if (Npoints .gt. 1) seed=int((gbx%psfc(start_idx:end_idx)-minval(gbx%psfc(start_idx:end_idx)))/      &
    959959            (maxval(gbx%psfc(start_idx:end_idx))-minval(gbx%psfc(start_idx:end_idx)))*100000) + 1
    960960       call init_rng(rngs, seed) 
    … …  
    964964       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    965965       ! Call SCOPS
    966        if (gbx%Ncolumns > 1) then
     966       if (gbx%Ncolumns .gt. 1) then
    967967          call scops(npoints,gbx%Nlevels,gbx%Ncolumns,rngs,                              &
    968968                     gbx%tca(start_idx:end_idx,gbx%Nlevels:1:-1),                        &
    … …  
    10181018                if (sgx%frac_out(start_idx+j-1,i,gbx%Nlevels+1-k) == I_CVC)              &
    10191019                     frac_cv(j,k) = frac_cv(j,k)+1._wp
    1020                 if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) == 1)               &
     1020                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 1)               &
    10211021                     prec_ls(j,k) = prec_ls(j,k)+1._wp
    1022                 if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) == 2)               &
     1022                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 2)               &
    10231023                     prec_cv(j,k) = prec_cv(j,k)+1._wp
    1024                 if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) == 3)               &
     1024                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 3)               &
    10251025                     prec_cv(j,k) = prec_cv(j,k)+1._wp
    1026                 if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) == 3)               &
     1026                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 3)               &
    10271027                     prec_ls(j,k) = prec_ls(j,k)+1._wp
    10281028             enddo
    … …  
    10991099          do j=1,npoints
    11001100             ! Clouds
    1101              if (frac_ls(j,k) /= 0.) then
     1101             if (frac_ls(j,k) .ne. 0.) then
    11021102                mr_hydro(j,:,k,I_LSCLIQ) = mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
    11031103                mr_hydro(j,:,k,I_LSCICE) = mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
    11041104             endif
    1105              if (frac_cv(j,k) /= 0.) then
     1105             if (frac_cv(j,k) .ne. 0.) then
    11061106                mr_hydro(j,:,k,I_CVCLIQ) = mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
    11071107                mr_hydro(j,:,k,I_CVCICE) = mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
    … …  
    11091109             ! Precipitation
    11101110             if (gbx%use_precipitation_fluxes) then
    1111                 if (prec_ls(j,k) /= 0.) then
     1111                if (prec_ls(j,k) .ne. 0.) then
    11121112                   gbx%rain_ls(start_idx+j-1,k) = gbx%rain_ls(start_idx+j-1,k)/prec_ls(j,k)
    11131113                   gbx%snow_ls(start_idx+j-1,k) = gbx%snow_ls(start_idx+j-1,k)/prec_ls(j,k)
    11141114                   gbx%grpl_ls(start_idx+j-1,k) = gbx%grpl_ls(start_idx+j-1,k)/prec_ls(j,k)
    11151115                endif
    1116                 if (prec_cv(j,k) /= 0.) then
     1116                if (prec_cv(j,k) .ne. 0.) then
    11171117                   gbx%rain_cv(start_idx+j-1,k) = gbx%rain_cv(start_idx+j-1,k)/prec_cv(j,k)
    11181118                   gbx%snow_cv(start_idx+j-1,k) = gbx%snow_cv(start_idx+j-1,k)/prec_cv(j,k)
    11191119                endif
    11201120             else
    1121                 if (prec_ls(j,k) /= 0.) then
     1121                if (prec_ls(j,k) .ne. 0.) then
    11221122                   mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
    11231123                   mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
    11241124                   mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
    11251125                endif
    1126                 if (prec_cv(j,k) /= 0.) then
     1126                if (prec_cv(j,k) .ne. 0.) then
    11271127                   mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
    11281128                   mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)
    … …  
    11901190       Reff(:,1,:,:)     = gbx%Reff(start_idx:end_idx,:,:)
    11911191       Np(:,1,:,:)       = gbx%Np(start_idx:end_idx,:,:)
    1192        where(gbx%dtau_s(start_idx:end_idx,:) > 0)
     1192       where(gbx%dtau_s(start_idx:end_idx,:) .gt. 0)
    11931193          sgx%frac_out(start_idx:end_idx,1,:) = 1
    11941194       endwhere
    … …  
    12391239       allocate(g_vol(nPoints,gbx%Nlevels))
    12401240       do ij=1,gbx%Ncolumns
    1241           if (ij == 1) then
     1241          if (ij .eq. 1) then
    12421242             cmpGases = .true.
    12431243             call quickbeam_optics(sd, rcfg_cloudsat,npoints,gbx%Nlevels, R_UNDEF,       &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_optics.F90

    r5087 r5095  
    7070    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    7171    do j=1,dim2
    72        where(flag(:,j,:) == 1)
     72       where(flag(:,j,:) .eq. 1)
    7373          varOUT(:,j,:) = varIN2
    7474       endwhere
    75        where(flag(:,j,:) == 2)
     75       where(flag(:,j,:) .eq. 2)
    7676          varOUT(:,j,:) = varIN1
    7777       endwhere
    … …  
    9494   
    9595    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    96    where(flag(:,:,:) == 1)
     96   where(flag(:,:,:) .eq. 1)
    9797       varOUT(:,:,:) = varIN2
    9898    endwhere
    99     where(flag(:,:,:) == 2)
     99    where(flag(:,:,:) .eq. 2)
    100100       varOUT(:,:,:) = varIN1
    101101    endwhere
    … …  
    295295    polpart(INDX_CVLIQ,1:5) = polpartCVLIQ
    296296    ! LS and CONV Ice water coefficients
    297     if (ice_type == 0) then
     297    if (ice_type .eq. 0) then
    298298       polpart(INDX_LSICE,1:5) = polpartLSICE0
    299299       polpart(INDX_CVICE,1:5) = polpartCVICE0
    300300    endif
    301     if (ice_type == 1) then
     301    if (ice_type .eq. 1) then
    302302       polpart(INDX_LSICE,1:5) = polpartLSICE1
    303303       polpart(INDX_CVICE,1:5) = polpartCVICE1
    … …  
    350350    ! Polynomials kp_lidar derived from Mie theory
    351351    do i = 1, npart
    352        where (rad_part(1:npoints,1:nlev,i) > 0.0)
     352       where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
    353353          kp_part(1:npoints,1:nlev,i) = &
    354354               polpart(i,1)*(rad_part(1:npoints,1:nlev,i)*1e6)**4 &
    … …  
    377377       ! Alpha of particles in each subcolumn:
    378378       do i = 1, npart
    379           where (rad_part(1:npoints,1:nlev,i) > 0.0)
     379          where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
    380380             alpha_part(1:npoints,icol,1:nlev,i) = 3._wp/4._wp * Qscat &
    381381                  * rhoair(1:npoints,1:nlev) * qpart(1:npoints,1:nlev,i) &
    … …  
    391391          ! Optical thickness of each layer (particles)
    392392          tau_part(1:npoints,icol,1:nlev,i) = tau_part(1:npoints,icol,1:nlev,i) &
    393    * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
     393               & * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
    394394          ! Optical thickness from TOA to layer k (particles)
    395395          do k=2,nlev

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90

    r5093 r5095  
    196196    do k=1,PARASOL_NREFL
    197197     do ip=1, Npoints
    198       if (stlidar%cldlayer(ip,4)>1.and.stlidar%parasolrefl(ip,k)/=missing_val) then
     198      if (stlidar%cldlayer(ip,4).gt.1.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
    199199        parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)/100.))/ &
    200200                             (stlidar%cldlayer(ip,4)/100.)
    … …  
    473473    CHARACTER(LEN=20) :: typeecrit
    474474
    475     ! ug On récupère le type écrit de la structure:
    476     !       Assez moche, à refaire si meilleure méthode...
     475    ! ug On récupère le type écrit de la structure:
     476    !       Assez moche, Ã|  refaire si meilleure méthode...
    477477    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
    478478       typeecrit = 'once'
    … …  
    540540
    541541! Axe vertical
    542       IF (nvertsave==nvertp(iff)) THEN
     542      IF (nvertsave.eq.nvertp(iff)) THEN
    543543          klevs=PARASOL_NREFL
    544544          nam_axvert="sza"
    545       ELSE IF (nvertsave==nvertisccp(iff)) THEN
     545      ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
    546546          klevs=7
    547547          nam_axvert="pressure2"
    548       ELSE IF (nvertsave==nvertcol(iff)) THEN
     548      ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
    549549          klevs=Ncolout
    550550          nam_axvert="column"
    551       ELSE IF (nvertsave==nverttemp(iff)) THEN
     551      ELSE IF (nvertsave.eq.nverttemp(iff)) THEN
    552552          klevs=LIDAR_NTEMP
    553553          nam_axvert="temp"
    554       ELSE IF (nvertsave==nvertmisr(iff)) THEN
     554      ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
    555555          klevs=numMISRHgtBins
    556556          nam_axvert="cth16"
    557       ELSE IF (nvertsave==nvertReffIce(iff)) THEN
     557      ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN
    558558          klevs= numMODISReffIceBins
    559559          nam_axvert="ReffIce"
    560       ELSE IF (nvertsave==nvertReffLiq(iff)) THEN
     560      ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN
    561561          klevs= numMODISReffLiqBins
    562562          nam_axvert="ReffLiq"
    … …  
    575575      END IF
    576576
    577     ! ug On récupère le type écrit de la structure:
    578     !       Assez moche, à refaire si meilleure méthode...
     577    ! ug On récupère le type écrit de la structure:
     578    !       Assez moche, Ã|  refaire si meilleure méthode...
    579579    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
    580580       typeecrit = 'once'
    … …  
    645645    IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
    646646
    647   ! On regarde si on est dans la phase de définition ou d'écriture:
     647  ! On regarde si on est dans la phase de définition ou d'écriture:
    648648  IF(.NOT.cosp_varsdefined) THEN
    649649!$OMP MASTER
    650       !Si phase de définition.... on définit
     650      !Si phase de définition.... on définit
    651651      CALL conf_cospoutputs(var%name,var%cles)
    652652      DO iff=1, 3
    … …  
    657657!$OMP END MASTER
    658658  ELSE
    659     !Et sinon on.... écrit
     659    !Et sinon on.... écrit
    660660    IF (SIZE(field)/=klon) &
    661661  CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
    … …  
    742742               nom=var%name
    743743      END IF
    744   ! On regarde si on est dans la phase de définition ou d'écriture:
     744  ! On regarde si on est dans la phase de définition ou d'écriture:
    745745  IF(.NOT.cosp_varsdefined) THEN
    746       !Si phase de définition.... on définit
     746      !Si phase de définition.... on définit
    747747!$OMP MASTER
    748748      CALL conf_cospoutputs(var%name,var%cles)
    … …  
    754754!$OMP END MASTER
    755755  ELSE
    756     !Et sinon on.... écrit
     756    !Et sinon on.... écrit
    757757    IF (SIZE(field,1)/=klon) &
    758758   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                 
    … …  
    826826
    827827  IF(cosp_varsdefined) THEN
    828     !Et sinon on.... écrit
     828    !Et sinon on.... écrit
    829829    IF (SIZE(field,1)/=klon) &
    830830   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)           

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_read_otputkeys.F90

    r5082 r5095  
    657657  if (Lproftemp)                cfg%out_list(i) = 'proftemp'         !TIBO
    658658   
    659   if (i>78) then
     659  if (i.gt.78) then
    660660     print *, 'COSP_IO: wrong number of output diagnostics'
    661661     print *, i,78

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_stats.F90

    r5082 r5095  
    203203          do j=1,Nlevels
    204204             sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
    205              if ((sc_ratio <= s_att) .and. (flag_sat == 0)) flag_sat = j
    206              if (Ze_tot(pr,i,j) < -30.) then  !radar can't detect cloud
    207                 if ( (sc_ratio > s_cld) .or. (flag_sat == j) ) then  !lidar sense cloud
     205             if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
     206             if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
     207                if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
    208208                   lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf
    209209                   flag_cld=1
    … …  
    213213             endif
    214214          enddo !levels
    215           if (flag_cld == 1) tcc(pr)=tcc(pr)+1._wp
     215          if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1._wp
    216216       enddo !columns
    217217    enddo !points
    … …  
    245245   
    246246    do ij=2,Nbins+1 
    247        hist1D(ij-1) = count(var >= bins(ij-1) .and. var < bins(ij))
    248        if (count(var == R_GROUND) >= 1) hist1D(ij-1)=R_UNDEF
     247       hist1D(ij-1) = count(var .ge. bins(ij-1) .and. var .lt. bins(ij))
     248       if (count(var .eq. R_GROUND) .ge. 1) hist1D(ij-1)=R_UNDEF
    249249    enddo
    250250   
    … …  
    278278    do ij=2,nbin1+1
    279279       do ik=2,nbin2+1
    280           jointHist(ij-1,ik-1)=count(var1 >= bin1(ij-1) .and. var1 < bin1(ij) .and. &
    281                var2 >= bin2(ik-1) .and. var2 < bin2(ik))
     280          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
     281               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       
    282282       enddo
    283283    enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/icarus.F90

    r5086 r5095  
    134134    ! ##########################################################################
    135135   
    136     if (debugcol/=0) then
     136    if (debugcol.ne.0) then
    137137       do j=1,npoints,debugcol
    138138         
    … …  
    140140          do ilev=1,nlev
    141141             acc(ilev,1:ncol)=frac_out(j,1:ncol,ilev)*2
    142              where(levmatch(j,1:ncol) == ilev) acc(ilev,1:ncol)=acc(ilev,1:ncol)+1
     142             where(levmatch(j,1:ncol) .eq. ilev) acc(ilev,1:ncol)=acc(ilev,1:ncol)+1
    143143          enddo
    144144         
    … …  
    155155                  (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev),&
    156156                  (cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    157           END DO
     157          end do
    158158          close(9)
    159159
    … …  
    224224
    225225    ! Set tropopause values
    226     if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     226    if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then
    227227       ptrop(1:npoints)     = 5000._wp
    228228       attropmin(1:npoints) = 400._wp
    … …  
    232232
    233233       do ilev=1,nlev
    234           where(pfull(1:npoints,ilev) < 40000. .and. &
    235                 pfull(1:npoints,ilev) >  5000. .and. &
    236                 at(1:npoints,ilev)    < attropmin(1:npoints))
     234          where(pfull(1:npoints,ilev) .lt. 40000. .and. &
     235                pfull(1:npoints,ilev) .gt.  5000. .and. &
     236                at(1:npoints,ilev)    .lt. attropmin(1:npoints))
    237237             ptrop(1:npoints)     = pfull(1:npoints,ilev)
    238238             attropmin(1:npoints) = at(1:npoints,ilev)
    … …  
    244244       do ilev=1,nlev
    245245          atmax(1:npoints) = merge(at(1:npoints,ilev),atmax(1:npoints),&
    246                at(1:npoints,ilev) > atmax(1:npoints) .and. ilev  >= itrop(1:npoints))
     246               at(1:npoints,ilev) .gt. atmax(1:npoints) .and. ilev  .ge. itrop(1:npoints))
    247247       enddo
    248248    end if
    249249 
    250     if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     250    if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then
    251251       ! ############################################################################
    252252       !                        Clear-sky radiance calculation
    … …  
    308308             dem(1:npoints,ibox) = merge(dem_wv(1:npoints,ilev), &
    309309                                         1._wp-(1._wp-demIN(1:npoints,ibox,ilev))*(1._wp-dem_wv(1:npoints,ilev)), &
    310                                          demIN(1:npoints,ibox,ilev) == 0)
     310                                         demIN(1:npoints,ibox,ilev) .eq. 0)
    311311
    312312             ! Increase TOA flux emitted from layer
    … …  
    322322       do ibox=1,ncol
    323323          fluxtop(1:npoints,ibox) = fluxtop(1:npoints,ibox) + emsfc_lw*bb(1:npoints)*trans_layers_above(1:npoints,ibox)
    324        END DO
     324       end do
    325325
    326326       ! All Sky brightness temperature
    … …  
    348348          tauir(1:npoints)    = tau(1:npoints,ibox)/2.13_wp
    349349          taumin(1:npoints)   = -log(max(min(transmax(1:npoints),0.9999999_wp),0.001_wp))
    350           if (isccp_top_height == 1) then
     350          if (isccp_top_height .eq. 1) then
    351351             do j=1,npoints 
    352                 if (transmax(j) > 0.001 .and.  transmax(j) <= 0.9999999) then
     352                if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
    353353                   fluxtopinit(j) = fluxtop(j,ibox)
    354354                   tauir(j) = tau(j,ibox)/2.13_wp
    … …  
    357357             do icycle=1,2
    358358                do j=1,npoints 
    359                    if (tau(j,ibox) > (tauchk)) then
    360                       if (transmax(j) > 0.001 .and.  transmax(j) <= 0.9999999) then
     359                   if (tau(j,ibox) .gt. (tauchk)) then
     360                      if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
    361361                         emcld(j,ibox) = 1._wp - exp(-1._wp * tauir(j)  )
    362362                         fluxtop(j,ibox) = fluxtopinit(j) - ((1.-emcld(j,ibox))*fluxtop_clrsky(j))
    363363                         fluxtop(j,ibox)=max(1.E-06_wp,(fluxtop(j,ibox)/emcld(j,ibox)))
    364364                         tb(j,ibox)= 1307.27_wp / (log(1._wp + (1._wp/fluxtop(j,ibox))))
    365                          if (tb(j,ibox) > 260.) then
     365                         if (tb(j,ibox) .gt. 260.) then
    366366                            tauir(j) = tau(j,ibox) / 2.56_wp
    367367                         end if
    … …  
    373373
    374374          ! Cloud-top temperature
    375           where(tau(1:npoints,ibox) > tauchk)
     375          where(tau(1:npoints,ibox) .gt. tauchk)
    376376             tb(1:npoints,ibox)= 1307.27_wp/ (log(1. + (1._wp/fluxtop(1:npoints,ibox))))
    377              where (isccp_top_height == 1 .and. tauir(1:npoints) < taumin(1:npoints))
     377             where (isccp_top_height .eq. 1 .and. tauir(1:npoints) .lt. taumin(1:npoints))
    378378                tb(1:npoints,ibox) = attrop(1:npoints) - 5._wp
    379379                tau(1:npoints,ibox) = 2.13_wp*taumin(1:npoints)
    … …  
    382382         
    383383          ! Clear-sky brightness temperature
    384           where(tau(1:npoints,ibox) <= tauchk)
     384          where(tau(1:npoints,ibox) .le. tauchk)
    385385             tb(1:npoints,ibox) = meantbclr(1:npoints)
    386386          endwhere
    … …  
    399399    do ibox=1,ncol
    400400       !segregate according to optical thickness
    401        if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     401       if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then 
    402402         
    403403          ! Find level whose temperature most closely matches brightness temperature
    404404          nmatch(1:npoints)=0
    405405          do k1=1,nlev-1
    406              ilev = merge(nlev-k1,k1,isccp_top_height_direction == 2)
     406             ilev = merge(nlev-k1,k1,isccp_top_height_direction .eq. 2)       
    407407             do j=1,npoints
    408                 if (ilev           >= itrop(j)     .and. &
    409                      ((at(j,ilev)  >= tb(j,ibox)   .and. &
    410                       at(j,ilev+1) <= tb(j,ibox))  .or.  &
    411                       (at(j,ilev)  <= tb(j,ibox)   .and. &
    412                       at(j,ilev+1) >= tb(j,ibox)))) then
     408                if (ilev           .ge. itrop(j)     .and. &
     409                     ((at(j,ilev)  .ge. tb(j,ibox)   .and. & 
     410                      at(j,ilev+1) .le. tb(j,ibox))  .or.  &
     411                      (at(j,ilev)  .le. tb(j,ibox)   .and. &
     412                      at(j,ilev+1) .ge. tb(j,ibox)))) then
    413413                   nmatch(j)=nmatch(j)+1
    414414                   match(j,nmatch(j))=ilev
    … …  
    418418
    419419          do j=1,npoints
    420              if (nmatch(j) >= 1) then
     420             if (nmatch(j) .ge. 1) then
    421421                k1 = match(j,nmatch(j))
    422422                k2 = k1 + 1
    … …  
    426426                logp=logp1+(logp2-logp1)*abs(tb(j,ibox)-at(j,k1))/atd
    427427                ptop(j,ibox) = exp(logp)
    428                 levmatch(j,ibox) = merge(k1,k2,abs(pfull(j,k1)-ptop(j,ibox)) < abs(pfull(j,k2)-ptop(j,ibox)))
     428                levmatch(j,ibox) = merge(k1,k2,abs(pfull(j,k1)-ptop(j,ibox)) .lt. abs(pfull(j,k2)-ptop(j,ibox)))
    429429             else
    430                 if (tb(j,ibox) <= attrop(j)) then
     430                if (tb(j,ibox) .le. attrop(j)) then
    431431                   ptop(j,ibox)=ptrop(j)
    432432                   levmatch(j,ibox)=itrop(j)
    433433                end if
    434                 if (tb(j,ibox) >= atmax(j)) then
     434                if (tb(j,ibox) .ge. atmax(j)) then
    435435                   ptop(j,ibox)=pfull(j,nlev)
    436436                   levmatch(j,ibox)=nlev
    … …  
    441441          ptop(1:npoints,ibox)=0.
    442442          do ilev=1,nlev
    443              where((ptop(1:npoints,ibox) == 0. ) .and.(frac_out(1:npoints,ibox,ilev) /= 0))
     443             where((ptop(1:npoints,ibox) .eq. 0. ) .and.(frac_out(1:npoints,ibox,ilev) .ne. 0))
    444444                ptop(1:npoints,ibox)=phalf(1:npoints,ilev)
    445445                levmatch(1:npoints,ibox)=ilev
    446446             endwhere
    447           END DO
     447          end do
    448448       end if
    449        where(tau(1:npoints,ibox) <= tauchk)
     449       where(tau(1:npoints,ibox) .le. tauchk)
    450450          ptop(1:npoints,ibox)=0._wp
    451451          levmatch(1:npoints,ibox)=0._wp
    … …  
    460460    do ibox=1,ncol
    461461       do j=1,npoints
    462           if (tau(j,ibox) > (tauchk) .and. ptop(j,ibox) > 0.) then
    463              if (sunlit(j)==1 .or. isccp_top_height == 3) then
     462          if (tau(j,ibox) .gt. (tauchk) .and. ptop(j,ibox) .gt. 0.) then
     463             if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
    464464                boxtau(j,ibox) = tau(j,ibox)
    465465                boxptop(j,ibox) = ptop(j,ibox)!/100._wp
    … …  
    508508    !                           Brightness Temperature
    509509    ! ####################################################################################
    510     if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     510    if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then
    511511       meantb(1:npoints)=sum(boxttop,2)/ncol
    512512    else
    … …  
    535535       do ilev2=1,7
    536536          do j=1,npoints !
    537              if (sunlit(j)==1 .or. isccp_top_height == 3) then
     537             if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
    538538                fq_isccp(j,ilev,ilev2)= 0.
    539539             else
    … …  
    546546   
    547547    ! Reset variables need for averaging cloud properties
    548     where(sunlit == 1 .or. isccp_top_height == 3)
     548    where(sunlit .eq. 1 .or. isccp_top_height .eq. 3)
    549549       totalcldarea(1:npoints)  = 0._wp
    550550       meanalbedocld(1:npoints) = 0._wp
    … …  
    561561    do j=1,npoints
    562562       ! Subcolumns that are cloudy(true) and not(false)
    563        box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) > tauchk .and. boxptop(j,1:ncol) > 0.)
     563       box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) .gt. tauchk .and. boxptop(j,1:ncol) .gt. 0.)
    564564
    565565       ! Compute joint histogram and column quantities for points that are sunlit and cloudy
    566        if (sunlit(j) ==1 .or. isccp_top_height == 3) then
     566       if (sunlit(j) .eq.1 .or. isccp_top_height .eq. 3) then
    567567          ! Joint-histogram
    568568          call hist2D(boxtau(j,1:ncol),boxptop(j,1:ncol),ncol,isccp_histTau,numISCCPTauBins, &
    … …  
    572572         
    573573          ! Column cloud area
    574           totalcldarea(j) = real(count(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) > isccp_taumin))/ncol
     574          totalcldarea(j) = real(count(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin))/ncol
    575575             
    576576          ! Subcolumn cloud albedo
    577577          !albedocld(j,1:ncol) = merge((boxtau(j,1:ncol)**0.895_wp)/((boxtau(j,1:ncol)**0.895_wp)+6.82_wp),&
    578578          !     0._wp,box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)
    579           where(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) > isccp_taumin)
     579          where(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)
    580580             albedocld(j,1:ncol) = (boxtau(j,1:ncol)**0.895_wp)/((boxtau(j,1:ncol)**0.895_wp)+6.82_wp)
    581581          elsewhere
    … …  
    587587         
    588588          ! Column cloud top pressure
    589           meanptop(j) = sum(boxptop(j,1:ncol),box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) > isccp_taumin)/ncol
     589          meanptop(j) = sum(boxptop(j,1:ncol),box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)/ncol
    590590       endif
    591591    enddo
    592592   
    593593    ! Compute mean cloud properties. Set to mssing value in the event that totalcldarea=0
    594     where(totalcldarea(1:npoints) > 0)
     594    where(totalcldarea(1:npoints) .gt. 0)
    595595       meanptop(1:npoints)      = 100._wp*meanptop(1:npoints)/totalcldarea(1:npoints)
    596596       meanalbedocld(1:npoints) = meanalbedocld(1:npoints)/totalcldarea(1:npoints)
    … …  
    609609
    610610    ! Represent in percent
    611     where(totalcldarea /= output_missing_value) totalcldarea = totalcldarea*100._wp
    612     where(fq_isccp     /= output_missing_value) fq_isccp     = fq_isccp*100._wp
     611    where(totalcldarea .ne. output_missing_value) totalcldarea = totalcldarea*100._wp
     612    where(fq_isccp     .ne. output_missing_value) fq_isccp     = fq_isccp*100._wp
    613613   
    614614   
    … …  
    634634    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    635635    do j=1,dim2
    636        where(flag(:,j,:) == 1)
     636       where(flag(:,j,:) .eq. 1)
    637637          varOUT(:,j,:) = varIN2
    638638       endwhere
    639        where(flag(:,j,:) == 2)
     639       where(flag(:,j,:) .eq. 2)
    640640          varOUT(:,j,:) = varIN1
    641641       endwhere

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/lidar_simulator.F90

    r5082 r5095  
    197197       ! Computation of the total perpendicular lidar signal (ATBperp for liq+ice)
    198198       ! Upper layer
    199        WHERE(tautot(1:npoints,icol,1) > 0)
     199       WHERE(tautot(1:npoints,icol,1) .gt. 0)
    200200          pnorm_perp_tot(1:npoints,icol,1) = (beta_perp_ice(1:npoints,icol,1)+           &
    201201               beta_perp_liq(1:npoints,icol,1)-                                          &
    … …  
    217217          ! Betaperp=beta_mol(:,k)/(1+1/0.0284)) [bodhaine et al. 1999] in the following
    218218          ! equations:
    219           WHERE (pnorm(1:npoints,icol,k) == 0)
     219          WHERE (pnorm(1:npoints,icol,k) .eq. 0)
    220220             pnorm_perp_tot(1:npoints,icol,k)=0._wp
    221221          ELSEWHERE
    222              where(tautot_lay(1:npoints) > 0.)
     222             where(tautot_lay(1:npoints) .gt. 0.)
    223223                pnorm_perp_tot(1:npoints,icol,k) = (beta_perp_ice(1:npoints,icol,k)+     &
    224224                   beta_perp_liq(1:npoints,icol,k)-(beta_mol(1:npoints,k)/(1._wp+1._wp/  &
    … …  
    318318       do ic = 1, ncol
    319319          pnorm_c = pnormFlip(:,ic,:)
    320           where ((pnorm_c < xmax) .and. (betamolFlip(:,1,:) < xmax) .and.          &
    321                 (betamolFlip(:,1,:) > 0.0 ))
     320          where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
     321                (betamolFlip(:,1,:) .gt. 0.0 ))
    322322             x3d_c = pnorm_c/betamolFlip(:,1,:)
    323323          elsewhere
    … …  
    333333       do ic = 1, ncol
    334334          pnorm_c = pnorm(:,ic,:)
    335           where ((pnorm_c<xmax) .and. (pmol<xmax) .and. (pmol> 0.0 ))
     335          where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
    336336             x3d_c = pnorm_c/pmol
    337337          elsewhere
    … …  
    354354          enddo
    355355       enddo
    356        where(cfad2 /= R_UNDEF) cfad2=cfad2/ncol
     356       where(cfad2 .ne. R_UNDEF) cfad2=cfad2/ncol
    357357
    358358    endif
    … …  
    389389    do k=2,nlev
    390390       tautot_lay(:) = tau(:,k)-tau(:,k-1)
    391        WHERE ( EXP(-2._wp*tau(:,k-1)) > 0. )
    392           WHERE (tautot_lay(:) > 0.)
     391       WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. 0. )
     392          WHERE (tautot_lay(:) .gt. 0.)
    393393             pnorm(:,k) = beta(:,k)*EXP(-2._wp*tau(:,k-1)) /&
    394394                  (2._wp*tautot_lay(:))*(1._wp-EXP(-2._wp*tautot_lay(:)))
    … …  
    418418    do k=2,nlev
    419419       tautot_lay(:) = tau(:,k)-tau(:,k-1)       
    420        WHERE ( EXP(-2._wp*tau(:,k-1)) > 0. )
    421           WHERE (tautot_lay(:) > 0.)
     420       WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. 0. )
     421          WHERE (tautot_lay(:) .gt. 0.)
    422422             beta(:,k) = pnorm(:,k)/ EXP(-2._wp*tau(:,k-1))* &
    423423                  (2._wp*tautot_lay(:))/(1._wp-exp(-2._wp*tautot_lay(:)))
    … …  
    539539    do k=1,Nlevels
    540540       ! Cloud detection at subgrid-scale:
    541        where ((x(:,:,k) > S_cld) .and. (x(:,:,k) /= undef) )
     541       where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    542542          cldy(:,:,k)=1._wp
    543543       elsewhere
    … …  
    546546       
    547547       ! Number of usefull sub-columns:
    548        where ((x(:,:,k) > S_att) .and. (x(:,:,k) /= undef) )
     548       where ((x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
    549549          srok(:,:,k)=1._wp
    550550       elsewhere
    … …  
    566566             ! Computation of the cloud fraction as a function of the temperature instead
    567567             ! of height, for ice,liquid and all clouds
    568              if(srok(ip,ic,k)>0.)then
     568             if(srok(ip,ic,k).gt.0.)then
    569569                do itemp=1,Ntemp
    570                    if( (tmp(ip,k)>=tempmod(itemp)).and.(tmp(ip,k)<tempmod(itemp+1)) )then
     570                   if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    571571                      lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1._wp
    572572                   endif
    … …  
    574574             endif
    575575             
    576              if(cldy(ip,ic,k)==1.)then
     576             if(cldy(ip,ic,k).eq.1.)then
    577577                do itemp=1,Ntemp
    578                    if( (tmp(ip,k) >= tempmod(itemp)).and.(tmp(ip,k) < tempmod(itemp+1)) )then
     578                   if( (tmp(ip,k) .ge. tempmod(itemp)).and.(tmp(ip,k) .lt. tempmod(itemp+1)) )then
    579579                      lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1._wp
    580580                   endif
    … …  
    584584             iz=1
    585585             p1 = pplay(ip,k)
    586              if ( p1>0. .and. p1<(440._wp*100._wp)) then ! high clouds
     586             if ( p1.gt.0. .and. p1.lt.(440._wp*100._wp)) then ! high clouds
    587587                iz=3
    588              else if(p1>=(440._wp*100._wp) .and. p1<(680._wp*100._wp)) then ! mid clouds
     588             else if(p1.ge.(440._wp*100._wp) .and. p1.lt.(680._wp*100._wp)) then ! mid clouds
    589589                iz=2
    590590             endif
    … …  
    603603   
    604604    ! Grid-box 3D cloud fraction
    605     where ( nsub(:,:)>0.0 )
     605    where ( nsub(:,:).gt.0.0 )
    606606       lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
    607607    elsewhere
    … …  
    618618       enddo
    619619    enddo
    620     where (nsublayer(:,:) > 0.0)
     620    where (nsublayer(:,:) .gt. 0.0)
    621621       cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
    622622    elsewhere
    … …  
    637637
    638638             ! Avoid zero values
    639              if( (cldy(i,ncol,nlev)==1.) .and. (ATBperp(i,ncol,nlev)>0.) )then
     639             if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
    640640                ! Computation of the ATBperp along the phase discrimination line
    641641                ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    645645                ! 4.1.a) Ice: ATBperp above the phase discrimination line
    646646                ! ########################################################################
    647                 if((ATBperp(i,ncol,nlev)-ATBperp_tmp) >= 0.)then ! Ice clouds
     647                if((ATBperp(i,ncol,nlev)-ATBperp_tmp) .ge. 0.)then ! Ice clouds
    648648
    649649                   ! ICE with temperature above 273,15°K = Liquid (false ice)
    650                    if(tmp(i,nlev) > 273.15) then ! Temperature above 273,15 K
     650                   if(tmp(i,nlev) .gt. 273.15) then ! Temperature above 273,15 K
    651651                     ! Liquid: False ice corrected by the temperature to Liquid
    652652                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp ! False ice detection ==> added to Liquid
    … …  
    656656                                                                              ! to classify the phase cloud
    657657                      cldlayphase(i,ncol,4,2) = 1. ! tot cloud
    658                       if (p1 > 0. .and. p1<(440._wp*100._wp)) then ! high cloud
     658                      if (p1 .gt. 0. .and. p1.lt.(440._wp*100._wp)) then ! high cloud
    659659                         cldlayphase(i,ncol,3,2) = 1._wp
    660                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then ! mid cloud
     660                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then ! mid cloud
    661661                         cldlayphase(i,ncol,2,2) = 1._wp
    662662                      else ! low cloud
    … …  
    665665                      cldlayphase(i,ncol,4,5) = 1._wp ! tot cloud
    666666                      ! High cloud
    667                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     667                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    668668                         cldlayphase(i,ncol,3,5) = 1._wp
    669669                      ! Middle cloud
    670                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     670                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    671671                         cldlayphase(i,ncol,2,5) = 1._wp
    672672                      ! Low cloud
    … …  
    680680                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    681681                      ! High cloud
    682                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     682                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    683683                         cldlayphase(i,ncol,3,1) = 1._wp
    684684                      ! Middle cloud   
    685                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     685                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    686686                         cldlayphase(i,ncol,2,1) = 1._wp
    687687                      ! Low cloud
    … …  
    695695                else
    696696                   ! Liquid with temperature above 231,15°K
    697                    if(tmp(i,nlev) > 231.15_wp) then
     697                   if(tmp(i,nlev) .gt. 231.15_wp) then
    698698                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp
    699699                      tmpl(i,ncol,nlev)       = tmp(i,nlev)
    700700                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    701701                      ! High cloud
    702                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     702                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    703703                         cldlayphase(i,ncol,3,2) = 1._wp
    704704                      ! Middle cloud   
    705                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     705                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    706706                         cldlayphase(i,ncol,2,2) = 1._wp
    707707                      ! Low cloud   
    … …  
    716716                      cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
    717717                      ! High cloud
    718                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     718                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    719719                         cldlayphase(i,ncol,3,4) = 1._wp
    720720                      ! Middle cloud   
    721                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     721                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    722722                         cldlayphase(i,ncol,2,4) = 1._wp
    723723                      ! Low cloud
    … …  
    727727                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    728728                      ! High cloud
    729                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     729                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    730730                         cldlayphase(i,ncol,3,1) = 1._wp
    731731                      ! Middle cloud   
    732                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     732                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    733733                         cldlayphase(i,ncol,2,1) = 1._wp
    734734                      ! Low cloud   
    … …  
    748748             p1 = pplay(i,nlev)
    749749
    750              if((cldy(i,ncol,nlev) == 1.) .and. (ATBperp(i,ncol,nlev) > 0.) )then
     750             if((cldy(i,ncol,nlev) .eq. 1.) .and. (ATBperp(i,ncol,nlev) .gt. 0.) )then
    751751                ! Computation of the ATBperp of the phase discrimination line
    752752                ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    757757                ! ########################################################################
    758758                ! ICE with temperature above 273,15°K = Liquid (false ice)
    759                 if((ATBperp(i,ncol,nlev)-ATBperp_tmp) >= 0.)then ! Ice clouds
    760                    if(tmp(i,nlev) > 273.15)then
     759                if((ATBperp(i,ncol,nlev)-ATBperp_tmp) .ge. 0.)then ! Ice clouds
     760                   if(tmp(i,nlev) .gt. 273.15)then
    761761                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp ! false ice ==> liq
    762762                      tmpl(i,ncol,nlev)       = tmp(i,nlev)
    … …  
    764764                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    765765                      ! High cloud
    766                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     766                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    767767                         cldlayphase(i,ncol,3,2) = 1._wp
    768768                      ! Middle cloud   
    769                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     769                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    770770                         cldlayphase(i,ncol,2,2) = 1._wp
    771771                      ! Low cloud
    … …  
    776776                      cldlayphase(i,ncol,4,5) = 1. ! tot cloud
    777777                      ! High cloud
    778                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     778                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    779779                         cldlayphase(i,ncol,3,5) = 1._wp
    780780                      ! Middle cloud   
    781                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     781                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    782782                         cldlayphase(i,ncol,2,5) = 1._wp
    783783                      ! Low cloud   
    … …  
    791791                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    792792                      ! High cloud
    793                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     793                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    794794                         cldlayphase(i,ncol,3,1) = 1._wp
    795795                      ! Middle cloud   
    796                       else if(p1 >= (440._wp*100._wp) .and. p1 <(680._wp*100._wp)) then
     796                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt.(680._wp*100._wp)) then
    797797                         cldlayphase(i,ncol,2,1) = 1._wp
    798798                      ! Low cloud   
    … …  
    807807                else
    808808                   ! Liquid with temperature above 231,15°K
    809                    if(tmp(i,nlev) > 231.15)then
     809                   if(tmp(i,nlev) .gt. 231.15)then
    810810                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp
    811811                      tmpl(i,ncol,nlev)       = tmp(i,nlev)
    812812                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    813813                      ! High cloud
    814                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     814                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    815815                         cldlayphase(i,ncol,3,2) = 1._wp
    816816                      ! Middle cloud   
    817                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     817                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    818818                         cldlayphase(i,ncol,2,2) = 1._wp
    819819                      ! Low cloud   
    … …  
    828828                      cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
    829829                      ! High cloud
    830                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     830                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    831831                         cldlayphase(i,ncol,3,4) = 1._wp
    832832                      ! Middle   
    833                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     833                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    834834                         cldlayphase(i,ncol,2,4) = 1._wp
    835835                      ! Low cloud   
    … …  
    840840                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    841841                      ! High cloud
    842                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     842                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    843843                         cldlayphase(i,ncol,3,1) = 1._wp
    844844                      ! Middle cloud   
    845                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     845                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    846846                         cldlayphase(i,ncol,2,1) = 1._wp
    847847                      ! Low cloud   
    … …  
    855855               
    856856                ! Find the level of the highest cloud with SR>30
    857                 if(x(i,ncol,nlev) > S_cld_att) then ! SR > 30.
     857                if(x(i,ncol,nlev) .gt. S_cld_att) then ! SR > 30.
    858858                    toplvlsat = nlev+1
    859859                    goto 99
    … …  
    867867          ! see Cesana and Chepfer 2013 Sect.III.2
    868868          ! ##############################################################################
    869           if(toplvlsat/=0) then
     869          if(toplvlsat.ne.0) then
    870870             do nlev = toplvlsat,Nlevels
    871871                p1 = pplay(i,nlev)
    872                 if(cldy(i,ncol,nlev)==1.)then
     872                if(cldy(i,ncol,nlev).eq.1.)then
    873873                   lidarcldphase(i,nlev,3) = lidarcldphase(i,nlev,3)+1._wp
    874874                   tmpu(i,ncol,nlev)       = tmp(i,nlev)
    875875                   cldlayphase(i,ncol,4,3) = 1._wp ! tot cloud
    876876                   ! High cloud
    877                    if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     877                   if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    878878                      cldlayphase(i,ncol,3,3) = 1._wp
    879879                   ! Middle cloud   
    880                    else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     880                   else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    881881                      cldlayphase(i,ncol,2,3) = 1._wp
    882882                   ! Low cloud   
    … …  
    897897    ! Compute the Ice percentage in cloud = ice/(ice+liq) as a function of the occurrences
    898898    lidarcldphasetmp(:,:) = lidarcldphase(:,:,1)+lidarcldphase(:,:,2);
    899     WHERE (lidarcldphasetmp(:,:) > 0.)
     899    WHERE (lidarcldphasetmp(:,:) .gt. 0.)
    900900       lidarcldphase(:,:,6)=lidarcldphase(:,:,1)/lidarcldphasetmp(:,:)
    901901    ELSEWHERE
    … …  
    905905    ! Compute Phase 3D Cloud Fraction
    906906    !WHERE (nsub(:,Nlevels:1:-1) .gt. 0.0 )
    907     WHERE (nsub(:,:) > 0.0 )
     907    WHERE (nsub(:,:) .gt. 0.0 ) 
    908908       lidarcldphase(:,:,1)=lidarcldphase(:,:,1)/nsub(:,:)
    909909       lidarcldphase(:,:,2)=lidarcldphase(:,:,2)/nsub(:,:)
    … …  
    938938    ! Compute the Ice percentage in cloud = ice/(ice+liq)
    939939    cldlayerphasetmp(:,:)=cldlayerphase(:,:,1)+cldlayerphase(:,:,2)
    940     WHERE (cldlayerphasetmp(:,:)> 0.)
     940    WHERE (cldlayerphasetmp(:,:).gt. 0.)
    941941       cldlayerphase(:,:,6)=cldlayerphase(:,:,1)/cldlayerphasetmp(:,:)
    942942    ELSEWHERE
    … …  
    945945   
    946946    do i=1,Nphase-1
    947        WHERE ( cldlayerphasesum(:,:)>0.0 )
     947       WHERE ( cldlayerphasesum(:,:).gt.0.0 )
    948948          cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
    949949       ENDWHERE
    … …  
    954954          checkcldlayerphase=0.
    955955          checkcldlayerphase2=0.
    956           if (cldlayerphasesum(i,iz) > 0.0 )then
     956          if (cldlayerphasesum(i,iz) .gt. 0.0 )then
    957957             do ic=1,Nphase-3
    958958                checkcldlayerphase = checkcldlayerphase+cldlayerphase(i,iz,ic)
    959959             enddo
    960960             checkcldlayerphase2 = cldlayer(i,iz)-checkcldlayerphase
    961              if((checkcldlayerphase2 > 0.01) .or. (checkcldlayerphase2 < -0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
     961             if((checkcldlayerphase2 .gt. 0.01) .or. (checkcldlayerphase2 .lt. -0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
    962962          endif
    963963       enddo
    … …  
    965965   
    966966    do i=1,Nphase-1
    967        WHERE (nsublayer(:,:) == 0.0)
     967       WHERE (nsublayer(:,:) .eq. 0.0)
    968968          cldlayerphase(:,:,i) = undef
    969969       ENDWHERE
    … …  
    975975          do i=1,Npoints
    976976             do itemp=1,Ntemp
    977                 if(tmpi(i,ncol,nlev)>0.)then
    978                    if((tmpi(i,ncol,nlev) >= tempmod(itemp)) .and. (tmpi(i,ncol,nlev) < tempmod(itemp+1)) )then
     977                if(tmpi(i,ncol,nlev).gt.0.)then
     978                   if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    979979                      lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1._wp
    980980                   endif
    981                 elseif(tmpl(i,ncol,nlev) > 0.)then
    982                    if((tmpl(i,ncol,nlev) >= tempmod(itemp)) .and. (tmpl(i,ncol,nlev) < tempmod(itemp+1)) )then
     981                elseif(tmpl(i,ncol,nlev) .gt. 0.)then
     982                   if((tmpl(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpl(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    983983                      lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1._wp
    984984                   endif
    985                 elseif(tmpu(i,ncol,nlev) > 0.)then
    986                    if((tmpu(i,ncol,nlev) >= tempmod(itemp)) .and. (tmpu(i,ncol,nlev) < tempmod(itemp+1)) )then
     985                elseif(tmpu(i,ncol,nlev) .gt. 0.)then
     986                   if((tmpu(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpu(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    987987                      lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1._wp
    988988                   endif
    … …  
    10071007    ! Compute the Ice percentage in cloud = ice/(ice+liq)
    10081008    sumlidarcldtemp(:,:)=lidarcldtemp(:,:,2)+lidarcldtemp(:,:,3)   
    1009     WHERE(sumlidarcldtemp(:,:) > 0.)
     1009    WHERE(sumlidarcldtemp(:,:) .gt. 0.)
    10101010       lidarcldtemp(:,:,5)=lidarcldtemp(:,:,2)/sumlidarcldtemp(:,:)
    10111011    ELSEWHERE
    … …  
    10141014   
    10151015    do i=1,4
    1016        WHERE(lidarcldtempind(:,:) > 0.)
     1016       WHERE(lidarcldtempind(:,:) .gt. 0.)
    10171017          lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
    10181018       ELSEWHERE

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/math_lib.F90

    r5086 r5095  
    209209          exit
    210210       end if
    211     END DO
     211    end do
    212212   
    213213    if (lerror) then
    … …  
    244244       end if
    245245       ilo = ilo + 1
    246     END DO
     246    end do
    247247   
    248248    ilo = max ( 2, ilo )
    … …  
    254254       end if
    255255       ihi = ihi - 1
    256     END DO
     256    end do
    257257   
    258258    ihi = min ( ihi, ntab - 1 )
    … …  
    305305       syl = x2
    306306       
    307     END DO
     307    end do
    308308
    309309    result = sum1 + ca * ( b**3 - syl**3 ) / 3._wp &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/mo_rng.F90

    r5082 r5095  
    9696    !          so we use sizeof(someInt) to determine wheter it is on 32 bit.
    9797    !if ( i2_16*i2_16 .le. huge32 ) then
    98     if (digits(testInt) <= 31) then
     98    if (digits(testInt) .le. 31) then
    9999    !if (sizeof(testInt) .eq. 4) then
    100100       r=r+1

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/modis_simulator.F90

    r5086 r5095  
    222222          retrievedTau(i)              = R_UNDEF
    223223       end if
    224     END DO
     224    end do
    225225    where((retrievedSize(1:nSubCols) < 0.).and.(retrievedSize(1:nSubCols) /= R_UNDEF)) &
    226226         retrievedSize(1:nSubCols) = 1.0e-06_wp*re_fill
    … …  
    455455      end if
    456456      if(totalTau >= tauLimit) exit
    457     END DO
     457    end do
    458458
    459459    if (totalTau > 0._wp) then
    … …  
    489489      end if
    490490      if(totalTau >= tauLimit) exit
    491     END DO
     491    end do
    492492
    493493    if (totalTau > 0._wp) then
    … …  
    715715    do i = 1, size(cloudIndicies)
    716716       call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    717     END DO
     717    end do
    718718   
    719719    call adding_doubling(count(tau(1:nLevels) > 0),Refl(:), Trans(:), Refl_tot, Trans_tot) 
    … …  
    897897       Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1._wp - Refl_cumulative(i-1) * Refl(i))
    898898       Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1._wp - Refl_cumulative(i-1) * Refl(i))
    899     END DO
     899    end do
    900900   
    901901    Refl_tot = Refl_cumulative(size(Refl))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/mrgrnk.F90

    r5081 r5095  
    6868       IRNGT (1) = 1
    6969       Return
     70    Case Default
     71       Continue
    7072    End Select
    7173    !
    … …  
    266268       IRNGT (1) = 1
    267269       Return
     270    Case Default
     271       Continue
    268272    End Select
    269273    !
    … …  
    463467       IRNGT (1) = 1
    464468       Return
     469    Case Default
     470       Continue
    465471    End Select
    466472    !

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/optics_lib.F90

    r5086 r5095  
    539539    if (alam < cutice) then
    540540       ! Region from 0.045 microns to 167.0 microns - no temperature depend
     541       do i=2,nwl
     542          if(alam < wl(i)) continue
     543       enddo
    541544       x1  = log(wl(i-1))
    542545       x2  = log(wl(i))
    … …  
    555558       if(tk < temref(4)) tk=temref(4)
    556559       do i=2,4
    557           if(tk>=temref(i)) go to 12
     560          if(tk.ge.temref(i)) go to 12
    558561       enddo
    55956212     lt1 = i
    560563       lt2 = i-1
    561564       do i=2,nwlt
    562           if(alam<=wlt(i)) go to 14
     565          if(alam.le.wlt(i)) go to 14
    563566       enddo
    56456714     x1  = log(wlt(i-1))
    … …  
    649652    Complex(wp) :: A1
    650653   
    651     If ((Dx>Imaxx) .Or. (InP>ImaxNP)) Then
     654    If ((Dx.Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then
    652655       Error = 1
    653656       Return
    … …  
    656659    Ir = 1 / Cm
    657660    Y =  Dx * Cm
    658     If (Dx<0.02) Then
     661    If (Dx.Lt.0.02) Then
    659662       NStop = 2
    660663    Else
    661        If (Dx<=8.0) Then
     664       If (Dx.Le.8.0) Then
    662665          NStop = Dx + 4.00*Dx**(1./3.) + 2.0
    663666       Else
    664           If (Dx< 4200.0) Then
     667          If (Dx.Lt. 4200.0) Then
    665668             NStop = Dx + 4.05*Dx**(1./3.) + 2.0
    666669          Else
    … …  
    670673    End If
    671674    NmX = Max(Real(NStop),Real(Abs(Y))) + 15.
    672     If (Nmx > Itermax) then
     675    If (Nmx .gt. Itermax) then
    673676       Error = 1
    674677       Return
    … …  
    723726!ds       Dqxt = Tnp1 *      Dble(A + B)          + Dqxt
    724727       Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc
    725        If (N>1) then
     728       If (N.Gt.1) then
    726729          Dg = Dg + (dN*dN - 1) * (ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 *(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    727730!ds          Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    … …  
    732735       AMB = A2 * (A - B)
    733736       Do I = 1,Inp2
    734           If (I>Inp) Then
     737          If (I.GT.Inp) Then
    735738             S(I) = -Pi1(I)
    736739          Else
    … …  
    753756    End Do
    754757
    755     If (Dg >0) Dg = 2 * Dg / Dqsc
     758    If (Dg .GT.0) Dg = 2 * Dg / Dqsc
    756759    Dqsc =  2 * Dqsc / Dx**2
    757760    Dqxt =  2 * Dqxt / Dx**2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/parasol.F90

    r5093 r5095  
    8181    ! Lum_norm=f(PARASOL_SZA,tau_cloud) derived from adding-doubling calculations
    8282    !        valid ONLY ABOVE OCEAN (albedo_sfce=5%)
    83     !        valid only in one viewing direction (theta_v=30°, phi_s-phi_v=320°)
     83    !        valid only in one viewing direction (theta_v=30�, phi_s-phi_v=320�)
    8484    !        based on adding-doubling radiative transfer computation
    8585    !        for PARASOL_TAU values (0 to 100) and for PARASOL_SZA values (0 to 80)
    … …  
    9797
    9898    ! Relative fraction of the opt. thick due to liquid or ice clouds
    99     WHERE (tautot_S(1:npoints) > 0.)
     99    WHERE (tautot_S(1:npoints) .gt. 0.)
    100100       frac_taucol_liq(1:npoints) = tautot_S_liq(1:npoints) / tautot_S(1:npoints)
    101101       frac_taucol_ice(1:npoints) = tautot_S_ice(1:npoints) / tautot_S(1:npoints)
    … …  
    118118    DO it=1,PARASOL_NREFL
    119119       DO ny=1,PARASOL_NTAU-1
    120           WHERE (tautot_S(1:npoints) >= PARASOL_TAU(ny).and. &
    121                  tautot_S(1:npoints) <= PARASOL_TAU(ny+1))
     120          WHERE (tautot_S(1:npoints) .ge. PARASOL_TAU(ny).and. &
     121                 tautot_S(1:npoints) .le. PARASOL_TAU(ny+1))
    122122             rlumA_mod(1:npoints,it) = aA(it,ny)*tautot_S(1:npoints) + bA(it,ny)
    123123             rlumB_mod(1:npoints,it) = aB(it,ny)*tautot_S(1:npoints) + bB(it,ny)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/phys_cosp2.F90

    r5082 r5095  
    257257          cfg%Lrttov_sim,cfg%Lstats
    258258
    259     if (overlaplmdz/=overlap) then
     259    if (overlaplmdz.ne.overlap) then
    260260       print*,'Attention overlaplmdz different de overlap lu dans namelist '
    261261    endif
    … …  
    265265
    266266!!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
    267   if ((itap>1).and.(first_write))then
     267  if ((itap.gt.1).and.(first_write))then
    268268   
    269269    IF (using_xios)   call read_xiosfieldactive(cfg)
    … …  
    331331
    332332        do ip = 1, Npoints
    333           if (fracTerLic(ip)>=0.5) then
     333          if (fracTerLic(ip).ge.0.5) then
    334334             gbx%land(ip) = 1.
    335335          else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/prec_scops.F90

    r5082 r5095  
    6464
    6565      cv_col = scops_ccfrac*ncol
    66       if (cv_col == 0) cv_col=1
     66      if (cv_col .eq. 0) cv_col=1
    6767 
    6868      do ilev=1,nlev
    … …  
    8181        flag_cv=0
    8282        do ilev=1,nlev
    83           if (frac_out(j,ibox,ilev) == 1) then
     83          if (frac_out(j,ibox,ilev) .eq. 1) then
    8484            flag_ls=1
    8585          endif
    86           if (frac_out(j,ibox,ilev) == 2) then
     86          if (frac_out(j,ibox,ilev) .eq. 2) then
    8787            flag_cv=1
    8888          endif
    8989        enddo !loop over nlev
    90         if (flag_ls == 1) then
     90        if (flag_ls .eq. 1) then
    9191           frac_out_ls(j,ibox)=1
    9292        endif
    93         if (flag_cv == 1) then
     93        if (flag_cv .eq. 1) then
    9494           frac_out_cv(j,ibox)=1
    9595        endif
    … …  
    102102        flag_cv=0
    103103   
    104         if (ls_p_rate(j,1) > 0.) then
     104        if (ls_p_rate(j,1) .gt. 0.) then
    105105            do ibox=1,ncol ! possibility ONE
    106                 if (frac_out(j,ibox,1) == 1) then
     106                if (frac_out(j,ibox,1) .eq. 1) then
    107107                    prec_frac(j,ibox,1) = 1
    108108                    flag_ls=1
    109109                endif
    110110            enddo ! loop over ncol
    111             if (flag_ls == 0) then ! possibility THREE
     111            if (flag_ls .eq. 0) then ! possibility THREE
    112112                do ibox=1,ncol
    113                     if (frac_out(j,ibox,2) == 1) then
     113                    if (frac_out(j,ibox,2) .eq. 1) then
    114114                        prec_frac(j,ibox,1) = 1
    115115                        flag_ls=1
    … …  
    117117                enddo ! loop over ncol
    118118            endif
    119         if (flag_ls == 0) then ! possibility Four
    120         do ibox=1,ncol
    121         if (frac_out_ls(j,ibox) == 1) then
     119        if (flag_ls .eq. 0) then ! possibility Four
     120        do ibox=1,ncol
     121        if (frac_out_ls(j,ibox) .eq. 1) then
    122122            prec_frac(j,ibox,1) = 1
    123123            flag_ls=1
    … …  
    125125        enddo ! loop over ncol
    126126        endif
    127         if (flag_ls == 0) then ! possibility Five
     127        if (flag_ls .eq. 0) then ! possibility Five
    128128        do ibox=1,ncol
    129129    !     prec_frac(j,1:ncol,1) = 1
    … …  
    134134       ! There is large scale precipitation
    135135     
    136         if (cv_p_rate(j,1) > 0.) then
     136        if (cv_p_rate(j,1) .gt. 0.) then
    137137         do ibox=1,ncol ! possibility ONE
    138           if (frac_out(j,ibox,1) == 2) then
    139            if (prec_frac(j,ibox,1) == 0) then
     138          if (frac_out(j,ibox,1) .eq. 2) then
     139           if (prec_frac(j,ibox,1) .eq. 0) then
    140140        prec_frac(j,ibox,1) = 2
    141141       else
    … …  
    145145      endif
    146146        enddo ! loop over ncol
    147         if (flag_cv == 0) then ! possibility THREE
    148         do ibox=1,ncol
    149         if (frac_out(j,ibox,2) == 2) then
    150                 if (prec_frac(j,ibox,1) == 0) then
     147        if (flag_cv .eq. 0) then ! possibility THREE
     148        do ibox=1,ncol
     149        if (frac_out(j,ibox,2) .eq. 2) then
     150                if (prec_frac(j,ibox,1) .eq. 0) then
    151151            prec_frac(j,ibox,1) = 2
    152152            else
    … …  
    157157        enddo ! loop over ncol
    158158        endif
    159         if (flag_cv == 0) then ! possibility Four
    160         do ibox=1,ncol
    161         if (frac_out_cv(j,ibox) == 1) then
    162                 if (prec_frac(j,ibox,1) == 0) then
     159        if (flag_cv .eq. 0) then ! possibility Four
     160        do ibox=1,ncol
     161        if (frac_out_cv(j,ibox) .eq. 1) then
     162                if (prec_frac(j,ibox,1) .eq. 0) then
    163163            prec_frac(j,ibox,1) = 2
    164164            else
    … …  
    169169        enddo ! loop over ncol
    170170        endif
    171         if (flag_cv == 0) then  ! possibility Five
     171        if (flag_cv .eq. 0) then  ! possibility Five
    172172        do ibox=1,cv_col
    173                 if (prec_frac(j,ibox,1) == 0) then
     173                if (prec_frac(j,ibox,1) .eq. 0) then
    174174            prec_frac(j,ibox,1) = 2
    175175            else
    … …  
    192192        flag_cv=0
    193193   
    194         if (ls_p_rate(j,ilev) > 0.) then
     194        if (ls_p_rate(j,ilev) .gt. 0.) then
    195195         do ibox=1,ncol ! possibility ONE&TWO
    196           if ((frac_out(j,ibox,ilev) == 1) .or. ((prec_frac(j,ibox,ilev-1) == 1)     &
    197             .or. (prec_frac(j,ibox,ilev-1) == 3))) then
     196          if ((frac_out(j,ibox,ilev) .eq. 1) .or. ((prec_frac(j,ibox,ilev-1) .eq. 1)     &
     197            .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
    198198           prec_frac(j,ibox,ilev) = 1
    199199           flag_ls=1
    200200          endif
    201201        enddo ! loop over ncol
    202         if ((flag_ls == 0) .and. (ilev < nlev)) then ! possibility THREE
    203         do ibox=1,ncol
    204         if (frac_out(j,ibox,ilev+1) == 1) then
     202        if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     203        do ibox=1,ncol
     204        if (frac_out(j,ibox,ilev+1) .eq. 1) then
    205205            prec_frac(j,ibox,ilev) = 1
    206206            flag_ls=1
    … …  
    208208        enddo ! loop over ncol
    209209        endif
    210         if (flag_ls == 0) then ! possibility Four
    211         do ibox=1,ncol
    212         if (frac_out_ls(j,ibox) == 1) then
     210        if (flag_ls .eq. 0) then ! possibility Four
     211        do ibox=1,ncol
     212        if (frac_out_ls(j,ibox) .eq. 1) then
    213213            prec_frac(j,ibox,ilev) = 1
    214214            flag_ls=1
    … …  
    216216        enddo ! loop over ncol
    217217        endif
    218         if (flag_ls == 0) then ! possibility Five
     218        if (flag_ls .eq. 0) then ! possibility Five
    219219        do ibox=1,ncol
    220220!     prec_frac(j,1:ncol,ilev) = 1
    … …  
    224224      endif ! There is large scale precipitation
    225225   
    226         if (cv_p_rate(j,ilev) > 0.) then
     226        if (cv_p_rate(j,ilev) .gt. 0.) then
    227227         do ibox=1,ncol ! possibility ONE&TWO
    228           if ((frac_out(j,ibox,ilev) == 2) .or. ((prec_frac(j,ibox,ilev-1) == 2)     &
    229             .or. (prec_frac(j,ibox,ilev-1) == 3))) then
    230             if (prec_frac(j,ibox,ilev) == 0) then
     228          if ((frac_out(j,ibox,ilev) .eq. 2) .or. ((prec_frac(j,ibox,ilev-1) .eq. 2)     &
     229            .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
     230            if (prec_frac(j,ibox,ilev) .eq. 0) then
    231231         prec_frac(j,ibox,ilev) = 2
    232232        else
    … …  
    236236        endif
    237237       enddo ! loop over ncol
    238         if ((flag_cv == 0) .and. (ilev < nlev)) then ! possibility THREE
    239         do ibox=1,ncol
    240         if (frac_out(j,ibox,ilev+1) == 2) then
    241                 if (prec_frac(j,ibox,ilev) == 0) then
     238        if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     239        do ibox=1,ncol
     240        if (frac_out(j,ibox,ilev+1) .eq. 2) then
     241                if (prec_frac(j,ibox,ilev) .eq. 0) then
    242242            prec_frac(j,ibox,ilev) = 2
    243243            else
    … …  
    248248        enddo ! loop over ncol
    249249        endif
    250         if (flag_cv == 0) then ! possibility Four
    251         do ibox=1,ncol
    252         if (frac_out_cv(j,ibox) == 1) then
    253                 if (prec_frac(j,ibox,ilev) == 0) then
     250        if (flag_cv .eq. 0) then ! possibility Four
     251        do ibox=1,ncol
     252        if (frac_out_cv(j,ibox) .eq. 1) then
     253                if (prec_frac(j,ibox,ilev) .eq. 0) then
    254254            prec_frac(j,ibox,ilev) = 2
    255255            else
    … …  
    260260        enddo ! loop over ncol
    261261        endif
    262         if (flag_cv == 0) then  ! possibility Five
     262        if (flag_cv .eq. 0) then  ! possibility Five
    263263        do ibox=1,cv_col
    264                 if (prec_frac(j,ibox,ilev) == 0) then
     264                if (prec_frac(j,ibox,ilev) .eq. 0) then
    265265            prec_frac(j,ibox,ilev) = 2
    266266            else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam.F90

    r5082 r5095  
    182182         
    183183          ! Attenuation due to gaseous absorption between radar and volume
    184           if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr == 1)) then
     184          if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr .eq. 1)) then
    185185             if (d_gate==1) then
    186186                if (k>1) then
    … …  
    270270          enddo
    271271       enddo
    272        where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns
     272       where(cfad_ze .ne. R_UNDEF) cfad_ze = cfad_ze/Ncolumns
    273273
    274274    else
    … …  
    279279          enddo
    280280       enddo
    281        where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns
     281       where(cfad_ze .ne. R_UNDEF) cfad_ze = cfad_ze/Ncolumns
    282282    endif   
    283283

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam_optics.F90

    r5086 r5095  
    160160          ! Gas attenuation (only need to do this for the first subcolumn (i.e. cmpGases=true)
    161161          if (cmpGases) then
    162              if (rcfg%use_gas_abs == 1 .or. (rcfg%use_gas_abs == 2 .and. pr == 1)) then
     162             if (rcfg%use_gas_abs == 1 .or. (rcfg%use_gas_abs == 2 .and. pr .eq. 1)) then
    163163                g_vol(pr,k) = gases(p_matrix(pr,k),t_matrix(pr,k),sh_matrix(pr,k),rcfg%freq)
    164164             endif
    … …  
    195195               
    196196                ! Compute effective radius from number concentration and distribution parameters
    197                 if (Re_internal == 0) then
     197                if (Re_internal .eq. 0) then
    198198                   call calc_Re(hm_matrix(pr,k,tp),Np_matrix(pr,k,tp),rho_a, &
    199199                        sd%dtype(tp),sd%apm(tp),sd%bpm(tp),sd%rho(tp),sd%p1(tp),sd%p2(tp),sd%p3(tp),Re)
    … …  
    210210                ! Index into particle size dimension of scaling tables
    211211                iRe_type=1
    212                 if(Re>0) then
     212                if(Re.gt.0) then
    213213                   ! Determine index in to scale LUT
    214214                   ! Distance between Re points (defined by "base" and "step") for
    … …  
    220220                   base = rcfg%base_list(n+1)
    221221                   iRe_type=Re/step
    222                    if (iRe_type<1) iRe_type=1
     222                   if (iRe_type.lt.1) iRe_type=1
    223223                   Re=step*(iRe_type+0.5_wp)    ! set value of Re to closest value allowed in LUT.
    224224                   iRe_type=iRe_type+base-int(n*Re_BIN_LENGTH/step)
    225225                   
    226226                   ! Make sure iRe_type is within bounds
    227                    if (iRe_type>=nRe_types) then
     227                   if (iRe_type.ge.nRe_types) then
    228228                      !write(*,*) 'Warning: size of Re exceed value permitted ', &
    229229                      !            'in Look-Up Table (LUT).  Will calculate. '
    … …  
    431431    ! Exponential is same as modified gamma with vu =1
    432432    ! if Np is specified then we will just treat as modified gamma
    433     if(dtype == 2 .and. Np > 0) then
     433    if(dtype .eq. 2 .and. Np .gt. 0) then
    434434       local_dtype = 1
    435435       local_p3    = 1
    … …  
    467467       endif
    468468       
    469        if( Np==0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
     469       if( Np.eq.0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default 
    470470          dm = p2             ! by definition, should have units of microns
    471471          D0 = gamma(vu)/gamma(vu+1)*dm
    472472       else   ! use value of Np
    473           if(Np==0) then
     473          if(Np.eq.0) then
    474474             if( abs(p1+1) > 1E-8 ) then  !   use default number concentration   
    475475                local_Np = p1 ! total number concentration / pa --- units kg^-1
    … …  
    551551       
    552552       ! get rg ...
    553        if( Np==0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
     553       if( Np.eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
    554554          rg = p2     
    555555       else
    … …  
    852852          log_sigma_g = p3
    853853          tmp2 = (bpm*log_sigma_g)*(bpm*log_sigma_g)
    854           if(Re<=0) then
     854          if(Re.le.0) then
    855855             rg = p2
    856856          else
    … …  
    10091009          call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    10101010               dg, xs1, xs2, dph, err)
    1011        END DO
     1011       end do
    10121012
    10131013    else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/scops.F90

    r5082 r5095  
    7575
    7676    ! Test for valid input overlap assumption
    77     if (overlap /= 1 .and. overlap /= 2 .and. overlap /= 3) then
     77    if (overlap .ne. 1 .and. overlap .ne. 2 .and. overlap .ne. 3) then
    7878       overlap=default_overlap
    7979       call errorMessage('ERROR(scops): Invalid overlap assumption provided. Using default overlap assumption (max/ran)')
    … …  
    9292    tca(1:npoints,1:nlev) = cc(1:npoints,1:nlev)
    9393   
    94     if (ncolprint/=0) then
     94    if (ncolprint.ne.0) then
    9595       write (6,'(a)') 'frac_out_pp_rev:'
    9696       do j=1,npoints,1000
    … …  
    102102       write (6,'(I3)') ncol
    103103    endif
    104     if (ncolprint/=0) then
     104    if (ncolprint.ne.0) then
    105105       write (6,'(a)') 'last_frac_pp:'
    106106       do j=1,npoints,1000
    … …  
    122122       
    123123       ! Initialise threshold
    124        IF (ilev==1) then
     124       IF (ilev.eq.1) then
    125125          ! If max overlap
    126           IF (overlap==1) then
     126          IF (overlap.eq.1) then
    127127             ! Select pixels spread evenly across the gridbox
    128128             threshold(1:npoints,1:ncol)=boxpos(1:npoints,1:ncol)
    … …  
    137137             enddo
    138138          ENDIF
    139           IF (ncolprint/=0) then
     139          IF (ncolprint.ne.0) then
    140140             write (6,'(a)') 'threshold_nsf2:'
    141141             do j=1,npoints,1000
    … …  
    147147       ENDIF
    148148       
    149        IF (ncolprint/=0) then
     149       IF (ncolprint.ne.0) then
    150150          write (6,'(a)') 'ilev:'
    151151          write (6,'(I2)') ilev
    … …  
    157157          !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox))
    158158          do j=1,npoints
    159              if (boxpos(j,ibox)<=conv(j,ilev)) then
     159             if (boxpos(j,ibox).le.conv(j,ilev)) then
    160160                maxocc(j,ibox) = 1
    161161             else
    … …  
    165165         
    166166          ! Max overlap
    167           if (overlap==1) then
     167          if (overlap.eq.1) then
    168168             threshold_min(1:npoints,ibox) = conv(1:npoints,ilev)
    169169             maxosc(1:npoints,ibox)        = 1               
    … …  
    171171         
    172172          ! Random overlap
    173           if (overlap==2) then
     173          if (overlap.eq.2) then
    174174             threshold_min(1:npoints,ibox) = conv(1:npoints,ilev)
    175175             maxosc(1:npoints,ibox)        = 0
    176176          endif
    177177          ! Max/Random overlap
    178           if (overlap==3) then
     178          if (overlap.eq.3) then
    179179             ! DS2014 START: The bounds on tca are not valid when ilev=1.
    180180             !threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)))
    … …  
    182182             !     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. &
    183183             !     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    184              if (ilev /= 1) then
     184             if (ilev .ne. 1) then
    185185                threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)))
    186                 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) < &
     186                maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. &
    187187                     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. &
    188                      (threshold(1:npoints,ibox)>conv(1:npoints,ilev)))
     188                     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    189189             else
    190190                threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(0._wp,tca(1:npoints,ilev)))
    191                 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) < &
     191                maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. &
    192192                     min(0._wp,tca(1:npoints,ilev)) .and. &
    193                      (threshold(1:npoints,ibox)>conv(1:npoints,ilev)))
     193                     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    194194             endif
    195195          endif
    … …  
    205205         
    206206          ! Fill frac_out with 1's where tca is greater than the threshold
    207           frac_out(1:npoints,ibox,ilev) = merge(1,0,tca(1:npoints,ilev)>threshold(1:npoints,ibox))
     207          frac_out(1:npoints,ibox,ilev) = merge(1,0,tca(1:npoints,ilev).gt.threshold(1:npoints,ibox))
    208208         
    209209          ! Code to partition boxes into startiform and convective parts goes here
    210           where(threshold(1:npoints,ibox)<=conv(1:npoints,ilev) .and. conv(1:npoints,ilev)>0.) frac_out(1:npoints,ibox,ilev)=2
     210          where(threshold(1:npoints,ibox).le.conv(1:npoints,ilev) .and. conv(1:npoints,ilev).gt.0.) frac_out(1:npoints,ibox,ilev)=2
    211211       ENDDO ! ibox
    212212       
    213213       
    214214       ! Set last_frac to tca at this level, so as to be tca from last level next time round
    215        if (ncolprint/=0) then
     215       if (ncolprint.ne.0) then
    216216          do j=1,npoints ,1000
    217217             write(6,'(a10)') 'j='

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/MISR_simulator.F90

    r5082 r5095  
    8484       do ilev=1,nlev
    8585          ! Define location of "layer top"
    86           if(ilev==1 .or. ilev==nlev) then
     86          if(ilev.eq.1 .or. ilev.eq.nlev) then
    8787             ztest=zfull(j,ilev)
    8888          else
    … …  
    9494          iMISR_ztop=2
    9595          do loop=2,numMISRHgtBins
    96              if ( ztest > 1000*misr_histHgt(loop+1) ) then
     96             if ( ztest .gt. 1000*misr_histHgt(loop+1) ) then
    9797                iMISR_ztop=loop+1
    9898             endif
    … …  
    110110          do ilev=1,nlev
    111111             ! If there a cloud, start the counter and store this height
    112              if(thres_crossed_MISR == 0 .and. dtau(j,ibox,ilev) > 0.) then
     112             if(thres_crossed_MISR .eq. 0 .and. dtau(j,ibox,ilev) .gt. 0.) then
    113113                ! First encountered a "cloud"
    114114                thres_crossed_MISR = 1 
    … …  
    116116             endif
    117117
    118              if( thres_crossed_MISR < 99 .and. thres_crossed_MISR > 0 ) then
    119                 if( dtau(j,ibox,ilev) == 0.) then
     118             if( thres_crossed_MISR .lt. 99 .and. thres_crossed_MISR .gt. 0 ) then
     119                if( dtau(j,ibox,ilev) .eq. 0.) then
    120120                   ! We have come to the end of the current cloud layer without yet
    121121                   ! selecting a CTH boundary. Restart cloud tau counter
    … …  
    129129                ! current layer cloud top to the current level then MISR will like
    130130                ! see a top below the top of the current layer.
    131                 if( dtau(j,ibox,ilev)>0 .and. (cloud_dtau-dtau(j,ibox,ilev)) < 1) then
    132                    if(dtau(j,ibox,ilev) < 1 .or. ilev==1 .or. ilev==nlev) then
     131                if( dtau(j,ibox,ilev).gt.0 .and. (cloud_dtau-dtau(j,ibox,ilev)) .lt. 1) then
     132                   if(dtau(j,ibox,ilev) .lt. 1 .or. ilev.eq.1 .or. ilev.eq.nlev) then
    133133                      ! MISR will likely penetrate to some point within this layer ... the middle
    134134                      MISR_penetration_height=zfull(j,ilev)
    … …  
    142142               
    143143                ! Check for a distinctive water layer
    144                 if(dtau(j,ibox,ilev) > 1 .and. at(j,ilev) > 273 ) then
     144                if(dtau(j,ibox,ilev) .gt. 1 .and. at(j,ilev) .gt. 273 ) then
    145145                   ! Must be a water cloud, take this as CTH level
    146146                   thres_crossed_MISR=99
    … …  
    149149                ! If the total column optical depth is "large" than MISR can't see
    150150                ! anything else. Set current point as CTH level
    151                 if(sum(dtau(j,ibox,1:ilev)) > 5) then
     151                if(sum(dtau(j,ibox,1:ilev)) .gt. 5) then
    152152                   thres_crossed_MISR=99           
    153153                endif
    … …  
    157157          ! Check to see if there was a cloud for which we didn't
    158158          ! set a MISR cloud top boundary
    159           if( thres_crossed_MISR == 1) then
     159          if( thres_crossed_MISR .eq. 1) then
    160160             ! If the cloud has a total optical depth of greater
    161161             ! than ~ 0.5 MISR will still likely pick up this cloud
    162162             ! with a height near the true cloud top
    163163             ! otherwise there should be no CTH
    164              if(sum(dtau(j,ibox,1:nlev)) > 0.5) then
     164             if(sum(dtau(j,ibox,1:nlev)) .gt. 0.5) then
    165165                ! keep MISR detected CTH
    166              elseif(sum(dtau(j,ibox,1:nlev)) > 0.2) then
     166             elseif(sum(dtau(j,ibox,1:nlev)) .gt. 0.2) then
    167167                ! MISR may detect but wont likley have a good height
    168168                box_MISR_ztop(j,ibox)=-1
    … …  
    215215    ! Fill dark scenes
    216216    do j=1,numMISRHgtBins
    217        where(sunlit /= 1) dist_model_layertops(1:npoints,j) = R_UNDEF
     217       where(sunlit .ne. 1) dist_model_layertops(1:npoints,j) = R_UNDEF
    218218    enddo
    219219
    … …  
    257257
    258258       ! Subcolumns that are cloudy(true) and not(false)
    259        box_cloudy(1:ncol) = merge(.true.,.false.,tau(j,1:ncol) > tauchk)
     259       box_cloudy(1:ncol) = merge(.true.,.false.,tau(j,1:ncol) .gt. tauchk)
    260260
    261261       ! Fill optically thin clouds with fill value
    262262       where(.not. box_cloudy(1:ncol)) tauWRK(j,1:ncol)  = -999._wp
    263        where(box_MISR_ztopWRK(j,1:ncol) == 0) box_MISR_ztopWRK(j,1:ncol)=-999._wp
     263       where(box_MISR_ztopWRK(j,1:ncol) .eq. 0) box_MISR_ztopWRK(j,1:ncol)=-999._wp
    264264
    265265       ! Compute joint histogram and column quantities for points that are sunlit and cloudy
    266        if (sunlit(j) == 1) then
     266       if (sunlit(j) .eq. 1) then
    267267          ! Joint histogram
    268268          call hist2D(tauWRK(j,1:ncol),box_MISR_ztopWRK(j,1:ncol),ncol,misr_histTau,numMISRTauBins,&
    … …  
    272272
    273273          ! Column cloud area
    274           MISR_cldarea(j)=real(count(box_MISR_ztopWRK(j,1:ncol) /= -999.))/ncol
     274          MISR_cldarea(j)=real(count(box_MISR_ztopWRK(j,1:ncol) .ne. -999.))/ncol
    275275
    276276          ! Column cloud-top height
    277           if ( count(box_MISR_ztopWRK(j,1:ncol) /= -999.) /= 0 ) then
    278              MISR_mean_ztop(j) = sum(box_MISR_ztopWRK(j,1:ncol),box_MISR_ztopWRK(j,1:ncol) /= -999.)/ &
    279                   count(box_MISR_ztopWRK(j,1:ncol) /= -999.)
     277          if ( count(box_MISR_ztopWRK(j,1:ncol) .ne. -999.) .ne. 0 ) then
     278             MISR_mean_ztop(j) = sum(box_MISR_ztopWRK(j,1:ncol),box_MISR_ztopWRK(j,1:ncol) .ne. -999.)/ &
     279                  count(box_MISR_ztopWRK(j,1:ncol) .ne. -999.)
    280280          else
    281281             MISR_mean_ztop(j) = R_UNDEF

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp.F90

    r5086 r5095  
    480480
    481481    ! Set flag to deallocate rttov types (only done on final call to simulator)
    482     if (size(cospOUT%isccp_meantb) == stop_idx) lrttov_cleanUp = .true.
     482    if (size(cospOUT%isccp_meantb) .eq. stop_idx) lrttov_cleanUp = .true.
    483483
    484484    ! ISCCP column
    … …  
    687687       modisIN%w0        => cospIN%ss_alb
    688688       modisIN%Nsunlit   = count(cospgridIN%sunlit > 0)
    689        if (modisIN%Nsunlit > 0) then
     689       if (modisIN%Nsunlit .gt. 0) then
    690690          allocate(modisIN%sunlit(modisIN%Nsunlit),modisIN%pres(modisIN%Nsunlit,cospIN%Nlevels+1))
    691691          modisIN%sunlit    = pack((/ (i, i = 1, Npoints ) /),mask = cospgridIN%sunlit > 0)
    692692          modisIN%pres      = cospgridIN%phalf(int(modisIN%sunlit(:)),:)
    693693       endif
    694        if (count(cospgridIN%sunlit <= 0) > 0) then
     694       if (count(cospgridIN%sunlit <= 0) .gt. 0) then
    695695          allocate(modisIN%notSunlit(count(cospgridIN%sunlit <= 0)))
    696696          modisIN%notSunlit = pack((/ (i, i = 1, Npoints ) /),mask = .not. cospgridIN%sunlit > 0)
    … …  
    886886                                  modisRetrievedCloudTopPressure(i,:),                   &
    887887                                  modisRetrievedTau(i,:),modisRetrievedSize(i,:))
    888           END DO
     888          end do
    889889       endif
    890890    endif
    … …  
    24302430    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    24312431    if (any([Lisccp_subcolumn, Lisccp_column, Lmisr_subcolumn, Lmisr_column, Lmodis_subcolumn, Lmodis_column])) then
    2432        if (any(cospgridIN%sunlit < 0)) then
     2432       if (any(cospgridIN%sunlit .lt. 0)) then
    24332433          nError=nError+1
    24342434          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%sunlit contains values out of range (0 or 1)'
    … …  
    24982498         Lcalipso_column, Lcloudsat_column, Lradar_lidar_tcc,Llidar_only_freq_cloud, &
    24992499         Lcloudsat_tcc, Lcloudsat_tcc2])) then
    2500        if (any(cospgridIN%at < 0)) then
     2500       if (any(cospgridIN%at .lt. 0)) then
    25012501          nError=nError+1
    25022502          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%at contains values out of range (at<0), expected units (K)'
    … …  
    25462546    endif
    25472547    if (any([Lisccp_subcolumn, Lisccp_column, Lrttov_column])) then
    2548        if (any(cospgridIN%pfull < 0)) then
     2548       if (any(cospgridIN%pfull .lt. 0)) then
    25492549          nError=nError+1
    25502550          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%pfull contains values out of range'
    … …  
    25662566    if (any([Lisccp_subcolumn,Lisccp_column,Lmodis_subcolumn,Lmodis_column,Lcalipso_column,Lrttov_column,&
    25672567             LgrLidar532_column,Latlid_column])) then
    2568        if (any(cospgridIN%phalf < 0)) then
     2568       if (any(cospgridIN%phalf .lt. 0)) then
    25692569          nError=nError+1
    25702570          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%phalf contains values out of range'
    … …  
    26482648    endif
    26492649    if (any([Lisccp_subcolumn,Lisccp_column,Lrttov_column])) then
    2650        if (any(cospgridIN%qv < 0)) then
     2650       if (any(cospgridIN%qv .lt. 0)) then
    26512651          nError=nError+1
    26522652          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%qv contains values out of range'
    … …  
    26682668    if (any([Lmisr_subcolumn,Lmisr_column,Lcloudsat_subcolumn,Lcloudsat_column,Lcalipso_column,Lradar_lidar_tcc,&
    26692669         Llidar_only_freq_cloud,LgrLidar532_column,Latlid_column,Lcloudsat_tcc, Lcloudsat_tcc2])) then
    2670        if (any(cospgridIN%hgt_matrix < -300)) then
     2670       if (any(cospgridIN%hgt_matrix .lt. -300)) then
    26712671          nError=nError+1
    26722672          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%hgt_matrix contains values out of range'
    … …  
    27142714    if (any([Lrttov_column,Lcloudsat_column,Lcalipso_column,Lradar_lidar_tcc,Llidar_only_freq_cloud, &
    27152715             LgrLidar532_column, Latlid_column, Lcloudsat_tcc, Lcloudsat_tcc2])) then
    2716        if (any(cospgridIN%hgt_matrix_half < -300)) then
     2716       if (any(cospgridIN%hgt_matrix_half .lt. -300)) then
    27172717          nError=nError+1
    27182718          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%hgt_matrix_half contains values out of range'
    … …  
    27532753    endif
    27542754    if (any([Lrttov_column,Lcalipso_column,Lparasol_column])) then
    2755        if (any(cospgridIN%land < 0)) then
     2755       if (any(cospgridIN%land .lt. 0)) then
    27562756          nError=nError+1
    27572757          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%land contains values out of range'
    … …  
    27762776    endif
    27772777    if (any([Lisccp_subcolumn,Lisccp_column,Lrttov_column])) then
    2778        if (any(cospgridIN%skt < 0)) then
     2778       if (any(cospgridIN%skt .lt. 0)) then
    27792779          nError=nError+1
    27802780          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%skt contains values out of range'
    … …  
    27972797    ! RTTOV Inputs
    27982798    if (Lrttov_column) then
    2799        if (cospgridIN%zenang < -90. .OR. cospgridIN%zenang > 90) then
     2799       if (cospgridIN%zenang .lt. -90. .OR. cospgridIN%zenang .gt. 90) then
    28002800          nError=nError+1
    28012801          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%zenang contains values out of range'
    … …  
    28032803          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28042804       endif
    2805        if (cospgridIN%co2 < 0) then
     2805       if (cospgridIN%co2 .lt. 0) then
    28062806          nError=nError+1
    28072807          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%co2 contains values out of range'
    … …  
    28092809          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28102810       endif
    2811        if (cospgridIN%ch4 < 0) then
     2811       if (cospgridIN%ch4 .lt. 0) then
    28122812          nError=nError+1
    28132813          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%ch4 contains values out of range'
    … …  
    28152815          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28162816       endif
    2817        if (cospgridIN%n2o < 0) then
     2817       if (cospgridIN%n2o .lt. 0) then
    28182818          nError=nError+1
    28192819          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%n2o contains values out of range'
    … …  
    28212821          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28222822       endif
    2823        if (cospgridIN%co< 0) then
     2823       if (cospgridIN%co.lt. 0) then
    28242824          nError=nError+1
    28252825          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%co contains values out of range'
    … …  
    28272827          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28282828       endif
    2829        if (any(cospgridIN%o3 < 0)) then
     2829       if (any(cospgridIN%o3 .lt. 0)) then
    28302830          nError=nError+1
    28312831          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%o3 contains values out of range'
    … …  
    28332833          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28342834       endif
    2835        if (any(cospgridIN%emis_sfc < 0. .OR. cospgridIN%emis_sfc > 1)) then
     2835       if (any(cospgridIN%emis_sfc .lt. 0. .OR. cospgridIN%emis_sfc .gt. 1)) then
    28362836          nError=nError+1
    28372837          errorMessage(nError) = 'ERROR: COSP input variable: cospgridIN%emis_sfc contains values out of range'
    … …  
    28392839          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28402840       endif
    2841        if (any(cospgridIN%u_sfc < -100. .OR. cospgridIN%u_sfc > 100.)) then
     2841       if (any(cospgridIN%u_sfc .lt. -100. .OR. cospgridIN%u_sfc .gt. 100.)) then
    28422842          nError=nError+1
    28432843          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%u_sfc contains values out of range'
    … …  
    28452845          Lrttov_column = .false.
    28462846       endif
    2847        if (any(cospgridIN%v_sfc < -100. .OR. cospgridIN%v_sfc > 100.)) then
     2847       if (any(cospgridIN%v_sfc .lt. -100. .OR. cospgridIN%v_sfc .gt. 100.)) then
    28482848          nError=nError+1
    28492849          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%v_sfc contains values out of range'
    … …  
    28512851          if (associated(cospOUT%rttov_tbs)) cospOUT%rttov_tbs(:,:) = R_UNDEF
    28522852       endif
    2853        if (any(cospgridIN%lat < -90 .OR. cospgridIN%lat > 90)) then
     2853       if (any(cospgridIN%lat .lt. -90 .OR. cospgridIN%lat .gt. 90)) then
    28542854          nError=nError+1
    28552855          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%lat contains values out of range'
    … …  
    28612861    ! COSP_INPUTS
    28622862    if (any([Lisccp_subcolumn,Lisccp_column])) then
    2863        if (cospIN%emsfc_lw < 0. .OR. cospIN%emsfc_lw > 1.) then
     2863       if (cospIN%emsfc_lw .lt. 0. .OR. cospIN%emsfc_lw .gt. 1.) then
    28642864          nError=nError+1
    28652865          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%emsfc_lw contains values out of range'
    … …  
    28782878    endif
    28792879    if (any([Lisccp_subcolumn,Lisccp_column,Lmisr_subcolumn,Lmisr_column,Lmodis_subcolumn,Lmodis_column])) then
    2880        if (any(cospIN%tau_067 < 0)) then
     2880       if (any(cospIN%tau_067 .lt. 0)) then
    28812881          nError=nError+1
    28822882          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tau_067 contains values out of range'
    … …  
    29432943    endif
    29442944    if (any([Lisccp_subcolumn,Lisccp_column])) then
    2945        if (any(cospIN%emiss_11 < 0. .OR. cospIN%emiss_11 > 1)) then
     2945       if (any(cospIN%emiss_11 .lt. 0. .OR. cospIN%emiss_11 .gt. 1)) then
    29462946          nError=nError+1
    29472947          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%emiss_11 contains values out of range'
    … …  
    29602960    endif
    29612961    if (any([Lmodis_subcolumn,Lmodis_column])) then
    2962        if (any(cospIN%asym < -1. .OR. cospIN%asym > 1)) then
     2962       if (any(cospIN%asym .lt. -1. .OR. cospIN%asym .gt. 1)) then
    29632963          nError=nError+1
    29642964          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%asym contains values out of range'
    … …  
    30063006               cospOUT%modis_Optical_Thickness_vs_ReffLIQ(:,:,:)            = R_UNDEF
    30073007       endif
    3008        if (any(cospIN%ss_alb < 0 .OR. cospIN%ss_alb > 1)) then
     3008       if (any(cospIN%ss_alb .lt. 0 .OR. cospIN%ss_alb .gt. 1)) then
    30093009          nError=nError+1
    30103010          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%ss_alb contains values out of range'
    … …  
    30543054    endif
    30553055    if (any([Latlid_subcolumn,Latlid_column])) then
    3056        if (any(cospIN%betatot_atlid < 0)) then
     3056       if (any(cospIN%betatot_atlid .lt. 0)) then
    30573057          nError=nError+1
    30583058          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%betatot_atlid contains values out of range'
    … …  
    30653065          if (associated(cospOUT%atlid_beta_mol))      cospOUT%atlid_beta_mol(:,:)   = R_UNDEF
    30663066       endif
    3067        if (any(cospIN%beta_mol_atlid < 0)) then
     3067       if (any(cospIN%beta_mol_atlid .lt. 0)) then
    30683068          nError=nError+1
    30693069          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%beta_mol_atlid contains values out of range'
    … …  
    30763076          if (associated(cospOUT%atlid_beta_mol))      cospOUT%atlid_beta_mol(:,:)   = R_UNDEF
    30773077       endif
    3078        if (any(cospIN%tautot_atlid < 0)) then
     3078       if (any(cospIN%tautot_atlid .lt. 0)) then
    30793079          nError=nError+1
    30803080          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_atlid contains values out of range'
    … …  
    30873087          if (associated(cospOUT%atlid_beta_mol))      cospOUT%atlid_beta_mol(:,:)   = R_UNDEF
    30883088       endif
    3089        if (any(cospIN%tau_mol_atlid < 0)) then
     3089       if (any(cospIN%tau_mol_atlid .lt. 0)) then
    30903090          nError=nError+1
    30913091          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tau_mol_atlid contains values out of range'
    … …  
    31013101   
    31023102    if (any([LgrLidar532_subcolumn,LgrLidar532_column])) then
    3103        if (any(cospIN%betatot_grLidar532 < 0)) then
     3103       if (any(cospIN%betatot_grLidar532 .lt. 0)) then
    31043104          nError=nError+1
    31053105          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%betatot_grLidar532 contains values out of range'
    … …  
    31123112          if (associated(cospOUT%grLidar532_beta_mol))      cospOUT%grLidar532_beta_mol(:,:)   = R_UNDEF
    31133113       endif
    3114        if (any(cospIN%beta_mol_grLidar532 < 0)) then
     3114       if (any(cospIN%beta_mol_grLidar532 .lt. 0)) then
    31153115          nError=nError+1
    31163116          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%beta_mol_grLidar532 contains values out of range'
    … …  
    31233123          if (associated(cospOUT%grLidar532_beta_mol))      cospOUT%grLidar532_beta_mol(:,:)   = R_UNDEF
    31243124       endif
    3125        if (any(cospIN%tautot_grLidar532 < 0)) then
     3125       if (any(cospIN%tautot_grLidar532 .lt. 0)) then
    31263126          nError=nError+1
    31273127          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_grLidar532 contains values out of range'
    … …  
    31343134          if (associated(cospOUT%grLidar532_beta_mol))      cospOUT%grLidar532_beta_mol(:,:)   = R_UNDEF
    31353135       endif
    3136        if (any(cospIN%tau_mol_grLidar532 < 0)) then
     3136       if (any(cospIN%tau_mol_grLidar532 .lt. 0)) then
    31373137          nError=nError+1
    31383138          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tau_mol_grLidar532 contains values out of range'
    … …  
    31483148
    31493149    if (any([Lcalipso_subcolumn,Lcalipso_column])) then
    3150        if (any(cospIN%betatot_calipso < 0)) then
     3150       if (any(cospIN%betatot_calipso .lt. 0)) then
    31513151          nError=nError+1
    31523152          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%betatot_calipso contains values out of range'
    … …  
    31673167          if (associated(cospOUT%calipso_cldthinemis))   cospOUT%calipso_cldthinemis(:)       = R_UNDEF
    31683168       endif
    3169        if (any(cospIN%betatot_liq_calipso < 0)) then
     3169       if (any(cospIN%betatot_liq_calipso .lt. 0)) then
    31703170          nError=nError+1
    31713171          errorMessage(nError) = ('ERROR: COSP input variable: cospIN%betatot_liq_calipso contains values out of range')
    … …  
    31863186          if (associated(cospOUT%calipso_cldthinemis))   cospOUT%calipso_cldthinemis(:)       = R_UNDEF
    31873187       endif
    3188        if (any(cospIN%betatot_ice_calipso < 0)) then
     3188       if (any(cospIN%betatot_ice_calipso .lt. 0)) then
    31893189          nError=nError+1
    31903190          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%betatot_ice_calipso contains values out of range'
    … …  
    32053205          if (associated(cospOUT%calipso_cldthinemis))   cospOUT%calipso_cldthinemis(:)       = R_UNDEF
    32063206       endif
    3207        if (any(cospIN%tautot_calipso < 0)) then
     3207       if (any(cospIN%tautot_calipso .lt. 0)) then
    32083208          nError=nError+1
    32093209          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_calipso contains values out of range'
    … …  
    32243224          if (associated(cospOUT%calipso_cldthinemis))   cospOUT%calipso_cldthinemis(:)       = R_UNDEF
    32253225       endif
    3226        if (any(cospIN%tautot_liq_calipso < 0)) then
     3226       if (any(cospIN%tautot_liq_calipso .lt. 0)) then
    32273227          nError=nError+1
    32283228          errorMessage(nError) = ('ERROR: COSP input variable: cospIN%tautot_liq_calipso contains values out of range')
    … …  
    32433243          if (associated(cospOUT%calipso_cldthinemis))   cospOUT%calipso_cldthinemis(:)       = R_UNDEF
    32443244       endif
    3245        if (any(cospIN%tautot_ice_calipso < 0)) then
     3245       if (any(cospIN%tautot_ice_calipso .lt. 0)) then
    32463246          nError=nError+1
    32473247          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_ice_calipso contains values out of range'
    … …  
    32623262          if (associated(cospOUT%calipso_cldthinemis))   cospOUT%calipso_cldthinemis(:)       = R_UNDEF
    32633263       endif
    3264        if (any(cospIN%tau_mol_calipso < 0)) then
     3264       if (any(cospIN%tau_mol_calipso .lt. 0)) then
    32653265          nError=nError+1
    32663266          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tau_mol_calipso contains values out of range'
    … …  
    32843284    if (any([Lcalipso_subcolumn,Lcalipso_column,Lcloudsat_column,Lradar_lidar_tcc,       &
    32853285        Llidar_only_freq_cloud, Lcloudsat_tcc, Lcloudsat_tcc2])) then
    3286        if (any(cospIN%beta_mol_calipso < 0)) then
     3286       if (any(cospIN%beta_mol_calipso .lt. 0)) then
    32873287          nError=nError+1
    32883288          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%beta_mol_calipso contains values out of range'
    … …  
    33153315    endif
    33163316    if (any([Lparasol_subcolumn,Lparasol_column])) then
    3317        if (any(cospIN%tautot_S_liq < 0)) then
     3317       if (any(cospIN%tautot_S_liq .lt. 0)) then
    33183318          nError=nError+1
    33193319          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_S_liq contains values out of range'
    … …  
    33233323          if (associated(cospOUT%parasolGrid_refl)) cospOUT%parasolGrid_refl(:,:)  = R_UNDEF
    33243324       endif
    3325        if (any(cospIN%tautot_S_ice < 0)) then
     3325       if (any(cospIN%tautot_S_ice .lt. 0)) then
    33263326          nError=nError+1
    33273327          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%tautot_S_ice contains values out of range'
    … …  
    33343334    if (any([Lcloudsat_subcolumn,Lcloudsat_column,Lradar_lidar_tcc,Llidar_only_freq_cloud, &
    33353335        Lcloudsat_tcc, Lcloudsat_tcc2])) then
    3336        if (any(cospIN%z_vol_cloudsat < 0)) then
     3336       if (any(cospIN%z_vol_cloudsat .lt. 0)) then
    33373337          nError=nError+1
    33383338          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%z_vol_cloudsat contains values out of range'
    … …  
    33503350          if (associated(cospOUT%cloudsat_tcc2)) cospOUT%cloudsat_tcc2(:) = R_UNDEF
    33513351       endif
    3352        if (any(cospIN%kr_vol_cloudsat < 0)) then
     3352       if (any(cospIN%kr_vol_cloudsat .lt. 0)) then
    33533353          nError=nError+1
    33543354          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%kr_vol_cloudsat contains values out of range'
    … …  
    33663366          if (associated(cospOUT%cloudsat_tcc2)) cospOUT%cloudsat_tcc2(:) = R_UNDEF
    33673367       endif
    3368        if (any(cospIN%g_vol_cloudsat < 0)) then
     3368       if (any(cospIN%g_vol_cloudsat .lt. 0)) then
    33693369          nError=nError+1
    33703370          errorMessage(nError) = 'ERROR: COSP input variable: cospIN%g_vol_cloudsat contains values out of range'
    … …  
    33893389    ! ISCCP
    33903390    if (Lisccp_subcolumn .or. Lisccp_column) then
    3391        if (size(cospIN%frac_out,1)  /= cospIN%Npoints .OR. &
    3392            size(cospIN%tau_067,1)   /= cospIN%Npoints .OR. &
    3393            size(cospIN%emiss_11,1)  /= cospIN%Npoints .OR. &
    3394            size(cospgridIN%skt)     /= cospIN%Npoints .OR. &
    3395            size(cospgridIN%qv,1)    /= cospIN%Npoints .OR. &
    3396            size(cospgridIN%at,1)    /= cospIN%Npoints .OR. &
    3397            size(cospgridIN%phalf,1) /= cospIN%Npoints .OR. &
    3398            size(cospgridIN%sunlit)  /= cospIN%Npoints .OR. &
    3399            size(cospgridIN%pfull,1) /= cospIN%Npoints) then
     3391       if (size(cospIN%frac_out,1)  .ne. cospIN%Npoints .OR. &
     3392           size(cospIN%tau_067,1)   .ne. cospIN%Npoints .OR. &
     3393           size(cospIN%emiss_11,1)  .ne. cospIN%Npoints .OR. &
     3394           size(cospgridIN%skt)     .ne. cospIN%Npoints .OR. &
     3395           size(cospgridIN%qv,1)    .ne. cospIN%Npoints .OR. &
     3396           size(cospgridIN%at,1)    .ne. cospIN%Npoints .OR. &
     3397           size(cospgridIN%phalf,1) .ne. cospIN%Npoints .OR. &
     3398           size(cospgridIN%sunlit)  .ne. cospIN%Npoints .OR. &
     3399           size(cospgridIN%pfull,1) .ne. cospIN%Npoints) then
    34003400          Lisccp_subcolumn = .false.
    34013401          Lisccp_column    = .false.
    … …  
    34033403          errorMessage(nError) = 'ERROR(isccp_simulator): The number of points in the input fields are inconsistent'
    34043404       endif
    3405        if (size(cospIN%frac_out,2) /= cospIN%Ncolumns .OR. &
    3406            size(cospIN%tau_067,2)  /= cospIN%Ncolumns .OR. &
    3407            size(cospIN%emiss_11,2) /= cospIN%Ncolumns) then
     3405       if (size(cospIN%frac_out,2) .ne. cospIN%Ncolumns .OR. &
     3406           size(cospIN%tau_067,2)  .ne. cospIN%Ncolumns .OR. &
     3407           size(cospIN%emiss_11,2) .ne. cospIN%Ncolumns) then
    34083408          Lisccp_subcolumn = .false.
    34093409          Lisccp_column    = .false.
    … …  
    34113411          errorMessage(nError) = 'ERROR(isccp_simulator): The number of sub-columns in the input fields are inconsistent'
    34123412       endif
    3413        if (size(cospIN%frac_out,3)  /= cospIN%Nlevels .OR. &
    3414            size(cospIN%tau_067,3)   /= cospIN%Nlevels .OR. &
    3415            size(cospIN%emiss_11,3)  /= cospIN%Nlevels .OR. &
    3416            size(cospgridIN%qv,2)    /= cospIN%Nlevels .OR. &
    3417            size(cospgridIN%at,2)    /= cospIN%Nlevels .OR. &
    3418            size(cospgridIN%pfull,2) /= cospIN%Nlevels .OR. &
    3419            size(cospgridIN%phalf,2) /= cospIN%Nlevels+1) then
     3413       if (size(cospIN%frac_out,3)  .ne. cospIN%Nlevels .OR. &
     3414           size(cospIN%tau_067,3)   .ne. cospIN%Nlevels .OR. &
     3415           size(cospIN%emiss_11,3)  .ne. cospIN%Nlevels .OR. &
     3416           size(cospgridIN%qv,2)    .ne. cospIN%Nlevels .OR. &
     3417           size(cospgridIN%at,2)    .ne. cospIN%Nlevels .OR. &
     3418           size(cospgridIN%pfull,2) .ne. cospIN%Nlevels .OR. &
     3419           size(cospgridIN%phalf,2) .ne. cospIN%Nlevels+1) then
    34203420          Lisccp_subcolumn = .false.
    34213421          Lisccp_column    = .false.
    … …  
    34273427    ! MISR
    34283428    if (Lmisr_subcolumn .or. Lmisr_column) then
    3429        if (size(cospIN%tau_067,1)        /= cospIN%Npoints .OR. &
    3430            size(cospgridIN%sunlit)       /= cospIN%Npoints .OR. &
    3431            size(cospgridIN%hgt_matrix,1) /= cospIN%Npoints .OR. &
    3432            size(cospgridIN%at,1)         /= cospIN%Npoints) then
     3429       if (size(cospIN%tau_067,1)        .ne. cospIN%Npoints .OR. &
     3430           size(cospgridIN%sunlit)       .ne. cospIN%Npoints .OR. &
     3431           size(cospgridIN%hgt_matrix,1) .ne. cospIN%Npoints .OR. &
     3432           size(cospgridIN%at,1)         .ne. cospIN%Npoints) then
    34333433          Lmisr_subcolumn = .false.
    34343434          Lmisr_column    = .false.
    … …  
    34363436          errorMessage(nError) = 'ERROR(misr_simulator): The number of points in the input fields are inconsistent'
    34373437       endif
    3438        if (size(cospIN%tau_067,2) /= cospIN%Ncolumns) then
     3438       if (size(cospIN%tau_067,2) .ne. cospIN%Ncolumns) then
    34393439          Lmisr_subcolumn = .false.
    34403440          Lmisr_column    = .false.
    … …  
    34423442          errorMessage(nError) = 'ERROR(misr_simulator): The number of sub-columns in the input fields are inconsistent'
    34433443       endif
    3444        if (size(cospIN%tau_067,3)        /= cospIN%Nlevels .OR. &
    3445            size(cospgridIN%hgt_matrix,2) /= cospIN%Nlevels .OR. &
    3446            size(cospgridIN%at,2)         /= cospIN%Nlevels) then
     3444       if (size(cospIN%tau_067,3)        .ne. cospIN%Nlevels .OR. &
     3445           size(cospgridIN%hgt_matrix,2) .ne. cospIN%Nlevels .OR. &
     3446           size(cospgridIN%at,2)         .ne. cospIN%Nlevels) then
    34473447          Lmisr_subcolumn = .false.
    34483448          Lmisr_column    = .false.
    … …  
    34543454    ! MODIS
    34553455    if (Lmodis_subcolumn .or. Lmodis_column) then
    3456        if (size(cospIN%fracLiq,1) /= cospIN%Npoints .OR. &
    3457            size(cospIN%tau_067,1) /= cospIN%Npoints .OR. &
    3458            size(cospIN%asym,1)    /= cospIN%Npoints .OR. &
    3459            size(cospIN%ss_alb,1)  /= cospIN%Npoints) then
     3456       if (size(cospIN%fracLiq,1) .ne. cospIN%Npoints .OR. &
     3457           size(cospIN%tau_067,1) .ne. cospIN%Npoints .OR. &
     3458           size(cospIN%asym,1)    .ne. cospIN%Npoints .OR. &
     3459           size(cospIN%ss_alb,1)  .ne. cospIN%Npoints) then
    34603460          Lmodis_subcolumn = .false.
    34613461          Lmodis_column    = .false.
    … …  
    34633463          errorMessage(nError) = 'ERROR(modis_simulator): The number of points in the input fields are inconsistent'
    34643464       endif
    3465        if (size(cospIN%fracLiq,2) /= cospIN%Ncolumns .OR. &
    3466            size(cospIN%tau_067,2) /= cospIN%Ncolumns .OR. &
    3467            size(cospIN%asym,2)    /= cospIN%Ncolumns .OR. &
    3468            size(cospIN%ss_alb,2)  /= cospIN%Ncolumns) then
     3465       if (size(cospIN%fracLiq,2) .ne. cospIN%Ncolumns .OR. &
     3466           size(cospIN%tau_067,2) .ne. cospIN%Ncolumns .OR. &
     3467           size(cospIN%asym,2)    .ne. cospIN%Ncolumns .OR. &
     3468           size(cospIN%ss_alb,2)  .ne. cospIN%Ncolumns) then
    34693469          Lmodis_subcolumn = .false.
    34703470          Lmodis_column    = .false.
    … …  
    34723472          errorMessage(nError) = 'ERROR(modis_simulator): The number of sub-columns in the input fields are inconsistent'
    34733473       endif
    3474        if (size(cospIN%fracLiq,3) /= cospIN%Nlevels .OR. &
    3475            size(cospIN%tau_067,3) /= cospIN%Nlevels .OR. &
    3476            size(cospIN%asym,3)    /= cospIN%Nlevels .OR. &
    3477            size(cospIN%ss_alb,3)  /= cospIN%Nlevels) then
     3474       if (size(cospIN%fracLiq,3) .ne. cospIN%Nlevels .OR. &
     3475           size(cospIN%tau_067,3) .ne. cospIN%Nlevels .OR. &
     3476           size(cospIN%asym,3)    .ne. cospIN%Nlevels .OR. &
     3477           size(cospIN%ss_alb,3)  .ne. cospIN%Nlevels) then
    34783478          Lmodis_subcolumn = .false.
    34793479          Lmodis_column    = .false.
    … …  
    34853485    ! CLOUDSAT
    34863486    if (Lcloudsat_subcolumn .or. Lcloudsat_column) then
    3487        if (size(cospIN%z_vol_cloudsat,1)   /= cospIN%Npoints .OR. &
    3488            size(cospIN%kr_vol_cloudsat,1)  /= cospIN%Npoints .OR. &
    3489            size(cospIN%g_vol_cloudsat,1)   /= cospIN%Npoints .OR. &
    3490            size(cospgridIN%hgt_matrix,1)   /= cospIN%Npoints) then
     3487       if (size(cospIN%z_vol_cloudsat,1)   .ne. cospIN%Npoints .OR. &
     3488           size(cospIN%kr_vol_cloudsat,1)  .ne. cospIN%Npoints .OR. &
     3489           size(cospIN%g_vol_cloudsat,1)   .ne. cospIN%Npoints .OR. &
     3490           size(cospgridIN%hgt_matrix,1)   .ne. cospIN%Npoints) then
    34913491          Lcloudsat_subcolumn = .false.
    34923492          Lcloudsat_column    = .false.
    … …  
    34943494          errorMessage(nError) = 'ERROR(cloudsat_simulator): The number of points in the input fields are inconsistent'
    34953495       endif
    3496        if (size(cospIN%z_vol_cloudsat,2)  /= cospIN%Ncolumns .OR. &
    3497            size(cospIN%kr_vol_cloudsat,2) /= cospIN%Ncolumns .OR. &
    3498            size(cospIN%g_vol_cloudsat,2)  /= cospIN%Ncolumns) then
     3496       if (size(cospIN%z_vol_cloudsat,2)  .ne. cospIN%Ncolumns .OR. &
     3497           size(cospIN%kr_vol_cloudsat,2) .ne. cospIN%Ncolumns .OR. &
     3498           size(cospIN%g_vol_cloudsat,2)  .ne. cospIN%Ncolumns) then
    34993499          Lcloudsat_subcolumn = .false.
    35003500          Lcloudsat_column    = .false.
    … …  
    35023502          errorMessage(nError) = 'ERROR(cloudsat_simulator): The number of sub-columns in the input fields are inconsistent'
    35033503       endif
    3504        if (size(cospIN%z_vol_cloudsat,3)  /= cospIN%Nlevels .OR. &
    3505            size(cospIN%kr_vol_cloudsat,3) /= cospIN%Nlevels .OR. &
    3506            size(cospIN%g_vol_cloudsat,3)  /= cospIN%Nlevels .OR. &
    3507            size(cospgridIN%hgt_matrix,2)  /= cospIN%Nlevels) then
     3504       if (size(cospIN%z_vol_cloudsat,3)  .ne. cospIN%Nlevels .OR. &
     3505           size(cospIN%kr_vol_cloudsat,3) .ne. cospIN%Nlevels .OR. &
     3506           size(cospIN%g_vol_cloudsat,3)  .ne. cospIN%Nlevels .OR. &
     3507           size(cospgridIN%hgt_matrix,2)  .ne. cospIN%Nlevels) then
    35083508          Lcloudsat_subcolumn = .false.
    35093509          Lcloudsat_column    = .false.
    … …  
    35153515    ! GROUND LIDAR @ 532nm
    35163516    if (LgrLidar532_subcolumn .or. LgrLidar532_column) then
    3517        if (size(cospIN%beta_mol_grLidar532,1)    /= cospIN%Npoints .OR. &
    3518            size(cospIN%betatot_grLidar532,1)     /= cospIN%Npoints .OR. &
    3519            size(cospIN%tau_mol_grLidar532,1)     /= cospIN%Npoints .OR. &
    3520            size(cospIN%tautot_grLidar532,1)      /= cospIN%Npoints) then
     3517       if (size(cospIN%beta_mol_grLidar532,1)    .ne. cospIN%Npoints .OR. &
     3518           size(cospIN%betatot_grLidar532,1)     .ne. cospIN%Npoints .OR. &
     3519           size(cospIN%tau_mol_grLidar532,1)     .ne. cospIN%Npoints .OR. &
     3520           size(cospIN%tautot_grLidar532,1)      .ne. cospIN%Npoints) then
    35213521          LgrLidar532_subcolumn = .false.
    35223522          LgrLidar532_column    = .false.
    … …  
    35243524          errorMessage(nError) = 'ERROR(grLidar532_simulator): The number of points in the input fields are inconsistent'
    35253525       endif
    3526        if (size(cospIN%betatot_grLidar532,2)    /= cospIN%Ncolumns .OR. &
    3527            size(cospIN%tautot_grLidar532,2)     /= cospIN%Ncolumns) then
     3526       if (size(cospIN%betatot_grLidar532,2)    .ne. cospIN%Ncolumns .OR. &
     3527           size(cospIN%tautot_grLidar532,2)     .ne. cospIN%Ncolumns) then
    35283528          LgrLidar532_subcolumn = .false.
    35293529          LgrLidar532_column    = .false.
    … …  
    35313531          errorMessage(nError) = 'ERROR(grLidar532_simulator): The number of sub-columns in the input fields are inconsistent'
    35323532       endif
    3533        if (size(cospIN%beta_mol_grLidar532,2)    /= cospIN%Nlevels .OR. &
    3534            size(cospIN%betatot_grLidar532,3)     /= cospIN%Nlevels .OR. &
    3535            size(cospIN%tau_mol_grLidar532,2)     /= cospIN%Nlevels .OR. &
    3536            size(cospIN%tautot_grLidar532,3)      /= cospIN%Nlevels) then
     3533       if (size(cospIN%beta_mol_grLidar532,2)    .ne. cospIN%Nlevels .OR. &
     3534           size(cospIN%betatot_grLidar532,3)     .ne. cospIN%Nlevels .OR. &
     3535           size(cospIN%tau_mol_grLidar532,2)     .ne. cospIN%Nlevels .OR. &
     3536           size(cospIN%tautot_grLidar532,3)      .ne. cospIN%Nlevels) then
    35373537          LgrLidar532_subcolumn = .false.
    35383538          LgrLidar532_column    = .false.
    … …  
    35443544    ! ATLID
    35453545    if (Latlid_subcolumn .or. Latlid_column) then
    3546        if (size(cospIN%beta_mol_atlid,1)    /= cospIN%Npoints .OR. &
    3547            size(cospIN%betatot_atlid,1)     /= cospIN%Npoints .OR. &
    3548            size(cospIN%tau_mol_atlid,1)     /= cospIN%Npoints .OR. &
    3549            size(cospIN%tautot_atlid,1)      /= cospIN%Npoints) then
     3546       if (size(cospIN%beta_mol_atlid,1)    .ne. cospIN%Npoints .OR. &
     3547           size(cospIN%betatot_atlid,1)     .ne. cospIN%Npoints .OR. &
     3548           size(cospIN%tau_mol_atlid,1)     .ne. cospIN%Npoints .OR. &
     3549           size(cospIN%tautot_atlid,1)      .ne. cospIN%Npoints) then
    35503550          Latlid_subcolumn = .false.
    35513551          Latlid_column    = .false.
    … …  
    35533553          errorMessage(nError) = 'ERROR(atlid_simulator): The number of points in the input fields are inconsistent'
    35543554       endif
    3555        if (size(cospIN%betatot_atlid,2)    /= cospIN%Ncolumns .OR. &
    3556            size(cospIN%tautot_atlid,2)     /= cospIN%Ncolumns) then
     3555       if (size(cospIN%betatot_atlid,2)    .ne. cospIN%Ncolumns .OR. &
     3556           size(cospIN%tautot_atlid,2)     .ne. cospIN%Ncolumns) then
    35573557          Latlid_subcolumn = .false.
    35583558          Latlid_column    = .false.
    … …  
    35603560          errorMessage(nError) = 'ERROR(atlid_simulator): The number of sub-columns in the input fields are inconsistent'
    35613561       endif
    3562        if (size(cospIN%beta_mol_atlid,2)    /= cospIN%Nlevels .OR. &
    3563            size(cospIN%betatot_atlid,3)     /= cospIN%Nlevels .OR. &
    3564            size(cospIN%tau_mol_atlid,2)     /= cospIN%Nlevels .OR. &
    3565            size(cospIN%tautot_atlid,3)      /= cospIN%Nlevels) then
     3562       if (size(cospIN%beta_mol_atlid,2)    .ne. cospIN%Nlevels .OR. &
     3563           size(cospIN%betatot_atlid,3)     .ne. cospIN%Nlevels .OR. &
     3564           size(cospIN%tau_mol_atlid,2)     .ne. cospIN%Nlevels .OR. &
     3565           size(cospIN%tautot_atlid,3)      .ne. cospIN%Nlevels) then
    35663566          Latlid_subcolumn = .false.
    35673567          Latlid_column    = .false.
    … …  
    35733573    ! CALIPSO
    35743574    if (Lcalipso_subcolumn .or. Lcalipso_column) then
    3575        if (size(cospIN%beta_mol_calipso,1)    /= cospIN%Npoints .OR. &
    3576            size(cospIN%betatot_calipso,1)     /= cospIN%Npoints .OR. &
    3577            size(cospIN%betatot_liq_calipso,1) /= cospIN%Npoints .OR. &
    3578            size(cospIN%betatot_ice_calipso,1) /= cospIN%Npoints .OR. &
    3579            size(cospIN%tau_mol_calipso,1)     /= cospIN%Npoints .OR. &
    3580            size(cospIN%tautot_calipso,1)      /= cospIN%Npoints .OR. &
    3581            size(cospIN%tautot_liq_calipso,1)  /= cospIN%Npoints .OR. &
    3582            size(cospIN%tautot_ice_calipso,1)  /= cospIN%Npoints) then
     3575       if (size(cospIN%beta_mol_calipso,1)    .ne. cospIN%Npoints .OR. &
     3576           size(cospIN%betatot_calipso,1)     .ne. cospIN%Npoints .OR. &
     3577           size(cospIN%betatot_liq_calipso,1) .ne. cospIN%Npoints .OR. &
     3578           size(cospIN%betatot_ice_calipso,1) .ne. cospIN%Npoints .OR. &
     3579           size(cospIN%tau_mol_calipso,1)     .ne. cospIN%Npoints .OR. &
     3580           size(cospIN%tautot_calipso,1)      .ne. cospIN%Npoints .OR. &
     3581           size(cospIN%tautot_liq_calipso,1)  .ne. cospIN%Npoints .OR. &
     3582           size(cospIN%tautot_ice_calipso,1)  .ne. cospIN%Npoints) then
    35833583          Lcalipso_subcolumn = .false.
    35843584          Lcalipso_column    = .false.
    … …  
    35863586          errorMessage(nError) = 'ERROR(calipso_simulator): The number of points in the input fields are inconsistent'
    35873587       endif
    3588        if (size(cospIN%betatot_calipso,2)     /= cospIN%Ncolumns .OR. &
    3589            size(cospIN%betatot_liq_calipso,2) /= cospIN%Ncolumns .OR. &
    3590            size(cospIN%betatot_ice_calipso,2) /= cospIN%Ncolumns .OR. &
    3591            size(cospIN%tautot_calipso,2)      /= cospIN%Ncolumns .OR. &
    3592            size(cospIN%tautot_liq_calipso,2)  /= cospIN%Ncolumns .OR. &
    3593            size(cospIN%tautot_ice_calipso,2)  /= cospIN%Ncolumns) then
     3588       if (size(cospIN%betatot_calipso,2)     .ne. cospIN%Ncolumns .OR. &
     3589           size(cospIN%betatot_liq_calipso,2) .ne. cospIN%Ncolumns .OR. &
     3590           size(cospIN%betatot_ice_calipso,2) .ne. cospIN%Ncolumns .OR. &
     3591           size(cospIN%tautot_calipso,2)      .ne. cospIN%Ncolumns .OR. &
     3592           size(cospIN%tautot_liq_calipso,2)  .ne. cospIN%Ncolumns .OR. &
     3593           size(cospIN%tautot_ice_calipso,2)  .ne. cospIN%Ncolumns) then
    35943594          Lcalipso_subcolumn = .false.
    35953595          Lcalipso_column    = .false.
    … …  
    35973597          errorMessage(nError) = 'ERROR(calipso_simulator): The number of sub-columns in the input fields are inconsistent'
    35983598       endif
    3599        if (size(cospIN%beta_mol_calipso,2)    /= cospIN%Nlevels .OR. &
    3600            size(cospIN%betatot_calipso,3)     /= cospIN%Nlevels .OR. &
    3601            size(cospIN%betatot_liq_calipso,3) /= cospIN%Nlevels .OR. &
    3602            size(cospIN%betatot_ice_calipso,3) /= cospIN%Nlevels .OR. &
    3603            size(cospIN%tau_mol_calipso,2)     /= cospIN%Nlevels .OR. &
    3604            size(cospIN%tautot_calipso,3)      /= cospIN%Nlevels .OR. &
    3605            size(cospIN%tautot_liq_calipso,3)  /= cospIN%Nlevels .OR. &
    3606            size(cospIN%tautot_ice_calipso,3)  /= cospIN%Nlevels) then
     3599       if (size(cospIN%beta_mol_calipso,2)    .ne. cospIN%Nlevels .OR. &
     3600           size(cospIN%betatot_calipso,3)     .ne. cospIN%Nlevels .OR. &
     3601           size(cospIN%betatot_liq_calipso,3) .ne. cospIN%Nlevels .OR. &
     3602           size(cospIN%betatot_ice_calipso,3) .ne. cospIN%Nlevels .OR. &
     3603           size(cospIN%tau_mol_calipso,2)     .ne. cospIN%Nlevels .OR. &
     3604           size(cospIN%tautot_calipso,3)      .ne. cospIN%Nlevels .OR. &
     3605           size(cospIN%tautot_liq_calipso,3)  .ne. cospIN%Nlevels .OR. &
     3606           size(cospIN%tautot_ice_calipso,3)  .ne. cospIN%Nlevels) then
    36073607          Lcalipso_subcolumn = .false.
    36083608          Lcalipso_column    = .false.
    … …  
    36143614    ! PARASOL
    36153615    if (Lparasol_subcolumn .or. Lparasol_column) then
    3616        if (size(cospIN%tautot_S_liq,1) /= cospIN%Npoints .OR. &
    3617            size(cospIN%tautot_S_ice,1) /= cospIN%Npoints) then
     3616       if (size(cospIN%tautot_S_liq,1) .ne. cospIN%Npoints .OR. &
     3617           size(cospIN%tautot_S_ice,1) .ne. cospIN%Npoints) then
    36183618          Lparasol_subcolumn = .false.
    36193619          Lparasol_column    = .false.
    … …  
    36213621          errorMessage(nError) = 'ERROR(parasol_simulator): The number of points in the input fields are inconsistent'
    36223622       endif
    3623        if (size(cospIN%tautot_S_liq,2) /= cospIN%Ncolumns .OR. &
    3624            size(cospIN%tautot_S_ice,2) /= cospIN%Ncolumns) then
     3623       if (size(cospIN%tautot_S_liq,2) .ne. cospIN%Ncolumns .OR. &
     3624           size(cospIN%tautot_S_ice,2) .ne. cospIN%Ncolumns) then
    36253625          Lparasol_subcolumn = .false.
    36263626          Lparasol_column    = .false.
    … …  
    36323632    ! RTTOV
    36333633    if (Lrttov_column) then
    3634        if (size(cospgridIN%pfull,1)           /= cospIN%Npoints .OR. &
    3635            size(cospgridIN%at,1)              /= cospIN%Npoints .OR. &
    3636            size(cospgridIN%qv,1)              /= cospIN%Npoints .OR. &
    3637            size(cospgridIN%hgt_matrix_half,1) /= cospIN%Npoints .OR. &
    3638            size(cospgridIN%u_sfc)             /= cospIN%Npoints .OR. &
    3639            size(cospgridIN%v_sfc)             /= cospIN%Npoints .OR. &
    3640            size(cospgridIN%skt)               /= cospIN%Npoints .OR. &
    3641            size(cospgridIN%phalf,1)           /= cospIN%Npoints .OR. &
    3642            size(cospgridIN%qv,1)              /= cospIN%Npoints .OR. &
    3643            size(cospgridIN%land)              /= cospIN%Npoints .OR. &
    3644            size(cospgridIN%lat)               /= cospIN%Npoints) then
     3634       if (size(cospgridIN%pfull,1)           .ne. cospIN%Npoints .OR. &
     3635           size(cospgridIN%at,1)              .ne. cospIN%Npoints .OR. &
     3636           size(cospgridIN%qv,1)              .ne. cospIN%Npoints .OR. &
     3637           size(cospgridIN%hgt_matrix_half,1) .ne. cospIN%Npoints .OR. &
     3638           size(cospgridIN%u_sfc)             .ne. cospIN%Npoints .OR. &
     3639           size(cospgridIN%v_sfc)             .ne. cospIN%Npoints .OR. &
     3640           size(cospgridIN%skt)               .ne. cospIN%Npoints .OR. &
     3641           size(cospgridIN%phalf,1)           .ne. cospIN%Npoints .OR. &
     3642           size(cospgridIN%qv,1)              .ne. cospIN%Npoints .OR. &
     3643           size(cospgridIN%land)              .ne. cospIN%Npoints .OR. &
     3644           size(cospgridIN%lat)               .ne. cospIN%Npoints) then
    36453645          Lrttov_column    = .false.
    36463646          nError=nError+1
    36473647          errorMessage(nError) = 'ERROR(rttov_simulator): The number of points in the input fields are inconsistent'
    36483648       endif
    3649        if (size(cospgridIN%pfull,2)           /= cospIN%Nlevels   .OR. &
    3650            size(cospgridIN%at,2)              /= cospIN%Nlevels   .OR. &
    3651            size(cospgridIN%qv,2)              /= cospIN%Nlevels   .OR. &
    3652            size(cospgridIN%hgt_matrix_half,2) /= cospIN%Nlevels+1 .OR. &
    3653            size(cospgridIN%phalf,2)           /= cospIN%Nlevels+1 .OR. &
    3654            size(cospgridIN%qv,2)              /= cospIN%Nlevels) then
     3649       if (size(cospgridIN%pfull,2)           .ne. cospIN%Nlevels   .OR. &
     3650           size(cospgridIN%at,2)              .ne. cospIN%Nlevels   .OR. &
     3651           size(cospgridIN%qv,2)              .ne. cospIN%Nlevels   .OR. &
     3652           size(cospgridIN%hgt_matrix_half,2) .ne. cospIN%Nlevels+1 .OR. &
     3653           size(cospgridIN%phalf,2)           .ne. cospIN%Nlevels+1 .OR. &
     3654           size(cospgridIN%qv,2)              .ne. cospIN%Nlevels) then
    36553655          Lrttov_column    = .false.
    36563656          nError=nError+1

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_optics.F90

    r5087 r5095  
    7272    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    7373    do j=1,dim2
    74        where(flag(:,j,:) == 1)
     74       where(flag(:,j,:) .eq. 1)
    7575          varOUT(:,j,:) = varIN2
    7676       endwhere
    77        where(flag(:,j,:) == 2)
     77       where(flag(:,j,:) .eq. 2)
    7878          varOUT(:,j,:) = varIN1
    7979       endwhere
    … …  
    9696   
    9797    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    98    where(flag(:,:,:) == 1)
     98   where(flag(:,:,:) .eq. 1)
    9999       varOUT(:,:,:) = varIN2
    100100    endwhere
    101     where(flag(:,:,:) == 2)
     101    where(flag(:,:,:) .eq. 2)
    102102       varOUT(:,:,:) = varIN1
    103103    endwhere
    … …  
    295295
    296296    ! Which LIDAR frequency are we using?
    297     if (lidar_freq == 355) then
     297    if (lidar_freq .eq. 355) then
    298298       Cmol   = Cmol_355nm
    299299       rdiffm = rdiffm_355nm
    300300    endif
    301     if (lidar_freq == 532) then
     301    if (lidar_freq .eq. 532) then
    302302       Cmol   = Cmol_532nm
    303303       rdiffm = rdiffm_532nm
    … …  
    336336   
    337337    ! LS and CONV Ice water coefficients
    338     if (ice_type == 0) then
     338    if (ice_type .eq. 0) then
    339339       polpart(INDX_LSICE,1:5) = polpartLSICE0
    340340       polpart(INDX_CVICE,1:5) = polpartCVICE0
    341341    endif
    342     if (ice_type == 1) then
     342    if (ice_type .eq. 1) then
    343343       polpart(INDX_LSICE,1:5) = polpartLSICE1
    344344       polpart(INDX_CVICE,1:5) = polpartCVICE1
    … …  
    393393    ! Polynomials kp_lidar derived from Mie theory
    394394    do i = 1, npart
    395        where (rad_part(1:npoints,1:nlev,i) > 0.0)
     395       where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
    396396          kp_part(1:npoints,1:nlev,i) = &
    397397               polpart(i,1)*(rad_part(1:npoints,1:nlev,i)*1e6)**4 &
    … …  
    426426       ! Alpha of particles in each subcolumn:
    427427       do i = 1, npart
    428           where (rad_part(1:npoints,1:nlev,i) > 0.0)
     428          where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
    429429             alpha_part(1:npoints,1:nlev,i) = 3._wp/4._wp * Qscat &
    430430                  * rhoair(1:npoints,1:nlev) * qpart(1:npoints,1:nlev,i) &
    … …  
    440440          ! Optical thickness of each layer (particles)
    441441          tau_part(1:npoints,1:nlev,i) = tau_part(1:npoints,1:nlev,i) &
    442    * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
     442               & * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
    443443          ! Optical thickness from TOA to layer k (particles)
    444444          do k=zi,zf,zinc

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_stats.F90

    r5082 r5095  
    210210          ! look for j_1km from bottom to top
    211211          j = 1
    212           do while (Ze_tot(pr,i,j) == R_GROUND)
     212          do while (Ze_tot(pr,i,j) .eq. R_GROUND)
    213213             j = j+1
    214214          enddo
    … …  
    217217          do j=1,Nlevels
    218218             sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
    219              if ((sc_ratio <= s_att) .and. (flag_sat == 0)) flag_sat = j
    220              if (Ze_tot(pr,i,j) < -30.) then  !radar can't detect cloud
    221                 if ( (sc_ratio > s_cld) .or. (flag_sat == j) ) then  !lidar sense cloud
     219             if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
     220             if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
     221                if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
    222222                   lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf
    223223                   flag_cld=1
    … …  
    226226                flag_cld=1
    227227                flag_radarcld=1
    228                 if (j > j_1km) flag_radarcld_no1km=1
     228                if (j .gt. j_1km) flag_radarcld_no1km=1             
    229229             endif
    230230          enddo !levels
    231           if (flag_cld == 1) tcc(pr)=tcc(pr)+1._wp
    232           if (flag_radarcld == 1) radar_tcc(pr)=radar_tcc(pr)+1.
    233           if (flag_radarcld_no1km == 1) radar_tcc2(pr)=radar_tcc2(pr)+1.
     231          if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1._wp
     232          if (flag_radarcld .eq. 1) radar_tcc(pr)=radar_tcc(pr)+1.
     233          if (flag_radarcld_no1km .eq. 1) radar_tcc2(pr)=radar_tcc2(pr)+1.       
    234234       enddo !columns
    235235    enddo !points
    … …  
    267267   
    268268    do ij=2,Nbins+1 
    269        hist1D(ij-1) = count(var >= bins(ij-1) .and. var < bins(ij))
    270        if (count(var == R_GROUND) >= 1) hist1D(ij-1)=R_UNDEF
     269       hist1D(ij-1) = count(var .ge. bins(ij-1) .and. var .lt. bins(ij))
     270       if (count(var .eq. R_GROUND) .ge. 1) hist1D(ij-1)=R_UNDEF
    271271    enddo
    272272   
    … …  
    300300    do ij=2,nbin1+1
    301301       do ik=2,nbin2+1
    302           jointHist(ij-1,ik-1)=count(var1 >= bin1(ij-1) .and. var1 < bin1(ij) .and. &
    303                var2 >= bin2(ik-1) .and. var2 < bin2(ik))
     302          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
     303               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       
    304304       enddo
    305305    enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/icarus.F90

    r5086 r5095  
    134134    ! ##########################################################################
    135135   
    136     if (debugcol/=0) then
     136    if (debugcol.ne.0) then
    137137       do j=1,npoints,debugcol
    138138         
    … …  
    140140          do ilev=1,nlev
    141141             acc(ilev,1:ncol)=frac_out(j,1:ncol,ilev)*2
    142              where(levmatch(j,1:ncol) == ilev) acc(ilev,1:ncol)=acc(ilev,1:ncol)+1
     142             where(levmatch(j,1:ncol) .eq. ilev) acc(ilev,1:ncol)=acc(ilev,1:ncol)+1
    143143          enddo
    144144         
    … …  
    155155                  (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev),&
    156156                  (cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    157           END DO
     157          end do
    158158          close(9)
    159159
    … …  
    224224
    225225    ! Set tropopause values
    226     if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     226    if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then
    227227       ptrop(1:npoints)     = 5000._wp
    228228       attropmin(1:npoints) = 400._wp
    … …  
    232232
    233233       do ilev=1,nlev
    234           where(pfull(1:npoints,ilev) < 40000. .and. &
    235                 pfull(1:npoints,ilev) >  5000. .and. &
    236                 at(1:npoints,ilev)    < attropmin(1:npoints))
     234          where(pfull(1:npoints,ilev) .lt. 40000. .and. &
     235                pfull(1:npoints,ilev) .gt.  5000. .and. &
     236                at(1:npoints,ilev)    .lt. attropmin(1:npoints))
    237237             ptrop(1:npoints)     = pfull(1:npoints,ilev)
    238238             attropmin(1:npoints) = at(1:npoints,ilev)
    … …  
    244244       do ilev=1,nlev
    245245          atmax(1:npoints) = merge(at(1:npoints,ilev),atmax(1:npoints),&
    246                at(1:npoints,ilev) > atmax(1:npoints) .and. ilev  >= itrop(1:npoints))
     246               at(1:npoints,ilev) .gt. atmax(1:npoints) .and. ilev  .ge. itrop(1:npoints))
    247247       enddo
    248248    end if
    249249 
    250     if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     250    if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then
    251251       ! ############################################################################
    252252       !                        Clear-sky radiance calculation
    … …  
    308308             dem(1:npoints,ibox) = merge(dem_wv(1:npoints,ilev), &
    309309                                         1._wp-(1._wp-demIN(1:npoints,ibox,ilev))*(1._wp-dem_wv(1:npoints,ilev)), &
    310                                          demIN(1:npoints,ibox,ilev) == 0)
     310                                         demIN(1:npoints,ibox,ilev) .eq. 0)
    311311
    312312             ! Increase TOA flux emitted from layer
    … …  
    322322       do ibox=1,ncol
    323323          fluxtop(1:npoints,ibox) = fluxtop(1:npoints,ibox) + emsfc_lw*bb(1:npoints)*trans_layers_above(1:npoints,ibox)
    324        END DO
     324       end do
    325325
    326326       ! All Sky brightness temperature
    … …  
    348348          tauir(1:npoints)    = tau(1:npoints,ibox)/2.13_wp
    349349          taumin(1:npoints)   = -log(max(min(transmax(1:npoints),0.9999999_wp),0.001_wp))
    350           if (isccp_top_height == 1) then
     350          if (isccp_top_height .eq. 1) then
    351351             do j=1,npoints 
    352                 if (transmax(j) > 0.001 .and.  transmax(j) <= 0.9999999) then
     352                if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
    353353                   fluxtopinit(j) = fluxtop(j,ibox)
    354354                   tauir(j) = tau(j,ibox)/2.13_wp
    … …  
    357357             do icycle=1,2
    358358                do j=1,npoints 
    359                    if (tau(j,ibox) > (tauchk)) then
    360                       if (transmax(j) > 0.001 .and.  transmax(j) <= 0.9999999) then
     359                   if (tau(j,ibox) .gt. (tauchk)) then
     360                      if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
    361361                         emcld(j,ibox) = 1._wp - exp(-1._wp * tauir(j)  )
    362362                         fluxtop(j,ibox) = fluxtopinit(j) - ((1.-emcld(j,ibox))*fluxtop_clrsky(j))
    363363                         fluxtop(j,ibox)=max(1.E-06_wp,(fluxtop(j,ibox)/emcld(j,ibox)))
    364364                         tb(j,ibox)= 1307.27_wp / (log(1._wp + (1._wp/fluxtop(j,ibox))))
    365                          if (tb(j,ibox) > 260.) then
     365                         if (tb(j,ibox) .gt. 260.) then
    366366                            tauir(j) = tau(j,ibox) / 2.56_wp
    367367                         end if
    … …  
    373373
    374374          ! Cloud-top temperature
    375           where(tau(1:npoints,ibox) > tauchk)
     375          where(tau(1:npoints,ibox) .gt. tauchk)
    376376             tb(1:npoints,ibox)= 1307.27_wp/ (log(1. + (1._wp/fluxtop(1:npoints,ibox))))
    377              where (isccp_top_height == 1 .and. tauir(1:npoints) < taumin(1:npoints))
     377             where (isccp_top_height .eq. 1 .and. tauir(1:npoints) .lt. taumin(1:npoints))
    378378                tb(1:npoints,ibox) = attrop(1:npoints) - 5._wp
    379379                tau(1:npoints,ibox) = 2.13_wp*taumin(1:npoints)
    … …  
    382382         
    383383          ! Clear-sky brightness temperature
    384           where(tau(1:npoints,ibox) <= tauchk)
     384          where(tau(1:npoints,ibox) .le. tauchk)
    385385             tb(1:npoints,ibox) = meantbclr(1:npoints)
    386386          endwhere
    … …  
    399399    do ibox=1,ncol
    400400       !segregate according to optical thickness
    401        if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     401       if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then 
    402402         
    403403          ! Find level whose temperature most closely matches brightness temperature
    404404          nmatch(1:npoints)=0
    405405          do k1=1,nlev-1
    406              ilev = merge(nlev-k1,k1,isccp_top_height_direction == 2)
     406             ilev = merge(nlev-k1,k1,isccp_top_height_direction .eq. 2)       
    407407             do j=1,npoints
    408                 if (ilev           >= itrop(j)     .and. &
    409                      ((at(j,ilev)  >= tb(j,ibox)   .and. &
    410                       at(j,ilev+1) <= tb(j,ibox))  .or.  &
    411                       (at(j,ilev)  <= tb(j,ibox)   .and. &
    412                       at(j,ilev+1) >= tb(j,ibox)))) then
     408                if (ilev           .ge. itrop(j)     .and. &
     409                     ((at(j,ilev)  .ge. tb(j,ibox)   .and. & 
     410                      at(j,ilev+1) .le. tb(j,ibox))  .or.  &
     411                      (at(j,ilev)  .le. tb(j,ibox)   .and. &
     412                      at(j,ilev+1) .ge. tb(j,ibox)))) then
    413413                   nmatch(j)=nmatch(j)+1
    414414                   match(j,nmatch(j))=ilev
    … …  
    418418
    419419          do j=1,npoints
    420              if (nmatch(j) >= 1) then
     420             if (nmatch(j) .ge. 1) then
    421421                k1 = match(j,nmatch(j))
    422422                k2 = k1 + 1
    … …  
    426426                logp=logp1+(logp2-logp1)*abs(tb(j,ibox)-at(j,k1))/atd
    427427                ptop(j,ibox) = exp(logp)
    428                 levmatch(j,ibox) = merge(k1,k2,abs(pfull(j,k1)-ptop(j,ibox)) < abs(pfull(j,k2)-ptop(j,ibox)))
     428                levmatch(j,ibox) = merge(k1,k2,abs(pfull(j,k1)-ptop(j,ibox)) .lt. abs(pfull(j,k2)-ptop(j,ibox)))
    429429             else
    430                 if (tb(j,ibox) <= attrop(j)) then
     430                if (tb(j,ibox) .le. attrop(j)) then
    431431                   ptop(j,ibox)=ptrop(j)
    432432                   levmatch(j,ibox)=itrop(j)
    433433                end if
    434                 if (tb(j,ibox) >= atmax(j)) then
     434                if (tb(j,ibox) .ge. atmax(j)) then
    435435                   ptop(j,ibox)=pfull(j,nlev)
    436436                   levmatch(j,ibox)=nlev
    … …  
    441441          ptop(1:npoints,ibox)=0.
    442442          do ilev=1,nlev
    443              where((ptop(1:npoints,ibox) == 0. ) .and.(frac_out(1:npoints,ibox,ilev) /= 0))
     443             where((ptop(1:npoints,ibox) .eq. 0. ) .and.(frac_out(1:npoints,ibox,ilev) .ne. 0))
    444444                ptop(1:npoints,ibox)=phalf(1:npoints,ilev)
    445445                levmatch(1:npoints,ibox)=ilev
    446446             endwhere
    447           END DO
     447          end do
    448448       end if
    449        where(tau(1:npoints,ibox) <= tauchk)
     449       where(tau(1:npoints,ibox) .le. tauchk)
    450450          ptop(1:npoints,ibox)=0._wp
    451451          levmatch(1:npoints,ibox)=0._wp
    … …  
    460460    do ibox=1,ncol
    461461       do j=1,npoints
    462           if (tau(j,ibox) > (tauchk) .and. ptop(j,ibox) > 0.) then
    463              if (sunlit(j)==1 .or. isccp_top_height == 3) then
     462          if (tau(j,ibox) .gt. (tauchk) .and. ptop(j,ibox) .gt. 0.) then
     463             if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
    464464                boxtau(j,ibox) = tau(j,ibox)
    465465                boxptop(j,ibox) = ptop(j,ibox)!/100._wp
    … …  
    508508    !                           Brightness Temperature
    509509    ! ####################################################################################
    510     if (isccp_top_height == 1 .or. isccp_top_height == 3) then
     510    if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then
    511511       meantb(1:npoints)=sum(boxttop,2)/ncol
    512512    else
    … …  
    535535       do ilev2=1,7
    536536          do j=1,npoints !
    537              if (sunlit(j)==1 .or. isccp_top_height == 3) then
     537             if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
    538538                fq_isccp(j,ilev,ilev2)= 0.
    539539             else
    … …  
    546546   
    547547    ! Reset variables need for averaging cloud properties
    548     where(sunlit == 1 .or. isccp_top_height == 3)
     548    where(sunlit .eq. 1 .or. isccp_top_height .eq. 3)
    549549       totalcldarea(1:npoints)  = 0._wp
    550550       meanalbedocld(1:npoints) = 0._wp
    … …  
    561561    do j=1,npoints
    562562       ! Subcolumns that are cloudy(true) and not(false)
    563        box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) > tauchk .and. boxptop(j,1:ncol) > 0.)
     563       box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) .gt. tauchk .and. boxptop(j,1:ncol) .gt. 0.)
    564564
    565565       ! Compute joint histogram and column quantities for points that are sunlit and cloudy
    566        if (sunlit(j) ==1 .or. isccp_top_height == 3) then
     566       if (sunlit(j) .eq.1 .or. isccp_top_height .eq. 3) then
    567567          ! Joint-histogram
    568568          call hist2D(boxtau(j,1:ncol),boxptop(j,1:ncol),ncol,isccp_histTau,numISCCPTauBins, &
    … …  
    572572         
    573573          ! Column cloud area
    574           totalcldarea(j) = real(count(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) > isccp_taumin))/ncol
     574          totalcldarea(j) = real(count(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin))/ncol
    575575             
    576576          ! Subcolumn cloud albedo
    577577          !albedocld(j,1:ncol) = merge((boxtau(j,1:ncol)**0.895_wp)/((boxtau(j,1:ncol)**0.895_wp)+6.82_wp),&
    578578          !     0._wp,box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)
    579           where(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) > isccp_taumin)
     579          where(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)
    580580             albedocld(j,1:ncol) = (boxtau(j,1:ncol)**0.895_wp)/((boxtau(j,1:ncol)**0.895_wp)+6.82_wp)
    581581          elsewhere
    … …  
    587587         
    588588          ! Column cloud top pressure
    589           meanptop(j) = sum(boxptop(j,1:ncol),box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) > isccp_taumin)/ncol
     589          meanptop(j) = sum(boxptop(j,1:ncol),box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)/ncol
    590590       endif
    591591    enddo
    592592   
    593593    ! Compute mean cloud properties. Set to mssing value in the event that totalcldarea=0
    594     where(totalcldarea(1:npoints) > 0)
     594    where(totalcldarea(1:npoints) .gt. 0)
    595595       meanptop(1:npoints)      = 100._wp*meanptop(1:npoints)/totalcldarea(1:npoints)
    596596       meanalbedocld(1:npoints) = meanalbedocld(1:npoints)/totalcldarea(1:npoints)
    … …  
    609609
    610610    ! Represent in percent
    611     where(totalcldarea /= output_missing_value) totalcldarea = totalcldarea*100._wp
    612     where(fq_isccp     /= output_missing_value) fq_isccp     = fq_isccp*100._wp
     611    where(totalcldarea .ne. output_missing_value) totalcldarea = totalcldarea*100._wp
     612    where(fq_isccp     .ne. output_missing_value) fq_isccp     = fq_isccp*100._wp
    613613   
    614614   
    … …  
    634634    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    635635    do j=1,dim2
    636        where(flag(:,j,:) == 1)
     636       where(flag(:,j,:) .eq. 1)
    637637          varOUT(:,j,:) = varIN2
    638638       endwhere
    639        where(flag(:,j,:) == 2)
     639       where(flag(:,j,:) .eq. 2)
    640640          varOUT(:,j,:) = varIN1
    641641       endwhere

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lidar_simulator.F90

    r5082 r5095  
    231231          ! Computation of the total perpendicular lidar signal (ATBperp for liq+ice)
    232232          ! Upper layer
    233           WHERE(tautot(1:npoints,icol,1) > 0)
     233          WHERE(tautot(1:npoints,icol,1) .gt. 0)
    234234             pnorm_perp_tot(1:npoints,icol,1) = (beta_perp_ice(1:npoints,icol,1)+           &
    235235                  beta_perp_liq(1:npoints,icol,1)-                                          &
    … …  
    251251             ! Betaperp=beta_mol(:,k)/(1+1/0.0284)) [bodhaine et al. 1999] in the following
    252252             ! equations:
    253              WHERE (pnorm(1:npoints,icol,k) == 0)
     253             WHERE (pnorm(1:npoints,icol,k) .eq. 0)
    254254                pnorm_perp_tot(1:npoints,icol,k)=0._wp
    255255             ELSEWHERE
    256                 where(tautot_lay(1:npoints) > 0.)
     256                where(tautot_lay(1:npoints) .gt. 0.)
    257257                   pnorm_perp_tot(1:npoints,icol,k) = (beta_perp_ice(1:npoints,icol,k)+     &
    258258                        beta_perp_liq(1:npoints,icol,k)-(beta_mol(1:npoints,k)/(1._wp+1._wp/  &
    … …  
    358358    latlid = .false.
    359359    lgrlidar532 = .false.
    360     if (platform == 'calipso') lcalipso=.true.
    361     if (platform == 'atlid') latlid=.true.
    362     if (platform == 'grlidar532') lgrlidar532=.true.
     360    if (platform .eq. 'calipso') lcalipso=.true.
     361    if (platform .eq. 'atlid') latlid=.true.
     362    if (platform .eq. 'grlidar532') lgrlidar532=.true.
    363363       
    364364    ! Vertically regrid input data
    … …  
    400400       do ic = 1, ncol
    401401          pnorm_c = pnormFlip(:,ic,:)
    402           where ((pnorm_c < xmax) .and. (betamolFlip(:,1,:) < xmax) .and.          &
    403                 (betamolFlip(:,1,:) > 0.0 ))
     402          where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
     403                (betamolFlip(:,1,:) .gt. 0.0 ))
    404404             x3d_c = pnorm_c/betamolFlip(:,1,:)
    405405          elsewhere
    … …  
    429429       do ic = 1, ncol
    430430          pnorm_c = pnorm(:,ic,:)
    431           where ((pnorm_c<xmax) .and. (pmol<xmax) .and. (pmol> 0.0 ))
     431          where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
    432432             x3d_c = pnorm_c/pmol
    433433          elsewhere
    … …  
    463463          enddo
    464464       enddo
    465        where(cfad2 /= R_UNDEF) cfad2=cfad2/ncol
     465       where(cfad2 .ne. R_UNDEF) cfad2=cfad2/ncol
    466466    endif
    467467   
    … …  
    501501    do k=2,nlev
    502502       tautot_lay(:) = tau(:,k)-tau(:,k-1)
    503        WHERE (tautot_lay(:) > 0.)
     503       WHERE (tautot_lay(:) .gt. 0.)
    504504          pnorm(:,k) = beta(:,k)*EXP(-2._wp*tau(:,k-1)) /&
    505505               (2._wp*tautot_lay(:))*(1._wp-EXP(-2._wp*tautot_lay(:)))
    … …  
    529529    do k=2,nlev
    530530       tautot_lay(:) = tau(:,k)-tau(:,k-1)       
    531        WHERE ( EXP(-2._wp*tau(:,k-1)) > epsrealwp )
    532           WHERE (tautot_lay(:) > 0.)
     531       WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. epsrealwp )
     532          WHERE (tautot_lay(:) .gt. 0.)
    533533             beta(:,k) = pnorm(:,k)/ EXP(-2._wp*tau(:,k-1))* &
    534534                  (2._wp*tautot_lay(:))/(1._wp-exp(-2._wp*tautot_lay(:)))
    … …  
    650650    do k=1,Nlevels
    651651       ! Cloud detection at subgrid-scale:
    652        where ((x(:,:,k) > S_cld) .and. (x(:,:,k) /= undef) )
     652       where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    653653          cldy(:,:,k)=1._wp
    654654       elsewhere
    … …  
    657657       
    658658       ! Number of usefull sub-columns:
    659        where ((x(:,:,k) > S_att) .and. (x(:,:,k) /= undef) )
     659       where ((x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
    660660          srok(:,:,k)=1._wp
    661661       elsewhere
    … …  
    677677             ! Computation of the cloud fraction as a function of the temperature instead
    678678             ! of height, for ice,liquid and all clouds
    679              if(srok(ip,ic,k)>0.)then
     679             if(srok(ip,ic,k).gt.0.)then
    680680                do itemp=1,Ntemp
    681                    if( (tmp(ip,k)>=tempmod(itemp)).and.(tmp(ip,k)<tempmod(itemp+1)) )then
     681                   if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    682682                      lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1._wp
    683683                   endif
    … …  
    685685             endif
    686686             
    687              if(cldy(ip,ic,k)==1.)then
     687             if(cldy(ip,ic,k).eq.1.)then
    688688                do itemp=1,Ntemp
    689                    if( (tmp(ip,k) >= tempmod(itemp)).and.(tmp(ip,k) < tempmod(itemp+1)) )then
     689                   if( (tmp(ip,k) .ge. tempmod(itemp)).and.(tmp(ip,k) .lt. tempmod(itemp+1)) )then
    690690                      lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1._wp
    691691                   endif
    … …  
    695695             iz=1
    696696             p1 = pplay(ip,k)
    697              if ( p1>0. .and. p1<(440._wp*100._wp)) then ! high clouds
     697             if ( p1.gt.0. .and. p1.lt.(440._wp*100._wp)) then ! high clouds
    698698                iz=3
    699              else if(p1>=(440._wp*100._wp) .and. p1<(680._wp*100._wp)) then ! mid clouds
     699             else if(p1.ge.(440._wp*100._wp) .and. p1.lt.(680._wp*100._wp)) then ! mid clouds
    700700                iz=2
    701701             endif
    … …  
    714714   
    715715    ! Grid-box 3D cloud fraction
    716     where ( nsub(:,:)>0.0 )
     716    where ( nsub(:,:).gt.0.0 )
    717717       lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
    718718    elsewhere
    … …  
    729729       enddo
    730730    enddo
    731     where (nsublayer(:,:) > 0.0)
     731    where (nsublayer(:,:) .gt. 0.0)
    732732       cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
    733733    elsewhere
    … …  
    748748
    749749             ! Avoid zero values
    750              if( (cldy(i,ncol,nlev)==1.) .and. (ATBperp(i,ncol,nlev)>0.) )then
     750             if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
    751751                ! Computation of the ATBperp along the phase discrimination line
    752752                ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    756756                ! 4.1.a) Ice: ATBperp above the phase discrimination line
    757757                ! ########################################################################
    758                 if((ATBperp(i,ncol,nlev)-ATBperp_tmp) >= 0.)then ! Ice clouds
     758                if((ATBperp(i,ncol,nlev)-ATBperp_tmp) .ge. 0.)then ! Ice clouds
    759759
    760760                   ! ICE with temperature above 273,15°K = Liquid (false ice)
    761                    if(tmp(i,nlev) > 273.15) then ! Temperature above 273,15 K
     761                   if(tmp(i,nlev) .gt. 273.15) then ! Temperature above 273,15 K
    762762                     ! Liquid: False ice corrected by the temperature to Liquid
    763763                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp ! False ice detection ==> added to Liquid
    … …  
    767767                                                                              ! to classify the phase cloud
    768768                      cldlayphase(i,ncol,4,2) = 1. ! tot cloud
    769                       if (p1 > 0. .and. p1<(440._wp*100._wp)) then ! high cloud
     769                      if (p1 .gt. 0. .and. p1.lt.(440._wp*100._wp)) then ! high cloud
    770770                         cldlayphase(i,ncol,3,2) = 1._wp
    771                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then ! mid cloud
     771                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then ! mid cloud
    772772                         cldlayphase(i,ncol,2,2) = 1._wp
    773773                      else ! low cloud
    … …  
    776776                      cldlayphase(i,ncol,4,5) = 1._wp ! tot cloud
    777777                      ! High cloud
    778                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     778                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    779779                         cldlayphase(i,ncol,3,5) = 1._wp
    780780                      ! Middle cloud
    781                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     781                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    782782                         cldlayphase(i,ncol,2,5) = 1._wp
    783783                      ! Low cloud
    … …  
    791791                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    792792                      ! High cloud
    793                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     793                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    794794                         cldlayphase(i,ncol,3,1) = 1._wp
    795795                      ! Middle cloud   
    796                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     796                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    797797                         cldlayphase(i,ncol,2,1) = 1._wp
    798798                      ! Low cloud
    … …  
    806806                else
    807807                   ! Liquid with temperature above 231,15°K
    808                    if(tmp(i,nlev) > 231.15_wp) then
     808                   if(tmp(i,nlev) .gt. 231.15_wp) then
    809809                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp
    810810                      tmpl(i,ncol,nlev)       = tmp(i,nlev)
    811811                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    812812                      ! High cloud
    813                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     813                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    814814                         cldlayphase(i,ncol,3,2) = 1._wp
    815815                      ! Middle cloud   
    816                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     816                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    817817                         cldlayphase(i,ncol,2,2) = 1._wp
    818818                      ! Low cloud   
    … …  
    827827                      cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
    828828                      ! High cloud
    829                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     829                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    830830                         cldlayphase(i,ncol,3,4) = 1._wp
    831831                      ! Middle cloud   
    832                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     832                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    833833                         cldlayphase(i,ncol,2,4) = 1._wp
    834834                      ! Low cloud
    … …  
    838838                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    839839                      ! High cloud
    840                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     840                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    841841                         cldlayphase(i,ncol,3,1) = 1._wp
    842842                      ! Middle cloud   
    843                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     843                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    844844                         cldlayphase(i,ncol,2,1) = 1._wp
    845845                      ! Low cloud   
    … …  
    859859             p1 = pplay(i,nlev)
    860860
    861              if((cldy(i,ncol,nlev) == 1.) .and. (ATBperp(i,ncol,nlev) > 0.) )then
     861             if((cldy(i,ncol,nlev) .eq. 1.) .and. (ATBperp(i,ncol,nlev) .gt. 0.) )then
    862862                ! Computation of the ATBperp of the phase discrimination line
    863863                ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    868868                ! ########################################################################
    869869                ! ICE with temperature above 273,15°K = Liquid (false ice)
    870                 if((ATBperp(i,ncol,nlev)-ATBperp_tmp) >= 0.)then ! Ice clouds
    871                    if(tmp(i,nlev) > 273.15)then
     870                if((ATBperp(i,ncol,nlev)-ATBperp_tmp) .ge. 0.)then ! Ice clouds
     871                   if(tmp(i,nlev) .gt. 273.15)then
    872872                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp ! false ice ==> liq
    873873                      tmpl(i,ncol,nlev)       = tmp(i,nlev)
    … …  
    875875                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    876876                      ! High cloud
    877                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     877                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    878878                         cldlayphase(i,ncol,3,2) = 1._wp
    879879                      ! Middle cloud   
    880                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     880                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    881881                         cldlayphase(i,ncol,2,2) = 1._wp
    882882                      ! Low cloud
    … …  
    887887                      cldlayphase(i,ncol,4,5) = 1. ! tot cloud
    888888                      ! High cloud
    889                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     889                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    890890                         cldlayphase(i,ncol,3,5) = 1._wp
    891891                      ! Middle cloud   
    892                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     892                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    893893                         cldlayphase(i,ncol,2,5) = 1._wp
    894894                      ! Low cloud   
    … …  
    902902                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    903903                      ! High cloud
    904                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     904                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    905905                         cldlayphase(i,ncol,3,1) = 1._wp
    906906                      ! Middle cloud   
    907                       else if(p1 >= (440._wp*100._wp) .and. p1 <(680._wp*100._wp)) then
     907                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt.(680._wp*100._wp)) then
    908908                         cldlayphase(i,ncol,2,1) = 1._wp
    909909                      ! Low cloud   
    … …  
    918918                else
    919919                   ! Liquid with temperature above 231,15°K
    920                    if(tmp(i,nlev) > 231.15)then
     920                   if(tmp(i,nlev) .gt. 231.15)then
    921921                      lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp
    922922                      tmpl(i,ncol,nlev)       = tmp(i,nlev)
    923923                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    924924                      ! High cloud
    925                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     925                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    926926                         cldlayphase(i,ncol,3,2) = 1._wp
    927927                      ! Middle cloud   
    928                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     928                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    929929                         cldlayphase(i,ncol,2,2) = 1._wp
    930930                      ! Low cloud   
    … …  
    939939                      cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
    940940                      ! High cloud
    941                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     941                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    942942                         cldlayphase(i,ncol,3,4) = 1._wp
    943943                      ! Middle   
    944                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     944                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    945945                         cldlayphase(i,ncol,2,4) = 1._wp
    946946                      ! Low cloud   
    … …  
    951951                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    952952                      ! High cloud
    953                       if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     953                      if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    954954                         cldlayphase(i,ncol,3,1) = 1._wp
    955955                      ! Middle cloud   
    956                       else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     956                      else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    957957                         cldlayphase(i,ncol,2,1) = 1._wp
    958958                      ! Low cloud   
    … …  
    966966               
    967967                ! Find the level of the highest cloud with SR>30
    968                 if(x(i,ncol,nlev) > S_cld_att) then ! SR > 30.
     968                if(x(i,ncol,nlev) .gt. S_cld_att) then ! SR > 30.
    969969                    toplvlsat = nlev+1
    970970                    goto 99
    … …  
    978978          ! see Cesana and Chepfer 2013 Sect.III.2
    979979          ! ##############################################################################
    980           if(toplvlsat/=0) then
     980          if(toplvlsat.ne.0) then
    981981             do nlev = toplvlsat,Nlevels
    982982                p1 = pplay(i,nlev)
    983                 if(cldy(i,ncol,nlev)==1.)then
     983                if(cldy(i,ncol,nlev).eq.1.)then
    984984                   lidarcldphase(i,nlev,3) = lidarcldphase(i,nlev,3)+1._wp
    985985                   tmpu(i,ncol,nlev)       = tmp(i,nlev)
    986986                   cldlayphase(i,ncol,4,3) = 1._wp ! tot cloud
    987987                   ! High cloud
    988                    if (p1 > 0. .and. p1 < (440._wp*100._wp)) then
     988                   if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
    989989                      cldlayphase(i,ncol,3,3) = 1._wp
    990990                   ! Middle cloud   
    991                    else if(p1 >= (440._wp*100._wp) .and. p1 < (680._wp*100._wp)) then
     991                   else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
    992992                      cldlayphase(i,ncol,2,3) = 1._wp
    993993                   ! Low cloud   
    … …  
    10081008    ! Compute the Ice percentage in cloud = ice/(ice+liq) as a function of the occurrences
    10091009    lidarcldphasetmp(:,:) = lidarcldphase(:,:,1)+lidarcldphase(:,:,2);
    1010     WHERE (lidarcldphasetmp(:,:) > 0.)
     1010    WHERE (lidarcldphasetmp(:,:) .gt. 0.)
    10111011       lidarcldphase(:,:,6)=lidarcldphase(:,:,1)/lidarcldphasetmp(:,:)
    10121012    ELSEWHERE
    … …  
    10161016    ! Compute Phase 3D Cloud Fraction
    10171017    !WHERE (nsub(:,Nlevels:1:-1) .gt. 0.0 )
    1018     WHERE (nsub(:,:) > 0.0 )
     1018    WHERE (nsub(:,:) .gt. 0.0 ) 
    10191019       lidarcldphase(:,:,1)=lidarcldphase(:,:,1)/nsub(:,:)
    10201020       lidarcldphase(:,:,2)=lidarcldphase(:,:,2)/nsub(:,:)
    … …  
    10491049    ! Compute the Ice percentage in cloud = ice/(ice+liq)
    10501050    cldlayerphasetmp(:,:)=cldlayerphase(:,:,1)+cldlayerphase(:,:,2)
    1051     WHERE (cldlayerphasetmp(:,:)> 0.)
     1051    WHERE (cldlayerphasetmp(:,:).gt. 0.)
    10521052       cldlayerphase(:,:,6)=cldlayerphase(:,:,1)/cldlayerphasetmp(:,:)
    10531053    ELSEWHERE
    … …  
    10561056   
    10571057    do i=1,Nphase-1
    1058        WHERE ( cldlayerphasesum(:,:)>0.0 )
     1058       WHERE ( cldlayerphasesum(:,:).gt.0.0 )
    10591059          cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
    10601060       ENDWHERE
    … …  
    10651065          checkcldlayerphase=0.
    10661066          checkcldlayerphase2=0.
    1067           if (cldlayerphasesum(i,iz) > 0.0 )then
     1067          if (cldlayerphasesum(i,iz) .gt. 0.0 )then
    10681068             do ic=1,Nphase-3
    10691069                checkcldlayerphase = checkcldlayerphase+cldlayerphase(i,iz,ic)
    10701070             enddo
    10711071             checkcldlayerphase2 = cldlayer(i,iz)-checkcldlayerphase
    1072              if((checkcldlayerphase2 > 0.01) .or. (checkcldlayerphase2 < -0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
     1072             if((checkcldlayerphase2 .gt. 0.01) .or. (checkcldlayerphase2 .lt. -0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
    10731073          endif
    10741074       enddo
    … …  
    10761076   
    10771077    do i=1,Nphase-1
    1078        WHERE (nsublayer(:,:) == 0.0)
     1078       WHERE (nsublayer(:,:) .eq. 0.0)
    10791079          cldlayerphase(:,:,i) = undef
    10801080       ENDWHERE
    … …  
    10861086          do i=1,Npoints
    10871087             do itemp=1,Ntemp
    1088                 if(tmpi(i,ncol,nlev)>0.)then
    1089                    if((tmpi(i,ncol,nlev) >= tempmod(itemp)) .and. (tmpi(i,ncol,nlev) < tempmod(itemp+1)) )then
     1088                if(tmpi(i,ncol,nlev).gt.0.)then
     1089                   if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    10901090                      lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1._wp
    10911091                   endif
    1092                 elseif(tmpl(i,ncol,nlev) > 0.)then
    1093                    if((tmpl(i,ncol,nlev) >= tempmod(itemp)) .and. (tmpl(i,ncol,nlev) < tempmod(itemp+1)) )then
     1092                elseif(tmpl(i,ncol,nlev) .gt. 0.)then
     1093                   if((tmpl(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpl(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    10941094                      lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1._wp
    10951095                   endif
    1096                 elseif(tmpu(i,ncol,nlev) > 0.)then
    1097                    if((tmpu(i,ncol,nlev) >= tempmod(itemp)) .and. (tmpu(i,ncol,nlev) < tempmod(itemp+1)) )then
     1096                elseif(tmpu(i,ncol,nlev) .gt. 0.)then
     1097                   if((tmpu(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpu(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    10981098                      lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1._wp
    10991099                   endif
    … …  
    11181118    ! Compute the Ice percentage in cloud = ice/(ice+liq)
    11191119    sumlidarcldtemp(:,:)=lidarcldtemp(:,:,2)+lidarcldtemp(:,:,3)   
    1120     WHERE(sumlidarcldtemp(:,:) > 0.)
     1120    WHERE(sumlidarcldtemp(:,:) .gt. 0.)
    11211121       lidarcldtemp(:,:,5)=lidarcldtemp(:,:,2)/sumlidarcldtemp(:,:)
    11221122    ELSEWHERE
    … …  
    11251125   
    11261126    do i=1,4
    1127        WHERE(lidarcldtempind(:,:) > 0.)
     1127       WHERE(lidarcldtempind(:,:) .gt. 0.)
    11281128          lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
    11291129       ELSEWHERE
    … …  
    11931193    do k=1,Nlevels
    11941194       ! Cloud detection at subgrid-scale:
    1195        where ((x(:,:,k) > S_cld) .and. (x(:,:,k) /= undef) )
     1195       where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    11961196          cldy(:,:,k)=1._wp
    11971197       elsewhere
    … …  
    12001200       
    12011201       ! Number of usefull sub-columns:
    1202        where ((x(:,:,k) > S_att) .and. (x(:,:,k) /= undef) )
     1202       where ((x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
    12031203          srok(:,:,k)=1._wp
    12041204       elsewhere
    … …  
    12161216             iz=1
    12171217             p1 = pplay(ip,k)
    1218              if ( p1>0. .and. p1<(440._wp*100._wp)) then ! high clouds
     1218             if ( p1.gt.0. .and. p1.lt.(440._wp*100._wp)) then ! high clouds
    12191219                iz=3
    1220              else if(p1>=(440._wp*100._wp) .and. p1<(680._wp*100._wp)) then ! mid clouds
     1220             else if(p1.ge.(440._wp*100._wp) .and. p1.lt.(680._wp*100._wp)) then ! mid clouds
    12211221                iz=2
    12221222             endif
    … …  
    12351235   
    12361236    ! Grid-box 3D cloud fraction
    1237     where ( nsub(:,:)>0.0 )
     1237    where ( nsub(:,:).gt.0.0 )
    12381238       lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
    12391239    elsewhere
    … …  
    12501250       enddo
    12511251    enddo
    1252     where (nsublayer(:,:) > 0.0)
     1252    where (nsublayer(:,:) .gt. 0.0)
    12531253       cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
    12541254    elsewhere
    … …  
    13441344    do k=1,Nlevels
    13451345       ! Cloud detection at subgrid-scale:
    1346        where ( (x(:,:,k) > S_cld) .and. (x(:,:,k) /= undef) )
     1346       where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    13471347          cldy(:,:,k)=1._wp
    13481348       elsewhere
    … …  
    13501350       endwhere
    13511351       ! Fully attenuated layer detection at subgrid-scale:
    1352        where ( (x(:,:,k) < S_att_opaq) .and. (x(:,:,k) >= 0.) .and. (x(:,:,k) /= undef) ) !DEBUG
     1352       where ( (x(:,:,k) .lt. S_att_opaq) .and. (x(:,:,k) .ge. 0.) .and. (x(:,:,k) .ne. undef) ) !DEBUG
    13531353          cldyopaq(:,:,k)=1._wp
    13541354       elsewhere
    … …  
    13581358
    13591359       ! Number of usefull sub-column layers:
    1360        where ( (x(:,:,k) > S_att) .and. (x(:,:,k) /= undef) )
     1360       where ( (x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
    13611361          srok(:,:,k)=1._wp
    13621362       elsewhere
    … …  
    13641364       endwhere
    13651365       ! Number of usefull sub-columns layers for z_opaque 3D fraction:
    1366        where ( (x(:,:,k) >= 0.) .and. (x(:,:,k) /= undef) ) !DEBUG
     1366       where ( (x(:,:,k) .ge. 0.) .and. (x(:,:,k) .ne. undef) ) !DEBUG
    13671367          srokopaq(:,:,k)=1._wp
    13681368       elsewhere
    … …  
    13971397
    13981398     ! Declaring non-opaque cloudy profiles as thin cloud profiles
    1399            if ( cldlay(ip,ic,4)> 0. .and. cldlay(ip,ic,1) == 0. ) then
     1399           if ( cldlay(ip,ic,4).gt. 0. .and. cldlay(ip,ic,1) .eq. 0. ) then
    14001400              cldlay(ip,ic,2)  =  1._wp
    14011401           endif
    … …  
    14041404
    14051405     ! Opaque cloud profiles
    1406            if ( cldlay(ip,ic,1) == 1. ) then
     1406           if ( cldlay(ip,ic,1) .eq. 1. ) then
    14071407              zopac = 0._wp
    14081408              z_top = 0._wp
    … …  
    14101410     ! Declaring z_opaque altitude and opaque cloud fraction for 3D and 2D variables
    14111411     ! From SFC-2-TOA ( actually from vgrid_z(SFC+1) = vgrid_z(Nlevels-1) )
    1412                  if ( cldy(ip,ic,Nlevels-k) == 1. .and. zopac == 0. ) then
     1412                 if ( cldy(ip,ic,Nlevels-k) .eq. 1. .and. zopac .eq. 0. ) then
    14131413                    lidarcldtype(ip,Nlevels-k + 1,3) = lidarcldtype(ip,Nlevels-k + 1,3) + 1._wp
    14141414                    cldlay(ip,ic,3)                  = vgrid_z(Nlevels-k+1)      ! z_opaque altitude
    … …  
    14161416                    zopac = Nlevels-k+1                        ! z_opaque vertical index on vgrid_z
    14171417                 endif
    1418                  if ( cldy(ip,ic,Nlevels-k) == 1. ) then
     1418                 if ( cldy(ip,ic,Nlevels-k) .eq. 1. ) then
    14191419                    lidarcldtype(ip,Nlevels-k ,1)    = lidarcldtype(ip,Nlevels-k ,1) + 1._wp
    14201420                    z_top = Nlevels-k    ! top cloud layer vertical index on vgrid_z
    … …  
    14231423     ! Summing opaque cloud mean temperatures and altitudes
    14241424     ! as defined in Vaillant de Guelis et al. 2017a, AMT
    1425               if (zopac /= 0) then
     1425              if (zopac .ne. 0) then
    14261426                 cldtypetemp(ip,1) = cldtypetemp(ip,1) + ( tmp(ip,zopac) + tmp(ip,z_top) )/2.
    14271427                 cldtypetemp(ip,3) = cldtypetemp(ip,3) + tmp(ip,zopac)                 ! z_opaque
    … …  
    14351435
    14361436     ! Thin cloud profiles
    1437            if ( cldlay(ip,ic,2) == 1. ) then
     1437           if ( cldlay(ip,ic,2) .eq. 1. ) then
    14381438              topcloud = 0._wp
    14391439              z_top = 0._wp
    … …  
    14421442     ! Declaring thin cloud fraction for 3D variable
    14431443     ! From TOA-2-SFC
    1444                  if ( cldy(ip,ic,k) == 1. .and. topcloud == 1. ) then
     1444                 if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 1. ) then
    14451445                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
    14461446                    z_base = k ! bottom cloud layer
    14471447                 endif
    1448                  if ( cldy(ip,ic,k) == 1. .and. topcloud == 0. ) then
     1448                 if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 0. ) then
    14491449                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
    14501450                    z_top = k  ! top cloud layer
    … …  
    14581458              cloudemis = 0._wp
    14591459              do k=z_base+1,Nlevels
    1460                  if (  (x(ip,ic,k) > S_att_opaq) .and. (x(ip,ic,k) < 1.0) .and. (x(ip,ic,k) /= undef)  ) then
     1460                 if (  (x(ip,ic,k) .gt. S_att_opaq) .and. (x(ip,ic,k) .lt. 1.0) .and. (x(ip,ic,k) .ne. undef)  ) then
    14611461                    srmean = srmean + x(ip,ic,k)
    14621462                    srcount = srcount + 1.
    … …  
    14641464              enddo
    14651465              ! If clear sky layers exist below bottom cloud layer
    1466               if ( srcount > 0. ) then
     1466              if ( srcount .gt. 0. ) then
    14671467                 trans2 = srmean/srcount              ! thin cloud transmittance**2
    14681468                 tau_app = -(log(trans2))/2.          ! apparent cloud optical depth
    … …  
    14841484
    14851485    ! 3D cloud types fraction (opaque=1 and thin=2 clouds)
    1486     where ( nsub(:,:) > 0. )
     1486    where ( nsub(:,:) .gt. 0. )
    14871487       lidarcldtype(:,:,1) = lidarcldtype(:,:,1)/nsub(:,:)
    14881488       lidarcldtype(:,:,2) = lidarcldtype(:,:,2)/nsub(:,:)
    … …  
    14921492    endwhere
    14931493    ! 3D z_opaque fraction (=3)
    1494     where ( nsubopaq(:,:) > 0. )
     1494    where ( nsubopaq(:,:) .gt. 0. )
    14951495       lidarcldtype(:,:,3) = lidarcldtype(:,:,3)/nsubopaq(:,:)
    14961496    elsewhere
    … …  
    15021502    do ip = 1, Npoints
    15031503        do k = 2, Nlevels
    1504             if ( (lidarcldtype(ip,k,3) /= undef) .and. (lidarcldtype(ip,k-1,4) /= undef) ) then
     1504            if ( (lidarcldtype(ip,k,3) .ne. undef) .and. (lidarcldtype(ip,k-1,4) .ne. undef) ) then
    15051505                lidarcldtype(ip,k,4) = lidarcldtype(ip,k,3) + lidarcldtype(ip,k-1,4)
    15061506            else
    … …  
    15201520
    15211521    ! Mean temperature and altitude
    1522     where (cldtype(:,1) > 0.)
     1522    where (cldtype(:,1) .gt. 0.)
    15231523       cldtypetemp(:,1) = cldtypetemp(:,1)/cldtype(:,1) ! opaque cloud temp
    15241524       cldtypetemp(:,3) = cldtypetemp(:,3)/cldtype(:,1) ! z_opaque
    … …  
    15341534    endwhere
    15351535
    1536     where (cldtype(:,2) > 0.) ! thin cloud
     1536    where (cldtype(:,2) .gt. 0.) ! thin cloud
    15371537       cldtypetemp(:,2) = cldtypetemp(:,2)/cldtype(:,2)
    15381538       cldtypemeanz(:,2) = cldtypemeanz(:,2)/cldtype(:,2)
    … …  
    15451545
    15461546    ! Mean thin cloud emissivity
    1547     where (count_emis(:) > 0.) ! thin cloud
     1547    where (count_emis(:) .gt. 0.) ! thin cloud
    15481548       cldthinemis(:) = cldthinemis(:)/count_emis(:)
    15491549    elsewhere
    … …  
    15511551    endwhere
    15521552
    1553     where (nsublayer(:,:) > 0.)
     1553    where (nsublayer(:,:) .gt. 0.)
    15541554       cldtype(:,:) = cldtype(:,:)/nsublayer(:,:)
    15551555    elsewhere

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90

    r5082 r5095  
    275275        cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
    276276
    277     if (overlaplmdz/=overlap) then
     277    if (overlaplmdz.ne.overlap) then
    278278       print*,'Attention overlaplmdz different de overlap lu dans namelist '
    279279    endif
    … …  
    282282   print*,'On passe par using_xios'
    283283 ELSE
    284    if (cosp_init_flag == 0) then
     284   if (cosp_init_flag .eq. 0) then
    285285
    286286      ! Initialize the distributional parameters for hydrometeors in radar simulator.
    … …  
    311311
    312312!!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
    313   if ((itap>=1).and.(first_write))then
     313  if ((itap.ge.1).and.(first_write))then
    314314    IF (using_xios) call read_xiosfieldactive(cfg)
    315315    first_write=.false.
    316316
    317 if (cosp_init_flag == 0) then
     317if (cosp_init_flag .eq. 0) then
    318318
    319319    ! Initialize the distributional parameters for hydrometeors in radar simulator.
    … …  
    384384! 3) Masque terre/mer a partir de la variable fracTerLic
    385385        do ip = 1, Npoints
    386           if (fracTerLic(ip)>=0.5) then
     386          if (fracTerLic(ip).ge.0.5) then
    387387             land(ip) = 1.
    388388          else
    … …  
    424424
    425425
    426 if (cosp_init_flag == 1) then      ! cosp_init_flag = 1
     426if (cosp_init_flag .eq. 1) then      ! cosp_init_flag = 1
    427427
    428428!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    … …  
    538538      endif ! debut_cosp
    539539
    540 if (cosp_init_flag == 1) then
     540if (cosp_init_flag .eq. 1) then
    541541
    542542!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90

    r5093 r5095  
    669669    CHARACTER(LEN=20) :: typeecrit
    670670
    671     ! ug On récupère le type écrit de la structure:
    672     !       Assez moche, à refaire si meilleure méthode...
     671    ! ug On récupère le type écrit de la structure:
     672    !       Assez moche, Ã|  refaire si meilleure méthode...
    673673    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
    674674       typeecrit = 'once'
    … …  
    730730
    731731! Axe vertical
    732       IF (nvertsave==nvertp(iff)) THEN
     732      IF (nvertsave.eq.nvertp(iff)) THEN
    733733          klevs=PARASOL_NREFL
    734734          nam_axvert="sza"
    735       ELSE IF (nvertsave==nvertisccp(iff)) THEN
     735      ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
    736736          klevs=7
    737737          nam_axvert="pressure2"
    738       ELSE IF (nvertsave==nvertcol(iff)) THEN
     738      ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
    739739          klevs=Ncolout
    740740          nam_axvert="column"
    741       ELSE IF (nvertsave==nverttemp(iff)) THEN
     741      ELSE IF (nvertsave.eq.nverttemp(iff)) THEN
    742742          klevs=LIDAR_NTEMP
    743743          nam_axvert="temp"
    744       ELSE IF (nvertsave==nvertmisr(iff)) THEN
     744      ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
    745745          klevs=numMISRHgtBins
    746746          nam_axvert="cth16"
    747       ELSE IF (nvertsave==nvertReffIce(iff)) THEN
     747      ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN
    748748          klevs= numMODISReffIceBins
    749749          nam_axvert="ReffIce"
    750       ELSE IF (nvertsave==nvertReffLiq(iff)) THEN
     750      ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN
    751751          klevs= numMODISReffLiqBins
    752752          nam_axvert="ReffLiq"
    … …  
    765765      END IF
    766766
    767     ! ug On récupère le type écrit de la structure:
    768     !       Assez moche, à refaire si meilleure méthode...
     767    ! ug On récupère le type écrit de la structure:
     768    !       Assez moche, Ã|  refaire si meilleure méthode...
    769769    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
    770770       typeecrit = 'once'
    … …  
    827827    IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
    828828
    829   ! On regarde si on est dans la phase de définition ou d'écriture:
     829  ! On regarde si on est dans la phase de définition ou d'écriture:
    830830  IF(.NOT.cosp_varsdefined) THEN
    831831!$OMP MASTER
    832832      print*,'var, cosp_varsdefined dans cosp_varsdefined ',var%name, cosp_varsdefined
    833       !Si phase de définition.... on définit
     833      !Si phase de définition.... on définit
    834834      CALL conf_cospoutputs(var%name,var%cles)
    835835      DO iff=1, 3
    … …  
    840840!$OMP END MASTER
    841841  ELSE
    842     !Et sinon on.... écrit
     842    !Et sinon on.... écrit
    843843    IF (SIZE(field)/=klon) &
    844844  CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
    … …  
    921921               nom=var%name
    922922      END IF
    923   ! On regarde si on est dans la phase de définition ou d'écriture:
     923  ! On regarde si on est dans la phase de définition ou d'écriture:
    924924  IF(.NOT.cosp_varsdefined) THEN
    925       !Si phase de définition.... on définit
     925      !Si phase de définition.... on définit
    926926!$OMP MASTER
    927927      CALL conf_cospoutputs(var%name,var%cles)
    … …  
    933933!$OMP END MASTER
    934934  ELSE
    935     !Et sinon on.... écrit
     935    !Et sinon on.... écrit
    936936    IF (SIZE(field,1)/=klon) &
    937937   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                 
    … …  
    10001000
    10011001  IF(cosp_varsdefined) THEN
    1002     !Et sinon on.... écrit
     1002    !Et sinon on.... écrit
    10031003    IF (SIZE(field,1)/=klon) &
    10041004   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)           

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90

    r5082 r5095  
    896896!  i = i+1 !si on laisse, 108 au lieu de 107
    897897
    898   if (i>107) then
     898  if (i.gt.107) then
    899899     print *, 'COSP_IO: wrong number of output diagnostics'
    900900     print *, i,107

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_subsample_and_optics_mod.F90

    r5086 r5095  
    9898    logical :: cmpGases=.true.
    9999
    100     if (Ncolumns > 1) then
     100    if (Ncolumns .gt. 1) then
    101101       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    102102       ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS)
    … …  
    107107       seed = int(cospstateIN%phalf(:,Nlevels+1))  ! In case of NPoints=1
    108108       ! *NOTE* Chunking will change the seed
    109        if (NPoints > 1) seed=int((cospstateIN%phalf(:,Nlevels+1)-minval(cospstateIN%phalf(:,Nlevels+1)))/      &
     109       if (NPoints .gt. 1) seed=int((cospstateIN%phalf(:,Nlevels+1)-minval(cospstateIN%phalf(:,Nlevels+1)))/      &
    110110            (maxval(cospstateIN%phalf(:,Nlevels+1))-minval(cospstateIN%phalf(:,Nlevels+1)))*100000) + 1
    111111       call init_rng(rngs, seed)
    … …  
    145145          do k=1,nLevels
    146146             do i=1,nColumns
    147                 if (cospIN%frac_out(j,i,k)  == 1)  frac_ls(j,k) = frac_ls(j,k)+1._wp
    148                 if (cospIN%frac_out(j,i,k)  == 2)  frac_cv(j,k) = frac_cv(j,k)+1._wp
    149                 if (frac_prec(j,i,k) == 1)  prec_ls(j,k) = prec_ls(j,k)+1._wp
    150                 if (frac_prec(j,i,k) == 2)  prec_cv(j,k) = prec_cv(j,k)+1._wp
    151                 if (frac_prec(j,i,k) == 3)  prec_cv(j,k) = prec_cv(j,k)+1._wp
    152                 if (frac_prec(j,i,k) == 3)  prec_ls(j,k) = prec_ls(j,k)+1._wp
     147                if (cospIN%frac_out(j,i,k)  .eq. 1)  frac_ls(j,k) = frac_ls(j,k)+1._wp
     148                if (cospIN%frac_out(j,i,k)  .eq. 2)  frac_cv(j,k) = frac_cv(j,k)+1._wp
     149                if (frac_prec(j,i,k) .eq. 1)  prec_ls(j,k) = prec_ls(j,k)+1._wp
     150                if (frac_prec(j,i,k) .eq. 2)  prec_cv(j,k) = prec_cv(j,k)+1._wp
     151                if (frac_prec(j,i,k) .eq. 3)  prec_cv(j,k) = prec_cv(j,k)+1._wp
     152                if (frac_prec(j,i,k) .eq. 3)  prec_ls(j,k) = prec_ls(j,k)+1._wp
    153153             enddo
    154154             frac_ls(j,k)=frac_ls(j,k)/nColumns
    … …  
    217217          do j=1,nPoints
    218218             ! In-cloud mixing ratios.
    219              if (frac_ls(j,k) /= 0.) then
     219             if (frac_ls(j,k) .ne. 0.) then
    220220                mr_hydro(j,:,k,I_LSCLIQ) = mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
    221221                mr_hydro(j,:,k,I_LSCICE) = mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
    222222             endif
    223              if (frac_cv(j,k) /= 0.) then
     223             if (frac_cv(j,k) .ne. 0.) then
    224224                mr_hydro(j,:,k,I_CVCLIQ) = mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
    225225                mr_hydro(j,:,k,I_CVCICE) = mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
    … …  
    227227             ! Precipitation
    228228             if (use_precipitation_fluxes) then
    229                 if (prec_ls(j,k) /= 0.) then
     229                if (prec_ls(j,k) .ne. 0.) then
    230230                   fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k)
    231231                   fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k)
    232232                   fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k)
    233233                endif
    234                 if (prec_cv(j,k) /= 0.) then
     234                if (prec_cv(j,k) .ne. 0.) then
    235235                   fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k)
    236236                   fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k)
    237237                endif
    238238             else
    239                 if (prec_ls(j,k) /= 0.) then
     239                if (prec_ls(j,k) .ne. 0.) then
    240240                   mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
    241241                   mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
    242242                   mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
    243243                endif
    244                 if (prec_cv(j,k) /= 0.) then
     244                if (prec_cv(j,k) .ne. 0.) then
    245245                   mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
    246246                   mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)
    … …  
    361361       do i=1,nPoints
    362362          do j=1,nLevels
    363              if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. (cospIN%rcfg_cloudsat%use_gas_abs == 2 .and. j == 1)) then
     363             if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. (cospIN%rcfg_cloudsat%use_gas_abs == 2 .and. j .eq. 1)) then
    364364                g_vol(i,j) = gases(cospstateIN%pfull(i,j), cospstateIN%at(i,j),cospstateIN%qv(i,j),cospIN%rcfg_cloudsat%freq)
    365365             endif
    366366             cospIN%g_vol_cloudsat(i,:,j)=g_vol(i,j)
    367           END DO
    368        END DO
     367          end do
     368       end do
    369369       
    370370       ! Loop over all subcolumns
    … …  
    379379         
    380380          ! At each model level, what fraction of the precipitation is frozen?
    381           where(mr_hydro(:,k,:,I_LSRAIN) > 0 .or. mr_hydro(:,k,:,I_LSSNOW) > 0 .or. &
    382                 mr_hydro(:,k,:,I_CVRAIN) > 0 .or. mr_hydro(:,k,:,I_CVSNOW) > 0 .or. &
    383                 mr_hydro(:,k,:,I_LSGRPL) > 0)
     381          where(mr_hydro(:,k,:,I_LSRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_LSSNOW) .gt. 0 .or. &
     382                mr_hydro(:,k,:,I_CVRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_CVSNOW) .gt. 0 .or. &
     383                mr_hydro(:,k,:,I_LSGRPL) .gt. 0)
    384384             fracPrecipIce(:,k,:) = (mr_hydro(:,k,:,I_LSSNOW) + mr_hydro(:,k,:,I_CVSNOW) + &
    385385                  mr_hydro(:,k,:,I_LSGRPL)) / &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/math_lib.F90

    r5086 r5095  
    209209          exit
    210210       end if
    211     END DO
     211    end do
    212212   
    213213    if (lerror) then
    … …  
    244244       end if
    245245       ilo = ilo + 1
    246     END DO
     246    end do
    247247   
    248248    ilo = max ( 2, ilo )
    … …  
    254254       end if
    255255       ihi = ihi - 1
    256     END DO
     256    end do
    257257   
    258258    ihi = min ( ihi, ntab - 1 )
    … …  
    305305       syl = x2
    306306       
    307     END DO
     307    end do
    308308
    309309    result = sum1 + ca * ( b**3 - syl**3 ) / 3._wp &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/mo_rng.F90

    r5082 r5095  
    9696    !          so we use sizeof(someInt) to determine wheter it is on 32 bit.
    9797    !if ( i2_16*i2_16 .le. huge32 ) then
    98     if (digits(testInt) <= 31) then
     98    if (digits(testInt) .le. 31) then
    9999    !if (sizeof(testInt) .eq. 4) then
    100100       r=r+1

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/modis_simulator.F90

    r5086 r5095  
    222222          retrievedTau(i)              = R_UNDEF
    223223       end if
    224     END DO
     224    end do
    225225    where((retrievedSize(1:nSubCols) < 0.).and.(retrievedSize(1:nSubCols) /= R_UNDEF)) &
    226226         retrievedSize(1:nSubCols) = 1.0e-06_wp*re_fill
    … …  
    455455      end if
    456456      if(totalTau >= tauLimit) exit
    457     END DO
     457    end do
    458458
    459459    if (totalTau > 0._wp) then
    … …  
    489489      end if
    490490      if(totalTau >= tauLimit) exit
    491     END DO
     491    end do
    492492
    493493    if (totalTau > 0._wp) then
    … …  
    715715    do i = 1, size(cloudIndicies)
    716716       call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    717     END DO
     717    end do
    718718   
    719719    call adding_doubling(count(tau(1:nLevels) > 0),Refl(:), Trans(:), Refl_tot, Trans_tot) 
    … …  
    897897       Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1._wp - Refl_cumulative(i-1) * Refl(i))
    898898       Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1._wp - Refl_cumulative(i-1) * Refl(i))
    899     END DO
     899    end do
    900900   
    901901    Refl_tot = Refl_cumulative(size(Refl))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/mrgrnk.F90

    r5081 r5095  
    6868       IRNGT (1) = 1
    6969       Return
     70    Case Default
     71       Continue
    7072    End Select
    7173    !
    … …  
    266268       IRNGT (1) = 1
    267269       Return
     270    Case Default
     271       Continue
    268272    End Select
    269273    !
    … …  
    463467       IRNGT (1) = 1
    464468       Return
     469    Case Default
     470       Continue
    465471    End Select
    466472    !

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/optics_lib.F90

    r5086 r5095  
    539539    if (alam < cutice) then
    540540       ! Region from 0.045 microns to 167.0 microns - no temperature depend
     541       do i=2,nwl
     542          if(alam < wl(i)) continue
     543       enddo
    541544       x1  = log(wl(i-1))
    542545       x2  = log(wl(i))
    … …  
    555558       if(tk < temref(4)) tk=temref(4)
    556559       do i=2,4
    557           if(tk>=temref(i)) go to 12
     560          if(tk.ge.temref(i)) go to 12
    558561       enddo
    55956212     lt1 = i
    560563       lt2 = i-1
    561564       do i=2,nwlt
    562           if(alam<=wlt(i)) go to 14
     565          if(alam.le.wlt(i)) go to 14
    563566       enddo
    56456714     x1  = log(wlt(i-1))
    … …  
    649652    Complex(wp) :: A1
    650653   
    651     If ((Dx>Imaxx) .Or. (InP>ImaxNP)) Then
     654    If ((Dx.Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then
    652655       Error = 1
    653656       Return
    … …  
    656659    Ir = 1 / Cm
    657660    Y =  Dx * Cm
    658     If (Dx<0.02) Then
     661    If (Dx.Lt.0.02) Then
    659662       NStop = 2
    660663    Else
    661        If (Dx<=8.0) Then
     664       If (Dx.Le.8.0) Then
    662665          NStop = Dx + 4.00*Dx**(1./3.) + 2.0
    663666       Else
    664           If (Dx< 4200.0) Then
     667          If (Dx.Lt. 4200.0) Then
    665668             NStop = Dx + 4.05*Dx**(1./3.) + 2.0
    666669          Else
    … …  
    670673    End If
    671674    NmX = Max(Real(NStop),Real(Abs(Y))) + 15.
    672     If (Nmx > Itermax) then
     675    If (Nmx .gt. Itermax) then
    673676       Error = 1
    674677       Return
    … …  
    723726!ds       Dqxt = Tnp1 *      Dble(A + B)          + Dqxt
    724727       Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc
    725        If (N>1) then
     728       If (N.Gt.1) then
    726729          Dg = Dg + (dN*dN - 1) * (ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 *(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    727730!ds          Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    … …  
    732735       AMB = A2 * (A - B)
    733736       Do I = 1,Inp2
    734           If (I>Inp) Then
     737          If (I.GT.Inp) Then
    735738             S(I) = -Pi1(I)
    736739          Else
    … …  
    753756    End Do
    754757
    755     If (Dg >0) Dg = 2 * Dg / Dqsc
     758    If (Dg .GT.0) Dg = 2 * Dg / Dqsc
    756759    Dqsc =  2 * Dqsc / Dx**2
    757760    Dqxt =  2 * Dqxt / Dx**2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/parasol.F90

    r5093 r5095  
    8181    ! Lum_norm=f(PARASOL_SZA,tau_cloud) derived from adding-doubling calculations
    8282    !        valid ONLY ABOVE OCEAN (albedo_sfce=5%)
    83     !        valid only in one viewing direction (theta_v=30°, phi_s-phi_v=320°)
     83    !        valid only in one viewing direction (theta_v=30�, phi_s-phi_v=320�)
    8484    !        based on adding-doubling radiative transfer computation
    8585    !        for PARASOL_TAU values (0 to 100) and for PARASOL_SZA values (0 to 80)
    … …  
    9797
    9898    ! Relative fraction of the opt. thick due to liquid or ice clouds
    99     WHERE (tautot_S(1:npoints) > 0.)
     99    WHERE (tautot_S(1:npoints) .gt. 0.)
    100100       frac_taucol_liq(1:npoints) = tautot_S_liq(1:npoints) / tautot_S(1:npoints)
    101101       frac_taucol_ice(1:npoints) = tautot_S_ice(1:npoints) / tautot_S(1:npoints)
    … …  
    118118    DO it=1,PARASOL_NREFL
    119119       DO ny=1,PARASOL_NTAU-1
    120           WHERE (tautot_S(1:npoints) >= PARASOL_TAU(ny).and. &
    121                  tautot_S(1:npoints) <= PARASOL_TAU(ny+1))
     120          WHERE (tautot_S(1:npoints) .ge. PARASOL_TAU(ny).and. &
     121                 tautot_S(1:npoints) .le. PARASOL_TAU(ny+1))
    122122             rlumA_mod(1:npoints,it) = aA(it,ny)*tautot_S(1:npoints) + bA(it,ny)
    123123             rlumB_mod(1:npoints,it) = aB(it,ny)*tautot_S(1:npoints) + bB(it,ny)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/prec_scops.F90

    r5082 r5095  
    6464
    6565      cv_col = scops_ccfrac*ncol
    66       if (cv_col == 0) cv_col=1
     66      if (cv_col .eq. 0) cv_col=1
    6767 
    6868      do ilev=1,nlev
    … …  
    8181        flag_cv=0
    8282        do ilev=1,nlev
    83           if (frac_out(j,ibox,ilev) == 1) then
     83          if (frac_out(j,ibox,ilev) .eq. 1) then
    8484            flag_ls=1
    8585          endif
    86           if (frac_out(j,ibox,ilev) == 2) then
     86          if (frac_out(j,ibox,ilev) .eq. 2) then
    8787            flag_cv=1
    8888          endif
    8989        enddo !loop over nlev
    90         if (flag_ls == 1) then
     90        if (flag_ls .eq. 1) then
    9191           frac_out_ls(j,ibox)=1
    9292        endif
    93         if (flag_cv == 1) then
     93        if (flag_cv .eq. 1) then
    9494           frac_out_cv(j,ibox)=1
    9595        endif
    … …  
    102102        flag_cv=0
    103103   
    104         if (ls_p_rate(j,1) > 0.) then
     104        if (ls_p_rate(j,1) .gt. 0.) then
    105105            do ibox=1,ncol ! possibility ONE
    106                 if (frac_out(j,ibox,1) == 1) then
     106                if (frac_out(j,ibox,1) .eq. 1) then
    107107                    prec_frac(j,ibox,1) = 1
    108108                    flag_ls=1
    109109                endif
    110110            enddo ! loop over ncol
    111             if (flag_ls == 0) then ! possibility THREE
     111            if (flag_ls .eq. 0) then ! possibility THREE
    112112                do ibox=1,ncol
    113                     if (frac_out(j,ibox,2) == 1) then
     113                    if (frac_out(j,ibox,2) .eq. 1) then
    114114                        prec_frac(j,ibox,1) = 1
    115115                        flag_ls=1
    … …  
    117117                enddo ! loop over ncol
    118118            endif
    119         if (flag_ls == 0) then ! possibility Four
    120         do ibox=1,ncol
    121         if (frac_out_ls(j,ibox) == 1) then
     119        if (flag_ls .eq. 0) then ! possibility Four
     120        do ibox=1,ncol
     121        if (frac_out_ls(j,ibox) .eq. 1) then
    122122            prec_frac(j,ibox,1) = 1
    123123            flag_ls=1
    … …  
    125125        enddo ! loop over ncol
    126126        endif
    127         if (flag_ls == 0) then ! possibility Five
     127        if (flag_ls .eq. 0) then ! possibility Five
    128128        do ibox=1,ncol
    129129    !     prec_frac(j,1:ncol,1) = 1
    … …  
    134134       ! There is large scale precipitation
    135135     
    136         if (cv_p_rate(j,1) > 0.) then
     136        if (cv_p_rate(j,1) .gt. 0.) then
    137137         do ibox=1,ncol ! possibility ONE
    138           if (frac_out(j,ibox,1) == 2) then
    139            if (prec_frac(j,ibox,1) == 0) then
     138          if (frac_out(j,ibox,1) .eq. 2) then
     139           if (prec_frac(j,ibox,1) .eq. 0) then
    140140        prec_frac(j,ibox,1) = 2
    141141       else
    … …  
    145145      endif
    146146        enddo ! loop over ncol
    147         if (flag_cv == 0) then ! possibility THREE
    148         do ibox=1,ncol
    149         if (frac_out(j,ibox,2) == 2) then
    150                 if (prec_frac(j,ibox,1) == 0) then
     147        if (flag_cv .eq. 0) then ! possibility THREE
     148        do ibox=1,ncol
     149        if (frac_out(j,ibox,2) .eq. 2) then
     150                if (prec_frac(j,ibox,1) .eq. 0) then
    151151            prec_frac(j,ibox,1) = 2
    152152            else
    … …  
    157157        enddo ! loop over ncol
    158158        endif
    159         if (flag_cv == 0) then ! possibility Four
    160         do ibox=1,ncol
    161         if (frac_out_cv(j,ibox) == 1) then
    162                 if (prec_frac(j,ibox,1) == 0) then
     159        if (flag_cv .eq. 0) then ! possibility Four
     160        do ibox=1,ncol
     161        if (frac_out_cv(j,ibox) .eq. 1) then
     162                if (prec_frac(j,ibox,1) .eq. 0) then
    163163            prec_frac(j,ibox,1) = 2
    164164            else
    … …  
    169169        enddo ! loop over ncol
    170170        endif
    171         if (flag_cv == 0) then  ! possibility Five
     171        if (flag_cv .eq. 0) then  ! possibility Five
    172172        do ibox=1,cv_col
    173                 if (prec_frac(j,ibox,1) == 0) then
     173                if (prec_frac(j,ibox,1) .eq. 0) then
    174174            prec_frac(j,ibox,1) = 2
    175175            else
    … …  
    192192        flag_cv=0
    193193   
    194         if (ls_p_rate(j,ilev) > 0.) then
     194        if (ls_p_rate(j,ilev) .gt. 0.) then
    195195         do ibox=1,ncol ! possibility ONE&TWO
    196           if ((frac_out(j,ibox,ilev) == 1) .or. ((prec_frac(j,ibox,ilev-1) == 1)     &
    197             .or. (prec_frac(j,ibox,ilev-1) == 3))) then
     196          if ((frac_out(j,ibox,ilev) .eq. 1) .or. ((prec_frac(j,ibox,ilev-1) .eq. 1)     &
     197            .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
    198198           prec_frac(j,ibox,ilev) = 1
    199199           flag_ls=1
    200200          endif
    201201        enddo ! loop over ncol
    202         if ((flag_ls == 0) .and. (ilev < nlev)) then ! possibility THREE
    203         do ibox=1,ncol
    204         if (frac_out(j,ibox,ilev+1) == 1) then
     202        if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     203        do ibox=1,ncol
     204        if (frac_out(j,ibox,ilev+1) .eq. 1) then
    205205            prec_frac(j,ibox,ilev) = 1
    206206            flag_ls=1
    … …  
    208208        enddo ! loop over ncol
    209209        endif
    210         if (flag_ls == 0) then ! possibility Four
    211         do ibox=1,ncol
    212         if (frac_out_ls(j,ibox) == 1) then
     210        if (flag_ls .eq. 0) then ! possibility Four
     211        do ibox=1,ncol
     212        if (frac_out_ls(j,ibox) .eq. 1) then
    213213            prec_frac(j,ibox,ilev) = 1
    214214            flag_ls=1
    … …  
    216216        enddo ! loop over ncol
    217217        endif
    218         if (flag_ls == 0) then ! possibility Five
     218        if (flag_ls .eq. 0) then ! possibility Five
    219219        do ibox=1,ncol
    220220!     prec_frac(j,1:ncol,ilev) = 1
    … …  
    224224      endif ! There is large scale precipitation
    225225   
    226         if (cv_p_rate(j,ilev) > 0.) then
     226        if (cv_p_rate(j,ilev) .gt. 0.) then
    227227         do ibox=1,ncol ! possibility ONE&TWO
    228           if ((frac_out(j,ibox,ilev) == 2) .or. ((prec_frac(j,ibox,ilev-1) == 2)     &
    229             .or. (prec_frac(j,ibox,ilev-1) == 3))) then
    230             if (prec_frac(j,ibox,ilev) == 0) then
     228          if ((frac_out(j,ibox,ilev) .eq. 2) .or. ((prec_frac(j,ibox,ilev-1) .eq. 2)     &
     229            .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
     230            if (prec_frac(j,ibox,ilev) .eq. 0) then
    231231         prec_frac(j,ibox,ilev) = 2
    232232        else
    … …  
    236236        endif
    237237       enddo ! loop over ncol
    238         if ((flag_cv == 0) .and. (ilev < nlev)) then ! possibility THREE
    239         do ibox=1,ncol
    240         if (frac_out(j,ibox,ilev+1) == 2) then
    241                 if (prec_frac(j,ibox,ilev) == 0) then
     238        if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     239        do ibox=1,ncol
     240        if (frac_out(j,ibox,ilev+1) .eq. 2) then
     241                if (prec_frac(j,ibox,ilev) .eq. 0) then
    242242            prec_frac(j,ibox,ilev) = 2
    243243            else
    … …  
    248248        enddo ! loop over ncol
    249249        endif
    250         if (flag_cv == 0) then ! possibility Four
    251         do ibox=1,ncol
    252         if (frac_out_cv(j,ibox) == 1) then
    253                 if (prec_frac(j,ibox,ilev) == 0) then
     250        if (flag_cv .eq. 0) then ! possibility Four
     251        do ibox=1,ncol
     252        if (frac_out_cv(j,ibox) .eq. 1) then
     253                if (prec_frac(j,ibox,ilev) .eq. 0) then
    254254            prec_frac(j,ibox,ilev) = 2
    255255            else
    … …  
    260260        enddo ! loop over ncol
    261261        endif
    262         if (flag_cv == 0) then  ! possibility Five
     262        if (flag_cv .eq. 0) then  ! possibility Five
    263263        do ibox=1,cv_col
    264                 if (prec_frac(j,ibox,ilev) == 0) then
     264                if (prec_frac(j,ibox,ilev) .eq. 0) then
    265265            prec_frac(j,ibox,ilev) = 2
    266266            else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam.F90

    r5081 r5095  
    179179         
    180180          ! Attenuation due to gaseous absorption between radar and volume
    181           if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr == 1)) then
     181          if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr .eq. 1)) then
    182182             if (d_gate==1) then
    183183                if (k>1) then
    … …  
    272272
    273273    ! Which platforms to create diagnostics for?
    274     if (platform == 'cloudsat') lcloudsat=.true.
     274    if (platform .eq. 'cloudsat') lcloudsat=.true.
    275275
    276276    ! Create Cloudsat diagnostics.
    … …  
    289289             enddo
    290290          enddo
    291           where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns
     291          where(cfad_ze .ne. R_UNDEF) cfad_ze = cfad_ze/Ncolumns
    292292
    293293          ! Compute cloudsat near-surface precipitation diagnostics
    … …  
    306306             enddo
    307307          enddo
    308           where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns
     308          where(cfad_ze .ne. R_UNDEF) cfad_ze = cfad_ze/Ncolumns
    309309       endif
    310310    endif
    … …  
    402402       do pr=1,Ncolumns
    403403          ! 1) Compute the PIA in all profiles containing hydrometeors
    404           if ( (Ze_non_out(i,pr,cloudsat_preclvl)>-100) .and. (Ze_out(i,pr,cloudsat_preclvl)>-100) ) then
    405              if ( (Ze_non_out(i,pr,cloudsat_preclvl)<100) .and. (Ze_out(i,pr,cloudsat_preclvl)<100) ) then
     404          if ( (Ze_non_out(i,pr,cloudsat_preclvl).gt.-100) .and. (Ze_out(i,pr,cloudsat_preclvl).gt.-100) ) then
     405             if ( (Ze_non_out(i,pr,cloudsat_preclvl).lt.100) .and. (Ze_out(i,pr,cloudsat_preclvl).lt.100) ) then
    406406                cloudsat_precip_pia(i,pr) = Ze_non_out(i,pr,cloudsat_preclvl) - Ze_out(i,pr,cloudsat_preclvl)
    407407             endif
    … …  
    412412          ! 2a) Oceanic points.
    413413          ! ################################################################################
    414           if (land(i) == 0) then
     414          if (land(i) .eq. 0) then
    415415!             print*, 'aaa i, pr, fracPrecipIce(i,pr) : ', i, pr, fracPrecipIce(i,pr) !Artem
    416416             ! Snow
    417              if(fracPrecipIce(i,pr)>0.9) then
    418                 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(2)) then
     417             if(fracPrecipIce(i,pr).gt.0.9) then
     418                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(2)) then
    419419                   cloudsat_pflag(i,pr) = pClass_Snow2                   ! TSL: Snow certain
    420420                endif
    421                 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. &
    422                      Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(2)) then
     421                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).and. &
     422                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(2)) then
    423423                   cloudsat_pflag(i,pr) = pClass_Snow1                   ! TSL: Snow possible
    424424                endif
    … …  
    426426             
    427427             ! Mixed
    428              if(fracPrecipIce(i,pr)>0.1.and.fracPrecipIce(i,pr)<=0.9) then
    429                 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(2)) then
     428             if(fracPrecipIce(i,pr).gt.0.1.and.fracPrecipIce(i,pr).le.0.9) then
     429                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(2)) then
    430430                   cloudsat_pflag(i,pr) = pClass_Mixed2                  ! TSL: Mixed certain
    431431                endif
    432                 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. &
    433                      Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(2)) then
     432                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).and. &
     433                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(2)) then
    434434                   cloudsat_pflag(i,pr) = pClass_Mixed1                  ! TSL: Mixed possible
    435435                endif
    … …  
    437437             
    438438             ! Rain
    439              if(fracPrecipIce(i,pr)<=0.1) then
    440                 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(1)) then
     439             if(fracPrecipIce(i,pr).le.0.1) then
     440                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(1)) then
    441441                   cloudsat_pflag(i,pr) = pClass_Rain3                   ! TSL: Rain certain
    442442                endif
    443                 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(3).and. &
    444                      Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(1)) then
     443                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(3).and. &
     444                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(1)) then
    445445                   cloudsat_pflag(i,pr) = pClass_Rain2                   ! TSL: Rain probable
    446446                endif
    447                 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. &
    448                      Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(3)) then
     447                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).and. &
     448                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(3)) then
    449449                   cloudsat_pflag(i,pr) = pClass_Rain1                   ! TSL: Rain possible
    450450                endif
    451                 if(cloudsat_precip_pia(i,pr)>40) then
     451                if(cloudsat_precip_pia(i,pr).gt.40) then
    452452                   cloudsat_pflag(i,pr) = pClass_Rain4                   ! TSL: Heavy Rain
    453453                endif
    … …  
    455455             
    456456             ! No precipitation
    457              if(Ze_non_out(i,pr,cloudsat_preclvl)<=-15) then
     457             if(Ze_non_out(i,pr,cloudsat_preclvl).le.-15) then
    458458                cloudsat_pflag(i,pr) = pClass_noPrecip                   ! TSL: Not Raining
    459459             endif
    … …  
    463463          ! 2b) Land points.
    464464          ! ################################################################################
    465           if (land(i) == 1) then
     465          if (land(i) .eq. 1) then
    466466             ! Find Zmax, the maximum reflectivity value in the attenuated profile (Ze_out);
    467467             Zmax=maxval(Ze_out(i,pr,:))
    468468
    469469             ! Snow (T<273)
    470              if(t2m(i) < 273._wp) then
    471                 if(Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(5)) then
     470             if(t2m(i) .lt. 273._wp) then
     471                if(Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(5)) then
    472472                   cloudsat_pflag(i,pr) = pClass_Snow2                      ! JEK: Snow certain
    473473                endif
    474                 if(Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6) .and. &
    475                      Ze_out(i,pr,cloudsat_preclvl)<=Zbinvallnd(5)) then
     474                if(Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6) .and. &
     475                     Ze_out(i,pr,cloudsat_preclvl).le.Zbinvallnd(5)) then
    476476                   cloudsat_pflag(i,pr) = pClass_Snow1                      ! JEK: Snow possible
    477477                endif
    … …  
    479479             
    480480             ! Mized phase (273<T<275)
    481              if(t2m(i) >= 273._wp .and. t2m(i) <= 275._wp) then
    482                 if ((Zmax > Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr)>30) .or. &
    483                      (Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(4))) then
     481             if(t2m(i) .ge. 273._wp .and. t2m(i) .le. 275._wp) then
     482                if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &
     483                     (Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(4))) then
    484484                   cloudsat_pflag(i,pr) = pClass_Mixed2                     ! JEK: Mixed certain
    485485                endif
    486                 if ((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6)  .and. &
    487                      Ze_out(i,pr,cloudsat_preclvl) <= Zbinvallnd(4)) .and. &
    488                      (Zmax > Zbinvallnd(5)) ) then
     486                if ((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)  .and. &
     487                     Ze_out(i,pr,cloudsat_preclvl) .le. Zbinvallnd(4)) .and. &
     488                     (Zmax .gt. Zbinvallnd(5)) ) then
    489489                   cloudsat_pflag(i,pr) = pClass_Mixed1                     ! JEK: Mixed possible
    490490                endif
    … …  
    492492
    493493             ! Rain (T>275)
    494              if(t2m(i) > 275) then
    495                 if ((Zmax > Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr)>30) .or. &
    496                      (Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(2))) then
     494             if(t2m(i) .gt. 275) then
     495                if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &
     496                     (Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(2))) then
    497497                   cloudsat_pflag(i,pr) = pClass_Rain3                      ! JEK: Rain certain
    498498                endif
    499                 if((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6)) .and. &
    500                      (Zmax > Zbinvallnd(3))) then
     499                if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .and. &
     500                     (Zmax .gt. Zbinvallnd(3))) then
    501501                   cloudsat_pflag(i,pr) = pClass_Rain2                      ! JEK: Rain probable
    502502                endif
    503                 if((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6)) .and. &
    504                      (Zmax<Zbinvallnd(3))) then
     503                if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .and. &
     504                     (Zmax.lt.Zbinvallnd(3))) then
    505505                   cloudsat_pflag(i,pr) = pClass_Rain1                      ! JEK: Rain possible
    506506                endif
    507                 if(cloudsat_precip_pia(i,pr)>40) then
     507                if(cloudsat_precip_pia(i,pr).gt.40) then
    508508                   cloudsat_pflag(i,pr) = pClass_Rain4                      ! JEK: Heavy Rain
    509509                endif
    … …  
    511511             
    512512             ! No precipitation
    513              if(Ze_out(i,pr,cloudsat_preclvl)<=-15) then
     513             if(Ze_out(i,pr,cloudsat_preclvl).le.-15) then
    514514                cloudsat_pflag(i,pr) =  pClass_noPrecip                     ! JEK: Not Precipitating
    515515             endif         
    … …  
    526526       ! Gridmean precipitation fraction for each precipitation type
    527527       do k=1,nCloudsatPrecipClass
    528           if (any(cloudsat_pflag(i,:) == k-1)) then
    529              cloudsat_precip_cover(i,k) = count(cloudsat_pflag(i,:) == k-1)
     528          if (any(cloudsat_pflag(i,:) .eq. k-1)) then
     529             cloudsat_precip_cover(i,k) = count(cloudsat_pflag(i,:) .eq. k-1)
    530530          endif
    531531       enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90

    r5086 r5095  
    172172               
    173173                ! Compute effective radius from number concentration and distribution parameters
    174                 if (Re_internal == 0) then
     174                if (Re_internal .eq. 0) then
    175175                   call calc_Re(hm_matrix(pr,k,tp),Np_matrix(pr,k,tp),rho_a, &
    176176                        sd%dtype(tp),sd%apm(tp),sd%bpm(tp),sd%rho(tp),sd%p1(tp),sd%p2(tp),sd%p3(tp),Re)
    … …  
    187187                ! Index into particle size dimension of scaling tables
    188188                iRe_type=1
    189                 if(Re>0) then
     189                if(Re.gt.0) then
    190190                   ! Determine index in to scale LUT
    191191                   ! Distance between Re points (defined by "base" and "step") for
    … …  
    197197                   base = rcfg%base_list(n+1)
    198198                   iRe_type=Re/step
    199                    if (iRe_type<1) iRe_type=1
     199                   if (iRe_type.lt.1) iRe_type=1
    200200                   Re=step*(iRe_type+0.5_wp)    ! set value of Re to closest value allowed in LUT.
    201201                   iRe_type=iRe_type+base-int(n*Re_BIN_LENGTH/step)
    202202                   
    203203                   ! Make sure iRe_type is within bounds
    204                    if (iRe_type>=nRe_types) then
     204                   if (iRe_type.ge.nRe_types) then
    205205                      !write(*,*) 'Warning: size of Re exceed value permitted ', &
    206206                      !            'in Look-Up Table (LUT).  Will calculate. '
    … …  
    405405    ! Exponential is same as modified gamma with vu =1
    406406    ! if Np is specified then we will just treat as modified gamma
    407     if(dtype == 2 .and. Np > 0) then
     407    if(dtype .eq. 2 .and. Np .gt. 0) then
    408408       local_dtype = 1
    409409       local_p3    = 1
    … …  
    441441       endif
    442442       
    443        if( Np==0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
     443       if( Np.eq.0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default 
    444444          dm = p2             ! by definition, should have units of microns
    445445          D0 = gamma(vu)/gamma(vu+1)*dm
    446446       else   ! use value of Np
    447           if(Np==0) then
     447          if(Np.eq.0) then
    448448             if( abs(p1+1) > 1E-8 ) then  !   use default number concentration   
    449449                local_Np = p1 ! total number concentration / pa --- units kg^-1
    … …  
    525525       
    526526       ! get rg ...
    527        if( Np==0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
     527       if( Np.eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
    528528          rg = p2     
    529529       else
    … …  
    826826          log_sigma_g = p3
    827827          tmp2 = (bpm*log_sigma_g)*(bpm*log_sigma_g)
    828           if(Re<=0) then
     828          if(Re.le.0) then
    829829             rg = p2
    830830          else
    … …  
    983983          call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    984984               dg, xs1, xs2, dph, err)
    985        END DO
     985       end do
    986986
    987987    else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/scops.F90

    r5081 r5095  
    7575
    7676    ! Test for valid input overlap assumption
    77     if (overlap /= 1 .and. overlap /= 2 .and. overlap /= 3) then
     77    if (overlap .ne. 1 .and. overlap .ne. 2 .and. overlap .ne. 3) then
    7878       overlap=default_overlap
    7979       call errorMessage('ERROR(scops): Invalid overlap assumption provided. Using default overlap assumption (max/ran)')
    … …  
    9292    tca(1:npoints,1:nlev) = cc(1:npoints,1:nlev)
    9393   
    94     if (ncolprint/=0) then
     94    if (ncolprint.ne.0) then
    9595       write (6,'(a)') 'frac_out_pp_rev:'
    9696       do j=1,npoints,1000
    … …  
    102102       write (6,'(I3)') ncol
    103103    endif
    104     if (ncolprint/=0) then
     104    if (ncolprint.ne.0) then
    105105       write (6,'(a)') 'last_frac_pp:'
    106106       do j=1,npoints,1000
    … …  
    122122       
    123123       ! Initialise threshold
    124        IF (ilev==1) then
     124       IF (ilev.eq.1) then
    125125          ! If max overlap
    126           IF (overlap==1) then
     126          IF (overlap.eq.1) then
    127127             ! Select pixels spread evenly across the gridbox
    128128             threshold(1:npoints,1:ncol)=boxpos(1:npoints,1:ncol)
    … …  
    137137             enddo
    138138          ENDIF
    139           IF (ncolprint/=0) then
     139          IF (ncolprint.ne.0) then
    140140             write (6,'(a)') 'threshold_nsf2:'
    141141             do j=1,npoints,1000
    … …  
    147147       ENDIF
    148148       
    149        IF (ncolprint/=0) then
     149       IF (ncolprint.ne.0) then
    150150          write (6,'(a)') 'ilev:'
    151151          write (6,'(I2)') ilev
    … …  
    157157          !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox))
    158158          do j=1,npoints
    159              if (boxpos(j,ibox)<=conv(j,ilev)) then
     159             if (boxpos(j,ibox).le.conv(j,ilev)) then
    160160                maxocc(j,ibox) = 1
    161161             else
    … …  
    165165         
    166166          ! Max overlap
    167           if (overlap==1) then
     167          if (overlap.eq.1) then
    168168             threshold_min(1:npoints,ibox) = conv(1:npoints,ilev)
    169169             maxosc(1:npoints,ibox)        = 1               
    … …  
    171171         
    172172          ! Random overlap
    173           if (overlap==2) then
     173          if (overlap.eq.2) then
    174174             threshold_min(1:npoints,ibox) = conv(1:npoints,ilev)
    175175             maxosc(1:npoints,ibox)        = 0
    176176          endif
    177177          ! Max/Random overlap
    178           if (overlap==3) then
     178          if (overlap.eq.3) then
    179179             ! DS2014 START: The bounds on tca are not valid when ilev=1.
    180180             !threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)))
    … …  
    182182             !     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. &
    183183             !     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    184              if (ilev /= 1) then
     184             if (ilev .ne. 1) then
    185185                threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)))
    186                 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) < &
     186                maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. &
    187187                     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. &
    188                      (threshold(1:npoints,ibox)>conv(1:npoints,ilev)))
     188                     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    189189             else
    190190                threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(0._wp,tca(1:npoints,ilev)))
    191                 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) < &
     191                maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. &
    192192                     min(0._wp,tca(1:npoints,ilev)) .and. &
    193                      (threshold(1:npoints,ibox)>conv(1:npoints,ilev)))
     193                     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    194194             endif
    195195          endif
    … …  
    205205         
    206206          ! Fill frac_out with 1's where tca is greater than the threshold
    207           frac_out(1:npoints,ibox,ilev) = merge(1,0,tca(1:npoints,ilev)>threshold(1:npoints,ibox))
     207          frac_out(1:npoints,ibox,ilev) = merge(1,0,tca(1:npoints,ilev).gt.threshold(1:npoints,ibox))
    208208         
    209209          ! Code to partition boxes into startiform and convective parts goes here
    210           where(threshold(1:npoints,ibox)<=conv(1:npoints,ilev) .and. conv(1:npoints,ilev)>0.) frac_out(1:npoints,ibox,ilev)=2
     210          where(threshold(1:npoints,ibox).le.conv(1:npoints,ilev) .and. conv(1:npoints,ilev).gt.0.) frac_out(1:npoints,ibox,ilev)=2
    211211       ENDDO ! ibox
    212212       
    213213       
    214214       ! Set last_frac to tca at this level, so as to be tca from last level next time round
    215        if (ncolprint/=0) then
     215       if (ncolprint.ne.0) then
    216216          do j=1,npoints ,1000
    217217             write(6,'(a10)') 'j='
Note: See TracChangeset for help on using the changeset viewer.