Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (12 months ago)
Author:
abarral
Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2
Files:
26 edited

Legend:

Unmodified
Added
Removed

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

    r5095 r5158  
    7878    box_MISR_ztop(1:npoints,1:ncol) = 0._wp 
    7979
    80     do j=1,npoints
     80    DO j=1,npoints
    8181
    8282       ! Estimate distribution of Model layer tops
    8383       dist_model_layertops(j,:)=0
    84        do ilev=1,nlev
     84       DO ilev=1,nlev
    8585          ! Define location of "layer top"
    8686          if(ilev.eq.1 .or. ilev.eq.nlev) then
    … …  
    9393          ! *NOTE* the first MISR level is "no height" level
    9494          iMISR_ztop=2
    95           do loop=2,numMISRHgtBins
     95          DO loop=2,numMISRHgtBins
    9696             if ( ztest .gt. 1000*misr_histHgt(loop+1) ) then
    9797                iMISR_ztop=loop+1
    … …  
    103103
    104104       ! For each GCM cell or horizontal model grid point   
    105        do ibox=1,ncol
     105       DO ibox=1,ncol
    106106          ! Compute optical depth as a cummulative distribution in the vertical (nlev).
    107107          tauOUT(j,ibox)=sum(dtau(j,ibox,1:nlev))
    108108
    109109          thres_crossed_MISR=0
    110           do ilev=1,nlev
     110          DO ilev=1,nlev
    111111             ! If there a cloud, start the counter and store this height
    112112             if(thres_crossed_MISR .eq. 0 .and. dtau(j,ibox,ilev) .gt. 0.) then
    … …  
    187187    ! This setup assumes the columns represent a about a 1 to 4 km scale
    188188    ! it will need to be modified significantly, otherwise
    189 !       ! DS2015: Add loop over gridpoints and index accordingly.
     189!    ! DS2015: Add loop over gridpoints and index accordingly.
    190190!    if(ncol.eq.1) then
    191191!       ! Adjust based on neightboring points.
    … …  
    214214     
    215215    ! Fill dark scenes
    216     do j=1,numMISRHgtBins
     216    DO j=1,numMISRHgtBins
    217217       where(sunlit .ne. 1) dist_model_layertops(1:npoints,j) = R_UNDEF
    218218    enddo
    … …  
    254254    tauWRK(1:npoints,1:ncol)                      = tau(1:npoints,1:ncol)
    255255    box_MISR_ztopWRK(1:npoints,1:ncol)            = box_MISR_ztop(1:npoints,1:ncol)
    256     do j=1,npoints
     256    DO j=1,npoints
    257257
    258258       ! Subcolumns that are cloudy(true) and not(false)

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

    r5095 r5158  
    190190     real(wp),dimension(:),pointer :: &
    191191          isccp_totalcldarea => null(), & ! The fraction of model grid box columns with cloud
    192                                           ! somewhere in them. (%)
     192                                     ! somewhere in them. (%)
    193193          isccp_meantb => null(),       & ! Mean all-sky 10.5 micron brightness temperature. (K)
    194194          isccp_meantbclr => null(),    & ! Mean clear-sky 10.5 micron brightness temperature. (K)
    … …  
    203203                                          ! the 49 ISCCP D level cloud types. (%)
    204204     
    205      ! MISR outptus                         
     205     ! MISR outptus
    206206     real(wp),dimension(:,:,:),pointer ::   & !
    207207          misr_fq => null()          ! Fraction of the model grid box covered by each of the MISR
    … …  
    211211     real(wp),dimension(:),pointer ::   & !
    212212          misr_meanztop => null(), & ! Mean MISR cloud top height
    213           misr_cldarea => null()     ! Mean MISR cloud cover area                                   
    214 
    215      ! MODIS outptus               
     213          misr_cldarea => null()     ! Mean MISR cloud cover area
     214
     215     ! MODIS outptus
    216216     real(wp),pointer,dimension(:) ::      & ! 
    217217          modis_Cloud_Fraction_Total_Mean => null(),       & ! L3 MODIS retrieved cloud fraction (total)
    … …  
    233233          modis_Ice_Water_Path_Mean => null()                ! L3 MODIS retrieved ice water path
    234234     real(wp),pointer,dimension(:,:,:) ::  &
    235           modis_Optical_Thickness_vs_Cloud_Top_Pressure => null(), & ! Tau/Pressure joint histogram                                 
     235          modis_Optical_Thickness_vs_Cloud_Top_Pressure => null(), & ! Tau/Pressure joint histogram
    236236          modis_Optical_Thickness_vs_ReffICE => null(),            & ! Tau/ReffICE joint histogram
    237237          modis_Optical_Thickness_vs_ReffLIQ => null()               ! Tau/ReffLIQ joint histogram
    … …  
    239239     ! RTTOV outputs
    240240     real(wp),pointer :: &
    241           rttov_tbs(:,:) => null() ! Brightness Temperature         
     241          rttov_tbs(:,:) => null() ! Brightness Temperature
    242242     
    243243  end type cosp_outputs
    … …  
    683683       allocate(parasolPix_refl(parasolIN%Npoints,parasolIN%Ncolumns,PARASOL_NREFL))
    684684       ! Call simulator
    685        do icol=1,parasolIN%Ncolumns
     685       DO icol=1,parasolIN%Ncolumns
    686686          call parasol_subcolumn(parasolIN%npoints, PARASOL_NREFL,                       &
    687687                                 parasolIN%tautot_S_liq(1:parasolIN%Npoints,icol),       &
    … …  
    700700       ! Allocate space for local variables
    701701       allocate(cloudsatDBZe(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels))
    702        do icol=1,cloudsatIN%ncolumns
     702       DO icol=1,cloudsatIN%ncolumns
    703703          call quickbeam_subcolumn(cloudsatIN%rcfg,cloudsatIN%Npoints,cloudsatIN%Nlevels,&
    704704                                   cloudsatIN%hgt_matrix/1000._wp,                       &
    … …  
    721721                   modisRetrievedCloudTopPressure(modisIN%nSunlit,modisIN%nColumns))
    722722          ! Call simulator
    723           do i = 1, modisIN%nSunlit
     723          DO i = 1, modisIN%nSunlit
    724724             call modis_subcolumn(modisIN%Ncolumns,modisIN%Nlevels,modisIN%pres(i,:),    &
    725725                                  modisIN%tau(int(modisIN%sunlit(i)),:,:),               &
    … …  
    13671367       ! Other grid requested. Constant vertical spacing with top at 20 km
    13681368       if (.not. luseCSATvgrid) zstep = 20000._wp/Nvgrid
    1369        do i=1,Nvgrid
     1369       DO i=1,Nvgrid
    13701370          vgrid_zl(Nlvgrid-i+1) = (i-1)*zstep
    13711371          vgrid_zu(Nlvgrid-i+1) = i*zstep
    … …  
    17261726    endif
    17271727
    1728         ! RTTOV Inputs
     1728    ! RTTOV Inputs
    17291729    if (cospgridIN%zenang .lt. -90. .OR. cospgridIN%zenang .gt. 90) then
    17301730       nError=nError+1

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

    r3358 r5158  
    8080
    8181  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    82   !     END MODULE
     82  !    END MODULE
    8383  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    8484END MODULE MOD_COSP_CALIPSO_INTERFACE

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

    r3358 r5158  
    123123    ! Set up Re bin "structure" for z_scaling
    124124    rcfg%base_list(1)=0
    125     do j=1,Re_MAX_BIN
     125    DO j=1,Re_MAX_BIN
    126126       rcfg%step_list(j)=0.1_wp+0.1_wp*((j-1)**1.5)
    127127       if(rcfg%step_list(j)>Re_BIN_LENGTH) then
    … …  
    143143
    144144  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    145   !                                       END MODULE
     145  !                                    END MODULE
    146146  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    147147END MODULE MOD_COSP_CLOUDSAT_INTERFACE

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

    r5133 r5158  
    177177                                   1.0,      0.909013, 0.709554, 0.430405, 0.121567/),   &
    178178                                   shape=(/PARASOL_NREFL,PARASOL_NTAU/)),                &
    179          ! LUT for ice particles                                     
     179         ! LUT for ice particles
    180180         rlumB = reshape(source=(/ 0.03,     0.03,     0.03,     0.03,     0.03,         &
    181181                                   0.092170, 0.087082, 0.083325, 0.084935, 0.054157,     &

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

    r5095 r5158  
    436436  end type cosp_modis 
    437437  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    438   ! TYPE cosp_misr     
     438  ! TYPE cosp_misr
    439439  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    440440  TYPE COSP_MISR
    … …  
    445445     real(wp),dimension(:,:,:),pointer ::   & !
    446446        fq_MISR          ! Fraction of the model grid box covered by each of the MISR
    447                                         ! cloud types
     447                          ! cloud types
    448448     real(wp),dimension(:,:),pointer ::   & !
    449449        MISR_dist_model_layertops ! 
    … …  
    474474     real(wp),dimension(:),pointer :: &
    475475        totalcldarea, & ! The fraction of model grid box columns with cloud somewhere in
    476                                           ! them.
     476                            ! them.
    477477        meantb,       & ! Mean all-sky 10.5 micron brightness temperature.
    478478        meantbclr,    & ! Mean clear-sky 10.5 micron brightness temperature.
    … …  
    485485     real(wp),dimension(:,:,:),pointer :: &
    486486        fq_isccp        ! The fraction of the model grid box covered by each of the 49
    487                                     ! ISCCP D level cloud types.
     487                          ! ISCCP D level cloud types.
    488488  END TYPE COSP_ISCCP
    489489  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    … …  
    589589    ! Outputs from COSP2
    590590    type(cosp_outputs),target :: cospOUT  ! NEW derived type output that contains all
    591                                                           ! simulator information
     591                                          ! simulator information
    592592    ! Local variables
    593593    integer :: i
    … …  
    596596         start_idx,  & ! Starting index when looping over points
    597597         end_idx,    & ! Ending index when looping over points
    598          Nptsperit     ! Number of points for current iteration                                           
     598         Nptsperit     ! Number of points for current iteration
    599599    logical :: &
    600600         lsingle=.true., & ! True if using MMF_v3_single_moment CLOUDSAT microphysical scheme (default)
    … …  
    606606    character(len=256),dimension(100) :: cosp_status
    607607
    608 #ifdef MMF_V3_SINGLE_MOMENT                                       
     608#ifdef MMF_V3_SINGLE_MOMENT
    609609    character(len=64) :: &
    610610         cloudsat_micro_scheme = 'MMF_v3_single_moment'
    … …  
    680680    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    681681    num_chunks = gbx%Npoints/gbx%Npoints_it+1
    682     do i=1,num_chunks
     682    DO i=1,num_chunks
    683683       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    684684       ! Determine indices for "chunking" (again, if necessary)
    … …  
    10111011       frac_cv(1:npoints,1:gbx%Nlevels) = 0._wp
    10121012       prec_cv(1:npoints,1:gbx%Nlevels) = 0._wp
    1013        do j=1,npoints,1
    1014           do k=1,gbx%Nlevels,1
    1015              do i=1,gbx%Ncolumns,1
     1013       DO j=1,npoints,1
     1014          DO k=1,gbx%Nlevels,1
     1015             DO i=1,gbx%Ncolumns,1
    10161016                if (sgx%frac_out(start_idx+j-1,i,gbx%Nlevels+1-k) == I_LSC)              &
    10171017                     frac_ls(j,k) = frac_ls(j,k)+1._wp
    … …  
    10501050       Reff(:,:,:,:)     = 0._wp
    10511051       Np(:,:,:,:)       = 0._wp
    1052        do k=1,gbx%Ncolumns
     1052       DO k=1,gbx%Ncolumns
    10531053          ! Subcolumn cloud fraction
    10541054          column_frac_out = sgx%frac_out(start_idx:end_idx,k,:)
    … …  
    10961096       ! the fraction-based values
    10971097       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1098        do k=1,gbx%Nlevels
    1099           do j=1,npoints
     1098       DO k=1,gbx%Nlevels
     1099          DO j=1,npoints
    11001100             ! Clouds
    11011101             if (frac_ls(j,k) .ne. 0.) then
    … …  
    12381238    if (cfg%Lradar_sim) then
    12391239       allocate(g_vol(nPoints,gbx%Nlevels))
    1240        do ij=1,gbx%Ncolumns
     1240       DO ij=1,gbx%Ncolumns
    12411241          if (ij .eq. 1) then
    12421242             cmpGases = .true.
    … …  
    15581558         trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
    15591559   
    1560     do i=1,maxhclass
    1561        do j=1,mt_ntt
    1562           do k=1,nRe_types
     1560    DO i=1,maxhclass
     1561       DO j=1,mt_ntt
     1562          DO k=1,nRe_types
    15631563             ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
    15641564             if(.not.LUT_file_exists .or. hp%Z_scale_added_flag(i,j,k)) then
    … …  
    15921592    ! Local variables
    15931593    integer :: i
    1594     real :: zstep
     1594    REAL :: zstep
    15951595   
    15961596    x%use_vgrid  = use_vgrid
    … …  
    16291629          zstep = 20000.0/x%Nlvgrid
    16301630       endif
    1631        do i=1,x%Nlvgrid
     1631       DO i=1,x%Nlvgrid
    16321632          x%zl(i) = (i-1)*zstep
    16331633          x%zu(i) = i*zstep
    … …  
    18581858
    18591859  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1860   !                                     SUBROUTINE construct_cosp_misr
     1860  !                      SUBROUTINE construct_cosp_misr
    18611861  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    18621862  SUBROUTINE CONSTRUCT_COSP_MISR(Npoints,x)
    … …  
    19681968  END SUBROUTINE destroy_cosp_modis 
    19691969  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    1970   !                                             SUBROUTINE construct_cosp_rttov
     1970  !                               SUBROUTINE construct_cosp_rttov
    19711971  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    19721972  SUBROUTINE CONSTRUCT_COSP_RTTOV(Npoints,Nchan,x)

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

    r3358 r5158  
    6767
    6868  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    69   !                                                     SUBROUTINE cosp_isccp_init
     69  !                              SUBROUTINE cosp_isccp_init
    7070  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    7171  SUBROUTINE COSP_ISCCP_INIT(top_height,top_height_direction)

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

    r3358 r5158  
    3636
    3737  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    38   !                                                             TYPE misr_in
     38  !                                 TYPE misr_in
    3939  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    4040  type misr_IN
    … …  
    5656
    5757  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    58   !                                                     SUBROUTINE cosp_misr_init
     58  !                              SUBROUTINE cosp_misr_init
    5959  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    6060  SUBROUTINE COSP_MISR_INIT()
    … …  
    6363
    6464  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    65   !                                                             END MODULE
     65  !                                     END MODULE
    6666  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    6767END MODULE MOD_COSP_MISR_INTERFACE

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

    r5095 r5158  
    6969   
    7070    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    71     do j=1,dim2
     71    DO j=1,dim2
    7272       where(flag(:,j,:) .eq. 1)
    7373          varOUT(:,j,:) = varIN2
    … …  
    133133   
    134134   
    135     do i=1,npoints
     135    DO i=1,npoints
    136136       where(cloudIce(i,:, :) <= 0.)
    137137          fracL(:, :) = 1._wp
    … …  
    168168    w0(1:nPoints,1:nSubCols,1:nLevels) = 0._wp
    169169   
    170     do j =1,nPoints
    171        do i=1,nSubCols
     170    DO j =1,nPoints
     171       DO i=1,nSubCols
    172172          water_g(1:nLevels)  = get_g_nir(  phaseIsLiquid, sizeLIQ(j,i,1:nLevels))
    173173          water_w0(1:nLevels) = get_ssa_nir(phaseIsLiquid, sizeLIQ(j,i,1:nLevels))
    … …  
    187187   
    188188    ! Compute the total optical thickness and the proportion due to liquid in each cell
    189     do i=1,npoints
     189    DO i=1,npoints
    190190       where(tauLIQ(i,1:nSubCols,1:nLevels) + tauICE(i,1:nSubCols,1:nLevels) > 0.)
    191191          fracLIQ(i,1:nSubCols,1:nLevels) = tauLIQ(i,1:nSubCols,1:nLevels)/ &
    … …  
    317317    ! Altitude at half pressure levels:
    318318    zheight(1:npoints,nlev+1) = 0._wp
    319     do k=nlev,1,-1
     319    DO k=nlev,1,-1
    320320       zheight(1:npoints,k) = zheight(1:npoints,k+1) &
    321321            -(presf(1:npoints,k)-presf(1:npoints,k+1))/(rhoair(1:npoints,k)*grav)
    … …  
    349349    ! ##############################################################################
    350350    ! Polynomials kp_lidar derived from Mie theory
    351     do i = 1, npart
     351    DO i = 1, npart
    352352       where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
    353353          kp_part(1:npoints,1:nlev,i) = &
    … …  
    363363   
    364364    ! Loop over all subcolumns
    365     do icol=1,ncolumns
     365    DO icol=1,ncolumns
    366366       ! ##############################################################################
    367367       ! Mixing ratio particles in each subcolum
    … …  
    376376       ! ##############################################################################
    377377       ! Alpha of particles in each subcolumn:
    378        do i = 1, npart
     378       DO i = 1, npart
    379379          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 &
    … …  
    388388       ! Optical thicknes
    389389       tau_part(1:npoints,icol,1:nlev,1:npart) = rdiffm * alpha_part(1:npoints,icol,1:nlev,1:npart)
    390        do i = 1, npart
     390       DO i = 1, npart
    391391          ! Optical thickness of each layer (particles)
    392392          tau_part(1:npoints,icol,1:nlev,i) = tau_part(1:npoints,icol,1:nlev,i) &
    393393               & * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
    394394          ! Optical thickness from TOA to layer k (particles)
    395           do k=2,nlev
     395          DO k=2,nlev
    396396             tau_part(1:npoints,icol,k,i) = tau_part(1:npoints,icol,k,i) + tau_part(1:npoints,icol,k-1,i)
    397397          enddo
    … …  
    434434    tautot_S_liq(1:npoints,1:ncolumns) = 0._wp
    435435    tautot_S_ice(1:npoints,1:ncolumns) = 0._wp
    436     do icol=1,ncolumns   
     436    DO icol=1,ncolumns
    437437       tautot_S_liq(1:npoints,icol) = tautot_S_liq(1:npoints,icol)+tau_part(1:npoints,icol,nlev,1)+tau_part(1:npoints,icol,nlev,3)
    438438       tautot_S_ice(1:npoints,icol) = tautot_S_ice(1:npoints,icol)+tau_part(1:npoints,icol,nlev,2)+tau_part(1:npoints,icol,nlev,4)

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

    r5157 r5158  
    7575         "clmcalipsoice", "CALIPSO Ice-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
    7676  TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    77          "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))                 
     77         "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
    7878  TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    7979         "clhcalipsoice", "CALIPSO Ice-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 
    … …  
    8383         "cltcalipsoice", "CALIPSO Ice-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
    8484  TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    85          "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))                 
     85         "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
    8686  TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    8787         "cllcalipsoun", "CALIPSO Undefined-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 
    … …  
    9797         "clcalipsoliq", "Lidar Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
    9898  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    99          "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))     
     99         "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
    100100  TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    101101         "clcalipsotmpice", "Lidar Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
    … …  
    118118         "clcalipsothin", "Lidar Thin profile Cloud Fraction", "%", (/ ('', i=1, 3) /))         !OPAQ
    119119  TYPE(ctrl_outcosp), SAVE :: o_clcalipsozopaque = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
    120          "clcalipsozopaque", "Lidar z_opaque Fraction", "%", (/ ('', i=1, 3) /))                !OPAQ
     120         "clcalipsozopaque", "Lidar z_opaque Fraction", "%", (/ ('', i=1, 3) /))            !OPAQ
    121121  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoopacity = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
    122          "clcalipsoopacity", "Lidar opacity Fraction", "%", (/ ('', i=1, 3) /))                 !OPAQ
     122         "clcalipsoopacity", "Lidar opacity Fraction", "%", (/ ('', i=1, 3) /))                    !OPAQ
    123123
    124124  TYPE(ctrl_outcosp), SAVE :: o_proftemp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &         !TIBO
    … …  
    254254  integer                  :: Nlevlmdz, Ncolumns      ! Number of levels
    255255  real,dimension(Nlevlmdz) :: presnivs
    256   real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
     256  REAL                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
    257257  logical                  :: use_vgrid
    258258  logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
    … …  
    262262!!! Variables locales
    263263  integer                   :: idayref, iff, ii
    264   real                      :: zjulian,zjulian_start
     264  REAL                      :: zjulian,zjulian_start
    265265  real(wp),dimension(Ncolumns)  :: column_ax
    266266  real(wp),dimension(DBZE_BINS) ::  dbze_ax
    … …  
    283283
    284284!! Definition valeurs axes
    285     do ii=1,Ncolumns
     285    DO ii=1,Ncolumns
    286286      column_ax(ii) = real(ii)
    287287    enddo
    288288
    289     do i=1,DBZE_BINS
     289    DO i=1,DBZE_BINS
    290290     dbze_ax(i) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(i - 0.5)
    291291    enddo

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

    r5157 r5158  
    4141!!! Variables d'entree
    4242  integer               :: itap, Nlevlmdz, Ncolumns, Npoints
    43   real                  :: freq_COSP, dtime, missing_val, missing_cosp
     43  REAL                  :: freq_COSP, dtime, missing_val, missing_cosp
    4444  type(cosp_config)     :: cfg     ! Control outputs
    4545  type(cosp_gridbox)    :: gbx     ! Gridbox information. Input for COSP
    … …  
    172172  IF (using_xios) THEN
    173173
    174     do icl=1,SR_BINS
     174    DO icl=1,SR_BINS
    175175      tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
    176176    enddo
    … …  
    180180  ELSE
    181181    if (cfg%LcfadLidarsr532) then
    182       do icl=1,SR_BINS
     182      DO icl=1,SR_BINS
    183183        CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
    184184      enddo
    … …  
    194194
    195195  if (cfg%LparasolRefl) then
    196     do k=1,PARASOL_NREFL
    197      do ip=1, Npoints
     196    DO k=1,PARASOL_NREFL
     197     DO ip=1, Npoints
    198198      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.))/ &
    … …  
    215215  ELSE
    216216    if (cfg%Latb532) then 
    217       do icl=1,Ncolumns
     217      DO icl=1,Ncolumns
    218218        CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
    219219      enddo
    … …  
    230230   where(stradar%cfad_ze == R_UNDEF) stradar%cfad_ze = missing_val
    231231  IF (using_xios) THEN
    232     do icl=1,DBZE_BINS
     232    DO icl=1,DBZE_BINS
    233233      tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
    234234    enddo
    … …  
    238238  ELSE
    239239    if (cfg%Ldbze94) then
    240       do icl=1,Ncolumns
     240      DO icl=1,Ncolumns
    241241        CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
    242242      enddo
    243243     endif
    244244     if (cfg%LcfadDbze94) then
    245        do icl=1,DBZE_BINS
     245       DO icl=1,DBZE_BINS
    246246         CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
    247247       enddo
    … …  
    278278  ELSE
    279279    if (cfg%Lclisccp) then
    280       do icl=1,7
     280      DO icl=1,7
    281281        CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
    282282      enddo
    … …  
    299299
    300300  IF (using_xios) THEN
    301     do icl=1,numMISRHgtBins
     301    DO icl=1,numMISRHgtBins
    302302      tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
    303303    enddo
    … …  
    306306  ELSE
    307307    if (cfg%LclMISR) then
    308       do icl=1,7
     308      DO icl=1,7
    309309        CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
    310310      enddo
    … …  
    379379  ELSE
    380380    if (cfg%Lclmodis) then
    381      do icl=1,7
     381     DO icl=1,7
    382382       CALL histwrite3d_cosp(o_clmodis, &
    383383         modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
    … …  
    397397    ELSE
    398398      if (cfg%Lclmodis) then
    399         do icl=1,7
     399        DO icl=1,7
    400400          CALL histwrite3d_cosp(o_crimodis, &
    401401             modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
    … …  
    403403      endif
    404404      if (cfg%Lclmodis) then
    405         do icl=1,7
     405        DO icl=1,7
    406406           CALL histwrite3d_cosp(o_crlmodis, &
    407407              modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)

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

    r3358 r5158  
    3535
    3636  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    37   !                                                                     TYPE cosp_parasol
     37  !                                    TYPE cosp_parasol
    3838  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3939  TYPE PARASOL_SGX
    … …  
    6363  END TYPE COSP_PARASOL
    6464  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    65   !                                                                             TYPE parasol_in
     65  !                                        TYPE parasol_in
    6666  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    6767  TYPE parasol_IN
    … …  
    8686
    8787  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    88   !                                                                 END MODULE
     88  !                                     END MODULE
    8989  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    9090end module MOD_COSP_PARASOL_INTERFACE

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

    r5133 r5158  
    2929
    3030               
    31    do i=1,78
     31   DO i=1,78
    3232      cfg%out_list(i)=''
    3333   enddo
    … …  
    132132
    133133
    134    do i=1,78
     134   DO i=1,78
    135135      cfg%out_list(i)=''
    136136   enddo
    … …  
    271271             LprofSR,Lproftemp                                                                        !TIBO (2)
    272272   
    273   do i=1,78
     273  DO i=1,78
    274274    cfg%out_list(i)=''
    275275  enddo
    … …  
    780780 IF (using_xios) THEN
    781781
    782   do i=1,78
     782  DO i=1,78
    783783    cfg%out_list(i)=''
    784784  enddo

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

    r5095 r5158  
    8080   r = 0._wp
    8181
    82    do i=1,Npoints
     82   DO i=1,Npoints
    8383     ! Calculate tops and bottoms of new and old grids
    8484     oldgrid_bot = zhalf(i,:)
    … …  
    8787     l = 0 ! Index of level in the old grid
    8888     ! Loop over levels in the new grid
    89      do k = 1,Nglevels
     89     DO k = 1,Nglevels
    9090       Nw = 0 ! Number of weigths
    9191       wt = 0._wp ! Sum of weights
    9292       ! Loop over levels in the old grid and accumulate total for weighted average
    93        do
     93       DO
    9494         l = l + 1
    9595         w = 0.0 ! Initialise weight to 0
    … …  
    118118             Nw = Nw + 1
    119119             wt = wt + w
    120              do j=1,Ncolumns
     120             DO j=1,Ncolumns
    121121               if (lunits) then
    122122                 if (y(i,j,l) /= R_UNDEF) then
    … …  
    137137       ! Calculate average in new grid
    138138       if (Nw > 0) then
    139          do j=1,Ncolumns
     139         DO j=1,Ncolumns
    140140           r(i,j,k) = r(i,j,k)/wt
    141141         enddo
    … …  
    145145
    146146   ! Set points under surface to R_UNDEF, and change to dBZ if necessary
    147    do k=1,Nglevels
    148      do j=1,Ncolumns
    149        do i=1,Npoints
     147   DO k=1,Nglevels
     148     DO j=1,Ncolumns
     149       DO i=1,Npoints
    150150         if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level
    151151           if (lunits) then
    … …  
    197197    lidar_only_freq_cloud = 0._wp
    198198    tcc = 0._wp
    199     do pr=1,Npoints
    200        do i=1,Ncolumns
     199    DO pr=1,Npoints
     200       DO i=1,Ncolumns
    201201          flag_sat = 0
    202202          flag_cld = 0
    203           do j=1,Nlevels
     203          DO j=1,Nlevels
    204204             sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
    205205             if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
    … …  
    244244    integer :: ij
    245245   
    246     do ij=2,Nbins+1 
     246    DO ij=2,Nbins+1
    247247       hist1D(ij-1) = count(var .ge. bins(ij-1) .and. var .lt. bins(ij))
    248248       if (count(var .eq. R_GROUND) .ge. 1) hist1D(ij-1)=R_UNDEF
    … …  
    276276    integer :: ij,ik
    277277   
    278     do ij=2,nbin1+1
    279        do ik=2,nbin2+1
     278    DO ij=2,nbin1+1
     279       DO ik=2,nbin2+1
    280280          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
    281281               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       

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

    r3358 r5158  
    6767        delta = (alpha_x + b_x + d_x - n_bx + 1._wp)
    6868       
    69         do k=1,Nlevels
    70             do j=1,Ncolumns
    71                 do i=1,Npoints
     69        DO k=1,Nlevels
     70            DO j=1,Ncolumns
     71                DO i=1,Npoints
    7272                    if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
    7373                        rho = p(i,k)/(287.05_wp*T(i,k))

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

    r5095 r5158  
    135135   
    136136    if (debugcol.ne.0) then
    137        do j=1,npoints,debugcol
     137       DO j=1,npoints,debugcol
    138138         
    139139          ! Produce character output
    140           do ilev=1,nlev
     140          DO ilev=1,nlev
    141141             acc(ilev,1:ncol)=frac_out(j,1:ncol,ilev)*2
    142142             where(levmatch(j,1:ncol) .eq. ilev) acc(ilev,1:ncol)=acc(ilev,1:ncol)+1
    … …  
    151151          write(9,'(a1)') ' '
    152152         
    153           do ibox=1,ncol
     153          DO ibox=1,ncol
    154154             write(9,'(40(a1),1x,40(a1))') &
    155155                  (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev),&
    … …  
    231231       itrop(1:npoints)     = 1
    232232
    233        do ilev=1,nlev
     233       DO ilev=1,nlev
    234234          where(pfull(1:npoints,ilev) .lt. 40000. .and. &
    235235                pfull(1:npoints,ilev) .gt.  5000. .and. &
    … …  
    242242       enddo
    243243
    244        do ilev=1,nlev
     244       DO ilev=1,nlev
    245245          atmax(1:npoints) = merge(at(1:npoints,ilev),atmax(1:npoints),&
    246246               at(1:npoints,ilev) .gt. atmax(1:npoints) .and. ilev  .ge. itrop(1:npoints))
    … …  
    256256       ! at a wavenumber of 955 cm-1, or 10.47 microns
    257257       ! ############################################################################
    258        do ilev=1,nlev
     258       DO ilev=1,nlev
    259259          press(1:npoints)  = pfull(1:npoints,ilev)*10._wp
    260260          dpress(1:npoints) = (phalf(1:npoints,ilev+1)-phalf(1:npoints,ilev))*10
    … …  
    273273       fluxtop_clrsky(1:npoints)            = 0._wp
    274274       trans_layers_above_clrsky(1:npoints) = 1._wp
    275        do ilev=1,nlev
     275       DO ilev=1,nlev
    276276          ! Black body emission at temperature of the layer
    277277          bb(1:npoints) = 1._wp / ( exp(1307.27_wp/at(1:npoints,ilev)) - 1._wp )
    … …  
    300300       fluxtop(1:npoints,1:ncol)            = 0._wp
    301301       trans_layers_above(1:npoints,1:ncol) = 1._wp
    302        do ilev=1,nlev
     302       DO ilev=1,nlev
    303303          ! Black body emission at temperature of the layer
    304304          bb=1._wp/(exp(1307.27_wp/at(1:npoints,ilev)) - 1._wp)
    305305         
    306           do ibox=1,ncol
     306          DO ibox=1,ncol
    307307             ! Emissivity
    308308             dem(1:npoints,ibox) = merge(dem_wv(1:npoints,ilev), &
    … …  
    320320       ! Add in surface emission
    321321       bb(1:npoints)=1._wp/( exp(1307.27_wp/skt(1:npoints)) - 1._wp )
    322        do ibox=1,ncol
     322       DO ibox=1,ncol
    323323          fluxtop(1:npoints,ibox) = fluxtop(1:npoints,ibox) + emsfc_lw*bb(1:npoints)*trans_layers_above(1:npoints,ibox)
    324324       end do
    … …  
    344344       btcmin(1:npoints) = 1._wp /  ( exp(1307.27_wp/(attrop(1:npoints)-5._wp)) - 1._wp )
    345345
    346        do ibox=1,ncol
     346       DO ibox=1,ncol
    347347          transmax(1:npoints) = (fluxtop(1:npoints,ibox)-btcmin) /(fluxtop_clrsky(1:npoints)-btcmin(1:npoints))
    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))
    350350          if (isccp_top_height .eq. 1) then
    351              do j=1,npoints 
     351             DO j=1,npoints
    352352                if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
    353353                   fluxtopinit(j) = fluxtop(j,ibox)
    … …  
    355355                endif
    356356             enddo
    357              do icycle=1,2
    358                 do j=1,npoints 
     357             DO icycle=1,2
     358                DO j=1,npoints
    359359                   if (tau(j,ibox) .gt. (tauchk)) then
    360360                      if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
    … …  
    397397    ! pressure (isccp_top_height = 1 or 3)
    398398    ! ####################################################################################
    399     do ibox=1,ncol
     399    DO ibox=1,ncol
    400400       !segregate according to optical thickness
    401401       if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then 
    … …  
    403403          ! Find level whose temperature most closely matches brightness temperature
    404404          nmatch(1:npoints)=0
    405           do k1=1,nlev-1
     405          DO k1=1,nlev-1
    406406             ilev = merge(nlev-k1,k1,isccp_top_height_direction .eq. 2)       
    407              do j=1,npoints
     407             DO j=1,npoints
    408408                if (ilev           .ge. itrop(j)     .and. &
    409409                     ((at(j,ilev)  .ge. tb(j,ibox)   .and. & 
    … …  
    417417          enddo
    418418
    419           do j=1,npoints
     419          DO j=1,npoints
    420420             if (nmatch(j) .ge. 1) then
    421421                k1 = match(j,nmatch(j))
    … …  
    440440       else
    441441          ptop(1:npoints,ibox)=0.
    442           do ilev=1,nlev
     442          DO ilev=1,nlev
    443443             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)
    … …  
    458458    boxtau(1:npoints,1:ncol)  = output_missing_value
    459459    boxptop(1:npoints,1:ncol) = output_missing_value
    460     do ibox=1,ncol
    461        do j=1,npoints
     460    DO ibox=1,ncol
     461       DO j=1,npoints
    462462          if (tau(j,ibox) .gt. (tauchk) .and. ptop(j,ibox) .gt. 0.) then
    463463             if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
    … …  
    532532    ! Reset frequencies
    533533    !fq_isccp = spread(spread(merge(0._wp,output_missing_value,sunlit .eq. 1 .or. isccp_top_height .eq. 3),2,7),2,7)
    534     do ilev=1,7
    535        do ilev2=1,7
    536           do j=1,npoints !
     534    DO ilev=1,7
     535       DO ilev2=1,7
     536          DO j=1,npoints !
    537537             if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
    538538                fq_isccp(j,ilev,ilev2)= 0.
    539              else
     539         else
    540540                fq_isccp(j,ilev,ilev2)= output_missing_value
    541541             end if
    … …  
    559559   
    560560    ! Compute column quantities and joint-histogram
    561     do j=1,npoints
     561    DO j=1,npoints
    562562       ! Subcolumns that are cloudy(true) and not(false)
    563563       box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) .gt. tauchk .and. boxptop(j,1:ncol) .gt. 0.)
    … …  
    633633   
    634634    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    635     do j=1,dim2
     635    DO j=1,dim2
    636636       where(flag(:,j,:) .eq. 1)
    637637          varOUT(:,j,:) = varIN2

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

    r5095 r5158  
    142142    ! PLANE PARRALLEL FIELDS
    143143    ! ####################################################################################
    144     do icol=1,ncolumns
     144    DO icol=1,ncolumns
    145145       ! #################################################################################
    146146       ! *) Total Backscatter signal
    … …  
    165165    ! PERDENDICULAR FIELDS
    166166    ! ####################################################################################
    167     do icol=1,ncolumns
     167    DO icol=1,ncolumns
    168168
    169169       ! #################################################################################
    … …  
    172172       ! Computation of ATBperp,ice/liq from ATBice/liq including the multiple scattering
    173173       ! contribution (Cesana and Chepfer 2013, JGR)
    174        do k=1,nlev
     174       DO k=1,nlev
    175175          ! Ice particles
    176176          pnorm_perp_ice(1:npoints,icol,k) = Alpha * pnorm_ice(1:npoints,icol,k)
    … …  
    208208             
    209209       ! Other layers
    210        do k=2,nlev
     210       DO k=2,nlev
    211211          ! Optical thickness of layer k
    212212          tautot_lay(1:npoints) = tautot(1:npoints,icol,k)-tautot(1:npoints,icol,k-1)
    … …  
    316316    ! Compute LIDAR scattering ratio
    317317    if (use_vgrid) then
    318        do ic = 1, ncol
     318       DO ic = 1, ncol
    319319          pnorm_c = pnormFlip(:,ic,:)
    320320          where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
    … …  
    331331                         lidarcld,cldlayer,lidarcldphase,cldlayerphase,lidarcldtmp)                           
    332332    else
    333        do ic = 1, ncol
     333       DO ic = 1, ncol
    334334          pnorm_c = pnorm(:,ic,:)
    335335          where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
    … …  
    349349    if (ok_lidar_cfad) then
    350350       ! CFADs of subgrid-scale lidar scattering ratios
    351        do i=1,Npoints
    352           do j=1,llm
     351       DO i=1,Npoints
     352          DO j=1,llm
    353353             cfad2(i,:,j) = hist1D(ncol,x3d(i,:,j),SR_BINS,calipso_histBsct)
    354354          enddo
    … …  
    387387
    388388    ! Other layers
    389     do k=2,nlev
     389    DO k=2,nlev
    390390       tautot_lay(:) = tau(:,k)-tau(:,k-1)
    391391       WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. 0. )
    … …  
    416416
    417417    beta(:,1) = pnorm(:,1) * (2._wp*tau(:,1))/(1._wp-exp(-2._wp*tau(:,1)))
    418     do k=2,nlev
     418    DO k=2,nlev
    419419       tautot_lay(:) = tau(:,k)-tau(:,k-1)       
    420420       WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. 0. )
    … …  
    458458       zeta50    = -9.4776e-07_wp    !
    459459       
    460         ! Inputs
     460    ! Inputs
    461461    integer,intent(in) :: &
    462462       Npoints,  & ! Number of gridpoints
    … …  
    465465       Ncat,     & ! Number of cloud layer types
    466466       Nphase      ! Number of cloud layer phase types
    467                        ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
     467                   ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
    468468    real(wp),intent(in) :: &
    469469       S_att,    & !
    … …  
    479479       pplay       ! Pressure
    480480
    481         ! Outputs
     481    ! Outputs
    482482    real(wp),intent(out),dimension(Npoints,Ntemp,5) :: &
    483483       lidarcldtemp  ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq
    … …  
    514514             
    515515    ! ####################################################################################
    516         ! 1) Initialize   
     516    ! 1) Initialize
    517517    ! ####################################################################################
    518518    lidarcld              = 0._wp
    … …  
    537537    ! 2) Cloud detection
    538538    ! ####################################################################################
    539     do k=1,Nlevels
     539    DO k=1,Nlevels
    540540       ! Cloud detection at subgrid-scale:
    541541       where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    … …  
    560560    cldlay   = 0._wp
    561561    nsublay  = 0._wp
    562     do k=1,Nlevels
    563        do ic = 1, Ncolumns
    564           do ip = 1, Npoints
     562    DO k=1,Nlevels
     563       DO ic = 1, Ncolumns
     564          DO ip = 1, Npoints
    565565         
    566566             ! Computation of the cloud fraction as a function of the temperature instead
    567567             ! of height, for ice,liquid and all clouds
    568568             if(srok(ip,ic,k).gt.0.)then
    569                 do itemp=1,Ntemp
     569                DO itemp=1,Ntemp
    570570                   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
    … …  
    575575             
    576576             if(cldy(ip,ic,k).eq.1.)then
    577                 do itemp=1,Ntemp
     577                DO itemp=1,Ntemp
    578578                   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
    … …  
    612612    cldlayer  = 0._wp
    613613    nsublayer = 0._wp
    614     do iz = 1, Ncat
    615        do ic = 1, Ncolumns
     614    DO iz = 1, Ncat
     615       DO ic = 1, Ncolumns
    616616          cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
    617617          nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
    … …  
    631631    ! 4.1) For Cloudy pixels with 8.16km < z < 19.2km
    632632    ! ####################################################################################
    633     do ncol=1,Ncolumns
    634        do i=1,Npoints         
    635           do nlev=1,23 ! from 19.2km until 8.16km
     633    DO ncol=1,Ncolumns
     634       DO i=1,Npoints
     635          DO nlev=1,23 ! from 19.2km until 8.16km
    636636               p1 = pplay(1,nlev)
    637637
    … …  
    745745          ! ##############################################################################
    746746          toplvlsat = 0
    747           do nlev=24,Nlevels! from 8.16km until 0km
     747          DO nlev=24,Nlevels! from 8.16km until 0km
    748748             p1 = pplay(i,nlev)
    749749
    … …  
    868868          ! ##############################################################################
    869869          if(toplvlsat.ne.0) then
    870              do nlev = toplvlsat,Nlevels
     870             DO nlev = toplvlsat,Nlevels
    871871                p1 = pplay(i,nlev)
    872872                if(cldy(i,ncol,nlev).eq.1.)then
    … …  
    920920
    921921    ! Compute Phase low mid high cloud fractions
    922     do iz = 1, Ncat
    923        do i=1,Nphase-3
    924           do ic = 1, Ncolumns
     922    DO iz = 1, Ncat
     923       DO i=1,Nphase-3
     924          DO ic = 1, Ncolumns
    925925             cldlayerphase(:,iz,i)  = cldlayerphase(:,iz,i)  + cldlayphase(:,ic,iz,i)
    926926             cldlayerphasesum(:,iz) = cldlayerphasesum(:,iz) + cldlayphase(:,ic,iz,i)
    … …  
    928928       enddo
    929929    enddo
    930     do iz = 1, Ncat
    931        do i=4,5
    932           do ic = 1, Ncolumns
     930    DO iz = 1, Ncat
     931       DO i=4,5
     932          DO ic = 1, Ncolumns
    933933             cldlayerphase(:,iz,i) = cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
    934934          enddo
    … …  
    944944    ENDWHERE
    945945   
    946     do i=1,Nphase-1
     946    DO i=1,Nphase-1
    947947       WHERE ( cldlayerphasesum(:,:).gt.0.0 )
    948948          cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
    … …  
    950950    enddo
    951951   
    952     do i=1,Npoints
    953        do iz=1,Ncat
     952    DO i=1,Npoints
     953       DO iz=1,Ncat
    954954          checkcldlayerphase=0.
    955955          checkcldlayerphase2=0.
    956956          if (cldlayerphasesum(i,iz) .gt. 0.0 )then
    957              do ic=1,Nphase-3
     957             DO ic=1,Nphase-3
    958958                checkcldlayerphase = checkcldlayerphase+cldlayerphase(i,iz,ic)
    959959             enddo
    … …  
    964964    enddo
    965965   
    966     do i=1,Nphase-1
     966    DO i=1,Nphase-1
    967967       WHERE (nsublayer(:,:) .eq. 0.0)
    968968          cldlayerphase(:,:,i) = undef
    … …  
    971971 
    972972    ! Compute Phase 3D as a function of temperature
    973     do nlev=1,Nlevels
    974        do ncol=1,Ncolumns
    975           do i=1,Npoints
    976              do itemp=1,Ntemp
     973    DO nlev=1,Nlevels
     974       DO ncol=1,Ncolumns
     975          DO i=1,Npoints
     976             DO itemp=1,Ntemp
    977977                if(tmpi(i,ncol,nlev).gt.0.)then
    978978                   if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    … …  
    994994   
    995995    ! Check temperature cloud fraction
    996     do i=1,Npoints
    997        do itemp=1,Ntemp
     996    DO i=1,Npoints
     997       DO itemp=1,Ntemp
    998998          checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
    999999          !if(checktemp .NE. lidarcldtemp(i,itemp,1))then
    … …  
    10131013    ENDWHERE
    10141014   
    1015     do i=1,4
     1015    DO i=1,4
    10161016       WHERE(lidarcldtempind(:,:) .gt. 0.)
    10171017          lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)

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

    r5095 r5158  
    9696    else
    9797       sumo = 0._wp
    98        do j=i1,i2
     98       DO j=i1,i2
    9999          deltah = abs(s(i1+1)-s(i1))
    100100          sumo = sumo + f(j)*deltah
    … …  
    204204    end if
    205205   
    206     do i = 2, ntab
     206    DO i = 2, ntab
    207207       if ( xtab(i) <= xtab(i-1) ) then
    208208          lerror = .true.
    … …  
    239239    ihi = ntab
    240240   
    241     do i = 1, ntab
     241    DO i = 1, ntab
    242242       if ( a <= xtab(i) ) then
    243243          exit
    … …  
    249249    ilo = min ( ilo, ntab - 1 )
    250250   
    251     do i = 1, ntab
     251    DO i = 1, ntab
    252252       if ( xtab(i) <= b ) then
    253253          exit
    … …  
    263263!ds    sum1 = 0.0D+00
    264264   
    265     do i = ilo, ihi
     265    DO i = ilo, ihi
    266266       
    267267       x1 = xtab(i-1)
    … …  
    371371          ga=1._wp
    372372          m1=x-1
    373           do k=2,m1
     373          DO k=2,m1
    374374             ga=ga*k
    375375          enddo
    … …  
    382382          m=int(z)
    383383          r=1._wp
    384           do k=1,m
     384          DO k=1,m
    385385             r=r*(z-k)
    386386          enddo
    … …  
    390390       endif
    391391       gr=g(26)
    392        do k=25,1,-1
     392       DO k=25,1,-1
    393393          gr=gr*z+g(k)
    394394       enddo

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

    r5095 r5158  
    163163    cloudMask = retrievedTau(1:nSubCols) >= min_OpticalThickness
    164164   
    165     do i = 1, nSubCols
     165    DO i = 1, nSubCols
    166166       if(cloudMask(i)) then
    167167          ! ##################################################################################
    … …  
    380380    reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
    381381    reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
    382     do j=1,nPoints
     382    DO j=1,nPoints
    383383
    384384       ! Fill clear and optically thin subcolumns with fill
    … …  
    439439    !   layers and use the trapezoidal rule.
    440440    totalTau = 0._wp; totalProduct = 0._wp
    441     do i = 2, size(tauIncrement)
     441    DO i = 2, size(tauIncrement)
    442442      if(totalTau + tauIncrement(i) > tauLimit) then
    443443        deltaX = tauLimit - totalTau
    … …  
    479479    ! Find the extinction-weighted value of f(tau), assuming constant f within each layer
    480480    totalTau = 0._wp; totalProduct = 0._wp
    481     do i = 1, size(tauIncrement)
     481    DO i = 1, size(tauIncrement)
    482482      if(totalTau + tauIncrement(i) > tauLimit) then
    483483        deltaX       = tauLimit - totalTau
    … …  
    713713    cloudMask(1:nLevels) = tau(1:nLevels) > 0.
    714714    cloudIndicies = pack((/ (i, i = 1, nLevels) /), mask = cloudMask)
    715     do i = 1, size(cloudIndicies)
     715    DO i = 1, size(cloudIndicies)
    716716       call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    717717    end do
    … …  
    893893    Tran_cumulative(1) = Tran(1)   
    894894   
    895     do i=2, npts
     895    DO i=2, npts
    896896       ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
    897897       Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1._wp - Refl_cumulative(i-1) * Refl(i))

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

    r5095 r5158  
    539539    if (alam < cutice) then
    540540       ! Region from 0.045 microns to 167.0 microns - no temperature depend
    541        do i=2,nwl
     541       DO i=2,nwl
    542542          if(alam < wl(i)) continue
    543543       enddo
    … …  
    557557       if(tk > temref(1)) tk=temref(1)
    558558       if(tk < temref(4)) tk=temref(4)
    559        do i=2,4
     559       DO i=2,4
    560560          if(tk.ge.temref(i)) go to 12
    561561       enddo
    56256212     lt1 = i
    563563       lt2 = i-1
    564        do i=2,nwlt
     564       DO i=2,nwlt
    565565          if(alam.le.wlt(i)) go to 14
    566566       enddo

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

    r5095 r5158  
    159159    ! Compute grid-box averaged Parasol reflectances
    160160    parasolrefl(:,:) = 0._wp
    161     do k = 1, nrefl
    162        do ic = 1, ncol
     161    DO k = 1, nrefl
     162       DO ic = 1, ncol
    163163          parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
    164164       enddo
    165165    enddo
    166166   
    167     do k = 1, nrefl
     167    DO k = 1, nrefl
    168168       parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
    169169       ! if land=1 -> parasolrefl=R_UNDEF

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

    r5133 r5158  
    4444! mr_ozone,                             !Concentration ozone (Kg/Kg)
    4545! dem_s                                 !Cloud optical emissivity
    46 ! dtau_s                                !Cloud optical thickness
    47 ! emsfc_lw = 1.                         !Surface emissivity dans radlwsw.F90
     46! dtau_s                           !Cloud optical thickness
     47! emsfc_lw = 1.                    !Surface emissivity dans radlwsw.F90
    4848
    4949!!! Outputs :
    … …  
    159159! Declaration necessaires pour les sorties IOIPSL
    160160  integer :: ii
    161   real    :: ecrit_day,ecrit_hf,ecrit_mth, missing_val
     161  REAL    :: ecrit_day,ecrit_hf,ecrit_mth, missing_val
    162162  logical :: ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, ok_all_xml
    163163
    … …  
    177177  real,dimension(Nlevlmdz)        :: presnivs
    178178  integer                         :: itap,k,ip
    179   real                            :: dtime,freq_cosp
     179  REAL                            :: dtime,freq_cosp
    180180  real,dimension(2)               :: time_bnds
    181181
    … …  
    312312
    313313        zlev_half(:,1) = phis(:)/9.81
    314         do k = 2, Nlevels
    315           do ip = 1, Npoints
     314        DO k = 2, Nlevels
     315          DO ip = 1, Npoints
    316316           zlev_half(ip,k) = phi(ip,k)/9.81 + &
    317317               (phi(ip,k)-phi(ip,k-1))/9.81 * (ph(ip,k)-p(ip,k)) / (p(ip,k)-p(ip,k-1))
    … …  
    330330        gbx%skt  = skt !Skin temperature (K)
    331331
    332         do ip = 1, Npoints
     332        DO ip = 1, Npoints
    333333          if (fracTerLic(ip).ge.0.5) then
    334334             gbx%land(ip) = 1.

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

    r5095 r5158  
    6666      if (cv_col .eq. 0) cv_col=1
    6767 
    68       do ilev=1,nlev
    69         do ibox=1,ncol
    70           do j=1,npoints
     68      DO ilev=1,nlev
     69        DO ibox=1,ncol
     70          DO j=1,npoints
    7171            prec_frac(j,ibox,ilev) = 0
    7272          enddo
    … …  
    7474      enddo
    7575     
    76       do j=1,npoints
    77        do ibox=1,ncol
     76      DO j=1,npoints
     77       DO ibox=1,ncol
    7878        frac_out_ls(j,ibox)=0
    7979        frac_out_cv(j,ibox)=0
    8080        flag_ls=0
    8181        flag_cv=0
    82         do ilev=1,nlev
     82        DO ilev=1,nlev
    8383          if (frac_out(j,ibox,ilev) .eq. 1) then
    8484            flag_ls=1
    … …  
    9898
    9999!      initialize the top layer     
    100        do j=1,npoints
     100       DO j=1,npoints
    101101        flag_ls=0
    102102        flag_cv=0
    103103   
    104104        if (ls_p_rate(j,1) .gt. 0.) then
    105             do ibox=1,ncol ! possibility ONE
     105            DO ibox=1,ncol ! possibility ONE
    106106                if (frac_out(j,ibox,1) .eq. 1) then
    107107                    prec_frac(j,ibox,1) = 1
    … …  
    110110            enddo ! loop over ncol
    111111            if (flag_ls .eq. 0) then ! possibility THREE
    112                 do ibox=1,ncol
     112                DO ibox=1,ncol
    113113                    if (frac_out(j,ibox,2) .eq. 1) then
    114114                        prec_frac(j,ibox,1) = 1
    … …  
    118118            endif
    119119        if (flag_ls .eq. 0) then ! possibility Four
    120         do ibox=1,ncol
     120        DO ibox=1,ncol
    121121        if (frac_out_ls(j,ibox) .eq. 1) then
    122122            prec_frac(j,ibox,1) = 1
    … …  
    126126        endif
    127127        if (flag_ls .eq. 0) then ! possibility Five
    128         do ibox=1,ncol
     128        DO ibox=1,ncol
    129129    !     prec_frac(j,1:ncol,1) = 1
    130130        prec_frac(j,ibox,1) = 1
    … …  
    135135     
    136136        if (cv_p_rate(j,1) .gt. 0.) then
    137          do ibox=1,ncol ! possibility ONE
     137         DO ibox=1,ncol ! possibility ONE
    138138          if (frac_out(j,ibox,1) .eq. 2) then
    139139           if (prec_frac(j,ibox,1) .eq. 0) then
    … …  
    146146        enddo ! loop over ncol
    147147        if (flag_cv .eq. 0) then ! possibility THREE
    148         do ibox=1,ncol
     148        DO ibox=1,ncol
    149149        if (frac_out(j,ibox,2) .eq. 2) then
    150150                if (prec_frac(j,ibox,1) .eq. 0) then
    … …  
    158158        endif
    159159        if (flag_cv .eq. 0) then ! possibility Four
    160         do ibox=1,ncol
     160        DO ibox=1,ncol
    161161        if (frac_out_cv(j,ibox) .eq. 1) then
    162162                if (prec_frac(j,ibox,1) .eq. 0) then
    … …  
    170170        endif
    171171        if (flag_cv .eq. 0) then  ! possibility Five
    172         do ibox=1,cv_col
     172        DO ibox=1,cv_col
    173173                if (prec_frac(j,ibox,1) .eq. 0) then
    174174            prec_frac(j,ibox,1) = 2
    … …  
    187187
    188188!     working on the levels from top to surface
    189       do ilev=2,nlev
    190        do j=1,npoints
     189      DO ilev=2,nlev
     190       DO j=1,npoints
    191191        flag_ls=0
    192192        flag_cv=0
    193193   
    194194        if (ls_p_rate(j,ilev) .gt. 0.) then
    195          do ibox=1,ncol ! possibility ONE&TWO
     195         DO ibox=1,ncol ! possibility ONE&TWO
    196196          if ((frac_out(j,ibox,ilev) .eq. 1) .or. ((prec_frac(j,ibox,ilev-1) .eq. 1)     &
    197197            .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
    … …  
    201201        enddo ! loop over ncol
    202202        if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
    203         do ibox=1,ncol
     203        DO ibox=1,ncol
    204204        if (frac_out(j,ibox,ilev+1) .eq. 1) then
    205205            prec_frac(j,ibox,ilev) = 1
    … …  
    209209        endif
    210210        if (flag_ls .eq. 0) then ! possibility Four
    211         do ibox=1,ncol
     211        DO ibox=1,ncol
    212212        if (frac_out_ls(j,ibox) .eq. 1) then
    213213            prec_frac(j,ibox,ilev) = 1
    … …  
    217217        endif
    218218        if (flag_ls .eq. 0) then ! possibility Five
    219         do ibox=1,ncol
     219        DO ibox=1,ncol
    220220!     prec_frac(j,1:ncol,ilev) = 1
    221221        prec_frac(j,ibox,ilev) = 1
    … …  
    225225   
    226226        if (cv_p_rate(j,ilev) .gt. 0.) then
    227          do ibox=1,ncol ! possibility ONE&TWO
     227         DO ibox=1,ncol ! possibility ONE&TWO
    228228          if ((frac_out(j,ibox,ilev) .eq. 2) .or. ((prec_frac(j,ibox,ilev-1) .eq. 2)     &
    229229            .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
    … …  
    237237       enddo ! loop over ncol
    238238        if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
    239         do ibox=1,ncol
     239        DO ibox=1,ncol
    240240        if (frac_out(j,ibox,ilev+1) .eq. 2) then
    241241                if (prec_frac(j,ibox,ilev) .eq. 0) then
    … …  
    249249        endif
    250250        if (flag_cv .eq. 0) then ! possibility Four
    251         do ibox=1,ncol
     251        DO ibox=1,ncol
    252252        if (frac_out_cv(j,ibox) .eq. 1) then
    253253                if (prec_frac(j,ibox,ilev) .eq. 0) then
    … …  
    261261        endif
    262262        if (flag_cv .eq. 0) then  ! possibility Five
    263         do ibox=1,cv_col
     263        DO ibox=1,cv_col
    264264                if (prec_frac(j,ibox,ilev) .eq. 0) then
    265265            prec_frac(j,ibox,ilev) = 2

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

    r5095 r5158  
    153153       d_gate     = -1
    154154    endif
    155     do k=start_gate,end_gate,d_gate
     155    DO k=start_gate,end_gate,d_gate
    156156       ! Loop over each profile (nprof)
    157        do pr=1,nprof
     157       DO pr=1,nprof
    158158          ! Attenuation due to hydrometeors between radar and volume
    159159         
    … …  
    265265
    266266       ! Effective reflectivity histogram
    267        do i=1,Npoints
    268           do j=1,llm
     267       DO i=1,Npoints
     268          DO j=1,llm
    269269             cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_totFlip(i,:,j),DBZE_BINS,cloudsat_histRef)
    270270          enddo
    … …  
    274274    else
    275275       ! Effective reflectivity histogram
    276        do i=1,Npoints
    277           do j=1,llm
     276       DO i=1,Npoints
     277          DO j=1,llm
    278278             cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_tot(i,:,j),DBZE_BINS,cloudsat_histRef)
    279279          enddo
    … …  
    315315            trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
    316316       
    317        do i=1,maxhclass
    318           do j=1,mt_ntt
    319              do k=1,nRe_types
     317       DO i=1,maxhclass
     318          DO j=1,mt_ntt
     319             DO k=1,nRe_types
    320320                ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
    321321                read(12,rec=ind) rcfg%Z_scale_flag(i,j,k), &
    … …  
    351351         trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
    352352   
    353     do i=1,maxhclass
    354        do j=1,mt_ntt
    355           do k=1,nRe_types
     353    DO i=1,maxhclass
     354       DO j=1,mt_ntt
     355          DO k=1,nRe_types
    356356             ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
    357357             if(.not.LUT_file_exists .or. rcfg%Z_scale_added_flag(i,j,k)) then

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

    r5095 r5158  
    7171    mt_ttl = (/ ((j-1)*5-60 + 273.15, j = 1, cnt_liq) /)
    7272    D(1) = dmin
    73     do j=2,nd
     73    DO j=2,nd
    7474       D(j) = D(j-1)*exp((log(dmax)-log(dmin))/(nd-1))
    7575    enddo
    … …  
    152152    kr_vol   = 0._wp
    153153
    154     do k=1,ngate       ! Loop over each profile (nprof)
    155        do pr=1,nprof
     154    DO k=1,ngate       ! Loop over each profile (nprof)
     155       DO pr=1,nprof
    156156          if (g_vol_in_present) then
    157157             g_vol(pr,k) = g_vol_in(pr,k)
    … …  
    167167          ! Determine if hydrometeor(s) present in volume
    168168          hydro = .false.
    169           do j=1,rcfg%nhclass
     169          DO j=1,rcfg%nhclass
    170170             if ((hm_matrix(pr,k,j) > 1E-12) .and. (sd%dtype(j) > 0)) then
    171171                hydro = .true.
    … …  
    180180             
    181181             ! Loop over hydrometeor type
    182              do tp=1,rcfg%nhclass
     182             DO tp=1,rcfg%nhclass
    183183                Re_internal = re_matrix(pr,k,tp)
    184184
    … …  
    368368   
    369369    where(kr_vol(:,:) <= EPSILON(kr_vol))
    370        ! Volume is hydrometeor-free     
     370       ! Volume is hydrometeor-free
    371371       !z_vol(:,:)  = undef
    372372       z_ray(:,:)  = undef
    … …  
    820820       lidx = infind(D,dmin)
    821821       uidx = infind(D,dmax)   
    822        do k=lidx,uidx
     822       DO k=lidx,uidx
    823823          N(k) = (ahp*(D(k)*1E-3)**bhp) * 1E-12   
    824824       enddo
    … …  
    10061006       sizep = (pi*D0)/wl
    10071007       dqv(1) = 0._wp
    1008        do i=1,nsizes
     1008       DO i=1,nsizes
    10091009          call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    10101010               dg, xs1, xs2, dph, err)
    … …  
    12091209    sumo = 0._wp
    12101210    aux1 = 1.1_wp*e_th
    1211     do i=1,nbands_o2
     1211    DO i=1,nbands_o2
    12121212       aux2   = f/v0(i)
    12131213       aux3   = v0(i)-f
    … …  
    12331233    sumo = 0._wp
    12341234    aux1 = 4.8_wp*e_th
    1235     do i=1,nbands_h2o
     1235    DO i=1,nbands_h2o
    12361236       aux2    = f/v1(i)
    12371237       aux3    = v1(i)-f
    … …  
    12981298    ! 4 for monodisperse distribution,
    12991299    ! 5 for lognormal distribution.
    1300         !
     1300    !
    13011301    ! PHASE - Set to 0 for liquid, 1 for ice.
    13021302    ! DMIN  - The minimum drop size for this class (micron), ignored for monodisperse.

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

    r5095 r5158  
    9494    if (ncolprint.ne.0) then
    9595       write (6,'(a)') 'frac_out_pp_rev:'
    96        do j=1,npoints,1000
     96       DO j=1,npoints,1000
    9797          write(6,'(a10)') 'j='
    9898          write(6,'(8I10)') j
    … …  
    104104    if (ncolprint.ne.0) then
    105105       write (6,'(a)') 'last_frac_pp:'
    106        do j=1,npoints,1000
     106       DO j=1,npoints,1000
    107107          write(6,'(a10)') 'j='
    108108          write(6,'(8I10)') j
    … …  
    139139          IF (ncolprint.ne.0) then
    140140             write (6,'(a)') 'threshold_nsf2:'
    141              do j=1,npoints,1000
     141             DO j=1,npoints,1000
    142142                write(6,'(a10)') 'j='
    143143                write(6,'(8I10)') j
    … …  
    156156          !maxocc(1:npoints,ibox) = merge(1,0,boxpos(1:npoints,ibox) .le. conv(1:npoints,ilev))
    157157          !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox))
    158           do j=1,npoints
     158          DO j=1,npoints
    159159             if (boxpos(j,ibox).le.conv(j,ilev)) then
    160160                maxocc(j,ibox) = 1
    … …  
    214214       ! Set last_frac to tca at this level, so as to be tca from last level next time round
    215215       if (ncolprint.ne.0) then
    216           do j=1,npoints ,1000
     216          DO j=1,npoints ,1000
    217217             write(6,'(a10)') 'j='
    218218             write(6,'(8I10)') j
Note: See TracChangeset for help on using the changeset viewer.