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 15548 for NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/DIA/diahth.F90 – NEMO

Ignore:
Timestamp:
2021-11-28T18:59:49+01:00 (3 years ago)
Author:
gsamson
Message:

update branch to the head of the trunk (r15547); ticket #2632

Location:
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk

    • Property svn:externals
      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 
  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/DIA/diahth.F90

    r13497 r15548  
    334334   SUBROUTINE dia_hth_htc( Kmm, pdep, pt, phtc ) 
    335335      ! 
    336       INTEGER , INTENT(in) :: Kmm      ! ocean time level index 
    337       REAL(wp), INTENT(in) :: pdep     ! depth over the heat content 
    338       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pt    
    339       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc   
    340       ! 
    341       INTEGER  :: ji, jj, jk, ik 
    342       REAL(wp), DIMENSION(jpi,jpj) :: zthick 
    343       INTEGER , DIMENSION(jpi,jpj) :: ilevel 
     336      INTEGER , INTENT(in) ::   Kmm      ! ocean time level index 
     337      REAL(wp), INTENT(in) ::   pdep     ! depth over the heat content 
     338      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)    ::  pt    
     339      REAL(wp), DIMENSION(jpi,jpj),     INTENT(inout) ::  phtc   
     340      ! 
     341      INTEGER  ::   ji, jj, jk, ik 
     342      REAL(wp), DIMENSION(jpi,jpj) ::   zthick 
     343      INTEGER , DIMENSION(jpi,jpj) ::   ilevel 
    344344 
    345345 
    346346      ! surface boundary condition 
    347347       
    348       IF( .NOT. ln_linssh ) THEN   ;   zthick(:,:) = 0._wp       ;   phtc(:,:) = 0._wp                                    
     348      IF( .NOT. ln_linssh ) THEN   ;   zthick(:,:) = 0._wp          ;   phtc(:,:) = 0._wp                                    
    349349      ELSE                         ;   zthick(:,:) = ssh(:,:,Kmm)   ;   phtc(:,:) = pt(:,:,1) * ssh(:,:,Kmm) * tmask(:,:,1)    
    350350      ENDIF 
    351351      ! 
    352352      ilevel(:,:) = 1 
    353       DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
    354          IF( ( gdept(ji,jj,jk,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN 
    355              ilevel(ji,jj) = jk 
     353      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     354         IF( ( gdepw(ji,jj,jk+1,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN 
     355             ilevel(ji,jj) = jk+1 
    356356             zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) 
    357357             phtc  (ji,jj) = phtc  (ji,jj) + e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk) 
     
    361361      DO_2D( 1, 1, 1, 1 ) 
    362362         ik = ilevel(ji,jj) 
    363          zthick(ji,jj) = pdep - zthick(ji,jj)   !   remaining thickness to reach depht pdep 
    364          phtc(ji,jj)   = phtc(ji,jj)    & 
    365             &           + pt (ji,jj,ik+1) * MIN( e3t(ji,jj,ik+1,Kmm), zthick(ji,jj) ) & 
    366                                                        * tmask(ji,jj,ik+1) 
     363         IF( tmask(ji,jj,ik) == 1 ) THEN 
     364            zthick(ji,jj) = MIN ( gdepw(ji,jj,ik+1,Kmm), pdep ) - zthick(ji,jj)   ! remaining thickness to reach dephw pdep 
     365            phtc(ji,jj)   = phtc(ji,jj) + pt(ji,jj,ik) * zthick(ji,jj) 
     366         ENDIF 
    367367      END_2D 
    368       ! 
    369368      ! 
    370369   END SUBROUTINE dia_hth_htc 
Note: See TracChangeset for help on using the changeset viewer.