Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (6 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/cospv2
Files:
29 edited

Legend:

Unmodified
Added
Removed

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

    r5099 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/cospv2/cosp.F90

    r5099 r5158  
    239239     real(wp),dimension(:),pointer :: &
    240240          isccp_totalcldarea => null(), & ! The fraction of model grid box columns with cloud
    241                                           ! somewhere in them. (%)
     241                                     ! somewhere in them. (%)
    242242          isccp_meantb => null(),       & ! Mean all-sky 10.5 micron brightness temperature. (K)
    243243          isccp_meantbclr => null(),    & ! Mean clear-sky 10.5 micron brightness temperature. (K)
    … …  
    837837       allocate(parasolPix_refl(parasolIN%Npoints,parasolIN%Ncolumns,PARASOL_NREFL))
    838838       ! Call simulator
    839        do icol=1,parasolIN%Ncolumns
     839       DO icol=1,parasolIN%Ncolumns
    840840          call parasol_subcolumn(parasolIN%npoints, PARASOL_NREFL,                       &
    841841                                 parasolIN%tautot_S_liq(1:parasolIN%Npoints,icol),       &
    … …  
    855855       allocate(cloudsatDBZe(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels), &
    856856                cloudsatZe_non(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels))
    857        do icol=1,cloudsatIN%ncolumns
     857       DO icol=1,cloudsatIN%ncolumns
    858858          call quickbeam_subcolumn(cloudsatIN%rcfg,cloudsatIN%Npoints,cloudsatIN%Nlevels,&
    859859                                   cloudsatIN%hgt_matrix/1000._wp,                       &
    … …  
    876876                   modisRetrievedCloudTopPressure(modisIN%nSunlit,modisIN%nColumns))
    877877          ! Call simulator
    878           do i = 1, modisIN%nSunlit
     878          DO i = 1, modisIN%nSunlit
    879879             call modis_subcolumn(modisIN%Ncolumns,modisIN%Nlevels,modisIN%pres(i,:),    &
    880880                                  modisIN%tau(int(modisIN%sunlit(i)),:,:),               &
    … …  
    12461246!            cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half,                           & !PREC_BUG
    12471247            cospgridIN%land(:), cospgridIN%surfelev(:), cospgridIN%at(:,cospIN%Nlevels), & !PREC_BUG
    1248             cospIN%fracPrecipIce, cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half,     & !PREC_BUG
     1248        cospIN%fracPrecipIce, cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half,     & !PREC_BUG
    12491249            cospOUT%cloudsat_cfad_ze(ij:ik,:,:), cospOUT%cloudsat_precip_cover,          &
    12501250            cospOUT%cloudsat_pia)
    … …  
    16911691       ! Other grid requested. Constant vertical spacing with top at 20 km
    16921692       if (.not. luseCSATvgrid) zstep = 20000._wp/Nvgrid
    1693        do i=1,Nvgrid
     1693       DO i=1,Nvgrid
    16941694          vgrid_zl(Nlvgrid-i+1) = (i-1)*zstep
    16951695          vgrid_zu(Nlvgrid-i+1) = i*zstep

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

    r5099 r5158  
    6262
    6363  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    64   !     END MODULE
     64  !    END MODULE
    6565  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    6666END MODULE MOD_COSP_ATLID_INTERFACE

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

    r5099 r5158  
    8181
    8282  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    83   !     END MODULE
     83  !    END MODULE
    8484  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    8585END MODULE MOD_COSP_CALIPSO_INTERFACE

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

    r5099 r5158  
    118118    ! Set up Re bin "structure" for z_scaling
    119119    rcfg%base_list(1)=0
    120     do j=1,Re_MAX_BIN
     120    DO j=1,Re_MAX_BIN
    121121       rcfg%step_list(j)=0.1_wp+0.1_wp*((j-1)**1.5)
    122122       if(rcfg%step_list(j)>Re_BIN_LENGTH) then
    … …  
    138138
    139139  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    140   !                                       END MODULE
     140  !                                    END MODULE
    141141  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    142142END MODULE MOD_COSP_CLOUDSAT_INTERFACE

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

    r5099 r5158  
    180180                                   1.0,      0.909013, 0.709554, 0.430405, 0.121567/),   &
    181181                                   shape=(/PARASOL_NREFL,PARASOL_NTAU/)),                &
    182          ! LUT for ice particles                                     
     182         ! LUT for ice particles
    183183         rlumB = reshape(source=(/ 0.03,     0.03,     0.03,     0.03,     0.03,         &
    184184                                   0.092170, 0.087082, 0.083325, 0.084935, 0.054157,     &
    … …  
    422422         vgrid_z_in = (/240.0, 720.0, 1200.0, 1680.0, 2160.0, 2640.0, 3120.0, 3600.0, &
    423423                        4080.0, 4560.0, 5040.0, 5520.0, 6000.0, 6480.0, 6960.0, 7440.0, &
    424                         7920.0, 8400.0, 8880.0, 9360.0, 9840.0, 10320.0, 10800.0, &
    425                         11280.0, 11760.0, 12240.0, 12720.0, 13200.0, 13680.0, 14160.0, &
    426                         14640.0, 15120.0, 15600.0, 16080.0, 16560.0, 17040.0, 17520.0, &
    427                         18000.0, 18480.0, 18960.0/)
     424            7920.0, 8400.0, 8880.0, 9360.0, 9840.0, 10320.0, 10800.0, &
     425            11280.0, 11760.0, 12240.0, 12720.0, 13200.0, 13680.0, 14160.0, &
     426            14640.0, 15120.0, 15600.0, 16080.0, 16560.0, 17040.0, 17520.0, &
     427            18000.0, 18480.0, 18960.0/)
    428428
    429429END MODULE MOD_COSP_CONFIG

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

    r5099 r5158  
    5858 
    5959  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    60   !     END MODULE
     60  !    END MODULE
    6161  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    6262END MODULE MOD_COSP_GRLIDAR532_INTERFACE

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

    r5099 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/cospv2/cosp_misr_interface.F90

    r5099 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/cospv2/cosp_optics.F90

    r5099 r5158  
    7171   
    7272    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    73     do j=1,dim2
     73    DO j=1,dim2
    7474       where(flag(:,j,:) .eq. 1)
    7575          varOUT(:,j,:) = varIN2
    … …  
    135135   
    136136   
    137     do i=1,npoints
     137    DO i=1,npoints
    138138       where(cloudIce(i,:, :) <= 0.)
    139139          fracL(:, :) = 1._wp
    … …  
    170170    w0(1:nPoints,1:nSubCols,1:nLevels) = 0._wp
    171171   
    172     do j =1,nPoints
    173        do i=1,nSubCols
     172    DO j =1,nPoints
     173       DO i=1,nSubCols
    174174          water_g(1:nLevels)  = get_g_nir(  phaseIsLiquid, sizeLIQ(j,i,1:nLevels))
    175175          water_w0(1:nLevels) = get_ssa_nir(phaseIsLiquid, sizeLIQ(j,i,1:nLevels))
    … …  
    189189   
    190190    ! Compute the total optical thickness and the proportion due to liquid in each cell
    191     do i=1,npoints
     191    DO i=1,npoints
    192192       where(tauLIQ(i,1:nSubCols,1:nLevels) + tauICE(i,1:nSubCols,1:nLevels) > 0.)
    193193          fracLIQ(i,1:nSubCols,1:nLevels) = tauLIQ(i,1:nSubCols,1:nLevels)/ &
    … …  
    358358    ! Altitude at half pressure levels:
    359359    zheight(1:npoints,nlev+1) = 0._wp
    360     do k=nlev,1,-1
     360    DO k=nlev,1,-1
    361361       zheight(1:npoints,k) = zheight(1:npoints,k+1) &
    362362            -(presf(1:npoints,k)-presf(1:npoints,k+1))/(rhoair(1:npoints,k)*grav)
    … …  
    392392    ! ##############################################################################
    393393    ! Polynomials kp_lidar derived from Mie theory
    394     do i = 1, npart
     394    DO i = 1, npart
    395395       where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
    396396          kp_part(1:npoints,1:nlev,i) = &
    … …  
    412412
    413413    ! Loop over all subcolumns
    414     do icol=1,ncolumns
     414    DO icol=1,ncolumns
    415415       ! ##############################################################################
    416416       ! Mixing ratio particles in each subcolum
    … …  
    425425       ! ##############################################################################
    426426       ! Alpha of particles in each subcolumn:
    427        do i = 1, npart
     427       DO i = 1, npart
    428428          where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
    429429             alpha_part(1:npoints,1:nlev,i) = 3._wp/4._wp * Qscat &
    … …  
    437437       ! Optical thicknes
    438438       tau_part(1:npoints,1:nlev,1:npart) = rdiffm * alpha_part(1:npoints,1:nlev,1:npart)
    439        do i = 1, npart
     439       DO i = 1, npart
    440440          ! Optical thickness of each layer (particles)
    441441          tau_part(1:npoints,1:nlev,i) = tau_part(1:npoints,1:nlev,i) &
    442442               & * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
    443443          ! Optical thickness from TOA to layer k (particles)
    444           do k=zi,zf,zinc
     444          DO k=zi,zf,zinc
    445445             tau_part(1:npoints,k,i) = tau_part(1:npoints,k,i) + tau_part(1:npoints,k+zoffset,i)
    446446          enddo

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

    r5099 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/cospv2/cosp_stats.F90

    r5099 r5158  
    8181   r = 0._wp
    8282
    83    do i=1,Npoints
     83   DO i=1,Npoints
    8484     ! Calculate tops and bottoms of new and old grids
    8585     oldgrid_bot = zhalf(i,:)
    … …  
    8888     l = 0 ! Index of level in the old grid
    8989     ! Loop over levels in the new grid
    90      do k = 1,Nglevels
     90     DO k = 1,Nglevels
    9191       Nw = 0 ! Number of weigths
    9292       wt = 0._wp ! Sum of weights
    9393       ! Loop over levels in the old grid and accumulate total for weighted average
    94        do
     94       DO
    9595         l = l + 1
    9696         w = 0.0 ! Initialise weight to 0
    … …  
    119119             Nw = Nw + 1
    120120             wt = wt + w
    121              do j=1,Ncolumns
     121             DO j=1,Ncolumns
    122122               if (lunits) then
    123123                 if (y(i,j,l) /= R_UNDEF) then
    … …  
    138138       ! Calculate average in new grid
    139139       if (Nw > 0) then
    140          do j=1,Ncolumns
     140         DO j=1,Ncolumns
    141141           r(i,j,k) = r(i,j,k)/wt
    142142         enddo
    … …  
    146146
    147147   ! Set points under surface to R_UNDEF, and change to dBZ if necessary
    148    do k=1,Nglevels
    149      do j=1,Ncolumns
    150        do i=1,Npoints
     148   DO k=1,Nglevels
     149     DO j=1,Ncolumns
     150       DO i=1,Npoints
    151151         if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level
    152152           if (lunits) then
    … …  
    202202    radar_tcc = 0._wp
    203203    radar_tcc2 = 0._wp
    204     do pr=1,Npoints
    205        do i=1,Ncolumns
     204    DO pr=1,Npoints
     205       DO i=1,Ncolumns
    206206          flag_sat = 0
    207207          flag_cld = 0
    … …  
    210210          ! look for j_1km from bottom to top
    211211          j = 1
    212           do while (Ze_tot(pr,i,j) .eq. R_GROUND)
     212          DO while (Ze_tot(pr,i,j) .eq. R_GROUND)
    213213             j = j+1
    214214          enddo
    215215          j_1km = j+1  !this is the vertical index of 1km above surface 
    216216         
    217           do j=1,Nlevels
     217          DO j=1,Nlevels
    218218             sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
    219219             if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
    … …  
    266266    integer :: ij
    267267   
    268     do ij=2,Nbins+1 
     268    DO ij=2,Nbins+1
    269269       hist1D(ij-1) = count(var .ge. bins(ij-1) .and. var .lt. bins(ij))
    270270       if (count(var .eq. R_GROUND) .ge. 1) hist1D(ij-1)=R_UNDEF
    … …  
    298298    integer :: ij,ik
    299299   
    300     do ij=2,nbin1+1
    301        do ik=2,nbin2+1
     300    DO ij=2,nbin1+1
     301       DO ik=2,nbin2+1
    302302          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
    303303               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       

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

    r5099 r5158  
    7777        delta = (alpha_x + b_x + d_x - n_bx + 1._wp)
    7878       
    79         do k=1,Nlevels
    80             do j=1,Ncolumns
    81                 do i=1,Npoints
     79        DO k=1,Nlevels
     80            DO j=1,Ncolumns
     81                DO i=1,Npoints
    8282                    if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
    8383                        rho = p(i,k)/(287.05_wp*T(i,k))

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

    r5099 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/cospv2/lidar_simulator.F90

    r5099 r5158  
    175175    ! PLANE PARRALLEL FIELDS
    176176    ! ####################################################################################
    177     do icol=1,ncolumns
     177    DO icol=1,ncolumns
    178178       ! #################################################################################
    179179       ! *) Total Backscatter signal
    … …  
    200200    ! ####################################################################################
    201201    if (lphaseoptics) then
    202        do icol=1,ncolumns
     202       DO icol=1,ncolumns
    203203          ! #################################################################################
    204204          ! *) Ice/Liq Perpendicular Backscatter signal
    … …  
    206206          ! Computation of ATBperp,ice/liq from ATBice/liq including the multiple scattering
    207207          ! contribution (Cesana and Chepfer 2013, JGR)
    208           do k=1,nlev
     208          DO k=1,nlev
    209209             ! Ice particles
    210210             pnorm_perp_ice(1:npoints,icol,k) = Alpha * pnorm_ice(1:npoints,icol,k)
    … …  
    242242         
    243243          ! Other layers
    244           do k=2,nlev
     244          DO k=2,nlev
    245245             ! Optical thickness of layer k
    246246             tautot_lay(1:npoints) = tautot(1:npoints,icol,k)-tautot(1:npoints,icol,k-1)
    … …  
    398398    ! Compute LIDAR scattering ratio
    399399    if (use_vgrid) then
    400        do ic = 1, ncol
     400       DO ic = 1, ncol
    401401          pnorm_c = pnormFlip(:,ic,:)
    402402          where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
    … …  
    427427       endif
    428428    else
    429        do ic = 1, ncol
     429       DO ic = 1, ncol
    430430          pnorm_c = pnorm(:,ic,:)
    431431          where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
    … …  
    458458    if (ok_lidar_cfad) then
    459459       ! CFADs of subgrid-scale lidar scattering ratios
    460        do i=1,Npoints
    461           do j=1,llm
     460       DO i=1,Npoints
     461          DO j=1,llm
    462462             cfad2(i,:,j) = hist1D(ncol,x3d(i,:,j),SR_BINS,histBsct)
    463463          enddo
    … …  
    499499
    500500    ! Other layers
    501     do k=2,nlev
     501    DO k=2,nlev
    502502       tautot_lay(:) = tau(:,k)-tau(:,k-1)
    503503       WHERE (tautot_lay(:) .gt. 0.)
    … …  
    527527    epsrealwp = epsilon(1._wp)
    528528    beta(:,1) = pnorm(:,1) * (2._wp*tau(:,1))/(1._wp-exp(-2._wp*tau(:,1)))
    529     do k=2,nlev
     529    DO k=2,nlev
    530530       tautot_lay(:) = tau(:,k)-tau(:,k-1)       
    531531       WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. epsrealwp )
    … …  
    569569       zeta50    = -9.4776e-07_wp    !
    570570       
    571         ! Inputs
     571    ! Inputs
    572572    integer,intent(in) :: &
    573573       Npoints,  & ! Number of gridpoints
    … …  
    576576       Ncat,     & ! Number of cloud layer types
    577577       Nphase      ! Number of cloud layer phase types
    578                        ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
     578                   ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
    579579    real(wp),intent(in) :: &
    580580       S_att,    & !
    … …  
    590590       pplay       ! Pressure
    591591
    592         ! Outputs
     592    ! Outputs
    593593    real(wp),intent(out),dimension(Npoints,Ntemp,5) :: &
    594594       lidarcldtemp  ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq
    … …  
    625625             
    626626    ! ####################################################################################
    627         ! 1) Initialize   
     627    ! 1) Initialize
    628628    ! ####################################################################################
    629629    lidarcld              = 0._wp
    … …  
    648648    ! 2) Cloud detection
    649649    ! ####################################################################################
    650     do k=1,Nlevels
     650    DO k=1,Nlevels
    651651       ! Cloud detection at subgrid-scale:
    652652       where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    … …  
    671671    cldlay   = 0._wp
    672672    nsublay  = 0._wp
    673     do k=1,Nlevels
    674        do ic = 1, Ncolumns
    675           do ip = 1, Npoints
     673    DO k=1,Nlevels
     674       DO ic = 1, Ncolumns
     675          DO ip = 1, Npoints
    676676         
    677677             ! Computation of the cloud fraction as a function of the temperature instead
    678678             ! of height, for ice,liquid and all clouds
    679679             if(srok(ip,ic,k).gt.0.)then
    680                 do itemp=1,Ntemp
     680                DO itemp=1,Ntemp
    681681                   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
    … …  
    686686             
    687687             if(cldy(ip,ic,k).eq.1.)then
    688                 do itemp=1,Ntemp
     688                DO itemp=1,Ntemp
    689689                   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
    … …  
    723723    cldlayer  = 0._wp
    724724    nsublayer = 0._wp
    725     do iz = 1, Ncat
    726        do ic = 1, Ncolumns
     725    DO iz = 1, Ncat
     726       DO ic = 1, Ncolumns
    727727          cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
    728728          nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
    … …  
    742742    ! 4.1) For Cloudy pixels with 8.16km < z < 19.2km
    743743    ! ####################################################################################
    744     do ncol=1,Ncolumns
    745        do i=1,Npoints         
    746           do nlev=1,23 ! from 19.2km until 8.16km
     744    DO ncol=1,Ncolumns
     745       DO i=1,Npoints
     746          DO nlev=1,23 ! from 19.2km until 8.16km
    747747               p1 = pplay(1,nlev)
    748748
    … …  
    856856          ! ##############################################################################
    857857          toplvlsat = 0
    858           do nlev=24,Nlevels! from 8.16km until 0km
     858          DO nlev=24,Nlevels! from 8.16km until 0km
    859859             p1 = pplay(i,nlev)
    860860
    … …  
    979979          ! ##############################################################################
    980980          if(toplvlsat.ne.0) then
    981              do nlev = toplvlsat,Nlevels
     981             DO nlev = toplvlsat,Nlevels
    982982                p1 = pplay(i,nlev)
    983983                if(cldy(i,ncol,nlev).eq.1.)then
    … …  
    10311031
    10321032    ! Compute Phase low mid high cloud fractions
    1033     do iz = 1, Ncat
    1034        do i=1,Nphase-3
    1035           do ic = 1, Ncolumns
     1033    DO iz = 1, Ncat
     1034       DO i=1,Nphase-3
     1035          DO ic = 1, Ncolumns
    10361036             cldlayerphase(:,iz,i)  = cldlayerphase(:,iz,i)  + cldlayphase(:,ic,iz,i)
    10371037             cldlayerphasesum(:,iz) = cldlayerphasesum(:,iz) + cldlayphase(:,ic,iz,i)
    … …  
    10391039       enddo
    10401040    enddo
    1041     do iz = 1, Ncat
    1042        do i=4,5
    1043           do ic = 1, Ncolumns
     1041    DO iz = 1, Ncat
     1042       DO i=4,5
     1043          DO ic = 1, Ncolumns
    10441044             cldlayerphase(:,iz,i) = cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
    10451045          enddo
    … …  
    10551055    ENDWHERE
    10561056   
    1057     do i=1,Nphase-1
     1057    DO i=1,Nphase-1
    10581058       WHERE ( cldlayerphasesum(:,:).gt.0.0 )
    10591059          cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
    … …  
    10611061    enddo
    10621062   
    1063     do i=1,Npoints
    1064        do iz=1,Ncat
     1063    DO i=1,Npoints
     1064       DO iz=1,Ncat
    10651065          checkcldlayerphase=0.
    10661066          checkcldlayerphase2=0.
    10671067          if (cldlayerphasesum(i,iz) .gt. 0.0 )then
    1068              do ic=1,Nphase-3
     1068             DO ic=1,Nphase-3
    10691069                checkcldlayerphase = checkcldlayerphase+cldlayerphase(i,iz,ic)
    10701070             enddo
    … …  
    10751075    enddo
    10761076   
    1077     do i=1,Nphase-1
     1077    DO i=1,Nphase-1
    10781078       WHERE (nsublayer(:,:) .eq. 0.0)
    10791079          cldlayerphase(:,:,i) = undef
    … …  
    10821082 
    10831083    ! Compute Phase 3D as a function of temperature
    1084     do nlev=1,Nlevels
    1085        do ncol=1,Ncolumns
    1086           do i=1,Npoints
    1087              do itemp=1,Ntemp
     1084    DO nlev=1,Nlevels
     1085       DO ncol=1,Ncolumns
     1086          DO i=1,Npoints
     1087             DO itemp=1,Ntemp
    10881088                if(tmpi(i,ncol,nlev).gt.0.)then
    10891089                   if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    … …  
    11051105   
    11061106    ! Check temperature cloud fraction
    1107     do i=1,Npoints
    1108        do itemp=1,Ntemp
     1107    DO i=1,Npoints
     1108       DO itemp=1,Ntemp
    11091109          checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
    11101110          !if(checktemp .NE. lidarcldtemp(i,itemp,1))then
    … …  
    11241124    ENDWHERE
    11251125   
    1126     do i=1,4
     1126    DO i=1,4
    11271127       WHERE(lidarcldtempind(:,:) .gt. 0.)
    11281128          lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
    … …  
    11911191    ! 2) Cloud detection
    11921192    ! ####################################################################################
    1193     do k=1,Nlevels
     1193    DO k=1,Nlevels
    11941194       ! Cloud detection at subgrid-scale:
    11951195       where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    … …  
    12101210    ! 3) Grid-box 3D cloud fraction and layered cloud fractions(ISCCP pressure categories)
    12111211    ! ####################################################################################
    1212     do k=1,Nlevels
    1213        do ic = 1, Ncolumns
    1214           do ip = 1, Npoints
     1212    DO k=1,Nlevels
     1213       DO ic = 1, Ncolumns
     1214          DO ip = 1, Npoints
    12151215
    12161216             iz=1
    … …  
    12441244    cldlayer  = 0._wp
    12451245    nsublayer = 0._wp
    1246     do iz = 1, Ncat
    1247        do ic = 1, Ncolumns
     1246    DO iz = 1, Ncat
     1247       DO ic = 1, Ncolumns
    12481248          cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
    12491249          nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
    … …  
    12721272       eta = 0.6_wp            ! Multiple-scattering factor (Vaillant de Guelis et al. 2017a, AMT)
    12731273
    1274         ! Inputs
     1274    ! Inputs
    12751275    integer,intent(in) :: &
    12761276       Npoints,  & ! Number of gridpoints
    … …  
    12911291       surfelev    ! Surface Elevation (SE)
    12921292
    1293         ! Outputs
     1293    ! Outputs
    12941294    real(wp),intent(out),dimension(Npoints,Nlevels,Ntype+1) :: &
    12951295       lidarcldtype   ! 3D OPAQ product fraction (opaque clouds, thin clouds, z_opaque, opacity)
    … …  
    13241324
    13251325    ! ####################################################################################
    1326         ! 1) Initialize   
     1326    ! 1) Initialize
    13271327    ! ####################################################################################
    13281328    cldtype(:,:)          = 0._wp
    … …  
    13421342    ! 2) Cloud detection and Fully attenuated layer detection
    13431343    ! ####################################################################################
    1344     do k=1,Nlevels
     1344    DO k=1,Nlevels
    13451345       ! Cloud detection at subgrid-scale:
    13461346       where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    … …  
    13751375    ! ####################################################################################
    13761376
    1377     do k=1,Nlevels
    1378        do ic = 1, Ncolumns
    1379           do ip = 1, Npoints
     1377    DO k=1,Nlevels
     1378       DO ic = 1, Ncolumns
     1379          DO ip = 1, Npoints
    13801380
    13811381             cldlay(ip,ic,1)   = MAX(cldlay(ip,ic,1),cldyopaq(ip,ic,k)) ! Opaque cloud
    … …  
    13931393
    13941394! OPAQ variables
    1395      do ic = 1, Ncolumns
    1396         do ip = 1, Npoints
     1395     DO ic = 1, Ncolumns
     1396        DO ip = 1, Npoints
    13971397
    13981398     ! Declaring non-opaque cloudy profiles as thin cloud profiles
    1399            if ( cldlay(ip,ic,4).gt. 0. .and. cldlay(ip,ic,1) .eq. 0. ) then
    1400               cldlay(ip,ic,2)  =  1._wp
    1401            endif
     1399       if ( cldlay(ip,ic,4).gt. 0. .and. cldlay(ip,ic,1) .eq. 0. ) then
     1400          cldlay(ip,ic,2)  =  1._wp
     1401        endif
    14021402
    14031403     ! Filling in 3D and 2D variables
    14041404
    14051405     ! Opaque cloud profiles
    1406            if ( cldlay(ip,ic,1) .eq. 1. ) then
    1407               zopac = 0._wp
    1408               z_top = 0._wp
    1409               do k=1,Nlevels-1
     1406       if ( cldlay(ip,ic,1) .eq. 1. ) then
     1407          zopac = 0._wp
     1408          z_top = 0._wp
     1409          DO k=1,Nlevels-1
    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) .eq. 1. .and. zopac .eq. 0. ) then
    1413                     lidarcldtype(ip,Nlevels-k + 1,3) = lidarcldtype(ip,Nlevels-k + 1,3) + 1._wp
    1414                     cldlay(ip,ic,3)                  = vgrid_z(Nlevels-k+1)      ! z_opaque altitude
    1415                     nsublay(ip,ic,3)                 = 1._wp
    1416                     zopac = Nlevels-k+1                        ! z_opaque vertical index on vgrid_z
    1417                 endif
    1418                  if ( cldy(ip,ic,Nlevels-k) .eq. 1. ) then
    1419                     lidarcldtype(ip,Nlevels-k ,1)    = lidarcldtype(ip,Nlevels-k ,1) + 1._wp
    1420                     z_top = Nlevels-k    ! top cloud layer vertical index on vgrid_z
     1412             if ( cldy(ip,ic,Nlevels-k) .eq. 1. .and. zopac .eq. 0. ) then
     1413            lidarcldtype(ip,Nlevels-k + 1,3) = lidarcldtype(ip,Nlevels-k + 1,3) + 1._wp
     1414            cldlay(ip,ic,3)                  = vgrid_z(Nlevels-k+1)      ! z_opaque altitude
     1415            nsublay(ip,ic,3)                 = 1._wp
     1416            zopac = Nlevels-k+1                        ! z_opaque vertical index on vgrid_z
     1417        endif
     1418             if ( cldy(ip,ic,Nlevels-k) .eq. 1. ) then
     1419            lidarcldtype(ip,Nlevels-k ,1)    = lidarcldtype(ip,Nlevels-k ,1) + 1._wp
     1420            z_top = Nlevels-k    ! top cloud layer vertical index on vgrid_z
    14211421                 endif
    1422               enddo
     1422          enddo
    14231423     ! Summing opaque cloud mean temperatures and altitudes
    14241424     ! as defined in Vaillant de Guelis et al. 2017a, AMT
    … …  
    14321432                 cldlay(ip,ic,1) = 0
    14331433              endif
    1434            endif
     1434       endif
    14351435
    14361436     ! Thin cloud profiles
    1437            if ( cldlay(ip,ic,2) .eq. 1. ) then
    1438               topcloud = 0._wp
    1439               z_top = 0._wp
    1440               z_base = 0._wp
    1441               do k=1,Nlevels
     1437       if ( cldlay(ip,ic,2) .eq. 1. ) then
     1438          topcloud = 0._wp
     1439          z_top = 0._wp
     1440          z_base = 0._wp
     1441          DO k=1,Nlevels
    14421442     ! Declaring thin cloud fraction for 3D variable
    14431443     ! From TOA-2-SFC
    14441444                 if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 1. ) then
    14451445                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
    1446                     z_base = k ! bottom cloud layer
     1446            z_base = k ! bottom cloud layer
    14471447                 endif
    1448                  if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 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
    1450                     z_top = k  ! top cloud layer
    1451                     z_base = k ! bottom cloud layer
     1450            z_top = k  ! top cloud layer
     1451            z_base = k ! bottom cloud layer
    14521452                    topcloud = 1._wp
    1453                 endif
    1454               enddo
     1453        endif
     1454          enddo
    14551455     ! Computing mean emissivity using layers below the bottom cloud layer to the surface
    1456               srmean = 0._wp
    1457               srcount = 0._wp
    1458               cloudemis = 0._wp
    1459               do k=z_base+1,Nlevels
    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
    1461                     srmean = srmean + x(ip,ic,k)
    1462                     srcount = srcount + 1.
     1456               srmean = 0._wp
     1457          srcount = 0._wp
     1458          cloudemis = 0._wp
     1459               DO k=z_base+1,Nlevels
     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
     1461            srmean = srmean + x(ip,ic,k)
     1462            srcount = srcount + 1.
    14631463                 endif
    1464               enddo
    1465               ! If clear sky layers exist below bottom cloud layer
    1466               if ( srcount .gt. 0. ) then
    1467                 trans2 = srmean/srcount              ! thin cloud transmittance**2
    1468                 tau_app = -(log(trans2))/2.          ! apparent cloud optical depth
    1469                 tau_vis = tau_app/eta                ! cloud visible optical depth (multiple scat.)
    1470                 tau_ir = tau_vis/2.                  ! approx. relation between visible and IR ODs
    1471                 cloudemis = 1. - exp(-tau_ir)        ! no diffusion in IR considered : emis = 1-T
    1472                 count_emis(ip) = count_emis(ip) + 1.
    1473               endif
     1464          enddo
     1465          ! If clear sky layers exist below bottom cloud layer
     1466          if ( srcount .gt. 0. ) then
     1467              trans2 = srmean/srcount              ! thin cloud transmittance**2
     1468              tau_app = -(log(trans2))/2.          ! apparent cloud optical depth
     1469              tau_vis = tau_app/eta                ! cloud visible optical depth (multiple scat.)
     1470              tau_ir = tau_vis/2.                  ! approx. relation between visible and IR ODs
     1471              cloudemis = 1. - exp(-tau_ir)        ! no diffusion in IR considered : emis = 1-T
     1472        count_emis(ip) = count_emis(ip) + 1.
     1473          endif
    14741474     ! Summing thin cloud mean temperatures and altitudes
    14751475     ! as defined in Vaillant de Guelis et al. 2017a, AMT
    … …  
    15001500    ! 3D opacity fraction (=4) !Summing z_opaque fraction from TOA(k=1) to SFC(k=Nlevels)
    15011501       lidarcldtype(:,1,4) = lidarcldtype(:,1,3) !top layer equal to 3D z_opaque fraction
    1502     do ip = 1, Npoints
    1503         do k = 2, Nlevels
     1502    DO ip = 1, Npoints
     1503         DO k = 2, Nlevels
    15041504            if ( (lidarcldtype(ip,k,3) .ne. undef) .and. (lidarcldtype(ip,k-1,4) .ne. undef) ) then
    1505                 lidarcldtype(ip,k,4) = lidarcldtype(ip,k,3) + lidarcldtype(ip,k-1,4)
    1506             else
    1507                 lidarcldtype(ip,k,4) = undef
    1508             endif
    1509         enddo
     1505            lidarcldtype(ip,k,4) = lidarcldtype(ip,k,3) + lidarcldtype(ip,k-1,4)
     1506        else
     1507            lidarcldtype(ip,k,4) = undef
     1508        endif
    15101509    enddo
     1510    enddo
    15111511
    15121512    ! Layered cloud types (opaque, thin and z_opaque 2D variables)
    15131513
    1514     do iz = 1, Ntype
    1515        do ic = 1, Ncolumns
     1514    DO iz = 1, Ntype
     1515       DO ic = 1, Ncolumns
    15161516          cldtype(:,iz)  = cldtype(:,iz)  + cldlay(:,ic,iz)
    15171517          nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)

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

    r5099 r5158  
    1515                              numMODISReffIceBins,reffICE_binCenters, &
    1616                              numMODISReffLiqBins, reffLIQ_binCenters, &
    17                               numISCCPTauBins,numISCCPPresBins, &
    18                               numMISRTauBins,numMISRHgtBins, &
    19                               numModisTauBins,numMODISPresBins
     17                  numISCCPTauBins,numISCCPPresBins, &
     18                  numMISRTauBins,numMISRHgtBins, &
     19                  numModisTauBins,numMODISPresBins
    2020
    2121  implicit none
    … …  
    297297    type(cosp_optical_inputs),intent(inout) :: y
    298298
    299     if (allocated(y%tau_067))             deallocate(y%tau_067)
    300     if (allocated(y%emiss_11))            deallocate(y%emiss_11)
    301     if (allocated(y%frac_out))            deallocate(y%frac_out)
     299    if (allocated(y%tau_067))             deallocate(y%tau_067)
     300    if (allocated(y%emiss_11))            deallocate(y%emiss_11)
     301    if (allocated(y%frac_out))          deallocate(y%frac_out)
    302302    if (allocated(y%beta_mol_calipso))    deallocate(y%beta_mol_calipso)
    303303    if (allocated(y%tau_mol_calipso))     deallocate(y%tau_mol_calipso)
    … …  
    308308    if (allocated(y%tautot_ice_calipso))  deallocate(y%tautot_ice_calipso)
    309309    if (allocated(y%tautot_liq_calipso))  deallocate(y%tautot_liq_calipso)
    310     if (allocated(y%tautot_S_liq))        deallocate(y%tautot_S_liq)
    311     if (allocated(y%tautot_S_ice))        deallocate(y%tautot_S_ice)
    312     if (allocated(y%z_vol_cloudsat))      deallocate(y%z_vol_cloudsat)
    313     if (allocated(y%kr_vol_cloudsat))     deallocate(y%kr_vol_cloudsat)
    314     if (allocated(y%g_vol_cloudsat))      deallocate(y%g_vol_cloudsat)
    315     if (allocated(y%asym))                deallocate(y%asym)
    316     if (allocated(y%ss_alb))              deallocate(y%ss_alb)
    317     if (allocated(y%fracLiq))             deallocate(y%fracLiq)
     310    if (allocated(y%tautot_S_liq))      deallocate(y%tautot_S_liq)
     311    if (allocated(y%tautot_S_ice))          deallocate(y%tautot_S_ice)
     312    if (allocated(y%z_vol_cloudsat))        deallocate(y%z_vol_cloudsat)
     313    if (allocated(y%kr_vol_cloudsat))       deallocate(y%kr_vol_cloudsat)
     314    if (allocated(y%g_vol_cloudsat))       deallocate(y%g_vol_cloudsat)
     315    if (allocated(y%asym))                  deallocate(y%asym)
     316    if (allocated(y%ss_alb))               deallocate(y%ss_alb)
     317    if (allocated(y%fracLiq))             deallocate(y%fracLiq)
    318318    if (allocated(y%beta_mol_grLidar532)) deallocate(y%beta_mol_grLidar532)
    319319    if (allocated(y%betatot_grLidar532))  deallocate(y%betatot_grLidar532)

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

    r5133 r5158  
    5353! mr_ozone,                             !Concentration ozone (Kg/Kg)
    5454! dem_s                                 !Cloud optical emissivity
    55 ! dtau_s                                !Cloud optical thickness
    56 ! emsfc_lw = 1.                         !Surface emissivity dans radlwsw.F90
     55! dtau_s                           !Cloud optical thickness
     56! emsfc_lw = 1.                    !Surface emissivity dans radlwsw.F90
    5757
    5858
    … …  
    9595
    9696  ! Local variables
    97   character(len=64),PARAMETER   :: cosp_input_nl  = 'cospv2_input_nl.txt'
    98   character(len=64),PARAMETER   :: cosp_output_nl = 'cospv2_output_nl.txt'
    99 
    100   integer, save                 :: isccp_topheight, isccp_topheight_direction, overlap
    101   integer, save                 :: Ncolumns             ! Number of subcolumns in SCOPS
    102   integer, save                 :: Npoints              ! Number of gridpoints
     97  character(len=64),PARAMETER    :: cosp_input_nl  = 'cospv2_input_nl.txt'
     98  character(len=64),PARAMETER      :: cosp_output_nl = 'cospv2_output_nl.txt'
     99
     100  integer, save                :: isccp_topheight, isccp_topheight_direction, overlap
     101  integer, save                 :: Ncolumns                ! Number of subcolumns in SCOPS
     102  integer, save                :: Npoints                ! Number of gridpoints
    103103!$OMP THREADPRIVATE(Npoints)
    104   integer, save                 :: Nlevels              ! Number of model vertical levels
    105   integer                       :: Nptslmdz, Nlevlmdz   ! Nb de points issus de physiq.F
    106   integer, save                 :: Npoints_it           ! Max number of gridpoints to be
    107                                                         ! processed in one iteration
    108   type(cosp_config), save       :: cfg                  ! Variable qui contient les cles
    109                                                         ! logiques des simulateurs et des
    110                                                         ! diagnostics, definie dans:
    111                                                         ! lmdz_cosp_construct_destroy_mod
     104  integer, save            :: Nlevels        ! Number of model vertical levels
     105  integer              :: Nptslmdz, Nlevlmdz      ! Nb de points issus de physiq.F
     106  integer, save         :: Npoints_it       ! Max number of gridpoints to be
     107                                    ! processed in one iteration
     108  type(cosp_config), save     :: cfg              ! Variable qui contient les cles
     109                                      ! logiques des simulateurs et des
     110                            ! diagnostics, definie dans:
     111                            ! lmdz_cosp_construct_destroy_mod
    112112!$OMP THREADPRIVATE(cfg)
    113113
    114   integer                       :: t0, t1, count_rate, count_max
    115   real(wp), save                :: cloudsat_radar_freq, cloudsat_k2, rttov_ZenAng, co2, &
    116                                    ch4, n2o, co, emsfc_lw
     114  integer            :: t0, t1, count_rate, count_max
     115  real(wp), save         :: cloudsat_radar_freq, cloudsat_k2, rttov_ZenAng, co2, &
     116                         ch4, n2o, co, emsfc_lw
    117117!$OMP THREADPRIVATE(emsfc_lw)
    118118
    119   integer, dimension(RTTOV_MAX_CHANNELS), save  :: rttov_Channels
     119  integer, dimension(RTTOV_MAX_CHANNELS), save    :: rttov_Channels
    120120  real(wp), dimension(RTTOV_MAX_CHANNELS), save  :: rttov_Surfem
    121   integer, save                                 :: surface_radar, use_mie_tables, &
    122                                                     cloudsat_use_gas_abs, cloudsat_do_ray, &
    123                                                     melt_lay
    124   integer, save                                 :: lidar_ice_type
    125   integer, save                                 :: rttov_platform, rttov_satellite, &
    126                                                     rttov_Instrument, rttov_Nchannels
    127   logical, save                                 :: use_vgrid_in, csat_vgrid_in, &
    128                                                     use_precipitation_fluxes
     121  integer, save                     :: surface_radar, use_mie_tables, &
     122                                 cloudsat_use_gas_abs, cloudsat_do_ray, &
     123                            melt_lay
     124  integer, save                 :: lidar_ice_type
     125  integer, save                 :: rttov_platform, rttov_satellite, &
     126                                 rttov_Instrument, rttov_Nchannels
     127  logical, save                 :: use_vgrid_in, csat_vgrid_in, &
     128                                 use_precipitation_fluxes
    129129
    130130! Declaration necessaires pour les sorties IOIPSL
    131   real          :: ecrit_day, ecrit_hf, ecrit_mth, missing_val
    132   logical       :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
     131  REAL            :: ecrit_day, ecrit_hf, ecrit_mth, missing_val
     132  logical     :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
    133133  logical, save :: debut_cosp=.true.
    134134!$OMP THREADPRIVATE(debut_cosp)
    … …  
    142142
    143143!-----------------------------  Input variables from LMDZ-GCM  -------------------------------
    144   integer                                    :: overlaplmdz   ! overlap type: 1=max,
    145                                                               ! 2=rand, 3=max/rand
    146   real, dimension(Nptslmdz,Nlevlmdz)         :: phi, p, ph, T, sh, rh, tca, cca, mr_lsliq,   &
    147                                                 mr_lsice, mr_ccliq, mr_ccice, fl_lsrain,     &
    148                                                 fl_lssnow, fl_ccrain, fl_ccsnow, fl_lsgrpl,  &
    149                                                 zlev, zlev_half, mr_ozone, radliq, radice,   &
    150                                                 dtau_s, dem_s, dtau_c, dem_c, ref_liq, ref_ice
    151   real, dimension(Nptslmdz,Nlevlmdz)         :: fl_lsrainI, fl_lssnowI, fl_ccrainI, fl_ccsnowI
    152   real, dimension(Nptslmdz)                  :: lon, lat, skt, fracTerLic, u_wind, v_wind, &
    153                                                 phis, sunlit
    154   real, dimension(Nptslmdz)                  :: land ! variables intermediaire pour masque TerLic
    155   real, dimension(Nlevlmdz)                  :: presnivs
    156   integer                                    :: itap, k, ip
    157   real                                       :: dtime, freq_cosp
    158   real, dimension(2)                         :: time_bnds
     144  integer                                      :: overlaplmdz   ! overlap type: 1=max,
     145                                           ! 2=rand, 3=max/rand
     146  real, dimension(Nptslmdz,Nlevlmdz)          :: phi, p, ph, T, sh, rh, tca, cca, mr_lsliq,   &
     147                              mr_lsice, mr_ccliq, mr_ccice, fl_lsrain,     &
     148                                                   fl_lssnow, fl_ccrain, fl_ccsnow, fl_lsgrpl,  &
     149                                                   zlev, zlev_half, mr_ozone, radliq, radice,   &
     150                            dtau_s, dem_s, dtau_c, dem_c, ref_liq, ref_ice
     151  real, dimension(Nptslmdz,Nlevlmdz)          :: fl_lsrainI, fl_lssnowI, fl_ccrainI, fl_ccsnowI
     152  real, dimension(Nptslmdz)                 :: lon, lat, skt, fracTerLic, u_wind, v_wind, &
     153                              phis, sunlit
     154  real, dimension(Nptslmdz)                 :: land ! variables intermediaire pour masque TerLic
     155  real, dimension(Nlevlmdz)                 :: presnivs
     156  integer                                  :: itap, k, ip
     157  REAL                                     :: dtime, freq_cosp
     158  real, dimension(2)                        :: time_bnds
    159159
    160160  double precision                           :: d_dtime
    … …  
    169169  logical :: &
    170170       Lsingle     = .true.,  & ! True if using MMF_v3_single_moment CLOUDSAT
    171                                 ! microphysical scheme (default)
     171                                  ! microphysical scheme (default)
    172172       Ldouble     = .false.    ! True if using MMF_v3.5_two_moment CLOUDSAT
    173                                 ! microphysical scheme
    174   type(size_distribution), save              :: sd            ! Hydrometeor description
     173                            ! microphysical scheme
     174  type(size_distribution), save            :: sd            ! Hydrometeor description
    175175!$OMP THREADPRIVATE(sd)
    176   type(radar_cfg), save                      :: rcfg_cloudsat ! Radar configuration
     176  type(radar_cfg), save                 :: rcfg_cloudsat ! Radar configuration
    177177!$OMP THREADPRIVATE(rcfg_cloudsat)
    178   real, dimension(Nptslmdz,Nlevlmdz,N_HYDRO) :: Reff          ! Liquid and Ice particles
    179                                                               ! effective radius
    180   type(cosp_outputs)                         :: cospOUT       ! COSP simulator outputs
    181   type(cosp_optical_inputs)                  :: cospIN        ! COSP optical (or derived?)
    182                                                               ! fields needed by simulators
    183   type(cosp_column_inputs)                   :: cospstateIN   ! COSP model fields needed
    184                                                               ! by simulators
    185   character(len=256), dimension(100)         :: cosp_status
    186   character(len=64), save                    :: cloudsat_micro_scheme
     178  real, dimension(Nptslmdz,Nlevlmdz,N_HYDRO) :: Reff          ! Liquid and Ice particles
     179                                         ! effective radius
     180  type(cosp_outputs)                 :: cospOUT       ! COSP simulator outputs
     181  type(cosp_optical_inputs)              :: cospIN        ! COSP optical (or derived?)
     182                                         ! fields needed by simulators
     183  type(cosp_column_inputs)              :: cospstateIN   ! COSP model fields needed
     184                                         ! by simulators
     185  character(len=256), dimension(100)         :: cosp_status
     186  character(len=64), save                   :: cloudsat_micro_scheme
    187187
    188188  ! Indices to address arrays of LS and CONV hydrometeors
    … …  
    271271  print*,' Cles des differents simulateurs cosp a itap :',itap
    272272  print*,'cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
    273         cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
     273    cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
    274274        cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
    275275        cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
    … …  
    340340print*,' Cles des differents simulateurs cosp a itap :',itap
    341341print*,'cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
    342         cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
     342    cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
    343343        cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
    344         cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
     344    cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
    345345
    346346  endif !(itap.gt.1).and.(first_write)
    … …  
    369369
    370370        zlev_half(:,1) = phis(:)/9.81
    371         do k = 2, Nlevels
    372           do ip = 1, Npoints
     371        DO k = 2, Nlevels
     372          DO ip = 1, Npoints
    373373           zlev_half(ip,k) = phi(ip,k)/9.81 + &
    374374               (phi(ip,k)-phi(ip,k-1))/9.81 * (ph(ip,k)-p(ip,k)) / (p(ip,k)-p(ip,k-1))
    … …  
    383383
    384384! 3) Masque terre/mer a partir de la variable fracTerLic
    385         do ip = 1, Npoints
     385        DO ip = 1, Npoints
    386386          if (fracTerLic(ip).ge.0.5) then
    387387             land(ip) = 1.
    … …  
    445445    call construct_cospstateIN(Npoints,Nlevels,0,cospstateIN)
    446446
    447     cospstateIN%lat                                     = lat(1:Npoints)
    448     cospstateIN%lon                                     = lon(1:Npoints)
    449     cospstateIN%at                                      = t(1:Npoints,Nlevels:1:-1)
    450     cospstateIN%qv                                      = sh(1:Npoints,Nlevels:1:-1)
    451     cospstateIN%o3                                      = mr_ozone(1:Npoints,Nlevels:1:-1) 
    452     cospstateIN%sunlit                                  = sunlit(1:Npoints)
    453     cospstateIN%skt                                     = skt(1:Npoints)
    454     cospstateIN%land                                    = land(1:Npoints)
    455     cospstateIN%surfelev                                = zlev_half(1:Npoints,1)
    456     cospstateIN%pfull                                   = p(1:Npoints,Nlevels:1:-1)
    457     cospstateIN%phalf(1:Npoints,1)                      = 0._wp
    458     cospstateIN%phalf(1:Npoints,2:Nlevels+1)            = ph(1:Npoints,Nlevels:1:-1) 
    459     cospstateIN%hgt_matrix                              = zlev(1:Npoints,Nlevels:1:-1)
    460     cospstateIN%hgt_matrix_half(1:Npoints,Nlevels+1)    = 0._wp
    461     cospstateIN%hgt_matrix_half(1:Npoints,1:Nlevels)    = zlev_half(1:Npoints,Nlevels:1:-1)
     447    cospstateIN%lat                                 = lat(1:Npoints)
     448    cospstateIN%lon                             = lon(1:Npoints)
     449    cospstateIN%at                                = t(1:Npoints,Nlevels:1:-1)
     450    cospstateIN%qv                               = sh(1:Npoints,Nlevels:1:-1)
     451    cospstateIN%o3                                = mr_ozone(1:Npoints,Nlevels:1:-1)
     452    cospstateIN%sunlit                            = sunlit(1:Npoints)
     453    cospstateIN%skt                                = skt(1:Npoints)
     454    cospstateIN%land                             = land(1:Npoints)
     455    cospstateIN%surfelev                             = zlev_half(1:Npoints,1)
     456    cospstateIN%pfull                             = p(1:Npoints,Nlevels:1:-1)
     457    cospstateIN%phalf(1:Npoints,1)                    = 0._wp
     458    cospstateIN%phalf(1:Npoints,2:Nlevels+1)            = ph(1:Npoints,Nlevels:1:-1)
     459    cospstateIN%hgt_matrix                          = zlev(1:Npoints,Nlevels:1:-1)
     460    cospstateIN%hgt_matrix_half(1:Npoints,Nlevels+1)     = 0._wp
     461    cospstateIN%hgt_matrix_half(1:Npoints,1:Nlevels)     = zlev_half(1:Npoints,Nlevels:1:-1)
    462462
    463463
    … …  
    483483!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    484484
    485     call subsample_and_optics(cfg, Npoints, Nlevels, Ncolumns, N_HYDRO,overlap, &
    486                               use_precipitation_fluxes, lidar_ice_type, sd, &
    487                               tca(1:Npoints,Nlevels:1:-1), cca(1:Npoints,Nlevels:1:-1), &
    488                               fl_lsrain(1:Npoints,Nlevels:1:-1), &
    489                               fl_lssnow(1:Npoints,Nlevels:1:-1), &
    490                               fl_lsgrpl(1:Npoints,Nlevels:1:-1), &
    491                               fl_ccrain(1:Npoints,Nlevels:1:-1), &
    492                               fl_ccsnow(1:Npoints,Nlevels:1:-1), &
    493                               mr_lsliq(1:Npoints,Nlevels:1:-1), &
    494                               mr_lsice(1:Npoints,Nlevels:1:-1), &
    495                               mr_ccliq(1:Npoints,Nlevels:1:-1), &
    496                               mr_ccice(1:Npoints,Nlevels:1:-1), &
    497                               Reff(1:Npoints,Nlevels:1:-1,:), &
    498                               dtau_c(1:Npoints,Nlevels:1:-1), &
    499                               dtau_s(1:Npoints,Nlevels:1:-1), &
    500                               dem_c(1:Npoints,Nlevels:1:-1), &
    501                               dem_s(1:Npoints,Nlevels:1:-1), cospstateIN, cospIN)
     485    call subsample_and_optics(cfg, Npoints, Nlevels, Ncolumns, N_HYDRO,overlap,    &
     486                      use_precipitation_fluxes, lidar_ice_type, sd, &
     487                  tca(1:Npoints,Nlevels:1:-1), cca(1:Npoints,Nlevels:1:-1), &
     488                         fl_lsrain(1:Npoints,Nlevels:1:-1), &
     489                  fl_lssnow(1:Npoints,Nlevels:1:-1), &
     490                  fl_lsgrpl(1:Npoints,Nlevels:1:-1), &
     491                  fl_ccrain(1:Npoints,Nlevels:1:-1), &
     492                        fl_ccsnow(1:Npoints,Nlevels:1:-1), &
     493                  mr_lsliq(1:Npoints,Nlevels:1:-1), &
     494                  mr_lsice(1:Npoints,Nlevels:1:-1), &
     495                  mr_ccliq(1:Npoints,Nlevels:1:-1), &
     496                  mr_ccice(1:Npoints,Nlevels:1:-1), &
     497                           Reff(1:Npoints,Nlevels:1:-1,:), &
     498                  dtau_c(1:Npoints,Nlevels:1:-1), &
     499                  dtau_s(1:Npoints,Nlevels:1:-1), &
     500                  dem_c(1:Npoints,Nlevels:1:-1), &
     501                  dem_s(1:Npoints,Nlevels:1:-1), cospstateIN, cospIN)
    502502
    503503
    … …  
    531531                                   ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml, &
    532532                                   ecrit_mth, ecrit_day, ecrit_hf, use_vgrid_in,         &
    533                                    niv_sorties, vgrid_z_in, zlev(1,:))
     533                       niv_sorties, vgrid_z_in, zlev(1,:))
    534534
    535535      !$OMP END MASTER

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

    r5157 r5158  
    8888         "clcalipsoliq", "CALIPSO Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
    8989  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    90          "clcalipsoun", "CALIPSO Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))   
     90         "clcalipsoun", "CALIPSO Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
    9191  TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    9292         "clcalipsotmpice", "CALIPSO Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
    … …  
    109109         "clcalipsothin", "CALIPSO Thin profile Cloud Fraction", "%", (/ ('', i=1, 3) /))     
    110110  TYPE(ctrl_outcosp), SAVE :: o_clcalipsozopaque = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    111          "clcalipsozopaque", "CALIPSO z_opaque Fraction", "%", (/ ('', i=1, 3) /))         
     111         "clcalipsozopaque", "CALIPSO z_opaque Fraction", "%", (/ ('', i=1, 3) /))
    112112  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoopacity = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    113113         "clcalipsoopacity", "CALIPSO opacity Fraction", "%", (/ ('', i=1, 3) /))
    … …  
    311311                              ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml,  &
    312312                              ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, Nlvgrid, vgrid_z_loc, &
    313                               vgrid_mz)
     313                  vgrid_mz)
    314314
    315315  use mod_cosp_config, only : CLOUDSAT_DBZE_BINS, SR_BINS, CLOUDSAT_CFAD_ZE_MIN, PARASOL_NREFL, &
    … …  
    319319                              numMODISReffIceBins,reffICE_binCenters, &
    320320                              numMODISReffLiqBins, reffLIQ_binCenters, pres_binCenters, &
    321                               cloudsat_binCenters, calipso_binCenters
     321                  cloudsat_binCenters, calipso_binCenters
    322322
    323323  USE iophy
    … …  
    335335  real,dimension(Nlevlmdz) :: presnivs, vgrid_mz
    336336  real,dimension(Nlvgrid)  :: vgrid_z_loc
    337   real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
     337  REAL                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
    338338  logical                  :: use_vgrid
    339339  logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
    … …  
    341341!!! Variables locales
    342342  integer                   :: idayref, iff, ii
    343   real                      :: zjulian,zjulian_start
     343  REAL                      :: zjulian,zjulian_start
    344344  real(wp),dimension(Ncolumns)  :: column_ax
    345345  CHARACTER(LEN=20), DIMENSION(3)  :: chfreq = (/ '1day', '1d  ', '3h  ' /)           
    … …  
    359359
    360360!! Definition valeurs axes
    361     do ii=1,Ncolumns
     361    DO ii=1,Ncolumns
    362362      column_ax(ii) = real(ii)
    363363    enddo

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

    r5157 r5158  
    4646!!! Variables d'entree
    4747  integer               :: itap, Nlevlmdz, Ncolumns, Npoints, Nlvgrid
    48   real                  :: freq_COSP, dtime, missing_val, missing_cosp
     48  REAL                  :: freq_COSP, dtime, missing_val, missing_cosp
    4949  type(cosp_config)     :: cfg     ! Control outputs
    5050  type(cosp_outputs)    :: &
    … …  
    257257     where(cospOUT%calipso_cfad_sr == R_UNDEF) cospOUT%calipso_cfad_sr = missing_val
    258258   
    259      do icl=1,SR_BINS
    260       do k=1,Nlvgrid
    261        do ip=1,Npoints
     259     DO icl=1,SR_BINS
     260      DO k=1,Nlvgrid
     261       DO ip=1,Npoints
    262262        tmp_fi4da_cfadL(ip,k,icl)=cospOUT%calipso_cfad_sr(ip,icl,k)
    263263       enddo
    … …  
    312312   if (cfg%LcfadLidarsr532gr) then
    313313     where(cospOUT%grLidar532_cfad_sr == R_UNDEF) cospOUT%grLidar532_cfad_sr = missing_val
    314      do icl=1,SR_BINS
    315       do k=1,Nlvgrid
    316        do ip=1,Npoints
     314     DO icl=1,SR_BINS
     315      DO k=1,Nlvgrid
     316       DO ip=1,Npoints
    317317         tmp_fi4da_cfadLgr(ip,k,icl)=cospOUT%grLidar532_cfad_sr(ip,icl,k)
    318318       enddo
    … …  
    360360   if (cfg%LcfadLidarsr355) then
    361361     where(cospOUT%atlid_cfad_sr == R_UNDEF) cospOUT%atlid_cfad_sr = missing_val
    362      do icl=1,SR_BINS
    363       do k=1,Nlvgrid
    364        do ip=1,Npoints
     362     DO icl=1,SR_BINS
     363      DO k=1,Nlvgrid
     364       DO ip=1,Npoints
    365365          tmp_fi4da_cfadLatlid(ip,k,icl)=cospOUT%atlid_cfad_sr(ip,icl,k)
    366366       enddo
    … …  
    456456   if (cfg%LcfadDbze94)  then
    457457     where(cospOUT%cloudsat_cfad_ze == R_UNDEF) cospOUT%cloudsat_cfad_ze = missing_val 
    458      do icl=1,CLOUDSAT_DBZE_BINS
    459       do k=1,Nlvgrid
    460        do ip=1,Npoints
     458     DO icl=1,CLOUDSAT_DBZE_BINS
     459      DO k=1,Nlvgrid
     460       DO ip=1,Npoints
    461461         tmp_fi4da_cfadR(ip,k,icl)=cospOUT%cloudsat_cfad_ze(ip,icl,k)
    462462       enddo
    … …  
    531531   where(cospOUT%misr_cldarea == R_UNDEF) cospOUT%misr_cldarea = missing_val
    532532
    533    do icl=1,numMISRHgtBins
    534       do k=1,Nlvgrid
    535        do ip=1,Npoints   
     533   DO icl=1,numMISRHgtBins
     534      DO k=1,Nlvgrid
     535       DO ip=1,Npoints
    536536      tmp_fi4da_misr(ip,icl,k)=cospOUT%misr_fq(ip,k,icl)
    537537       enddo

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

    r5133 r5158  
    2929         Lcloudsat,        & ! CLOUDSAT simulator on/off switch
    3030         Lcalipso,         & ! CALIPSO simulator on/off switch
    31         LgrLidar532,      & ! GROUND LIDAR simulator on/off switch
     31    LgrLidar532,      & ! GROUND LIDAR simulator on/off switch
    3232         Latlid,           & ! ATLID simulator on/off switch
    3333         Lisccp,           & ! ISCCP simulator on/off switch
    … …  
    161161  integer :: i
    162162               
    163    do i=1,107
     163   DO i=1,107
    164164      cfg%out_list(i)=''
    165165   enddo
    … …  
    295295  integer :: i
    296296
    297    do i=1,107
     297   DO i=1,107
    298298      cfg%out_list(i)=''
    299299   enddo
    … …  
    490490                       Lptradarflag8,Lptradarflag9,Lradarpia
    491491
    492   do i=1,107
     492  DO i=1,107
    493493    cfg%out_list(i)=''
    494494  enddo
    … …  
    10621062 IF (using_xios) THEN
    10631063
    1064   do i=1,107
     1064  DO i=1,107
    10651065    cfg%out_list(i)=''
    10661066  enddo

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

    r5099 r5158  
    142142       frac_cv(1:nPoints,1:nLevels) = 0._wp
    143143       prec_cv(1:nPoints,1:nLevels) = 0._wp
    144        do j=1,nPoints
    145           do k=1,nLevels
    146              do i=1,nColumns
     144       DO j=1,nPoints
     145          DO k=1,nLevels
     146             DO i=1,nColumns
    147147                if (cospIN%frac_out(j,i,k)  .eq. 1)  frac_ls(j,k) = frac_ls(j,k)+1._wp
    148148                if (cospIN%frac_out(j,i,k)  .eq. 2)  frac_cv(j,k) = frac_cv(j,k)+1._wp
    … …  
    171171       Reff(:,:,:,:)     = 0._wp
    172172       Np(:,:,:,:)       = 0._wp
    173        do k=1,nColumns
     173       DO k=1,nColumns
    174174          ! Subcolumn cloud fraction
    175175          column_frac_out = cospIN%frac_out(:,k,:)
    … …  
    214214       fl_ccrain(:,:) = 0._wp
    215215       fl_ccsnow(:,:) = 0._wp
    216        do k=1,nLevels
    217           do j=1,nPoints
     216       DO k=1,nLevels
     217          DO j=1,nPoints
    218218             ! In-cloud mixing ratios.
    219219             if (frac_ls(j,k) .ne. 0.) then
    … …  
    359359       allocate(g_vol(nPoints,nLevels))
    360360       g_vol(:,:)=0._wp
    361        do i=1,nPoints
    362           do j=1,nLevels
     361       DO i=1,nPoints
     362          DO j=1,nLevels
    363363             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)
    … …  
    371371       allocate(fracPrecipIce(nPoints,nColumns,nLevels))
    372372       fracPrecipIce(:,:,:) = 0._wp
    373        do k=1,nColumns
     373       DO k=1,nColumns
    374374          call quickbeam_optics(sd, cospIN%rcfg_cloudsat, nPoints, nLevels, R_UNDEF,  &
    375375               mr_hydro(:,k,:,1:nHydro)*1000._wp, Reff(:,k,:,1:nHydro)*1.e6_wp,&
    … …  
    406406
    407407       ! For near-surface diagnostics, we only need the frozen fraction at one layer.
    408        do i=1,nPoints                                                                       !PREC_BUG
    409           cospIN%fracPrecipIce(i,:) = fracPrecipIce_statGrid(i,:,cloudsat_preclvl_index(i)) !PREC_BUG
     408       DO i=1,nPoints                                                                       !PREC_BUG
     409      cospIN%fracPrecipIce(i,:) = fracPrecipIce_statGrid(i,:,cloudsat_preclvl_index(i)) !PREC_BUG
    410410       enddo                                                                                !PREC_BUG
    411411!       cospIN%fracPrecipIce(:,:) = fracPrecipIce_statGrid(:,:,cloudsat_preclvl)      !!! ORIGINAL

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

    r5099 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/cospv2/modis_simulator.F90

    r5099 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
    … …  
    712712    cloudMask(1:nLevels) = tau(1:nLevels) > 0.
    713713    cloudIndicies = pack((/ (i, i = 1, nLevels) /), mask = cloudMask)
    714     do i = 1, size(cloudIndicies)
     714    DO i = 1, size(cloudIndicies)
    715715       call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    716716    end do
    … …  
    892892    Tran_cumulative(1) = Tran(1)   
    893893   
    894     do i=2, npts
     894    DO i=2, npts
    895895       ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
    896896       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/cospv2/optics_lib.F90

    r5099 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/cospv2/parasol.F90

    r5099 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/cospv2/prec_scops.F90

    r5099 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/cospv2/quickbeam.F90

    r5099 r5158  
    150150       d_gate     = -1
    151151    endif
    152     do k=start_gate,end_gate,d_gate
     152    DO k=start_gate,end_gate,d_gate
    153153       ! Loop over each profile (nprof)
    154        do pr=1,nprof
     154       DO pr=1,nprof
    155155          ! Attenuation due to hydrometeors between radar and volume
    156156         
    … …  
    284284         
    285285          ! Effective reflectivity histogram
    286           do i=1,Npoints
    287              do j=1,llm
     286          DO i=1,Npoints
     287             DO j=1,llm
    288288                cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_toti(i,:,j),DBZE_BINS,cloudsat_histRef)
    289289             enddo
    … …  
    301301       else
    302302          ! Effective reflectivity histogram
    303           do i=1,Npoints
    304              do j=1,llm
     303          DO i=1,Npoints
     304             DO j=1,llm
    305305                cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_tot(i,:,j),DBZE_BINS,cloudsat_histRef)
    306306             enddo
    … …  
    395395    ! SUBCOLUMN processing
    396396    ! ######################################################################################
    397     do i=1, Npoints
     397    DO i=1, Npoints
    398398
    399399       cloudsat_preclvl = cloudsat_preclvl_index(i) !PREC_BUG
    400400!       print*, 'i, surfelev(i), cloudsat_preclvl : ', i, surfelev(i), cloudsat_preclvl !PREC_BUG
    401401
    402        do pr=1,Ncolumns
     402       DO pr=1,Ncolumns
    403403          ! 1) Compute the PIA in all profiles containing hydrometeors
    404404          if ( (Ze_non_out(i,pr,cloudsat_preclvl).gt.-100) .and. (Ze_out(i,pr,cloudsat_preclvl).gt.-100) ) then
    … …  
    523523
    524524    ! Aggregate subcolumns
    525     do i=1,Npoints
     525    DO i=1,Npoints
    526526       ! Gridmean precipitation fraction for each precipitation type
    527        do k=1,nCloudsatPrecipClass
     527       DO k=1,nCloudsatPrecipClass
    528528          if (any(cloudsat_pflag(i,:) .eq. k-1)) then
    529529             cloudsat_precip_cover(i,k) = count(cloudsat_pflag(i,:) .eq. k-1)
    … …  
    571571            trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
    572572       
    573        do i=1,maxhclass
    574           do j=1,mt_ntt
    575              do k=1,nRe_types
     573       DO i=1,maxhclass
     574          DO j=1,mt_ntt
     575             DO k=1,nRe_types
    576576                ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
    577577                read(12,rec=ind) rcfg%Z_scale_flag(i,j,k), &
    … …  
    607607         trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
    608608   
    609     do i=1,maxhclass
    610        do j=1,mt_ntt
    611           do k=1,nRe_types
     609    DO i=1,maxhclass
     610       DO j=1,mt_ntt
     611          DO k=1,nRe_types
    612612             ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
    613613             if(.not.LUT_file_exists .or. rcfg%Z_scale_added_flag(i,j,k)) then

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

    r5099 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
    … …  
    140140    kr_vol   = 0._wp
    141141
    142     do k=1,ngate       ! Loop over each profile (nprof)
    143        do pr=1,nprof
     142    DO k=1,ngate       ! Loop over each profile (nprof)
     143       DO pr=1,nprof
    144144          ! Determine if hydrometeor(s) present in volume
    145145          hydro = .false.
    146           do j=1,rcfg%nhclass
     146          DO j=1,rcfg%nhclass
    147147             if ((hm_matrix(pr,k,j) > 1E-12) .and. (sd%dtype(j) > 0)) then
    148148                hydro = .true.
    … …  
    157157             
    158158             ! Loop over hydrometeor type
    159              do tp=1,rcfg%nhclass
     159             DO tp=1,rcfg%nhclass
    160160                Re_internal = re_matrix(pr,k,tp)
    161161
    … …  
    342342   
    343343    where(kr_vol(:,:) <= EPSILON(kr_vol))
    344        ! Volume is hydrometeor-free     
     344       ! Volume is hydrometeor-free
    345345       !z_vol(:,:)  = undef
    346346       z_ray(:,:)  = undef
    … …  
    794794       lidx = infind(D,dmin)
    795795       uidx = infind(D,dmax)   
    796        do k=lidx,uidx
     796       DO k=lidx,uidx
    797797          N(k) = (ahp*(D(k)*1E-3)**bhp) * 1E-12   
    798798       enddo
    … …  
    980980       sizep = (pi*D0)/wl
    981981       dqv(1) = 0._wp
    982        do i=1,nsizes
     982       DO i=1,nsizes
    983983          call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    984984               dg, xs1, xs2, dph, err)
    … …  
    11831183    sumo = 0._wp
    11841184    aux1 = 1.1_wp*e_th
    1185     do i=1,nbands_o2
     1185    DO i=1,nbands_o2
    11861186       aux2   = f/v0(i)
    11871187       aux3   = v0(i)-f
    … …  
    12071207    sumo = 0._wp
    12081208    aux1 = 4.8_wp*e_th
    1209     do i=1,nbands_h2o
     1209    DO i=1,nbands_h2o
    12101210       aux2    = f/v1(i)
    12111211       aux3    = v1(i)-f

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

    r5099 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.