Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (3 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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics.F90

    r4853 r5158  
    243243
    244244        if (ao%use_hydrophilic) then
    245           do jtype = 1,n_type_philic
     245          DO jtype = 1,n_type_philic
    246246            ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
    247247            ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
    … …  
    266266
    267267        if (ao%use_hydrophilic) then
    268           do jtype = 1,n_type_philic
     268          DO jtype = 1,n_type_philic
    269269            ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
    270270            ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
    … …  
    280280      if (allocated(ao%wavelength_mono)) then
    281281        ! Monochromatic wavelengths also required
    282         do jwl = 1,nmono
     282        DO jwl = 1,nmono
    283283          ! Wavelength (m) to wavenumber (cm-1)
    284284          wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl)
    … …  
    292292          else
    293293            iwn = 1
    294             do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
     294            DO while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
    295295              iwn = iwn + 1
    296296            end do
    … …  
    419419
    420420      if (ao%use_hydrophilic) then
    421         do jtype = 1,ao%n_type_philic
     421        DO jtype = 1,ao%n_type_philic
    422422          ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype))
    423423          ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype) &
    … …  
    451451
    452452      if (ao%use_hydrophilic) then
    453         do jtype = 1,ao%n_type_philic
     453        DO jtype = 1,ao%n_type_philic
    454454          ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype))
    455455          ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype) &
    … …  
    579579      ! Aerosol mixing ratios have been provided
    580580
    581       do jtype = 1,config%n_aerosol_types
     581      DO jtype = 1,config%n_aerosol_types
    582582        if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
    583583          write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
    … …  
    612612
    613613      ! Loop over column
    614       do jcol = istartcol,iendcol
     614      DO jcol = istartcol,iendcol
    615615
    616616        ! Reset temporary arrays
    … …  
    622622        scat_g_lw_aerosol = 0.0_jprb
    623623
    624         do jlev = istartlev,iendlev
     624        DO jlev = istartlev,iendlev
    625625          ! Compute relative humidity with respect to liquid
    626626          ! saturation and the index to the relative-humidity index of
    … …  
    634634        end do
    635635
    636         do jtype = 1,config%n_aerosol_types
     636        DO jtype = 1,config%n_aerosol_types
    637637          itype = ao%itype(jtype)
    638638
    … …  
    643643          ! dimension being spectral band.
    644644          if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
    645             do jlev = istartlev,iendlev
     645            DO jlev = istartlev,iendlev
    646646              mixing_ratio = aerosol%mixing_ratio(jcol,jlev,jtype)
    647               do jband = 1,config%n_bands_sw
     647              DO jband = 1,config%n_bands_sw
    648648                local_od_sw = factor(jlev) * mixing_ratio &
    649649                     &  * ao%mass_ext_sw_phobic(jband,itype)
    … …  
    656656              end do
    657657              if (config%do_lw_aerosol_scattering) then
    658                 do jband = 1,config%n_bands_lw
     658                DO jband = 1,config%n_bands_lw
    659659                  local_od_lw = factor(jlev) * mixing_ratio &
    660660                       &  * ao%mass_ext_lw_phobic(jband,itype)
    … …  
    670670                ! weight the optical depth by the single scattering
    671671                ! co-albedo
    672                 do jband = 1,config%n_bands_lw
     672                DO jband = 1,config%n_bands_lw
    673673                  od_lw_aerosol(jband,jlev) = od_lw_aerosol(jband,jlev) &
    674674                       &  + factor(jlev) * mixing_ratio &
    … …  
    682682            ! Hydrophilic aerosols require the look-up tables to
    683683            ! be indexed with irh
    684             do jlev = istartlev,iendlev
     684            DO jlev = istartlev,iendlev
    685685              mixing_ratio = aerosol%mixing_ratio(jcol,jlev,jtype)
    686686              irh = irhs(jlev)
    687               do jband = 1,config%n_bands_sw
     687              DO jband = 1,config%n_bands_sw
    688688                local_od_sw = factor(jlev) * mixing_ratio &
    689689                     &  * ao%mass_ext_sw_philic(jband,irh,itype)
    … …  
    696696              end do
    697697              if (config%do_lw_aerosol_scattering) then
    698                 do jband = 1,config%n_bands_lw
     698                DO jband = 1,config%n_bands_lw
    699699                  local_od_lw = factor(jlev) * mixing_ratio &
    700700                       &  * ao%mass_ext_lw_philic(jband,irh,itype)
    … …  
    710710                ! weight the optical depth by the single scattering
    711711                ! co-albedo
    712                 do jband = 1,config%n_bands_lw
     712                DO jband = 1,config%n_bands_lw
    713713                  od_lw_aerosol(jband,jlev) = od_lw_aerosol(jband,jlev) &
    714714                       &  + factor(jlev) * mixing_ratio &
    … …  
    740740
    741741          ! We can assume the band and g-point indices are the same
    742           do jlev = 1,nlev
    743             do jg = 1,config%n_g_sw
     742          DO jlev = 1,nlev
     743            DO jg = 1,config%n_g_sw
    744744              local_scat = ssa_sw(jg,jlev,jcol)*od_sw(jg,jlev,jcol) + scat_sw_aerosol(jg,jlev)
    745745              od_sw(jg,jlev,jcol) = od_sw(jg,jlev,jcol) + od_sw_aerosol(jg,jlev)
    … …  
    751751        else
    752752
    753           do jlev = 1,nlev
    754             do jg = 1,config%n_g_sw
     753          DO jlev = 1,nlev
     754            DO jg = 1,config%n_g_sw
    755755              ! Need to map between bands and g-points
    756756              iband = config%i_band_from_reordered_g_sw(jg)
    … …  
    781781               &                             scat_lw_aerosol, scat_g_lw_aerosol)
    782782
    783           do jlev = istartlev,iendlev
    784             do jg = 1,config%n_g_lw
     783          DO jlev = istartlev,iendlev
     784            DO jg = 1,config%n_g_lw
    785785              iband = config%i_band_from_reordered_g_lw(jg)
    786786              local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband,jlev)
    … …  
    802802          if (config%do_cloud_aerosol_per_lw_g_point) then
    803803            ! We can assume band and g-point indices are the same
    804             do jlev = istartlev,iendlev
    805               do jg = 1,config%n_g_lw
     804            DO jlev = istartlev,iendlev
     805              DO jg = 1,config%n_g_lw
    806806                od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) + od_lw_aerosol(jg,jlev)
    807807              end do
    808808            end do
    809809          else
    810             do jlev = istartlev,iendlev
    811               do jg = 1,config%n_g_lw
     810            DO jlev = istartlev,iendlev
     811              DO jg = 1,config%n_g_lw
    812812                od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
    813813                     &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg),jlev)
    … …  
    901901
    902902      ! Loop over position
    903       do jcol = istartcol,iendcol
     903      DO jcol = istartcol,iendcol
    904904! Added for DWD (2020)
    905905!NEC$ forced_collapse
    906         do jlev = istartlev,iendlev
    907           do jb = 1,config%n_bands_sw
     906        DO jlev = istartlev,iendlev
     907          DO jb = 1,config%n_bands_sw
    908908            od_sw_aerosol(jb,jlev) = aerosol%od_sw(jb,jlev,jcol)
    909909            scat_sw_aerosol(jb,jlev) = aerosol%ssa_sw(jb,jlev,jcol) * od_sw_aerosol(jb,jlev)
    … …  
    923923        ! properties (noting that any gas scattering will have an
    924924        ! asymmetry factor of zero)
    925         do jlev = istartlev,iendlev
     925        DO jlev = istartlev,iendlev
    926926          if (od_sw_aerosol(1,jlev) > 0.0_jprb) then
    927             do jg = 1,config%n_g_sw
     927            DO jg = 1,config%n_g_sw
    928928              iband = config%i_band_from_reordered_g_sw(jg)
    929929              local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband,jlev)
    … …  
    961961
    962962        ! Loop over position
    963         do jcol = istartcol,iendcol
     963        DO jcol = istartcol,iendcol
    964964! Added for DWD (2020)
    965965!NEC$ forced_collapse
    966           do jlev = istartlev,iendlev
    967             do jb = 1,config%n_bands_lw
     966          DO jlev = istartlev,iendlev
     967            DO jb = 1,config%n_bands_lw
    968968              od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol)
    969969              scat_lw_aerosol(jb,jlev) = aerosol%ssa_lw(jb,jlev,jcol) * od_lw_aerosol(jb,jlev)
    … …  
    974974            end do
    975975          end do
    976           do jlev = istartlev,iendlev
    977             do jg = 1,config%n_g_lw
     976          DO jlev = istartlev,iendlev
     977            DO jg = 1,config%n_g_lw
    978978              iband = config%i_band_from_reordered_g_lw(jg)
    979979              if (od_lw_aerosol(iband,jlev) > 0.0_jprb) then
    … …  
    995995
    996996        ! Loop over position
    997         do jcol = istartcol,iendcol
     997        DO jcol = istartcol,iendcol
    998998! Added for DWD (2020)
    999999!NEC$ forced_collapse
    1000           do jlev = istartlev,iendlev
     1000          DO jlev = istartlev,iendlev
    10011001            ! If aerosol longwave scattering is not included then we
    10021002            ! weight the optical depth by the single scattering
    10031003            ! co-albedo
    1004             do jb = 1, config%n_bands_lw
     1004            DO jb = 1, config%n_bands_lw
    10051005              od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol) &
    10061006                 &  * (1.0_jprb - aerosol%ssa_lw(jb,jlev,jcol))
    10071007            end do
    10081008          end do
    1009           do jlev = istartlev,iendlev
    1010             do jg = 1,config%n_g_lw
     1009          DO jlev = istartlev,iendlev
     1010            DO jg = 1,config%n_g_lw
    10111011              od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
    10121012                   &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg),jlev)
    … …  
    11201120    if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_extinction',0,hook_handle)
    11211121
    1122     do jtype = 1,config%n_aerosol_types
     1122    DO jtype = 1,config%n_aerosol_types
    11231123      if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
    11241124        write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
    … …  
    11381138
    11391139    ! Loop over position
    1140     do jcol = istartcol,iendcol
     1140    DO jcol = istartcol,iendcol
    11411141      ext = 0.0_jprb
    11421142      ! Get relative-humidity index
    11431143      irh = ao%calc_rh_index(relative_humidity(jcol))
    11441144      ! Add extinction coefficients from each aerosol type
    1145       do jtype = 1,config%n_aerosol_types
     1145      DO jtype = 1,config%n_aerosol_types
    11461146        if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
    11471147          ext = ext + mixing_ratio(jcol,jtype) &
Note: See TracChangeset for help on using the changeset viewer.