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

Timestamp:

Aug 2, 2024, 2:12:03 PM (7 weeks 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.v1.5.1/radiation_spectral_definition.F90 (modified) (20 diffs)

LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spectral_definition.F90

@@ -170 +170 @@
     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
@@ -244 +244 @@
            &                                          temperature)
 
-      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
@@ -281 +281 @@
             ! 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
@@ -314 +314 @@
       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
@@ -356 +356 @@
                  &  / (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) &
@@ -403 +403 @@
                  &  / (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 &
@@ -424 +424 @@
         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
@@ -434 +434 @@
 
       ! 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
@@ -548 +548 @@
     ! 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'
@@ -568 +568 @@
       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
@@ -643 +643 @@
       
       ! 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)
@@ -661 +661 @@
       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))
@@ -675 +675 @@
     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
@@ -736 +736 @@
     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
@@ -782 +782 @@
       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
@@ -791 +791 @@
         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
@@ -802 +802 @@
         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
@@ -810 +810 @@
       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
@@ -818 +818 @@
         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
@@ -827 +827 @@
         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