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 8078 – NEMO

Changeset 8078


Ignore:
Timestamp:
2017-05-26T11:16:21+02:00 (7 years ago)
Author:
timgraham
Message:

#1884 fix in diaar5.F90 for calculation of tnpeo

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r7753 r8078  
    212212      ! Exclude points where rn2 is negative as convection kicks in here and 
    213213      ! 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 
     214         CALL wrk_alloc( jpi, jpj, zpe ) 
     215         zpe(:,:) = 0._wp 
     216         IF( ln_zdfddm ) THEN 
     217            DO jk = 2, jpk 
     218               DO jj = 1, jpj 
     219                  DO ji = 1, jpi 
     220                     IF( rn2(ji,jj,jk) > 0._wp ) THEN 
     221                        zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
     222                           &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
     223                        ! 
     224                        zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     225                        zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     226                        ! 
     227                        zpe(ji, jj) = zpe(ji, jj)            & 
     228                           &        -  grav * (    avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
     229                           &                   - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
     230                     ENDIF 
     231                  END DO 
     232               END DO 
     233             END DO 
    233234          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)          
    243           CALL iom_put( 'tnpeo', zpe ) 
    244           CALL wrk_dealloc( jpi, jpj, zpe ) 
     235            DO jk = 1, jpk 
     236               DO ji = 1, jpi 
     237                  DO jj = 1, jpj 
     238                     zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 
     239                  END DO 
     240               END DO 
     241            END DO 
     242         ENDIF 
     243         CALL lbc_lnk( zpe, 'T', 1._wp)          
     244         CALL iom_put( 'tnpeo', zpe ) 
     245         CALL wrk_dealloc( jpi, jpj, zpe ) 
    245246      ENDIF 
    246247      ! 
Note: See TracChangeset for help on using the changeset viewer.