Changeset 5189 for branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

Timestamp:

2015-03-31T19:58:23+02:00 (9 years ago)

Author:

mathiot

Message:

ISF cleaning branch: simplification and bug correction in hpg_isf, zps_hde_isf, mixed layer definition, slope, diffusion, vertical advection and top friction

File:

• branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90 (modified) (5 diffs)

branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

@@ -108 +108 @@
       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
       REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw 
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt , ztfw 
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso')
       !
-      CALL wrk_alloc( jpi, jpj,      z2d ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 
+      CALL wrk_alloc( jpi, jpj,      zdkt, zdk1t, z2d  ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt , ztfw ) 
       !
 
@@ -168 +168 @@
          !!   II - horizontal trend  (full)
          !!----------------------------------------------------------------------
-!!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
             ! 1. Vertical tracer gradient at level jk and jk+1
             ! ------------------------------------------------
-         ! 
-         ! interior value 
-         DO jk = 2, jpkm1               
-            DO jj = 1, jpj
-               DO ji = 1, jpi   ! vector opt.
-                  zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn  ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)
-                  !
-                  zdkt(ji,jj,jk)  = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn  ) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-         zdk1t(:,:,1) = ( ptb(:,:,1,jn  ) - ptb(:,:,2,jn) ) * wmask(:,:,2)
-         zdkt (:,:,1) = zdk1t(:,:,1)
-         IF ( ln_isfcav ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi   ! vector opt.
-                  ikt = mikt(ji,jj) ! surface level
-                  zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1)
-                  zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt)
-               END DO
-            END DO
-         END IF
-
-         ! 2. Horizontal fluxes
-         ! --------------------   
-         DO jk = 1, jpkm1
+            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk)
+            ENDIF
+
+            ! 2. Horizontal fluxes
+            ! --------------------   
             DO jj = 1 , jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
@@ -203 +188 @@
                   zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
                   !
-                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
-                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
-                  !
-                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
-                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. )
                   !
                   zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
@@ -213 +198 @@
                   !
                   zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
-                     &              + zcof1 * (  zdkt (ji+1,jj,jk) + zdk1t(ji,jj,jk)      &
-                     &                         + zdk1t(ji+1,jj,jk) + zdkt (ji,jj,jk)  )  ) * umask(ji,jj,jk)
+                     &              + zcof1 * (  zdkt (ji+1,jj  ) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji+1,jj  ) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
                   zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
-                     &              + zcof2 * (  zdkt (ji,jj+1,jk) + zdk1t(ji,jj,jk)      &
-                     &                         + zdk1t(ji,jj+1,jk) + zdkt (ji,jj,jk)  )  ) * vmask(ji,jj,jk)                  
+                     &              + zcof2 * (  zdkt (ji  ,jj+1) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji  ,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
                END DO
             END DO
@@ -322 +307 @@
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, z2d ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 
+      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d  ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , ztfw ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')