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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/tests/BENCH/MY_SRC/usrdef_istate.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/tests/BENCH/MY_SRC/usrdef_istate.F90

    r10179 r13463  
    2828   PUBLIC   usr_def_istate   ! called by istate.F90 
    2929 
     30   !! * Substitutions 
     31#  include "do_loop_substitute.h90" 
    3032   !!---------------------------------------------------------------------- 
    3133   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    … …  
    5557      REAL(wp) ::   zfact 
    5658      INTEGER  ::   ji, jj, jk 
     59      INTEGER  ::   igloi, igloj   ! to be removed in the future, see comment bellow 
    5760      !!---------------------------------------------------------------------- 
    5861      ! 
    … …  
    6164      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
    6265      ! 
    63       ! define unique value on each point. z2d ranging from 0.05 to -0.05 
    64       DO jj = 1, jpj 
    65          DO ji = 1, jpi 
    66             z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 
    67          ENDDO 
    68       ENDDO 
     66      ! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05 
     67      ! 
     68      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     69      ! we must define z2d as bellow. 
     70      ! Once we decide to forget trunk compatibility, we must simply define z2d as: 
     71!!$      DO_2D( 0, 0, 0, 0 ) 
     72!!$         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) 
     73!!$      END_2D 
     74      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     75      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 
     76      DO_2D( 0, 0, 0, 0 ) 
     77         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 
     78      END_2D 
    6979      ! 
    7080      ! sea level: 
    7181      pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m 
    7282      ! 
    73       DO jk = 1, jpk 
     83      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    7484         zfact = REAL(jk-1,wp) / REAL(jpk-1,wp)   ! 0 to 1 to add a basic stratification 
    75          ! temperature choosen to lead to 20% ice 
    76          pts(:,:,jk,jp_tem) = 2._wp - 0.1_wp * zfact + z2d(:,:) * 100._wp ! 2 to 1.9 +/- 5 degG 
    77          WHERE ( pts(:,:,jk,jp_tem) < -1.5_wp ) pts(:,:,jk,jp_tem) = -1.5_wp + z2d(:,:) * 0.2_wp   
     85         ! temperature choosen to lead to ~50% ice at the beginning if rn_thres_sst = 0.5 
     86         pts(:,:,jk,jp_tem) = 20._wp*z2d(:,:) - 1._wp - 0.5_wp * zfact    ! -1 to -1.5 +/-1.0 degG 
    7887         ! salinity:   
    7988         pts(:,:,jk,jp_sal) = 30._wp + 1._wp * zfact + z2d(:,:)           ! 30 to 31 +/- 0.05 psu 
    8089         ! velocities: 
    81          pu(:,:,jk) = z2d(:,:) * 0.1_wp                                   ! +/- 0.005  m/s 
    82          pv(:,:,jk) = z2d(:,:) * 0.01_wp                                  ! +/- 0.0005 m/s 
    83       ENDDO 
     90         pu(:,:,jk) = z2d(:,:) *  0.1_wp * umask(:,:,jk)                  ! +/- 0.005  m/s 
     91         pv(:,:,jk) = z2d(:,:) * 0.01_wp * vmask(:,:,jk)                  ! +/- 0.0005 m/s 
     92      END_3D 
     93      pts(:,:,jpk,:) = 0._wp 
     94      pu( :,:,jpk  ) = 0._wp 
     95      pv( :,:,jpk  ) = 0._wp 
    8496      ! 
    8597      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 
    86       CALL lbc_lnk( 'usrdef_istate', pts, 'T',  1. )            ! apply boundary conditions 
    87       CALL lbc_lnk(  'usrdef_istate', pu, 'U', -1. )            ! apply boundary conditions 
    88       CALL lbc_lnk(  'usrdef_istate', pv, 'V', -1. )            ! apply boundary conditions 
     98      CALL lbc_lnk('usrdef_istate', pts, 'T',  1. )            ! apply boundary conditions 
     99      CALL lbc_lnk('usrdef_istate',  pu, 'U', -1. )            ! apply boundary conditions 
     100      CALL lbc_lnk('usrdef_istate',  pv, 'V', -1. )            ! apply boundary conditions 
    89101       
    90102   END SUBROUTINE usr_def_istate 
Note: See TracChangeset for help on using the changeset viewer.