Changeset 12353 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF

Timestamp:

2020-01-29T17:15:37+01:00 (4 years ago)

Author:

acc

Message:

Branch 2019/dev_r11943_MERGE_2019. Additions to the do loop macro implementation: converted a few loops previously missed because they used jpi-1 instead of jpim1 etc.; changed internal macro names in do_loop_substitute.h90 to strings that are much more unlikely to appear in any future code elsewhere and removed the key_vectopt_loop option (and all related code) since the do loop macros have suppressed this option. These changes have been fully SETTE-tested and this branch should now be ready to go back to the trunk.

File:

• NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcpl.F90 (modified) (2 diffs)

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcpl.F90

@@ -177 +177 @@
          !
          zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:)
-         DO jj = 2,jpj-1
-            DO ji = 2,jpi-1
-               jip1=ji+1; jim1=ji-1;
-               jjp1=jj+1; jjm1=jj-1;
-               !
-               zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1)
-               !
-               IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN
-                  ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj)     &
-                  &           + zssh(jim1,jj)*zssmask0(jim1,jj)     &
-                  &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     &
-                  &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk
-                  zssmask_b(ji,jj) = 1._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            jip1=ji+1; jim1=ji-1;
+            jjp1=jj+1; jjm1=jj-1;
+            !
+            zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1)
+            !
+            IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN
+               ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj)     &
+               &           + zssh(jim1,jj)*zssmask0(jim1,jj)     &
+               &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     &
+               &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk
+               zssmask_b(ji,jj) = 1._wp
+            ENDIF
+         END_2D
          !
          zssh(:,:) = ssh(:,:,Kmm)
@@ -300 +298 @@
             zdmask(:,:) = tmask(:,:,jk) - ztmask0(:,:,jk);
             !
-            DO jj = 2,jpj-1
-               DO ji = 2,jpi-1
-                  jip1=ji+1; jim1=ji-1;
-                  jjp1=jj+1; jjm1=jj-1;
+            DO_2D_00_00
+               jip1=ji+1; jim1=ji-1;
+               jjp1=jj+1; jjm1=jj-1;
+               !
+               ! check if a wet neigbourg cell is present
+               zsummsk = ztmask0(jip1,jj  ,jk) + ztmask0(jim1,jj  ,jk) &
+                       + ztmask0(ji  ,jjp1,jk) + ztmask0(ji  ,jjm1,jk)
+               !
+               ! if neigbourg wet cell available at the same level
+               IF ( zdmask(ji,jj) == 1._wp  .AND. zsummsk /= 0._wp ) THEN
+                  !
+                  ! horizontal basic extrapolation
+                  ts(ji,jj,jk,1,Kmm)=( zts0(jip1,jj  ,jk,1) * ztmask0(jip1,jj  ,jk) &
+                  &               + zts0(jim1,jj  ,jk,1) * ztmask0(jim1,jj  ,jk) &
+                  &               + zts0(ji  ,jjp1,jk,1) * ztmask0(ji  ,jjp1,jk) &
+                  &               + zts0(ji  ,jjm1,jk,1) * ztmask0(ji  ,jjm1,jk) ) / zsummsk
+                  ts(ji,jj,jk,2,Kmm)=( zts0(jip1,jj  ,jk,2) * ztmask0(jip1,jj  ,jk) &
+                  &               + zts0(jim1,jj  ,jk,2) * ztmask0(jim1,jj  ,jk) &
+                  &               + zts0(ji  ,jjp1,jk,2) * ztmask0(ji  ,jjp1,jk) &
+                  &               + zts0(ji  ,jjm1,jk,2) * ztmask0(ji  ,jjm1,jk) ) / zsummsk
+                  !
+                  ! update mask for next pass
+                  ztmask1(ji,jj,jk)=1
+                  !
+               ! in case no neigbourg wet cell available at the same level
+               ! check if a wet cell is available below
+               ELSEIF (zdmask(ji,jj) == 1._wp .AND. zsummsk == 0._wp) THEN
+                  !
+                  ! vertical extrapolation if horizontal extrapolation failed
+                  jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
                   !
                   ! check if a wet neigbourg cell is present
-                  zsummsk = ztmask0(jip1,jj  ,jk) + ztmask0(jim1,jj  ,jk) &
-                          + ztmask0(ji  ,jjp1,jk) + ztmask0(ji  ,jjm1,jk)
-                  !
-                  ! if neigbourg wet cell available at the same level
-                  IF ( zdmask(ji,jj) == 1._wp  .AND. zsummsk /= 0._wp ) THEN
-                     !
-                     ! horizontal basic extrapolation
-                     ts(ji,jj,jk,1,Kmm)=( zts0(jip1,jj  ,jk,1) * ztmask0(jip1,jj  ,jk) &
-                     &               + zts0(jim1,jj  ,jk,1) * ztmask0(jim1,jj  ,jk) &
-                     &               + zts0(ji  ,jjp1,jk,1) * ztmask0(ji  ,jjp1,jk) &
-                     &               + zts0(ji  ,jjm1,jk,1) * ztmask0(ji  ,jjm1,jk) ) / zsummsk
-                     ts(ji,jj,jk,2,Kmm)=( zts0(jip1,jj  ,jk,2) * ztmask0(jip1,jj  ,jk) &
-                     &               + zts0(jim1,jj  ,jk,2) * ztmask0(jim1,jj  ,jk) &
-                     &               + zts0(ji  ,jjp1,jk,2) * ztmask0(ji  ,jjp1,jk) &
-                     &               + zts0(ji  ,jjm1,jk,2) * ztmask0(ji  ,jjm1,jk) ) / zsummsk
+                  zsummsk = ztmask0(ji,jj,jkm1) + ztmask0(ji,jj,jkp1)
+                  IF (zdmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp ) THEN
+                     ts(ji,jj,jk,1,Kmm)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
+                     &               + zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1)) / zsummsk
+                     ts(ji,jj,jk,2,Kmm)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
+                     &               + zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1)) / zsummsk
                      !
                      ! update mask for next pass
-                     ztmask1(ji,jj,jk)=1
-                     !
-                  ! in case no neigbourg wet cell available at the same level
-                  ! check if a wet cell is available below
-                  ELSEIF (zdmask(ji,jj) == 1._wp .AND. zsummsk == 0._wp) THEN
-                     !
-                     ! vertical extrapolation if horizontal extrapolation failed
-                     jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
-                     !
-                     ! check if a wet neigbourg cell is present
-                     zsummsk = ztmask0(ji,jj,jkm1) + ztmask0(ji,jj,jkp1)
-                     IF (zdmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp ) THEN
-                        ts(ji,jj,jk,1,Kmm)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
-                        &               + zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1)) / zsummsk
-                        ts(ji,jj,jk,2,Kmm)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
-                        &               + zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1)) / zsummsk
-                        !
-                        ! update mask for next pass
-                        ztmask1(ji,jj,jk)=1._wp
-                     END IF
+                     ztmask1(ji,jj,jk)=1._wp
                   END IF
-               END DO
-            END DO
+               END IF
+            END_2D
          END DO
          !