New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 7931 for branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 – NEMO

Ignore:
Timestamp:
2017-04-19T12:15:07+02:00 (7 years ago)
Author:
gm
Message:

#1880 (HPC-09): remove key_zdfddm + phasing with last changes of HPC08 branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r7753 r7931  
    3939       
    4040   !! * Substitutions 
    41 #  include "zdfddm_substitute.h90" 
    4241#  include "vectopt_loop_substitute.h90" 
    4342   !!---------------------------------------------------------------------- 
     
    212211      ! Exclude points where rn2 is negative as convection kicks in here and 
    213212      ! work is not being done against stratification 
    214           CALL wrk_alloc( jpi, jpj, zpe ) 
    215           zpe(:,:) = 0._wp 
    216           IF( lk_zdfddm ) THEN 
    217              DO ji=1,jpi 
    218                 DO jj=1,jpj 
    219                    DO jk=1,jpk 
    220                       zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
    221                          &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
    222                       ! 
    223                       zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
    224                       zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
    225                       ! 
    226                       zpe(ji, jj) = zpe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 
    227                            &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
    228                            &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
    229  
    230                    ENDDO 
    231                 ENDDO 
    232              ENDDO 
     213         CALL wrk_alloc( jpi, jpj, zpe ) 
     214         zpe(:,:) = 0._wp 
     215         IF( ln_zdfddm ) THEN 
     216            DO jk = 2, jpk 
     217               DO jj = 1, jpj 
     218                  DO ji = 1, jpi 
     219                     IF( rn2(ji,jj,jk) > 0._wp ) THEN 
     220                        zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
     221                           &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
     222!!gm  this can be reduced to :  (depw-dept) / e3w   (NB idem dans bn2 !) 
     223!                        zrw =   ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 
     224!!gm end 
     225                        ! 
     226                        zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     227                        zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     228                        ! 
     229                        zpe(ji, jj) = zpe(ji, jj)            & 
     230                           &        -  grav * (  avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
     231                           &                   - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
     232                     ENDIF 
     233                  END DO 
     234               END DO 
     235             END DO 
    233236          ELSE 
    234              DO ji = 1, jpi 
    235                 DO jj = 1, jpj 
    236                    DO jk = 1, jpk 
    237                        zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 
    238                    ENDDO 
    239                 ENDDO 
    240              ENDDO 
    241           ENDIF 
    242           CALL lbc_lnk( zpe, 'T', 1._wp)          
     237            DO jk = 1, jpk 
     238               DO ji = 1, jpi 
     239                  DO jj = 1, jpj 
     240                     zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 
     241                  END DO 
     242               END DO 
     243            END DO 
     244         ENDIF 
     245!!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj 
     246!!gm           CALL lbc_lnk( zpe, 'T', 1._wp)          
    243247          CALL iom_put( 'tnpeo', zpe ) 
    244248          CALL wrk_dealloc( jpi, jpj, zpe ) 
Note: See TracChangeset for help on using the changeset viewer.