Changeset 5158 for LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spectral_definition.F90

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:

• LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spectral_definition.F90 (modified) (22 diffs)

LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spectral_definition.F90

@@ -201 +201 @@
     else
       find_wavenumber = 1
-      do while (wavenumber > this%wavenumber2(find_wavenumber) &
+      DO while (wavenumber > this%wavenumber2(find_wavenumber) &
            &    .and. find_wavenumber < this%nwav)
         find_wavenumber = find_wavenumber + 1
@@ -284 +284 @@
       end if
 
-      do jband = 1,this%nband
+      DO jband = 1,this%nband
         weight = 0.0_jprb
-        do jwav = 1,nwav
+        DO jwav = 1,nwav
           ! Work out wavenumber range for which this cloud wavenumber
           ! will be applicable
@@ -321 +321 @@
             ! Find interpolating points
             iwav = 2
-            do while (wavenumber(iwav) < this%wavenumber2_band(jband))
+            DO while (wavenumber(iwav) < this%wavenumber2_band(jband))
               iwav = iwav+1
             end do
@@ -358 +358 @@
       mapping = 0.0_jprb
       ! Loop over wavenumbers representing cloud
-      do jwav = 1,nwav
+      DO jwav = 1,nwav
         ! Clear the weights. The weight says for one wavenumber in the
         ! cloud file, what is its fractional contribution to each of
@@ -400 +400 @@
                  &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
             if (isd1-isd0 > 1) then
-              do isd = isd0+1,isd1-1
+              DO isd = isd0+1,isd1-1
                 ! Intermediate trapezia
                 weight(isd) = 0.5_jprb * (this%wavenumber1(isd)+this%wavenumber2(isd) &
@@ -447 +447 @@
                  &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
             if (isd2-isd1 > 1) then
-              do isd = isd1+1,isd2-1
+              DO isd = isd1+1,isd2-1
                 ! Intermediate trapezia
                 weight(isd) = weight(isd) + 0.5_jprb * (2.0_jprb*wavenum2 &
@@ -468 +468 @@
         weight = weight * planck_weight
 
-        do jg = 1,this%ng
+        DO jg = 1,this%ng
           mapping(jg, jwav) = sum(weight * this%gpoint_fraction(:,jg))
         end do
@@ -478 +478 @@
 
       ! Normalize mapping matrix
-      do jg = 1,this%ng
+      DO jg = 1,this%ng
         mapping(jg,:) = mapping(jg,:) * (1.0_jprb/sum(mapping(jg,:)))
       end do
@@ -589 +589 @@
     ! Check wavelength is monotonically increasing
     if (ninterval > 2) then
-      do jint = 2,ninterval-1
+      DO jint = 2,ninterval-1
         if (wavelength_bound(jint) <= wavelength_bound(jint-1)) then
           write(nulerr, '(a)') '*** Error: wavelength bounds must be monotonically increasing'
@@ -609 +609 @@
       end if
 
-      do jband = 1,this%nband
-        do jint = 1,ninterval
+      DO jband = 1,this%nband
+        DO jint = 1,ninterval
           if (jint == 1) then
             ! First input interval in wavelength space: lower
@@ -692 +692 @@
       
       ! All bounded intervals
-      do jint = 2,ninterval-1
+      DO jint = 2,ninterval-1
         wavenumber1_bound = 0.01_jprb / wavelength_bound(jint)
         wavenumber2_bound = 0.01_jprb / wavelength_bound(jint-1)
@@ -710 +710 @@
       end if
 
-      do jg = 1,this%ng
-        do jin = 1,ninput
+      DO jg = 1,this%ng
+        DO jin = 1,ninput
           mapping(jin,jg) = sum(this%gpoint_fraction(:,jg) * planck, &
                &                 mask=(i_input==jin))
@@ -723 +723 @@
 
       ! Loop through all intervals
-      do jint = 1,ninterval
+      DO jint = 1,ninterval
         ! Loop through the wavenumbers for gpoint_fraction
-        do jwav = 1,this%nwav
+        DO jwav = 1,this%nwav
           if (jint == 1) then
             ! First input interval in wavelength space: lower
@@ -758 +758 @@
       end do
       if (use_fluxes_local) then
-        do jg = 1,this%ng
+        DO jg = 1,this%ng
           mapping(:,jg) = mapping(:,jg) / sum(this%gpoint_fraction(:,jg) * planck)
         end do
@@ -769 +769 @@
     if (.not. use_fluxes_local) then
       ! Normalize mapping matrix
-      do jg = 1,size(mapping,dim=2)
+      DO jg = 1,size(mapping,dim=2)
         mapping(:,jg) = mapping(:,jg) * (1.0_jprb/sum(mapping(:,jg)))
       end do
@@ -828 +828 @@
     is_band_unassigned = .true.
 
-    do jint = 1,ninterval
+    DO jint = 1,ninterval
       inext = minloc(wavelength1, dim=1, mask=is_band_unassigned)
       if (jint > 1) then
@@ -873 +873 @@
       write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' bands (wavenumber ranges in cm-1)'
       if (nout <= 40) then
-        do jout = 1,nout
+        DO jout = 1,nout
           write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
                &                        nint(this%wavenumber2_band(jout)), ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -882 +882 @@
         end do
       else
-        do jout = 1,30
+        DO jout = 1,30
           write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
                &                        nint(this%wavenumber2_band(jout)), ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -893 +893 @@
         write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(nout)), ' to', &
              &                        nint(this%wavenumber2_band(nout)), ':'
-        do jin = 1,nin
+        DO jin = 1,nin
           write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
         end do
@@ -901 +901 @@
       write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' g-points'
       if (nout <= 40) then
-        do jout = 1,nout
+        DO jout = 1,nout
           write(nulout,'(i3,a)',advance='no') jout, ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -909 +909 @@
         end do
       else
-        do jout = 1,30
+        DO jout = 1,30
           write(nulout,'(i3,a)',advance='no') jout, ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -918 +918 @@
         write(nulout,'(a)') '  ...'
         write(nulout,'(i3,a)',advance='no') nout, ':'
-        do jin = 1,nin
+        DO jin = 1,nin
           write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
         end do