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 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90 – NEMO

Ignore:
Timestamp:
2015-08-12T17:46:45+02:00 (9 years ago)
Author:
mattmartin
Message:

OBS simplification changes committed to branch after running SETTE tests to make sure we get the same results as the trunk for ORCA2_LIM_OBS.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90

    r2143 r5682  
    105105    IMPLICIT NONE 
    106106    ! 
    107     REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 
     107    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 
    108108    TYPE(Coordinates) :: Grid 
    109109    INTEGER :: i,j 
     
    134134       za0  = pa0 
    135135       za1  = pa1 
     136       za2  = pa2 
    136137       ! 
    137138    ELSE 
     
    147148 
    148149    zacr = ppacr 
    149     zkth = ppkth  
    150  
     150    zkth = ppkth 
     151    zacr2 = ppacr2 
     152    zkth2 = ppkth2    
    151153    ! 
    152154    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    153155    ! 
    154     DO i = 1,N 
    155        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    156        gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    157        e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    158        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    159     END DO 
     156    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     157       za1 = pphmax / FLOAT(N-1)  
     158       DO i = 1, N 
     159          gdepw(i) = ( i - 1   ) * za1 
     160          gdept(i) = ( i - 0.5 ) * za1 
     161          e3w  (i) =  za1 
     162          e3t  (i) =  za1 
     163       END DO 
     164    ELSE                            ! Madec & Imbard 1996 function 
     165       IF( .NOT. ldbletanh ) THEN 
     166          DO i = 1,N 
     167             !  
     168             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     169             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     170             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     171             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     172             ! 
     173          END DO 
     174       ELSE 
     175          DO i = 1,N 
     176             ! Double tanh function 
     177             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     178                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     179             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
     180                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
     181             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
     182                &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
     183             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     184                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     185            END DO 
     186       ENDIF 
     187    ENDIF 
    160188    ! 
    161189    gdepw(1) = 0.0 
    162190    zmax = gdepw(N) + e3t(N) 
    163     zmin = gdepw(4) 
     191    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
     192    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
     193    ENDIF 
     194    zmin = gdepw(i+1) 
    164195    ! 
    165196    IF ( .NOT. ASSOCIATED(Grid%bathy_level)) & 
     
    227258    IMPLICIT NONE 
    228259    ! 
    229     REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 
     260    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 
    230261    TYPE(Coordinates) :: Grid 
    231262    INTEGER :: i,j 
     
    257288       za0  = pa0 
    258289       za1  = pa1 
     290       za2  = pa2 
    259291       ! 
    260292    ELSE 
     
    264296       WRITE(*,*) 'please check values of variables' 
    265297       WRITE(*,*) 'in namelist vertical_grid section' 
    266        WRITE(*,*) ' ' 
    267        STOP       
     298       WRITE(*,*) ' '  
     299       STOP      
    268300       !        
    269301    ENDIF 
    270     ! 
     302 
    271303    zacr = ppacr 
    272     zkth = ppkth  
    273  
     304    zkth = ppkth 
     305    zacr2 = ppacr2 
     306    zkth2 = ppkth2    
    274307    ! 
    275308    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    276309    ! 
    277     DO i = 1,N 
    278        !  
    279        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    280        gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    281        e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    282        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    283     END DO 
     310    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     311       za1 = pphmax / FLOAT(N-1)  
     312       DO i = 1, N 
     313          gdepw(i) = ( i - 1   ) * za1 
     314          gdept(i) = ( i - 0.5 ) * za1 
     315          e3w  (i) =  za1 
     316          e3t  (i) =  za1 
     317       END DO 
     318    ELSE                            ! Madec & Imbard 1996 function 
     319       IF( .NOT. ldbletanh ) THEN 
     320          DO i = 1,N 
     321             !  
     322             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     323             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     324             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     325             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     326             ! 
     327          END DO 
     328       ELSE 
     329          DO i = 1,N 
     330             ! Double tanh function 
     331             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     332                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     333             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
     334                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
     335             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
     336                &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
     337             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     338                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     339         END DO 
     340       ENDIF 
     341    ENDIF 
    284342    ! 
    285343    gdepw(1) = 0.0   
     
    684742  ! for consistency with fine grid bathymetry         * 
    685743  !                        * 
    686   ! if a given coarse grid point is masked and one of the      * 
    687   ! child grid points contained in this coarse cell is not masked * 
    688   ! the corresponding coarse grid point is unmasked with gdepw(4) * 
    689   ! value                        * 
     744  ! if a given coarse grid point is masked and one of the     * 
     745  ! child grid points contained in this coarse cell is not masked * 
     746  ! the corresponding coarse grid point is unmasked with rn_hmin * 
     747  ! value                            * 
    690748  !                        * 
    691749  ! - input :                    * 
     
    704762    ! 
    705763    INTEGER :: ideb,jdeb,ifin,jfin 
    706     REAL*8 :: za1,za0,zsur,zacr,zkth,zmin 
     764    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin 
    707765    INTEGER :: i,j 
    708766    INTEGER :: k1 
     
    727785       za0  = pa0 
    728786       za1  = pa1 
     787       za2  = pa2 
    729788       ! 
    730789    ELSE 
     
    740799 
    741800    zacr = ppacr 
    742     zkth = ppkth  
    743  
     801    zkth = ppkth 
     802    zacr2 = ppacr2 
     803    zkth2 = ppkth2    
    744804    ! 
    745805    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    746806    ! 
    747     DO i = 1,N 
    748        !  
    749        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    750        gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    751        e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    752        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    753     END DO 
    754     ! 
    755     zmin = gdepw(4) 
     807    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     808       za1 = pphmax / FLOAT(N-1)  
     809       DO i = 1, N 
     810          gdepw(i) = ( i - 1   ) * za1 
     811          gdept(i) = ( i - 0.5 ) * za1 
     812          e3w  (i) =  za1 
     813          e3t  (i) =  za1 
     814       END DO 
     815    ELSE                            ! Madec & Imbard 1996 function 
     816       IF( .NOT. ldbletanh ) THEN 
     817          DO i = 1,N 
     818             !  
     819             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     820             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     821             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     822             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     823             ! 
     824          END DO 
     825       ELSE 
     826          DO i = 1,N 
     827             ! Double tanh function 
     828             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     829                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     830             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
     831                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
     832             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
     833                &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
     834             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     835                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     836          END DO 
     837       ENDIF 
     838    ENDIF 
     839    ! 
     840    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
     841    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
     842    ENDIF 
     843    zmin = gdepw(i+1) 
    756844    !       
    757845    diff = 0 
Note: See TracChangeset for help on using the changeset viewer.