Changeset 10870 for branches/UKMO/dev_r5518_GO6_fix_diaar5/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

Timestamp:

2019-04-15T13:00:50+02:00 (6 years ago)

Author:

frrh

Message:

Apply correction to tnpeo calculation including reordering of k loop
as per #1884. This version of the code reflects the vn 3.6 STABLE branch
more than the vn 4.0 trunk. Although functionality is the same, here we
include the lbc_lnk of the STABLE branch (not used in the trunk)
and the workspace allocation of zpe as a pointer rather than the trunk
version which defines zpe (and other workspace arrays) simply as normal
allocatable arrays. i.e. I've opted to reflect the STABLE branch exactly
rather than to transplant more optimal code from the trunk out of context.

File:

• branches/UKMO/dev_r5518_GO6_fix_diaar5/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 (modified) (4 diffs)

branches/UKMO/dev_r5518_GO6_fix_diaar5/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

@@ -81 +81 @@
       !
       REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace 
-      REAL(wp), POINTER, DIMENSION(:,:)     :: pe                         ! 2D workspace 
+      REAL(wp), POINTER, DIMENSION(:,:) :: zpe                        ! 2D workspace 
       REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace
@@ -91 +91 @@
       IF( kt == nit000 )     CALL dia_ar5_init
  
-      CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, pe )
+      CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, zpe)
       CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    )
       CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 )
@@ -207 +207 @@
       ! Exclude points where rn2 is negative as convection kicks in here and
       ! work is not being done against stratification
-          pe(:,:) = 0._wp
-          IF( lk_zdfddm ) THEN
-             DO ji=1,jpi
-                DO jj=1,jpj
-                   DO jk=2,jpk
-                      zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
-                         &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )
-                      !
-                      zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
-                      zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
-                      !
-                      pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * &
-                           &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  &
-                           &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )
+          zpe(:,:) = 0._wp
+          IF( ln_zdfddm ) THEN
+             DO jk = 2, jpk
+                DO jj = 1, jpj
+                   DO ji = 1, jpi
+                     IF( rn2(ji,jj,jk) > 0._wp ) THEN
+
+                        zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
+                           &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )
+                        !
+                        zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
+                        zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
+                        !
+
+                        zpe(ji, jj) = zpe(ji, jj)            &
+                                    -  grav * (  avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  &
+                                               - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )
 
                    ENDDO
@@ -226 +229 @@
              ENDDO
           ELSE
-             DO ji=1,jpi
-                DO jj=1,jpj
-                   DO jk=1,jpk
-                       pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk)
+             DO jk=1,jpk
+                DO ji=1,jpi
+                   DO jj=1,jpj
+                      zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk)
                    ENDDO
                 ENDDO
              ENDDO
           ENDIF
-          CALL iom_put( 'tnpeo', pe )
+          CALL lbc_lnk(zpe, 'T', 1._wp) 
+          CALL iom_put( 'tnpeo', zpe )          
       ENDIF
       !
-      CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, pe )
+      CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, zpe )
       CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    )
       CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 )