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 14200 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/tests/DOME/MY_SRC/usrdef_istate.F90 – NEMO

Ignore:
Timestamp:
2020-12-17T15:36:44+01:00 (4 years ago)
Author:
mcastril
Message:

Merging r14117 through r14199 into dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/tests/DOME/MY_SRC/usrdef_istate.F90

    r14001 r14200  
    1515   USE par_oce        ! ocean space and time domain 
    1616   USE phycst         ! physical constants 
     17   USE eosbn2, ONLY: rn_a0 
    1718   ! 
    1819   USE in_out_manager ! I/O manager 
     
    2324 
    2425   PUBLIC   usr_def_istate   ! called by istate.F90 
    25  
     26   PUBlIC   usr_def_istate_ssh 
    2627   !!---------------------------------------------------------------------- 
    2728   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3435CONTAINS 
    3536   
    36    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     37   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3738      !!---------------------------------------------------------------------- 
    3839      !!                   ***  ROUTINE usr_def_istate  *** 
     
    5455      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5556      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    56       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5757      ! 
    5858      INTEGER  :: ji,jj,jk     ! dummy loop indices 
     
    7070      pu  (:,:,:) = 0._wp        ! ocean at rest 
    7171      pv  (:,:,:) = 0._wp 
    72       pssh(:,:)   = 0._wp 
    7372      pts(:,:,:,:) = 0._wp 
    7473      ! 
     
    10099               zf = 1._wp 
    101100            ENDIF    
    102             zrho1 = rho0*zn2*zdt/grav/0.2_wp 
     101            zrho1 = rho0*zn2*zdt/grav/rn_a0 
    103102            pts(ji,jj,jk,jp_tem) = (15._wp - zrho1) * ptmask(ji,jj,jk) 
    104103! Mass conserving initialization: 
    105 !            ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(0.2_wp*grav)*gdepw_0(ji,jj,jk+1)**2 
    106 !            ztu = 15._wp*gdepw_0(ji,jj,jk  )-0.5*rho0*zn2/(0.2_wp*grav)*gdepw_0(ji,jj,jk  )**2 
    107 !            pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk) 
     104            ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2 
     105            ztu = 15._wp*gdepw_0(ji,jj,jk  )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk  )**2 
     106            pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk) 
    108107            IF (Agrif_root().AND.(  mjg0(jj) == Nj0glo-2 ) )  THEN 
    109108               pv(ji,jj,jk) = -sqrt(zdb*zh0)*exp(-zxw/zro)*(1._wp-zf) * ptmask(ji,jj,jk) 
    110109            ENDIF 
    111110            IF (Agrif_root().AND.(  mjg0(jj) == Nj0glo-1 ) )  THEN 
    112                pts(ji,jj,jk,jp_tem) = MIN(pts(ji,jj,jk,jp_tem), 15._wp - zdb*rho0/grav/0.2_wp*(1._wp-zf)) * ptmask(ji,jj,jk)  
     111               pts(ji,jj,jk,jp_tem) = MIN(pts(ji,jj,jk,jp_tem), 15._wp - zdb*rho0/grav/rn_a0*(1._wp-zf)) * ptmask(ji,jj,jk)  
    113112               pts(ji,jj,jk,jp_sal) = 1._wp * ptmask(ji,jj,jk)  
    114113            ENDIF 
     
    118117   END SUBROUTINE usr_def_istate 
    119118 
     119   
     120   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     121      !!---------------------------------------------------------------------- 
     122      !!                   ***  ROUTINE usr_def_istate  *** 
     123      !!  
     124      !! ** Purpose :   Initialization of ssh 
     125      !!                Here DOME configuration  
     126      !! 
     127      !! ** Method  :   set no initial sea level anomaly 
     128      !!   
     129      !!---------------------------------------------------------------------- 
     130      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! 
     131      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! 
     132      ! 
     133      !!---------------------------------------------------------------------- 
     134      ! 
     135      pssh(:,:) = 0._wp 
     136      ! 
     137   END SUBROUTINE usr_def_istate_ssh 
     138 
    120139   !!====================================================================== 
    121140END MODULE usrdef_istate 
Note: See TracChangeset for help on using the changeset viewer.