Changeset 10870


Ignore:
Timestamp:
2019-04-15T13:00:50+02:00 (19 months 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:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_fix_diaar5/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r10863 r10870  
    8181      ! 
    8282      REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    83       REAL(wp), POINTER, DIMENSION(:,:)     :: pe                         ! 2D workspace  
     83      REAL(wp), POINTER, DIMENSION(:,:) :: zpe                        ! 2D workspace  
    8484      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace 
    8585      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
     
    9191      IF( kt == nit000 )     CALL dia_ar5_init 
    9292  
    93       CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
     93      CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, zpe) 
    9494      CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    9595      CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
     
    207207      ! Exclude points where rn2 is negative as convection kicks in here and 
    208208      ! work is not being done against stratification 
    209           pe(:,:) = 0._wp 
    210           IF( lk_zdfddm ) THEN 
    211              DO ji=1,jpi 
    212                 DO jj=1,jpj 
    213                    DO jk=2,jpk 
    214                       zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
    215                          &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
    216                       ! 
    217                       zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
    218                       zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
    219                       ! 
    220                       pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 
    221                            &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
    222                            &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
     209          zpe(:,:) = 0._wp 
     210          IF( ln_zdfddm ) THEN 
     211             DO jk = 2, jpk 
     212                DO jj = 1, jpj 
     213                   DO ji = 1, jpi 
     214                     IF( rn2(ji,jj,jk) > 0._wp ) THEN 
     215 
     216                        zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     217                           &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
     218                        ! 
     219                        zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     220                        zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     221                        ! 
     222 
     223                        zpe(ji, jj) = zpe(ji, jj)            & 
     224                                    -  grav * (  avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
     225                                               - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
    223226 
    224227                   ENDDO 
     
    226229             ENDDO 
    227230          ELSE 
    228              DO ji=1,jpi 
    229                 DO jj=1,jpj 
    230                    DO jk=1,jpk 
    231                        pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 
     231             DO jk=1,jpk 
     232                DO ji=1,jpi 
     233                   DO jj=1,jpj 
     234                      zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 
    232235                   ENDDO 
    233236                ENDDO 
    234237             ENDDO 
    235238          ENDIF 
    236           CALL iom_put( 'tnpeo', pe ) 
     239          CALL lbc_lnk(zpe, 'T', 1._wp)  
     240          CALL iom_put( 'tnpeo', zpe )           
    237241      ENDIF 
    238242      ! 
    239       CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
     243      CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, zpe ) 
    240244      CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    241245      CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 ) 
Note: See TracChangeset for help on using the changeset viewer.