Changeset 5158 for LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_matrix.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.v1.5.1/radiation_matrix.F90 (modified) (24 diffs)

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

@@ -90 +90 @@
       mat_x_vec(1:iend,1) = A(1:iend,1,1)*b(1:iend,1)
     else
-      do j1 = 1,m
-        do j2 = 1,m
+      DO j1 = 1,m
+        DO j2 = 1,m
           mat_x_vec(1:iend,j1) = mat_x_vec(1:iend,j1) &
                &               + A(1:iend,j1,j2)*b(1:iend,j2)
@@ -124 +124 @@
     singlemat_x_vec = 0.0_jprb
 
-    do j1 = 1,m
-      do j2 = 1,m
+    DO j1 = 1,m
+      DO j2 = 1,m
         singlemat_x_vec(1:iend,j1) = singlemat_x_vec(1:iend,j1) &
              &                    + A(j1,j2)*b(1:iend,j2)
@@ -175 +175 @@
       m2block = 2*mblock 
       ! Do the top-left (C, D, F, G)
-      do j2 = 1,m2block
-        do j1 = 1,m2block
-          do j3 = 1,m2block
+      DO j2 = 1,m2block
+        DO j1 = 1,m2block
+          DO j3 = 1,m2block
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -183 +183 @@
         end do
       end do
-      do j2 = m2block+1,m
+      DO j2 = m2block+1,m
         ! Do the top-right (E & H)
-        do j1 = 1,m2block
-          do j3 = 1,m
+        DO j1 = 1,m2block
+          DO j3 = 1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -192 +192 @@
         end do
         ! Do the bottom-right (I)
-        do j1 = m2block+1,m
-          do j3 = m2block+1,m
+        DO j1 = m2block+1,m
+          DO j3 = m2block+1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -201 +201 @@
     else
       ! Ordinary dense matrix
-      do j2 = 1,m
-        do j1 = 1,m
-          do j3 = 1,m
+      DO j2 = 1,m
+        DO j1 = 1,m
+          DO j3 = 1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -237 +237 @@
     singlemat_x_mat = 0.0_jprb
 
-    do j2 = 1,m
-      do j1 = 1,m
-        do j3 = 1,m
+    DO j2 = 1,m
+      DO j1 = 1,m
+        DO j3 = 1,m
           singlemat_x_mat(1:iend,j1,j2) = singlemat_x_mat(1:iend,j1,j2) &
                &                        + A(j1,j3)*B(1:iend,j3,j2)
@@ -272 +272 @@
     mat_x_singlemat = 0.0_jprb
 
-    do j2 = 1,m
-      do j1 = 1,m
-        do j3 = 1,m
+    DO j2 = 1,m
+      DO j1 = 1,m
+        DO j3 = 1,m
           mat_x_singlemat(1:iend,j1,j2) = mat_x_singlemat(1:iend,j1,j2) &
                &                        + A(1:iend,j1,j3)*B(j3,j2)
@@ -310 +310 @@
 
     identity_minus_mat_x_mat = - identity_minus_mat_x_mat
-    do j = 1,m
+    DO j = 1,m
       identity_minus_mat_x_mat(1:iend,j,j) &
            &     = 1.0_jprb + identity_minus_mat_x_mat(1:iend,j,j)
@@ -348 +348 @@
       mblock = m/3
       m2block = 2*mblock
-      do j4 = 1,nrepeat
+      DO j4 = 1,nrepeat
         repeated_square = 0.0_jprb
         ! Do the top-left (C, D, F & G)
-        do j2 = 1,m2block
-          do j1 = 1,m2block
-            do j3 = 1,m2block
+        DO j2 = 1,m2block
+          DO j1 = 1,m2block
+            DO j3 = 1,m2block
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -359 +359 @@
           end do
         end do
-        do j2 = m2block+1, m
+        DO j2 = m2block+1, m
           ! Do the top-right (E & H)
-          do j1 = 1,m2block
-            do j3 = 1,m
+          DO j1 = 1,m2block
+            DO j3 = 1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -368 +368 @@
           end do
           ! Do the bottom-right (I)
-          do j1 = m2block+1, m
-            do j3 = m2block+1,m
+          DO j1 = m2block+1, m
+            DO j3 = m2block+1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -381 +381 @@
     else
       ! Ordinary dense matrix
-      do j4 = 1,nrepeat
+      DO j4 = 1,nrepeat
         repeated_square = 0.0_jprb
-        do j2 = 1,m
-          do j1 = 1,m
-            do j3 = 1,m
+        DO j2 = 1,m
+          DO j1 = 1,m
+            DO j3 = 1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -521 +521 @@
     U33 = A(1:iend,3,3) - L31*A(1:iend,1,3) - L32*U23
 
-    do j = 1,3
+    DO j = 1,3
       ! Solve Ly = B(:,:,j) by forward substitution
       ! y1 = B(:,1,j)
@@ -621 +621 @@
     LU(1:iend,1:m,1:m) = A(1:iend,1:m,1:m)
 
-    do j2 = 1, m
-      do j1 = 1, j2-1
+    DO j2 = 1, m
+      DO j1 = 1, j2-1
         s = LU(1:iend,j1,j2)
-        do j3 = 1, j1-1
+        DO j3 = 1, j1-1
           s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
         end do
         LU(1:iend,j1,j2) = s
       end do
-      do j1 = j2, m
+      DO j1 = j2, m
         s = LU(1:iend,j1,j2)
-        do j3 = 1, j2-1
+        DO j3 = 1, j2-1
           s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
         end do
@@ -638 +638 @@
       if (j2 /= m) then
         s = 1.0_jprb / LU(1:iend,j2,j2)
-        do j1 = j2+1, m
+        DO j1 = j2+1, m
           LU(1:iend,j1,j2) = LU(1:iend,j1,j2) * s
         end do
@@ -663 +663 @@
 
     ! First solve Ly=b
-    do j2 = 2, m
-      do j1 = 1, j2-1
+    DO j2 = 2, m
+      DO j1 = 1, j2-1
         x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
       end do
     end do
     ! Now solve Ux=y
-    do j2 = m, 1, -1
-      do j1 = j2+1, m
+    DO j2 = m, 1, -1
+      DO j1 = j2+1, m
         x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
       end do
@@ -694 +694 @@
     call lu_factorization(n,iend,m,A,LU)
 
-    do j = 1, m
+    DO j = 1, m
       call lu_substitution(n,iend,m,LU,B(1:,1:m,j),X(1:iend,1:m,j))
 !      call lu_substitution(n,iend,m,LU,B(1:n,1:m,j),X(1:iend,1:m,j))
@@ -807 +807 @@
 
     ! Compute the 1-norms of A
-    do j3 = 1,m
+    DO j3 = 1,m
       sum_column(:) = 0.0_jprb
-      do j2 = 1,m
-        do j1 = 1,iend
+      DO j2 = 1,m
+        DO j1 = 1,iend
           sum_column(j1) = sum_column(j1) + abs(A(j1,j2,j3))
         end do
       end do
-      do j1 = 1,iend
+      DO j1 = 1,iend
         if (sum_column(j1) > normA(j1)) then
           normA(j1) = sum_column(j1)
@@ -833 +833 @@
     ! Scale the input matrices by a power of 2
     scaling = 2.0_jprb**(-expo)
-    do j3 = 1,m
-      do j2 = 1,m
+    DO j3 = 1,m
+      DO j2 = 1,m
         A(1:iend,j2,j3) = A(1:iend,j2,j3) * scaling
       end do
@@ -844 +844 @@
 
     V = c(8)*A6 + c(6)*A4 + c(4)*A2
-    do j3 = 1,m
+    DO j3 = 1,m
       V(:,j3,j3) = V(:,j3,j3) + c(2)
     end do
@@ -850 +850 @@
     V = c(7)*A6 + c(5)*A4 + c(3)*A2
     ! Add a multiple of the identity matrix
-    do j3 = 1,m
+    DO j3 = 1,m
       V(:,j3,j3) = V(:,j3,j3) + c(1)
     end do
@@ -859 +859 @@
 
     ! Add the identity matrix
-    do j3 = 1,m
+    DO j3 = 1,m
       A(1:iend,j3,j3) = A(1:iend,j3,j3) + 1.0_jprb
     end do
 
     ! Loop through the matrices
-    do j1 = 1,iend
+    DO j1 = 1,iend
       if (expo(j1) > 0) then
         ! Square matrix j1 expo(j1) times          
@@ -983 +983 @@
 
     ! Compute V * diag_rdivide_V
-    do j1 = 1,3
-      do j2 = 1,3
+    DO j1 = 1,3
+      DO j2 = 1,3
         R(1:iend,j2,j1) = V(1:iend,j2,1)*diag_rdivide_V(1:iend,1,j1) &
              &          + V(1:iend,j2,2)*diag_rdivide_V(1:iend,2,j1) &